package provide app-dbfhtml 1.0 if {[info exists starkit::topdir]} { set pkg_home $starkit::topdir } \ else { set pkg_home [pwd] } package require dbf proc htmlentities {string} { return "[string map {> > < < & &} $string]" } if {$argc > 0} { set input_file [lindex $argv 0] set output_file [file rootname $input_file].html set out [open $output_file w] if {[dbf d -open $input_file -readonly]} { puts $out "" puts $out "" puts $out "" puts $out " Information about $input_file" puts $out " " puts $out "" puts $out "" puts $out "

Information about $input_file

" set nr [lindex [$d info] 0] set nf [lindex [$d info] 1] puts $out "
" puts $out " " puts $out " " puts $out " " puts $out " " puts $out " " puts $out " " puts $out " " puts $out " " puts $out " " puts $out " " puts $out " " puts $out "
Records$nr
Fields$nf
" puts $out "
" set fields [$d fields] puts $out "

Field information

" puts $out "
" puts $out " " puts $out " " puts $out " " puts $out " " puts $out " " puts $out " " puts $out " " puts $out " " puts $out " " puts $out " " puts $out " " puts $out " " foreach field $fields { set label [lindex $field 0] set type [lindex $field 1] set native [lindex $field 2] set width [lindex $field 3] set prec [lindex $field 4] set longest "" set tr " " if {[string equal $native "C"]} { set longest 0 foreach value [$d values $label] { set n [string length [string trimright $value]] if {$n > $longest} { set longest $n } } if {$longest == $width && $width > 253} { set tr " " } } puts $out $tr puts $out " " puts $out " " puts $out " " puts $out " " puts $out " " puts $out " " puts $out " " } puts $out " " puts $out "
LabelTypeNativeWidthPrecisionLongest
$label$type$native$width$prec$longest
" puts $out "
" puts $out "

Record information

" puts $out "
" puts $out " " puts $out " " puts $out " " foreach field $fields { set label [lindex $field 0] puts $out " " } puts $out " " for {set i 0} {$i < $nr} {incr i} { puts $out " " set data [$d record $i] for {set j 0} {$j < $nf} {incr j} { set value [lindex $data $j] set native [lindex [lindex $fields $j] 2] set width [lindex [lindex $fields $j] 3] if {[string length $value] > 0} { if {[string equal $native N]} { puts $out " " } \ else { if {$width > 253 && [string length [string trimright $value]] == $width} { puts $out " " } \ else { puts $out " " } } } \ else { if {[string equal $native N]} { puts $out " " } \ else { puts $out " " } } } puts $out " " } puts $out " " puts $out "
$label
$value[htmlentities $value][htmlentities $value](empty)(empty)
" puts $out "
" set today [clock format [clock seconds] -format "%d-%b-%Y"] set now [clock format [clock seconds] -format "%H:%M:%S"] puts $out "
" puts $out "Generated by dbfhtml.tcl on $today at $now from $input_file" puts $out "
" puts $out "" puts $out "" close $out $d close } \ else { puts "Error: could not open input file $input_file" exit 1 } } \ else { puts "Program to generate an HTML representation of a DBF file" puts "Usage: Name the DBF file on the command line" exit 0 }