#!/usr/local/bin/tclsh 
# ^^^^^^^^^^^^^^^^^^
# Edit this to match your path to tcl
#  actually tcl + tclX
#  
# ingest-master <html-file>
# 
# writes master.tcl output file
#
# 

# ----------------------------------------------------
#
# string_file --
#
# Functions to read and write strings from a file that has not been opened.
#------------------------------------------------------------------------------
# Copyright 1992-1993 Karl Lehenbauer and Mark Diekhans.
#
# Permission to use, copy, modify, and distribute this software and its
# documentation for any purpose and without fee is hereby granted, provided
# that the above copyright notice appear in all copies.  Karl Lehenbauer and
# Mark Diekhans make no representations about the suitability of this
# software for any purpose.  It is provided "as is" without express or
# implied warranty.
#------------------------------------------------------------------------------
# $Id: stringfile.tcl,v 3.0 1993/11/19 07:00:41 markd Rel $
#------------------------------------------------------------------------------
#

#@package: TclX-stringfile_functions read_file write_file

proc read_file {fileName args} {
    if {$fileName == "-nonewline"} {
        set flag $fileName
        set fileName [lvarpop args]
    } else {
        set flag {}
    }
    set fp [open $fileName]
    set stat [catch {
        eval read $flag $fp $args
    } result]
    close $fp
    if {$stat != 0} {
        global errorInfo errorCode
        error $result $errorInfo $errorCode
    }
    return $result
} 

proc write_file {fileName args} {
    set fp [open $fileName w]
    
    set stat [catch {
        foreach string $args {
            puts $fp $string
        }
    } result]
    close $fp
    if {$stat != 0} {
        global errorInfo errorCode
        error $result $errorInfo $errorCode
    }
}
# --------------------------------------------

proc outputit { fh words } {
        set debug 1
        if { $debug == 1 &&
             [catch { eval $words } msg]
                } then {
                puts stdout "EVAL-ERROR - $msg\n$words\n"
                flush stdout
                } else {
                puts $fh $words
                flush $fh
                }
        }

if { $argc != 2 } {
    puts stdout "Usage: munge-html <html-file> <tcl-file>"
    exit 1
}
set input [read_file [lindex $argv 0]]
set outfile [lindex $argv 1]

# strip off stuff before first <DL>
set start [expr [string first "<DL>" $input] - 1]
if { $start > -2 } then {
        set input [string range $input $start end]
        }

# strip off stuff after last </DL>
set end [expr [string last "</DL>" $input] -1]
if { $end > -2 } then {
        set input [string range $input 0 $end]
        }

write_file tmp-master.tcl $input

proc processdt { fh outh } {
        global url
        set line [gets $fh]
        set first [expr [string first "\"" $line]+1 ]
        set last [expr [string last "\"" $line]-1 ]
        set url [string range $line $first $last]
        set url [translit [list \  \n \r \t] {} $url]
        set line [gets $fh]
    puts $outh "\nurl: \{ $url \}"
#       puts $outh "\n\nset longtitle($url) \{ $line \}"
    puts $outh "longtitle: \{ $line \}"
        flush $outh
        while { [eof $fh] == 0 } {
                set line [gets $fh]
                if [string match "</DT>" $line] then {
                        return
                } elseif [string match "</A>" $line] then {
                        continue
                } elseif [string match "<!-- CATEGORY*" $line] then {
                        set last [expr [llength [split $line]]-2 ]
                        set value [join [lrange [split $line] 2 $last]]
                        if { [string length $value] > 0 } then {
#                               puts $outh "set category($url) \{ $value \}"
                            puts $outh "category: \{ $value \}"
                                flush $outh
                                }
                } elseif [string match "<!-- OWNER*" $line] then {
                        set last [expr [llength [split $line]]-2 ]
                        set value [join [lrange [split $line] 2 $last]]
                        if { [string length $value] > 0 } then {
#                               puts $outh "set owner($url) \{ $value \}"
                            puts $outh "owner: \{ $value \}"
                                flush $outh
                                }
                } else {
#                       puts $outh "set shorttitle($url) \{ $line \}"
                    puts $outh "shorttitle: \{ [string trim $line {()}] \}"
                        flush $outh
                        }
                }
        }

proc breakdescript { descr } {
    set retstr ""
    set wordcount 0
    set descr [string trim $descr]
    regsub -all \n $descr { } descr
    regsub -all {(\ )+} $descr { } descr
    foreach word [split [string trim $descr] "\ "] {
        append retstr "$word "
        incr wordcount
        if { $wordcount == 10 } {
            set wordcount 0
            append retstr "\n"
        }
    }
    return [string trim $retstr]
}
proc processdd { fh outh } {
        global url
        set descrip {}
        while { [eof $fh] == 0 } {
                set line [gets $fh]
                if [string match "</DD>" $line] then {
                        if { [string length $descrip] > 0 } then {
                                # Handle problem storing {'s and }'s
                                regsub -all \{ $descrip \\\{ out1
                                regsub -all \} $out1 \\\} descrip
#                               puts $outh "set description($url) \{ $descrip \} "
                                # handle HTTP escaped characters
                                regsub -all \& $descrip \\&amp\; descrip
                                regsub -all \< $descrip \\&lt\; descrip
                                regsub -all \> $descrip \\&gt\; descrip

                                puts $outh "description: \{ [breakdescript $descrip] \}"
                                flush $outh
                                }
                        return
                } else {
                        append descrip "$line "
                        }
                }
        }

set fh [open tmp-master.tcl r]
set outh [open $outfile w]

while { [eof $fh] == 0 } {
        set line [gets $fh]
        if { [string match "*DL>*" $line] 
             || [string match "*<HR>*" $line]
             || [string length $line] == 0
                } then {
                continue
        } elseif [string match "<DT>" $line] then {
                processdt $fh $outh
        } elseif [string match "<DD>" $line] then {
                processdd $fh $outh
        }
}

close $fh

close $outh

exec rm tmp-master.tcl