Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
| Comment: | 2011-04-28 Steve Huntley <[email protected]> * zipvfs.tcl: Added contributed patch to speed up zipvfs directory listing. See patch 3279418. |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | trunk |
| Files: | files | file ages | folders |
| SHA1: |
1267093049130608c70f608055717370 |
| User & Date: | blacksqr 2011-04-28 08:01:32 |
Context
|
2011-11-28
| ||
| 19:12 | 2011-11-28 Steve Huntley <[email protected]> * zipvfs.tcl: Reverted bug fix for 3224057. See bug ID 3303287. check-in: fdacfadbd2 user: blacksqr tags: trunk | |
|
2011-04-28
| ||
| 08:01 | 2011-04-28 Steve Huntley <[email protected]> * zipvfs.tcl: Added contributed patch to speed up zipvfs directory listing. See patch 3279418. check-in: 1267093049 user: blacksqr tags: trunk | |
|
2011-03-30
| ||
| 06:44 | 2011-03-30 Steve Huntley <[email protected]> * vfslib.tcl, zipvfs.tcl: Added contributed patches to fix bugs 3160686 & 3224057. check-in: d888143e47 user: blacksqr tags: trunk | |
Changes
Changes to ChangeLog.
1 2 3 4 5 6 7 |
2011-03-30 Steve Huntley <[email protected]> * vfslib.tcl, zipvfs.tcl: Added contributed patches to fix bugs 3160686 & 3224057. 2011-03-30 Steve Huntley <[email protected]> |
> > > > > |
1 2 3 4 5 6 7 8 9 10 11 12 |
2011-04-28 Steve Huntley <[email protected]> * zipvfs.tcl: Added contributed patch to speed up zipvfs directory listing. See patch 3279418. 2011-03-30 Steve Huntley <[email protected]um.mit.edu> * vfslib.tcl, zipvfs.tcl: Added contributed patches to fix bugs 3160686 & 3224057. 2011-03-30 Steve Huntley <[email protected]> |
Changes to library/zipvfs.tcl.
486 487 488 489 490 491 492 493 494 495 496 497 498 499 ... 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 ... 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 ... 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 |
set cb(base) [expr {wide($cb(base)) - 4294967296}]
set cb(coff) [expr {wide($cb(coff)) + 4294967296}]
}
}
proc zip::TOC {fd arr} {
upvar #0 zip::$fd cb
upvar 1 $arr sb
set buf [read $fd 46]
binary scan $buf A4ssssssiiisssssii hdr \
sb(vem) sb(ver) sb(flags) sb(method) time date \
sb(crc) sb(csize) sb(size) \
................................................................................
set sb(ino) [expr {wide($sb(ino)) + 4294967296}]
}
if {$sb(flags) & (1 << 11)} {
set sb(name) [encoding convertfrom utf-8 $sb(name)]
set sb(comment) [encoding convertfrom utf-8 $sb(comment)]
}
set sb(name) [string trimleft $sb(name) "./"]
}
proc zip::open {path} {
#vfs::log [list open $path]
set fd [::open $path]
if {[catch {
upvar #0 zip::$fd cb
upvar #0 zip::$fd.toc toc
fconfigure $fd -translation binary ;#-buffering none
zip::EndOfArchive $fd cb
seek $fd [expr {$cb(base) + $cb(coff)}] start
................................................................................
set toc(_) 0; unset toc(_); #MakeArray
for {set i 0} {$i < $cb(nitems)} {incr i} {
zip::TOC $fd sb
set sb(depth) [llength [file split $sb(name)]]
set name [string tolower $sb(name)]
set toc($name) [array get sb]
FAKEDIR toc [file dirname $name]
}
} err]} {
close $fd
return -code error $err
}
return $fd
}
proc zip::FAKEDIR {arr path} {
upvar 1 $arr toc
if { $path == "."} { return }
if { ![info exists toc($path)] } {
# Implicit directory
lappend toc($path) \
name $path \
type directory mtime 0 size 0 mode 0777 \
ino -1 depth [llength [file split $path]]
}
FAKEDIR toc [file dirname $path]
}
proc zip::exists {fd path} {
#::vfs::log "$fd $path"
if {$path == ""} {
return 1
} else {
................................................................................
return ""
}
# Treats empty pattern as asking for a particular file only
proc zip::getdir {fd path {pat *}} {
#::vfs::log [list getdir $fd $path $pat]
upvar #0 zip::$fd.toc toc
if { $path == "." || $path == "" } {
set path [set tmp [string tolower $pat]]
} else {
set globmap [list "\[" "\\\[" "*" "\\*" "?" "\\?"]
set tmp [string tolower $path]
set path [string map $globmap $tmp]
if {$pat != ""} {
append tmp /[string tolower $pat]
append path /[string tolower $pat]
}
}
# file split can be confused by the glob quoting so split tmp string
set depth [llength [file split $tmp]]
#vfs::log "getdir $fd $path $depth $pat [array names toc $path]"
if {$depth} {
set ret {}
foreach key [array names toc $path] {
if {[string index $key end] == "/"} {
# Directories are listed twice: both with and without
# the trailing '/', so we ignore the one with
continue
}
array set sb $toc($key)
if { $sb(depth) == $depth } {
if {[info exists toc(${key}/)]} {
array set sb $toc(${key}/)
}
lappend ret [file tail $sb(name)]
} else {
#::vfs::log "$sb(depth) vs $depth for $sb(name)"
}
unset sb
}
return $ret
} else {
# just the 'root' of the zip archive. This obviously exists and
# is a directory.
return [list {}]
}
}
proc zip::_close {fd} {
variable $fd
variable $fd.toc
unset $fd
unset $fd.toc
::close $fd
}
# Implementation of stream based decompression for zip
if {([info commands ::rechan] != "") || ([info commands ::chan] != "")} {
if {![catch {package require Tcl 8.6}]} {
# implementation using [zlib stream inflate] and [rechan]/[chan create]
|
> > > > > | > | | > > > | | | | > > > > > < > | < | < < < < | | > > > > | < | < < < < < < < < | < < > | < > > > > > > < < < < < < < < < > > > |
486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 ... 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 ... 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 ... 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 |
set cb(base) [expr {wide($cb(base)) - 4294967296}]
set cb(coff) [expr {wide($cb(coff)) + 4294967296}]
}
}
proc zip::TOC {fd arr} {
upvar #0 zip::$fd cb
upvar #0 zip::$fd.dir cbdir
upvar 1 $arr sb
set buf [read $fd 46]
binary scan $buf A4ssssssiiisssssii hdr \
sb(vem) sb(ver) sb(flags) sb(method) time date \
sb(crc) sb(csize) sb(size) \
................................................................................
set sb(ino) [expr {wide($sb(ino)) + 4294967296}]
}
if {$sb(flags) & (1 << 11)} {
set sb(name) [encoding convertfrom utf-8 $sb(name)]
set sb(comment) [encoding convertfrom utf-8 $sb(comment)]
}
set sb(name) [string trimleft $sb(name) "./"]
set parent [file dirname $sb(name)]
if {$parent == "."} {set parent ""}
lappend cbdir([string tolower $parent]) [file tail [string trimright $sb(name) /]]
}
proc zip::open {path} {
#vfs::log [list open $path]
set fd [::open $path]
if {[catch {
upvar #0 zip::$fd cb
upvar #0 zip::$fd.toc toc
upvar #0 zip::$fd.dir cbdir
fconfigure $fd -translation binary ;#-buffering none
zip::EndOfArchive $fd cb
seek $fd [expr {$cb(base) + $cb(coff)}] start
................................................................................
set toc(_) 0; unset toc(_); #MakeArray
for {set i 0} {$i < $cb(nitems)} {incr i} {
zip::TOC $fd sb
set sb(depth) [llength [file split $sb(name)]]
set name [string trimright [string tolower $sb(name)] /]
set sba [array get sb]
set toc($name) $sba
FAKEDIR toc cbdir [file dirname $name]
}
foreach {n v} [array get cbdir] {
set cbdir($n) [lsort -unique $v]
}
} err]} {
close $fd
return -code error $err
}
return $fd
}
proc zip::FAKEDIR {tocarr cbdirarr path} {
upvar 1 $tocarr toc $cbdirarr cbdir
if { $path == "."} { return }
if { ![info exists toc($path)] } {
# Implicit directory
lappend toc($path) \
name $path \
type directory mtime 0 size 0 mode 0777 \
ino -1 depth [llength [file split $path]]
set parent [file dirname $path]
if {$parent == "."} {set parent ""}
lappend cbdir($parent) [file tail $path]
}
FAKEDIR toc cbdir [file dirname $path]
}
proc zip::exists {fd path} {
#::vfs::log "$fd $path"
if {$path == ""} {
return 1
} else {
................................................................................
return ""
}
# Treats empty pattern as asking for a particular file only
proc zip::getdir {fd path {pat *}} {
#::vfs::log [list getdir $fd $path $pat]
upvar #0 zip::$fd.toc toc
upvar #0 zip::$fd.dir cbdir
if { $path == "." || $path == "" } {
set path ""
} else {
set path [string tolower $path]
}
if {$pat == ""} {
if {[info exists cbdir($path)]} {
return [list $path]
} else {
return [list]
}
}
set rc [list]
if {[info exists cbdir($path)]} {
if {$pat == "*"} {
set rc $cbdir($path)
} else {
foreach f $cbdir($path) {
if {[string match -nocase $pat $f]} {
lappend rc $f
}
}
}
}
return $rc
}
proc zip::_close {fd} {
variable $fd
variable $fd.toc
variable $fd.dir
unset $fd
unset $fd.toc
unset $fd.dir
::close $fd
}
# Implementation of stream based decompression for zip
if {([info commands ::rechan] != "") || ([info commands ::chan] != "")} {
if {![catch {package require Tcl 8.6}]} {
# implementation using [zlib stream inflate] and [rechan]/[chan create]
|