Version 24 of CGI script to edit csv file

Over the last days, the script has become more complex and unreadable but also more powerfull.... It is unlikely yet that someone ever will understand the code. But for now, it works!

Here are three examples of what it's all about:

Showing a table
Editing a row of that table, optionally with column-dependent select-boxes to offer predefined values
Inserting a date via calendar-popup

With this CGI script your are able to edit predefined standard csv files over the web, using your web browser. It is not possible to add or delete columns (what means: the file structure is fix), but to add new rows, delete rows, edit cells and sort in ascending or descending order. As an addition, a cool javascript is used to choose dates from a popup calendar (see the noted web reference for more details). To declare a field as a date field, simply add @date as the last word in it and the see what happens after klicking edit again... To generate a Link in a cell, use LinkName url @link-notation. To show it bold, add @bold (other gimmicks not to mention...).

To install the script and make it work:

Download the following script and copy it to some location below your cgi-bin
Optionally download the DatePopup-Javascript-Routines and install them under httproot/jscalendar-1.0 (or to another location, but then you must alter the source ;-)
create a standard csv file (that is, fields surrounded with Doublequotes and separated by commas), e.g. with Excel or - much better ;-) - with OpenOffice - somewhere in your http-tree
point your browser to .../cgi-bin/csvedit.tcl?file=[path/]yourcsvfile (file relative to script path!) (optional args may follow, like sort...)
of course, your webserver must be able to run CGI scripts coded in tcl... (what about tclhttpd ;-?)
optionally, you can create a csvname.rc-file which holds special configuration options. Such a file is shown at the very bottom but it's format is again not documented (as usual...;-)

The scripts create a file.bak before each write access and stores deleted records to file.log.

