TclVFS

Check-in [b3589b4476]
Login
Bounty program for improvements to Tcl and certain Tcl packages.

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Fix for zipvfs not preserving missing directories' upper case characters.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: b3589b4476858673781ae6e7b836d175c4ef4830
User & Date: zoro2 2014-03-10 11:39:33
Context
2014-03-10
11:40
Fix for #92 vfs::zip unable to read zip archives with wrong modes check-in: e12c3ee732 user: zoro2 tags: trunk
11:39
Fix for zipvfs not preserving missing directories' upper case characters. check-in: b3589b4476 user: zoro2 tags: trunk
2013-02-05
13:18
2013-02-05 Wojciech Kocjan <[email protected]> * library/zipvfs.tcl: vfs::zip unable to read zip archives with wrong modes, bug 3603414 check-in: 811432f961 user: zoro2 tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to library/zipvfs.tcl.

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
601
602
603
604
605
606
607
608
609
610
611
612
	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 {






>


|


|












|


>

<




|





|

|







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
601
602
603
604
605
606
607
608
609
610
611
612
613
	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 origname [string trimright $sb(name) /]
	    set sb(depth) [llength [file split $sb(name)]]
	    
	    set name [string tolower $origname]
	    set sba [array get sb]
	    set toc($name) $sba
	    FAKEDIR toc cbdir [file dirname $origname]
	}
	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 origpath} {
    upvar 1 $tocarr toc $cbdirarr cbdir

    set path [string tolower $origpath]
    if { $path == "."} { return }


    if { ![info exists toc($path)] } {
	# Implicit directory
	lappend toc($path) \
		name $origpath \
		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 $origpath]
    }
    FAKEDIR toc cbdir [file dirname $origpath]
}

proc zip::exists {fd path} {
    #::vfs::log "$fd $path"
    if {$path == ""} {
	return 1
    } else {