#! /bin/sh
#
# Regenerate all the .html files from the .tml files in a given tree
# (features: avoids sym links loops, do a width first traversal, 
#  deals with all kind of potential errors, etc ...), based on checkrec -- dl
#
# SCCS: @(#) tml2html 1.13 98/01/23 17:46:50
#
# restart with tclsh \
exec tclsh8.0 $0 "$@"

#
# Recursive directory traversal utility, with link loop checking/detection:
#
set pwd [pwd]
proc checkLoop {dir} {
    global done pwd
    set fdir [file join $pwd $dir]
    if {[catch {cd $fdir} msg] || [catch {set rdir [pwd]} msg]} {
	puts stderr "$dir can't check $dir ($fdir:$msg)"
	cd $pwd
	return 1
    }
    cd $pwd
    if {[info exists done($rdir)]} {
	puts stderr "$dir already seen (= $rdir -> $done($rdir))\
		(sym link loop ?), skipping"
	return 1
    }
    set done($rdir) $dir
    return 0
}

proc doDir {dir} {
    global verbose
    if {$verbose} {
	puts "in $dir"
    }
    if {[checkLoop $dir]} {
	return
    }
    foreach sub [glob -nocomplain -- [file join $dir *]] {
	doOne $sub
    }
}

proc doOne {filename} {
    global links verbose
#    puts "doOne($filename)"
    if {(!$links) && ([file type $filename]=="link")} {
	if {$verbose} {
	    puts "skipping link $filename"
	}
	return
    }
    if {[file isdirectory $filename]} {
	# Skip SCCS dirs
	if {[string compare [file tail $filename] "SCCS"]} {
	    lappend ::doList $filename
	}
    } elseif {[doMatch? $filename]} {
	doFile $filename
    }
}

proc doMatch? {filename} {
    # Is a .tml and is not a ,* file
    expr {([string compare [string tolower [file extension $filename]]\
	    ".tml"] == 0) && (![string match ",*" [file tail $filename]])}
}

proc doFile {srcFilename} {
    global force verbose weblint setPerm mode

    set dstFilename "[file rootname $srcFilename].html"
    if {[file exists $dstFilename] && !$force} {
	if {[file mtime $dstFilename]  > [file mtime $srcFilename]} {
	    puts stderr "skipping \"$srcFilename\" (older\
		    then \"$dstFilename\")"
	    return
	}
    }

    if {$verbose} {
	puts stdout "starting $srcFilename -> $dstFilename"
    }
    if {[catch {open $srcFilename r} fs]} {
	puts stderr "skipping \"$srcFilename\" (read error $fs)"
	return
    }
    set what [read $fs]
    close $fs
    set ret [catch {doSubst $srcFilename $dstFilename $what} res]
    if {$ret} {
	if {$ret==1} {
	    puts stderr "ERROR substituting \"$srcFilename\": $res"
	    if {$verbose} {
		puts stderr "($::errorInfo)"
	    }
	}
	return
    }
    if {$setPerm && [file exists $dstFilename]} {
	if {[catch {file delete $dstFilename} msg]} {
	    puts stderr $msg
	}
     }
    if {[catch {open $dstFilename w} fd]} {
	puts stderr "skipping \"$dstFilename\" (write error $fd)"
	return
    }
    puts -nonewline $fd $res
    close $fd
    if {$setPerm} {
	if {[catch {file attributes $dstFilename -permissions $mode} msg]} {
	    puts stderr $msg
	}
    }
    if {$weblint} {
	if {[catch {exec weblintTcl $dstFilename} res]} {
	    regsub "\nchild process exited abnormally\$" $res {} res
	    puts "Weblint Warnings:\n$res"
	} else {
	    if {[string length $res]} {
		puts "Weblint Output:\n$res"
	    }
	}
    }
    puts "DONE $srcFilename -> $dstFilename"
    
}

