# Usage: ar.tcl <opts> <archive> ?<files>?
#
#   <opts> : -c   create archive of specified files
#            -t   show table of contents
#            -x   extract specified files of all if non are specified

set aropt [lindex $argv 0]
set arfnm [lindex $argv 1]
set archs [lrange $argv 2 end]

if {$aropt eq "-c"} {

    set arf [open $arfnm w]
    fconfigure $arf -encoding binary -translation binary
    
    puts -nonewline $arf "!<arch>\n"
    
    set strtable ""
    
    foreach fnm $archs {
        file stat $fnm fstat
        set nm [file tail $fnm]
        if {[string length $nm] > 15} {
            set stroffset($fnm) [string length $strtable]
            append strtable $nm/\n
        }
    }
    
    if {[string length $strtable]} {
        puts -nonewline $arf [format %-16s //]
        puts -nonewline $arf [format %-12s ""]
        puts -nonewline $arf [format %-6s ""]
        puts -nonewline $arf [format %-6s ""]
        puts -nonewline $arf [format %-8s ""]
        set sl [string length $strtable]
        if {[string length $strtable] % 2} {
            incr sl
        }
        puts -nonewline $arf [format %-10s $sl]
        puts -nonewline $arf "`\n"
        puts -nonewline $arf $strtable
        if {[tell $arf] % 2} {
            puts -nonewline $arf "\n"
        }
    }
    
    foreach fnm $archs {
        file stat $fnm fstat
        set nm [file tail $fnm]
        if {[string length $nm] > 15} {
            puts -nonewline $arf [format %-16s /$stroffset($fnm)]
        } else {    
            puts -nonewline $arf [format %-16s $nm/]
        }
        puts -nonewline $arf [format %-12s $fstat(mtime)]
        puts -nonewline $arf [format %-6s $fstat(uid)]
        puts -nonewline $arf [format %-6s $fstat(gid)]
        puts -nonewline $arf [format %-8o $fstat(mode)]
        puts -nonewline $arf [format %-10s $fstat(size)]
        puts -nonewline $arf "`\n"
        set df [open $fnm r]
        fconfigure $df -encoding binary -translation binary
        fcopy $df $arf
        close $df
        if {$fstat(size) % 2} {
            puts -nonewline $arf "\n"
        }
    }

    close $arf

} elseif {$aropt eq "-t" || $aropt eq "-x"} {

    set strtable ""

    set arf [open $arfnm r]
    fconfigure $arf -encoding binary -translation binary
    
    set magic [read $arf 8]
    if {$magic != "!<arch>\n"} {
        return -code error "This is not an archive. Invalid magic number."
    }

    while { 1 } { 
        set ar_name [string trim [read $arf 16] " "]
        if {[eof $arf]} {
            break
        }
        set ar_date [read $arf 12]
        set ar_uid  [read $arf 6]
        set ar_gid  [read $arf 6]
        set ar_mode [read $arf 8]
        set ar_size [read $arf 10]
        set ar_fmag [read $arf 2]
        if {$aropt eq "-t"} {
            if {$ar_name ne "//"} {
                if {[string match "/*" $ar_name]} {
                    set sidx [string range $ar_name 1 end]
                    set eidx [string first "/" $strtable $sidx]
                    puts [string range $strtable $sidx $eidx-1]
                } else {
                    puts [string trim $ar_name "/"]
                }
            }
        }
        set dta [read $arf $ar_size]
        if {$ar_name eq "//"} {
            set strtable $dta
        }
        if {$aropt eq "-x" && ([llength $archs] == 0 || [lsearch -exact $archs [string trim $ar_name "/"]] >= 0)} {
            set df [open $ar_name w]
            fconfigure $df -encoding binary -translation binary
            puts -nonewline $df $dta
            close $df
        }
        if {$ar_size % 2} {
            read $arf 1
        }
    }

    close $arf
}