I implemented a simple todo-list with this script... (that's the original reason I started to wrote it).

 #===============================================================================
 # CSVEdit 0.4 (c) M.Hoffmann 2006
 # 31.03.2006
 # ToDo/Bugs:
 # - CSS für EditElemente (Input, Button) werden vom IE ignoriert...
 # - evtl. Bubble-Help für Vollanzeige benutzen, oder Klick auf Details ganz
 #   rechts zeigt VollText unten etc.
 # - Statt input type=text immer textarea verwenden; Anzeige wahlweise EXPANDen
 #   = nowrap entfernen o.ä.; NOWRAP konfigurierbar machen + WIDTH
 # - Sortfeld ist manchmal nicht gesetzt? (defsort)
 # - SORT-Chaos: tw. stimmen Requested_Positions nicht ??? (Del) ???
 # - BACKLink-Handling ist definitiv mackig! <<<<<<<<< ???
 # - Statistik ausgeben (Anzahl Sätze etc.)
 # - Mehrere Sortierfelder (Datum, PRIO) - aber nicht per Interface (geht nicht
 #   von Haus aus mit LSORT, daher komplex)
 # - Vor ÄNDERUNG auch LOGGEN
 # - Bei EDIT POSITIONIEREN; IST DAS MÖGLICH?! # geht nicht in CGI-URLs!? evtl.
 #   über JS:focus (aber: welches Ziel?)
 # - NOSCRIPT-Auswertung! Wenn JS=OFF, Direkter DEL button
 # - LfdNr als eigene Spalte mitführen/nur anzeigen?
 #   Rückgängigmachen der Sortierung!?
 # - Wahlweise später: Insert_Before, _After, MoveUp/Dn etc. - ein ganzes Muster
 #   an Befehlen ist in der rechten Spalte denkbar! (aber nur mit Sequenz-Vor-
 #   haltung)
 # - Fehlerausstieg bei fehlender Datei und an anderen Stellen!
 # - Farbe Spaltenkopf setzen, je nachdem ob Sortcolumn (statt *)
 # - DefaultSortOrder über Profil einstellbar machen
 # - Reset()-Button
 # - mehrere Links mit @link handeln
 # - Zeilen mit @date-Einträgen in der Vergangenheit -> überfällig (markieren)?
 # - Farben konfigurierbar
 # - über Defaults (maximale) Feldlängen einstellbar machen
 # - deforder wieder rausgenommen, da bereits zuvor sortiert wird
 # - Alternatives Editieren im 'FullScreen/Dialog'-Modus
 # - Diese Idee für einen generischen INIEditor nutzen!
 # - Löschen muss INDIREKT erfolgen, damit POS gesetzt ist!
 #===============================================================================

 package require ncgi;     # tcllib
 package require html;     # tcllib
 package require csv;      # tcllib
 package require lock;     # http://wiki.tcl.tk/15173
 package require readprof; # http://wiki.tcl.tk/12647

 #-------------------------------------------------------------------------------

 # Einträge für <head>
 proc addToHead {} {
    puts {
       <style type="text/css">
          <!--
          @media screen {
             body   { font-family:Tahoma,"Trebuchet Ms",Verdana,"Lucida Sans Unicode","MS Sans Serif",Arial;
                      font-size:8pt; line-height:10pt;
                      color: #000; margin-left: 1%; margin-right: 1%; margin-top: 1%; }
          }
          @media print  {
             body   { font-family:"Trebuchet Ms",Verdana,Tahoma,"Lucida Sans Unicode","MS Sans Serif",Arial;
                      font-size:7pt; line-height:9pt;
                      color: #000; margin-left: 1%; margin-right: 1%; margin-top: 1%; }
          }
          a:link       { text-decoration:none; font-weight:bold; color:blue; }
          a:visited    { text-decoration:none; font-weight:bold; color:purple; }
          a:hover      { text-decoration:none; font-weight:bold; color:white; background-color:blue; }
          a:active     { text-decoration:none; font-weight:bold; color:purple; }
          a:focus      { text-decoration:none; font-weight:bold; color:purple; }
          td           { font-family:Tahoma,"Trebuchet Ms",Verdana,"Lucida Sans Unicode","MS Sans Serif",Arial;
                         font-size:8pt; line-height:10pt;
                         color: #000; margin-left: 1%; margin-right: 1%; margin-top: 1%; }
          th           { font-family:Tahoma,"Trebuchet Ms",Verdana,"Lucida Sans Unicode","MS Sans Serif",Arial;
                         font-size:8pt;  line-height:10pt; font-weight: bold;
                         color: #000; margin-left: 1%; margin-right: 1%; margin-top: 1%; }
          input[type=submit], input[type=reset], input[type=button]
                       { font-size:7pt; font-weight:bold; }
          input[type=text]
                       { font-size:8pt; background-color:lightpink; }
          select       { font-size:8pt; background-color:antiquewhite; }
          -->
       </style>
    }
    # Pfad noch variabel gestalten, nur wenn existent, einbinden; bei noscript überspringen!
    # muss eigentlich nur im EDITMODE eingebunden werden!! Siehe http://dynarch.com/mishoo/
    puts {
      <!-- --------------------------------- -->
      <!-- Einbindung der Kalenderfunktionen -->
      <!-- --------------------------------- -->
      <!-- calendar stylesheet -->
      <link rel="stylesheet" type="text/css" media="all" href="/jscalendar-1.0/calendar-tas.css" title="tas" />
      <!-- main calendar program -->
      <script type="text/javascript" src="/jscalendar-1.0/calendar.js"></script>
      <!-- language for the calendar -->
      <script type="text/javascript" src="/jscalendar-1.0/lang/calendar-de.js"></script>
      <!-- the following script defines the Calendar.setup helper function, which makes
           adding a calendar a matter of 1 or 2 lines of code. -->
      <script type="text/javascript" src="/jscalendar-1.0/calendar-setup.js"></script>
    }
 }
 # Baut Argumentliste für Links auf: link?var1=value1&var2=value2...
 proc makeLink {title args} {
    lappend args file $::file sort $::sort order $::order back $::back readonly $::readonly mtime $::mtime
    foreach {p v} $args {lappend ret $p=[ncgi::encode $v]}
    return "<a href=\"[ncgi::urlStub]?[join $ret &]\">$title</a>"
 }
 # dito, aber ohne <a href="..."></a>
 # später dies beides Verschachteln, um doppelten Code zu sparen!
 proc makeLink1 args {
    lappend args file $::file sort $::sort order $::order back $::back readonly $::readonly mtime $::mtime
    foreach {p v} $args {lappend ret $p=[ncgi::encode $v]}
    return [ncgi::urlStub]?[join $ret &]
 }
 # Baut Argumentliste für Links auf: link?var1=value1&var2=value2..., aber OHNE ORDER UND SORT
 proc makeLink2 {title args} {
    lappend args file $::file back $::back readonly $::readonly mtime $::mtime
    foreach {p v} $args {lappend ret $p=[ncgi::encode $v]}
    return "<a href=\"[ncgi::urlStub]?[join $ret &]\">$title</a>"
 }
 # Setzt globale Variablen aus gleichnamigen CGI-Vars, falls fehlend mit Vorgaben
 # es fehlt: Range-Check!
 proc readVars args {
    foreach {varname default} $args {
       set temp [ncgi::value $varname]
       set ::$varname [expr {[string length $temp] ? $temp : $default}]
    }
 }
 # Hidden-Inputfelder erzeugen (muss $value ESCAPEd werden???)
 proc makeHidden args {
    foreach {varname value} $args {
       puts "<input type=\"hidden\" name=\"$varname\" value=\"[quote $value]\">"
    }
 }
 # (einige) HTML-Sonderzeichen umsetzen, siehe auch http://wiki.tcl.tk/13008
 proc quote in {
      return [string map \
         {ä &auml; Ä &Auml; ö &ouml; Ö &Ouml; ü &uuml; Ü &Uuml; ß &szlig;} \
         [html::quoteFormValue $in]]
 }
 # "überlange" Anzeigen b.a.W. abkürzen, später optional expandable! I.d.Z.: kann CSV \n speichern?
 proc shortenCell {ix cellIn} {
     if {$::debug == 1} {
        puts "shortenCell "
     }
     set mW $::opts(maxDisplayWidth_$ix)
     if {$::debug == 1} {
        puts "mw := $mW | actLen := [string length $cellIn]<br>"
     }
     if {[string length $cellIn] > $mW} {
        incr mW -4; # Achtung: bedingt mindestwert > 4!
        return "[string range $cellIn 0 $mW]..."
     } else {
        return $cellIn
     }
 }
 # ggF. Spezialcodes in Zellen umsetzen, 1. Versuch
 proc formatCell {ix cellIn} {
     if {[lindex $cellIn end] == {@link}} {
        # name ziel @link; später erweitern: mehrere Name-Link-Paare
        return "<a href=\"[lindex $cellIn 1]\">[quote [shortenCell $ix [lindex $cellIn 0]]]</a>"
     } elseif {[lindex $cellIn end] == {@date}} {
        # ACHTUNG: dieser Code ist abgestimmt auf das 'ifFormat'!!!
        foreach {Y m d} [split [lindex $cellIn 0] .] {}
        set temp "$d.$m.$Y"; if {[string range $temp 0 1] == ".."} {return [lindex $cellIn 0]} else {return $temp}
     } elseif {[lindex $cellIn end] == "@bold"} {
        set bPos [string last " @bold" $cellIn]; incr bPos -1
        return "<b>[quote [shortenCell $ix [string range $cellIn 0 $bPos]]]</b>"
     } else {
        return [quote [shortenCell $ix $cellIn]]
     }
 }
 # Javascriptcode für Datumsauswahlbutton erzeugen/stacken, siehe http://dynarch.com/mishoo/
 proc pushJSDate id {
    append ::jsCode "
       <script type=\"text/javascript\">
          Calendar.setup({
             inputField : \"$id\",            // id of the input field
             ifFormat   : \"%Y.%m.%d @date\", // format of the input field
             showsTime  : false,              // will display a time selector (später nur TRUE, wenn Format ZEIT enthält!)
             button     : \"${id}_b\",        // trigger for the calendar (button ID)
             singleClick: true,               // double-click mode
             step       : 1                   // show all years in drop-down boxes (instead of every other year as default)
          });
       </script>
    \n"
 }
 # Farbe zeilenweise umschalten, Test
 proc toggleColor {} {
      global lineColor
      if {$lineColor == "#fffacd"} {
         set lineColor "white"
      } else {
         set lineColor "#fffacd"
      }
      return $lineColor
 }
 # Some important security feature: don't allow editing arbitrary files!
 # prevent from leaving the http-root! Paths are always relative to script's
 # [pwd], but can contain dir(s). Don't note error if spec is absolute.
 proc relFile file {
     if {[string range $file 1 1] == ":"} {set file [string replace $file 0 1]}; # MS-Win
     set file [string trimleft $file {./\\}]; # remove problematic chars
     return $file
 }
 # primitive AbortHandler (don't care about open html-tags...)
 proc abort {args} {
    puts "<p><table align=\"center\" bgcolor=\"silver\" border=\"3\" width=\"50%\" \
     cellpadding=\"5\" frame=\"box\" height=\"30%\">\n
     <tr><th align=\"left\" height=\"10%\">Fehler:</th></tr>\n
     <tr><td align=\"left\" valign=\"top\">[join $args]</td></tr>\n
     <tr><td align=\"right\" height=\"10%\">(Programm-Abbruch)\n
     </th></tr></table><p></body></html>"
    exit 1;
 }

 #-------------------------------------------------------------------------------

 set lineColor "#fffacd"
 ncgi::reset
 ncgi::parse
 ncgi::header
 readVars file data/demo.dat sort -1 cmd "" pos 0 order increasing back "" debug 0 readonly 0 mtime 0
 set file [relFile $file]
 if {[string length $back] == 0} {
    set uri {}; catch {set uri $::env(REQUEST_URI)}
    set ref {}; catch {set ref $::env(HTTP_REFERER)}
    if {$uri != $ref} {
       set back $ref
    }
 }
 puts {<html><head><title>CSVEdit 0.4</title>}
 addToHead
 puts {</head><body>}
 puts "Tabelle: <b>$file</b> "
 if {[string length $cmd]} {puts "Modus: <b>$cmd</b>"}
 puts {<div align="right">}
 puts [makeLink Refresh]
 if {[string length $back]} {puts " <a href=\"$back\">Zur&uuml;ck</a>"}
 puts {</div>}
 puts {<hr><p>}
 set jsCode {}
 set hdr  {}
 set rows {}
 if {[catch {
    set f [open $file r]
    gets $f hdr
    set hdr [csv::split $hdr]
    set cols [llength $hdr]
    while {[gets $f rec] > -1} {
        lappend rows [csv::split $rec]
    }
    close $f
 } rc]} then {
    abort $rc
 }
 # Profile-Handling:
 set prf [file rootname $file].rc
 set defopts {}
 for {set i 0} {$i < [llength $hdr]} {incr i} {
    lappend defopts default_$i {}
    lappend defopts select_$i {}
    lappend defopts maxDisplayWidth_$i 12; # mindestens erforderlich für Datum!
 }
 lappend defopts defsort $sort readonly $readonly
 array set opts [readprof::readprof1 $prf $defopts]; unset defopts
 if {$sort == -1} {
    set sort $opts(defsort)
 }
 set rows [lsort -dictionary -$order -index $sort $rows]; # vor Edit/Repl, damit 'pos' stimmt!
 for {set i 0} {$i < [llength $hdr]} {incr i} {
    if {$opts(default_$i) == "@date"} {
       set opts(default_$i) [clock format [clock seconds] -format {%Y.%m.%d @date}]; # Achtung: Format muss passen!
    }
    if {$opts(maxDisplayWidth_$i) < 10} {
       set opts(maxDisplayWidth_$i) 10
    }
 }
 if {$debug == 1} {
    foreach x [array names opts] {puts "$x := $opts($x)<br>"}; # DEBUG <<<<<<<<<<
 }
 set saveFile 0
 if {$readonly == 0} {
    if {($cmd == "save" || $cmd == "add" || $cmd == "del!" || $cmd == "edit" || $cmd == "reqdel") && $mtime != [file mtime $file]} {
       puts "<font color=\"red\">Operation abgebrochen, Datei wurde zwischenzeitlich ge&auml;ndert!"
       puts "Bitte die Operation <b>wiederholen!</b></font>"
       ncgi::setValue cmd ""; # Kommando zurücksetzen!! nützt nichts für Browser URL, Back!!!
       set cmd ""
       ncgi::setValue pos ""; # Kommando zurücksetzen!! nützt nichts für Browser URL, Back!!!
       set pos ""
    } elseif {$cmd == "save"} {
       # wird gerufen über SUBMIT-Button nach Feldänderungen
       for {set i 0} {$i < $cols} {incr i} {lappend newRow [ncgi::value f$i]}
       lset rows $pos $newRow
       set rows [lsort -dictionary -$order -index $sort $rows]
       set saveFile 1
    } elseif {$cmd == "add"} {
       for {set i 0} {$i < [llength $hdr]} {incr i} {
          lappend newRow [join $opts(default_$i)]
       }
       lappend rows $newRow
       set rows [lsort -dictionary -$order -index $sort $rows]
       set saveFile 1
    } elseif {$cmd == "del!"} {
       catch {
          set f [open [file rootname $file].log a]
          puts $f [csv::join [lindex $rows $pos]]
          close $f
       }
       set rows [lreplace $rows $pos $pos]
       set saveFile 1
    }
    # Fehler hier noch auswerten!
    if {$saveFile} {
       ######## schlecht: CSV wird SORTIERT abgespeichert, ist das ein Problem?
       ## ggF. Satznummer mitführen, und immer vor Speichern nach Satz# sortieren
       if {[catch {lock::withLock {
          file copy -force $file $file.bak
          set f [open $file w]
          puts $f [csv::join $hdr]
          foreach row $rows {
             puts $f [csv::join [string map {\n \\n} $row]]
          }
          close $f
          set mtime [file mtime $file]
       } 5000 [file join $::env(temp) _gentable.lock]} rc]} {
          puts "<font color=\"red\">Timeout beim Schreibzugriff: $rc</font>"
       }
       ncgi::setValue cmd ""; # Kommando zurücksetzen!! nützt nichts für Browser URL, Back!!!
       set cmd ""
       ncgi::setValue pos ""; # Kommando zurücksetzen!! nützt nichts für Browser URL, Back!!!
       set pos ""
       # ncgi::redirect [makeLink1]; # URL-Zeile um Parameter bereinigen!!! Klappt nicht!
    }
 }
 set mtime [file mtime $file]
 puts "<form name=\"frm1\" action=\"[ncgi::urlStub]\" method=\"post\""
 # puts { onreset="return confirm('Wirklich alle Eingaben zurücksetzen?');"}
 puts { onsubmit="return confirm('Operation durchführen?');">}
 puts {<table border="1"><thead><tr bgcolor="silver" align="left" nowrap>}
 set i 0
 foreach h $hdr {
    if {$i == $sort} {puts {<th nowrap bgcolor="#DCDCDC">}} else {puts {<th nowrap>}}
    # IE kann die dicken Pfeile &dArr; und &uArr; nicht!
    puts "[makeLink2 &darr\; sort $i order increasing] $h [makeLink2 &uarr\; sort $i order decreasing]</th>"
    incr i
 }
 if {$readonly == 0} {
    puts {<th align="center" nowrap><input type="submit" value="add" name="cmd" /></th></tr>}
 } else {
    puts {</tr>}
 }
 puts {</thead><tbody>}
 set rowIx 0
 set focus ""
 foreach row $rows {
    puts "<tr bgcolor=\"[toggleColor]\" id=\"z$rowIx\">"
    set cellIx 0
    if {$cmd == "edit" && $pos == $rowIx && $readonly == 0} {
       foreach cell $row {
          puts "<td nowrap><input type=\"text\" name=\"f$cellIx\" id=\"f$cellIx\" value=\"[quote $cell]\"
                size=\"$opts(maxDisplayWidth_$cellIx)\" />"
          if {[lindex $cell end] == "@date"} {
             puts "<button type=\"reset\" id=\"f${cellIx}_b\">...</button>"
             pushJSDate f$cellIx
          }
          if {[llength $opts(select_$cellIx)]} {
             puts "<select size=\"1\" name=\"s$cellIx\"
                onCHange=\"this.form.f$cellIx.value = this.form.s$cellIx.options\[this.form.s$cellIx.selectedIndex\].value;\">"
             puts "<option>[quote $cell]</option>"
             foreach o [join $opts(select_$cellIx)] {
                puts "<option>$o</option>"
             }
             puts {</select>}
          }
          puts </td>
          if {$focus == ""} {
             append ::jsCode "
                <script type=\"text/javascript\">
                   document.frm1.f$cellIx.focus();
                </script>
             \n"
             set focus done
          }
          incr cellIx
       }
       puts "<td nowrap>[makeLink cancel] <input type=\"submit\" value=\"save\" name=\"cmd\" /></td>"
    } elseif {$cmd == "reqdel" && $pos == $rowIx && $readonly == 0} {
       foreach cell $row {
          if {![string length $cell]} {
             puts {<td>&nbsp;</td>} ; # dafür sorgen, daß der Rahmen bei leeren Felder erscheint
          } else {
             puts "<td nowrap><strike>[formatCell $cellIx $cell]</strike></td>"
          }
          incr cellIx
       }
       puts "<td nowrap>[makeLink cancel] <input type=\"submit\" value=\"del!\" name=\"cmd\" /></td>"
    } else {
       foreach cell $row {
          if {![string length $cell]} {
             puts {<td>&nbsp;</td>} ; # dafür sorgen, daß der Rahmen bei leeren Felder erscheint
          } else {
             puts "<td nowrap>[formatCell $cellIx $cell]</td>"
          }
          incr cellIx
       }
       if {$readonly == 0} {
          puts "<td nowrap>[makeLink edit cmd edit pos $rowIx] [makeLink del cmd reqdel pos $rowIx]</td>"
       }
    }
    puts "</tr>"
    incr rowIx
 }
 makeHidden sort $sort file $file pos $pos order $order back $back readonly $readonly mtime $mtime
 puts {</tbody></table>}
 puts {</form>}
 puts "<p>Letzte Dateiänderung: <b>[clock format $mtime -format {%d.%m.%Y %H:%M:%S}]</b>"
 puts {<p><hr><div align="right">}
 puts [makeLink Refresh]
 if {[string length $back]} {
    puts " <a href=\"$back\">Zur&uuml;ck</a>"
 }
 puts {</div>}
 if {[string length $back]} {
 }
 puts $jsCode
 puts {</body></html>}
 exit 0

Example profile (.rc) file, belonging to each-csv file

The format of such a profile is explained here (I hope): http://wiki.tcl.tk/12647
Parameters ending with _n belong to the whole column n (leftmost column is 0)
the default_n values control what appears in the fields of a newly added record; @date is replaced by current date (the format is fixed for now)
select_n displays a select-Box with the given values when editing this field (Javascript required to put a list value in the edit field)
readonly 1 prevents from altering (display only-mode)
the following profile controls what is displayed in the three pictures at the top of this page

     defsort 6
     default_2 @date
     default_4 HMK
     default_5 3
     default_6 offen @date
     default_8 neu
     select_1 FEHLER Klärung Betrieb NetInstall Kommunizieren Testen Projekt Doku Idee Entwicklung Kunde Orga Meeting Persönlich
     select_4 DAK HMK HEK
     select_5 1 2 3
     select_8 neu inArbeit wartet ausgesetzt QS Abnahme AV-Transfer Produktion
     maxDisplayWidth_0 55

Bug's:

The table does not print very well with Mozilla, the reason is unknown; perhaps I forgot to generate some <tag>s...

ToDo's:

code consolidation (rewrite everything based on the given functionality) (puuuuhh.......!), e.g.: make use of html::-functions, comment everything, structure the code, removing duplicate code sequences etc. etc...

History:

31.03.2006: Added code to handle simultaneous access from multiple users
Mapping \n to \\n before writing to avoid destroying the file structure