proc doSource {interp idir} {
    global verbose
    set fname [file join $idir .tml]
    if {[file exist $fname]} {
	if {$verbose} {
	    puts "sourcing $fname"
	}
	interp eval $interp [list source $fname]
    } else {
	if {$verbose} {
	    puts "no $fname"
	}
    }
}

proc doSubst {srcFilename dstFilename string} {
    global interp root rootPattern rootLength errorCode errorInfo
    if {![string match $rootPattern $srcFilename]} {
	puts stderr "ERROR \"$srcFilename\" does not match \"$rootPattern\""
	return -code break
    }
    # Compute the stuff
    set idir $root
    set toDo "doSource $interp $idir;"
    set dir [file dirname $srcFilename]
    set relRoot ""
    set url "/"
    foreach sdir [lrange [file split $dir] $rootLength end] {
	set idir [file join $idir $sdir]
	append toDo "doSource $interp $idir;"
	append relRoot ../
	append url $sdir/
    }
    append url [file tail $dstFilename]
    interp eval $interp {catch {unset page}}
    interp eval $interp [list array set page [list \
	dynamic 0 \
	root    $relRoot \
	filename $dstFilename \
	template $srcFilename \
	url $url \
	]]
    eval $toDo
    set ret [catch {interp eval $interp [list subst $string]} res]
    if {$ret==1 && $errorCode=="IGNORE"} {
	puts stderr "warning \"$srcFilename\": $res (ignored, skipping file)"
	return -code break
    }
    #
    if {(![catch {interp eval $interp {set page(dynamic)}} dyn]) && ($dyn)} {
	puts stderr "\"$srcFilename\": skipped, dynamic"
	return -code break
    }
    return -code $ret -errorinfo $errorInfo $res
}

# unix/win only, minimal.
proc canonalize {path} {
    while {[regsub -all {/\./} $path {/} path]} {
	# empty body
    }
    regsub {/\.$} $path {/} path
    return $path
}

set doList {}
#set force 0
#set root .

proc Lvarpop {listName} {
    upvar 1 $listName list
    set res [lindex $list 0]
    set list [lreplace $list 0 0]
    return $res
}

package require opt 0.1

if {[catch {::tcl::OptParse {
    {-root -path ./ "Server document root"}
    {-force "Force generation"}
    {-weblint "Launch weblint on each processed file"}
    {-autopath -list {} "List of directories to add to the auto path"}
    {-verbose "be verbose"}
    {-nolinks "don't follow links"}
    {-setPerm "Set permissions on the files (chmod)"}
    {-mode 0666 "Permission Mode to use if setting permissions"}
    {?target? -path ./ "File or directory to process"}
    {args -list {} "additional targets"}
} $argv} msg]} {
    puts stderr "[file tail $argv0]: $msg"
    exit 1
}



set root [canonalize $root]
set links [expr {!$nolinks}]

set argv [concat [list $target] $args]

puts "force=$force, weblint=$weblint, root=$root, verbose=$verbose, links=$links, setPerm=$setPerm, mode=$mode, new argv=($argv)"

foreach d $autopath {
    lappend auto_path $d
}
lappend auto_path [file join $root libtml]

puts "auto_path=($auto_path)"


if {![file isdirectory $root]} {
    puts stderr "[file tail $argv0]: document root \"$root\" must\
	    be a directory!"
    exit 2
}

set interp [interp create]
interp eval $interp [list set auto_path $auto_path]

#interp eval $interp {package require tml 1.0}

if {[file pathtype $root] == "relative"} {
    set absolute 0
} else {
    set absolute 1
}

set rootPattern [file join $root *]
set rootLength [llength [file split $root]]

foreach f $argv {
    if {$absolute} {
	set f [canonalize [file join $pwd $f]]
    } else {
	set f [canonalize [file join ./ $f]]
    }
    doOne $f
}

while {[llength $doList]} {
    doDir [Lvarpop doList]
}

puts "All done!"
