| # diodisplay.tcl -- |
| |
| # Copyright 2002-2004 The Apache Software Foundation |
| |
| # Licensed under the Apache License, Version 2.0 (the "License"); |
| # you may not use this file except in compliance with the License. |
| # You may obtain a copy of the License at |
| |
| # http://www.apache.org/licenses/LICENSE-2.0 |
| |
| # Unless required by applicable law or agreed to in writing, software |
| # distributed under the License is distributed on an "AS IS" BASIS, |
| # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. |
| # See the License for the specific language governing permissions and |
| # limitations under the License. |
| # |
| # $Id$ |
| # |
| |
| package require Itcl |
| package require DIO |
| package require form |
| |
| package provide DIODisplay 1.0 |
| |
| catch { ::itcl::delete class DIODisplay } |
| |
| ::itcl::class ::DIODisplay { |
| constructor {args} { |
| eval configure $args |
| load_response |
| |
| if {[::rivet::lempty $DIO]} { |
| return -code error "You must specify a DIO object" |
| } |
| |
| if {[::rivet::lempty $form]} { |
| set form [namespace which [::form #auto -defaults response]] |
| } |
| |
| set document [env DOCUMENT_NAME] |
| |
| if {[info exists response(num)] \ |
| && ![::rivet::lempty $response(num)]} { |
| set pagesize $response(num) |
| } |
| |
| read_css_file |
| } |
| |
| destructor { |
| if {$cleanup} { do_cleanup } |
| } |
| |
| method destroy {} { |
| ::itcl::delete object $this |
| } |
| |
| # |
| # configvar - a convenient helper for creating methods that can |
| # set and fetch one of the object's variables |
| # |
| method configvar {varName string} { |
| if {[::rivet::lempty $string]} { return [set $varName] } |
| configure -$varName $string |
| } |
| |
| # |
| # is_function - return true if name is known to be a function |
| # such as Search List Add Edit Delete Details Main Save DoDelete Cancel |
| # etc. |
| # |
| method is_function {name} { |
| if {[lsearch $functions $name] > -1} { return 1 } |
| if {[lsearch $allfunctions $name] > -1} { return 1 } |
| return 0 |
| } |
| |
| # |
| # do_cleanup - clean up our field subobjects, DIO objects, forms, and the |
| # like. |
| # |
| method do_cleanup {} { |
| ## Destroy all the fields created. |
| foreach field $allfields { catch { $field destroy } } |
| |
| ## Destroy the DIO object. |
| catch { $DIO destroy } |
| |
| ## Destroy the form object. |
| catch { $form destroy } |
| } |
| |
| # |
| # handle_error - emit an error message |
| # |
| method handle_error {error} { |
| puts "<B>An error has occurred processing your request</B>" |
| puts "<PRE>" |
| puts "$error" |
| puts "" |
| puts "$::errorInfo" |
| puts "</PRE>" |
| } |
| |
| # |
| # read_css_file - parse and read in a CSS file so we can |
| # recognize CSS info and emit it in appropriate places |
| # |
| method read_css_file {} { |
| if {[::rivet::lempty $css]} { return } |
| if {[catch {open [virtual_filename $css]} fp]} { return } |
| set contents [read $fp] |
| close $fp |
| array set tmpArray $contents |
| foreach class [array names tmpArray] { |
| set cssArray([string toupper $class]) $tmpArray($class) |
| } |
| } |
| |
| # |
| # get_css_class - figure out which CSS class we want to use. |
| # If class exists, we use that. If not, we use default. |
| # |
| method get_css_class {tag default class} { |
| |
| # if tag.class exists, use that |
| if {[info exists cssArray([string toupper $tag.$class])]} { |
| return $class |
| } |
| |
| # if .class exists, use that |
| if {[info exists cssArray([string toupper .$class])]} { |
| return $class |
| } |
| |
| # use the default |
| return $default |
| } |
| |
| # |
| # parse_css_class - given a class and the name of an array, parse |
| # the named CSS class (read from the style sheet) and return it as |
| # key-value pairs in the named array. |
| # |
| method parse_css_class {class arrayName} { |
| |
| # if we don't have an entry for the specified glass, give up |
| if {![info exists cssArray($class)]} { |
| return |
| } |
| |
| # split CSS entry on semicolons, for each one... |
| upvar 1 $arrayName array |
| foreach line [split $cssArray($class) \;] { |
| |
| # trim leading and trailing spaces |
| set line [string trim $line] |
| |
| # split the line on a colon into property and value |
| lassign [split $line :] property value |
| |
| # map the property to space-trimmed lowercase and |
| # space-trim the value, then store in the passed array |
| set property [string trim [string tolower $property]] |
| set value [string trim $value] |
| set array($property) $value |
| } |
| } |
| |
| # |
| # button_image_src - return the value of the image-src element in |
| # the specified class (from the CSS style sheet), or an empty |
| # string if there isn't one. |
| # |
| method button_image_src {class} { |
| set class [string toupper input.$class] |
| parse_css_class $class array |
| if {![info exists array(image-src)]} { |
| return |
| } |
| return $array(image-src) |
| } |
| |
| # state - return a list of name-value pairs that represents the current |
| # state of the query, which can be used to properly populate links |
| # outside DIOdisplay. |
| method state {} { |
| set state {} |
| foreach fld {mode query by how sort num page} { |
| if [info exists response($fld)] { |
| lappend state $fld $response($fld) |
| } |
| } |
| return $state |
| } |
| |
| method show {} { |
| |
| # if there's a mode in the response array, use that, else set |
| # mode to Main |
| set mode Main |
| if {[info exists response(mode)]} { |
| set mode $response(mode) |
| } |
| |
| # if there is a style sheet defined, emit HTML to reference it |
| if {![::rivet::lempty $css]} { |
| puts "<LINK REL=\"stylesheet\" TYPE=\"text/css\" HREF=\"$css\">" |
| } |
| |
| # put out the table header |
| puts {<TABLE WIDTH="100%" CLASS="DIO">} |
| puts "<TR>" |
| puts {<TD VALIGN="center" CLASS="DIO">} |
| |
| # if mode isn't Main and persistentmain is set (the default), |
| # run Main |
| if {$mode != "Main" && $persistentmain} { |
| Main |
| } |
| |
| if {![is_function $mode]} { |
| puts "In-valid function" |
| return |
| } |
| |
| if {[catch "$this $mode" error]} { |
| handle_error $error |
| } |
| |
| puts "</TD>" |
| puts "</TR>" |
| puts "</TABLE>" |
| |
| if {$cleanup} { destroy } |
| } |
| |
| method showview {} { |
| puts {<TABLE CLASS="DIOView">} |
| set row 0 |
| foreach field $fields { |
| $field showview [lindex {"" "Alt"} $row] |
| set row [expr 1 - $row] |
| } |
| puts "</TABLE>" |
| } |
| |
| # |
| # showform_prolog - emit a form for inserting a new record |
| # |
| # response(by) will contain whatever was in the "where" field |
| # response(query) will contain whatever was in the "is" field |
| # |
| method showform_prolog {{args ""}} { |
| get_field_values array |
| |
| eval $form start $args |
| foreach fld [array names hidden] { |
| $form hidden $fld -value $hidden($fld) |
| } |
| $form hidden mode -value Save |
| $form hidden DIODfromMode -value $response(mode) |
| $form hidden DIODkey -value [$DIO makekey array] |
| puts {<TABLE CLASS="DIOForm">} |
| } |
| |
| method showform_epilog {} { |
| set save [button_image_src DIOFormSaveButton] |
| set cancel [button_image_src DIOFormCancelButton] |
| |
| puts "</TABLE>" |
| |
| puts "<TABLE>" |
| puts "<TR>" |
| puts "<TD>" |
| if {![::rivet::lempty $save]} { |
| $form image save -src $save -class DIOFormSaveButton |
| } else { |
| $form submit save.x -value "Save" -class DIOFormSaveButton |
| } |
| puts "</TD>" |
| puts "<TD>" |
| if {![::rivet::lempty $cancel]} { |
| $form image cancel -src $cancel -class DIOFormSaveButton |
| } else { |
| $form submit cancel.x -value "Cancel" -class DIOFormCancelButton |
| } |
| puts "</TD>" |
| puts "</TR>" |
| puts "</TABLE>" |
| |
| $form end |
| } |
| |
| # |
| # showform - emit a form for inserting a new record |
| # |
| # response(by) will contain whatever was in the "where" field |
| # response(query) will contain whatever was in the "is" field |
| # |
| method showform {} { |
| showform_prolog |
| |
| # emit each field |
| foreach field $fields { |
| showform_field $field |
| } |
| |
| showform_epilog |
| } |
| |
| # showform_field - emit the form field for the specified field using |
| # the showform method of the field. If the user has typed something |
| # into the search field and it matches the fields being emitted, |
| # use that value as the default |
| # |
| method showform_field {field} { |
| if {[info exists response(by)] && $response(by) == [$field text]} { |
| if {![$field readonly] && $response(query) != ""} { |
| $field value $response(query) |
| } |
| } |
| $field showform |
| } |
| |
| method page_buttons {end {count 0}} { |
| if {$pagesize <= 0} { return } |
| |
| if {![info exists response(page)]} { set response(page) 1 } |
| |
| set pref DIO$end |
| if {!$count} { |
| set count [$DIOResult numrows] |
| } |
| |
| set pages [expr ($count + $pagesize - 1) / $pagesize] |
| |
| if {$pages <= 1} { |
| return |
| } |
| |
| set first [expr $response(page) - 4] |
| if {$first > $pages - 9} { |
| set first [expr $pages - 9] |
| } |
| if {$first > 1} { |
| lappend pagelist 1 1 |
| if {$first > 3} { |
| lappend pagelist ".." 0 |
| } elseif {$first > 2} { |
| lappend pagelist 2 2 |
| } |
| } else { |
| set first 1 |
| } |
| set last [expr $response(page) + 4] |
| if {$last < 9} { |
| set last 9 |
| } |
| if {$last > $pages} { |
| set last $pages |
| } |
| for {set i $first} {$i <= $last} {incr i} { |
| lappend pagelist $i $i |
| } |
| if {$last < $pages} { |
| if {$last < $pages - 2} { |
| lappend pagelist ".." 0 |
| } elseif {$last < $pages - 1} { |
| incr last |
| lappend pagelist $last $last |
| } |
| lappend pagelist $pages $pages |
| } |
| |
| foreach {n p} $pagelist { |
| if {$p == 0 || $p == $response(page)} { |
| lappend navbar $n |
| } else { |
| set html {<A HREF="} |
| append html "$document?mode=$response(mode)" |
| foreach var {query by how sort num} { |
| if {[info exists response($var)]} { |
| append html "&$var=$response($var)" |
| } |
| } |
| foreach fld [array names hidden] { |
| append html "&$fld=$hidden($fld)" |
| } |
| append html "&page=$p\">$n</A>" |
| lappend navbar $html |
| } |
| } |
| |
| if {"$end" == "Bottom"} { |
| puts "<BR/>" |
| } |
| set class [get_css_class TABLE DIONavButtons ${pref}NavButtons] |
| puts "<TABLE WIDTH=\"100%\" CLASS=\"$class\">" |
| puts "<TR>" |
| puts "<TD>" |
| if {"$end" == "Top"} { |
| puts "$count rows, go to page" |
| } else { |
| puts "Go to page" |
| } |
| foreach link $navbar { |
| puts "$link " |
| } |
| puts "</TD>" |
| if {"$end" == "Top" && $pages>10} { |
| set f [::form #auto] |
| $f start |
| foreach fld [array names hidden] { |
| $f hidden $fld -value $hidden($fld) |
| } |
| foreach fld {mode query by how sort num} { |
| if [info exists response($fld)] { |
| $f hidden $fld -value $response($fld) |
| } |
| } |
| puts "<TD ALIGN=RIGHT>" |
| puts "Jump directly to" |
| $f text page -size 4 -value $response(page) |
| $f submit submit -value "Go" |
| puts "</TD>" |
| $f end |
| } |
| puts "</TR>" |
| puts "</TABLE>" |
| if {"$end" == "Top"} { |
| puts "<BR/>" |
| } |
| } |
| |
| |
| method rowheader {{total 0}} { |
| set fieldList $fields |
| if {![::rivet::lempty $rowfields]} { set fieldList $rowfields } |
| |
| set rowcount 0 |
| |
| puts <P> |
| |
| if {$topnav} { page_buttons Top $total } |
| |
| puts {<TABLE BORDER WIDTH="100%" CLASS="DIORowHeader">} |
| puts "<TR CLASS=DIORowHeader>" |
| foreach field $fieldList { |
| set text [$field text] |
| set sorting $allowsort |
| ## If sorting is turned off, or this field is not in the |
| ## sortfields, we don't display the sort option. |
| if {$sorting && ![::rivet::lempty $sortfields]} { |
| if {[lsearch $sortfields $field] < 0} { |
| set sorting 0 |
| } |
| } |
| if {$sorting && [info exists response(sort)]} { |
| if {"$response(sort)" == "$field"} { |
| set sorting 0 |
| } |
| } |
| |
| if {!$sorting} { |
| set html $text |
| } else { |
| set html {<A HREF="} |
| append html "$document?mode=$response(mode)" |
| foreach var {query by how num} { |
| if {[info exists response($var)]} { |
| append html "&$var=$response($var)" |
| } |
| } |
| foreach fld [array names hidden] { |
| append html "&$fld=$hidden($fld)" |
| } |
| append html "&sort=$field\">$text</A>" |
| } |
| set class [get_css_class TH DIORowHeader DIORowHeader-$field] |
| puts "<TH CLASS=\"$class\">$html</TH>" |
| } |
| |
| if {![::rivet::lempty $rowfunctions] && "$rowfunctions" != "-"} { |
| puts {<TH CLASS="DIORowHeaderFunctions">Functions</TH>} |
| } |
| puts "</TR>" |
| } |
| |
| method showrow {arrayName} { |
| upvar 1 $arrayName a |
| |
| incr rowcount |
| set alt "" |
| if {$alternaterows && ![expr $rowcount % 2]} { set alt Alt } |
| |
| set fieldList $fields |
| if {![::rivet::lempty $rowfields]} { set fieldList $rowfields } |
| |
| puts "<TR>" |
| foreach field $fieldList { |
| set class [get_css_class TD DIORowField$alt DIORowField$alt-$field] |
| set text "" |
| if {[info exists a($field)]} { |
| set text $a($field) |
| if [info exists filters($field)] { |
| set text [$filters($field) $text] |
| } |
| } |
| if ![string length $text] { |
| set text " " |
| } |
| puts "<TD CLASS=\"$class\">$text</TD>" |
| } |
| |
| if {![::rivet::lempty $rowfunctions] && "$rowfunctions" != "-"} { |
| set f [::form #auto] |
| puts "<TD NOWRAP CLASS=\"DIORowFunctions$alt\">" |
| $f start |
| foreach fld [array names hidden] { |
| $f hidden $fld -value $hidden($fld) |
| } |
| $f hidden query -value [$DIO makekey a] |
| if {[llength $rowfunctions] > 1} { |
| $f select mode -values $rowfunctions -class DIORowFunctionSelect$alt |
| $f submit submit -value "Go" -class DIORowFunctionButton$alt |
| } else { |
| set func [lindex $rowfunctions 0] |
| $f hidden mode -value $func |
| $f submit submit -value $func -class DIORowFunctionButton$alt |
| } |
| puts "</TD>" |
| $f end |
| } |
| |
| puts "</TR>" |
| } |
| |
| method rowfooter {{total 0}} { |
| puts "</TABLE>" |
| |
| if {$bottomnav} { page_buttons Bottom $total } |
| } |
| |
| ## Define a new function. |
| method function {name} { |
| lappend allfunctions $name |
| } |
| |
| ## Define a field in the object. |
| method field {name args} { |
| import_keyvalue_pairs data $args |
| lappend fields $name |
| lappend allfields $name |
| |
| set class DIODisplayField |
| if {[info exists data(type)]} { |
| if {![::rivet::lempty [::itcl::find classes *DIODisplayField_$data(type)]]} { |
| set class DIODisplayField_$data(type) |
| } |
| |
| } |
| |
| eval $class $name -name $name -display $this -form $form $args |
| set FieldTextMap([$name text]) $name |
| } |
| |
| method fetch {key arrayName} { |
| upvar 1 $arrayName $arrayName |
| set result [$DIO fetch $key $arrayName] |
| set error [$DIO errorinfo] |
| if {![::rivet::lempty $error]} { return -code error $error } |
| return $result |
| } |
| |
| method store {arrayName} { |
| upvar 1 $arrayName array |
| set result [$DIO store array] |
| set error [$DIO errorinfo] |
| if {![::rivet::lempty $error]} { return -code error $error } |
| return $result |
| } |
| |
| method update_with_explicit_key {key arrayName} { |
| upvar 1 $arrayName array |
| set result [$DIO update_with_explicit_key $key array] |
| set error [$DIO errorinfo] |
| if {![::rivet::lempty $error]} {return -code error $error} |
| return $result |
| } |
| |
| method delete {key} { |
| set result [$DIO delete $key] |
| set error [$DIO errorinfo] |
| if {![::rivet::lempty $error]} { return -code error $error } |
| return $result |
| } |
| |
| method pretty_fields {list} { |
| foreach field $list { |
| lappend fieldList [$field text] |
| } |
| return $fieldList |
| } |
| |
| method set_field_values {arrayName} { |
| upvar 1 $arrayName array |
| |
| # for all the elements in the specified array, try to invoke |
| # the element as an object, invoking the method "value" to |
| # set the value to the specified value |
| foreach var [array names array] { |
| #if {[catch { $var value $array($var) } result] == 1} {} |
| if {[catch { $var configure -value $array($var) } result] == 1} { |
| } |
| } |
| } |
| |
| method get_field_values {arrayName} { |
| upvar 1 $arrayName array |
| |
| foreach field $allfields { |
| |
| # for some reason the method for getting the value doesn't |
| # work for boolean values, which inherit DIODisplayField, |
| # something to do with configvar |
| #set array($field) [$field value] |
| set array($field) [$field cget -value] |
| } |
| } |
| |
| method DisplayRequest {query} { |
| set DIOResult [eval $DIO search -select "count(*)" $query] |
| if [$DIOResult numrows] { |
| $DIOResult next -array a |
| set total $a(count) |
| } else { |
| set total 0 |
| } |
| $DIOResult destroy |
| set DIOResult "" |
| |
| append query [sql_order_by_syntax] |
| append query [sql_limit_syntax] |
| set DIOResult [eval $DIO search $query] |
| |
| if {[$DIOResult numrows] <= 0} { |
| puts "Could not find any matching records." |
| $DIOResult destroy |
| set DIOResult "" |
| return |
| } |
| |
| rowheader $total |
| |
| $DIOResult forall -array a { |
| showrow a |
| } |
| |
| rowfooter $total |
| |
| $DIOResult destroy |
| set DIOResult "" |
| } |
| |
| method Main {} { |
| puts "<TABLE BORDER=0 WIDTH=100% CLASS=DIOForm><TR>" |
| |
| set selfunctions {} |
| foreach f $functions { |
| if {"$f" != "List"} { |
| lappend selfunctions $f |
| } else { |
| set f [::form #auto] |
| $f start |
| foreach fld [array names hidden] { |
| $f hidden $fld -value $hidden($fld) |
| } |
| $f hidden mode -value "List" |
| $f hidden query -value "" |
| puts "<TD CLASS=DIOForm ALIGN=CENTER VALIGN=MIDDLE WIDTH=0%>" |
| $f submit submit -value "Show All" -class DIORowFunctionButton |
| puts "</TD>" |
| $f end |
| } |
| } |
| |
| puts "<TD CLASS=DIOForm VALIGN=MIDDLE WIDTH=100%>" |
| $form start |
| puts " " |
| |
| foreach fld [array names hidden] { |
| $form hidden $fld -value $hidden($fld) |
| } |
| |
| if {[llength $selfunctions] > 1} { |
| $form select mode -values $selfunctions -class DIOMainFunctionsSelect |
| puts "where" |
| } else { |
| puts "Where" |
| } |
| |
| set useFields $fields |
| if {![::rivet::lempty $searchfields]} { set useFields $searchfields } |
| |
| $form select by -values [pretty_fields $useFields] \ |
| -class DIOMainSearchBy |
| |
| if [string match {[Ss]earch} $selfunctions] { |
| $form select how -values {"=" "<" "<=" ">" ">="} |
| } else { |
| puts "is" |
| } |
| |
| if [info exists response(query)] { |
| $form text query -value $response(query) -class DIOMainQuery |
| } else { |
| $form text query -value "" -class DIOMainQuery |
| } |
| |
| if {[llength $selfunctions] > 1} { |
| $form submit submit -value "GO" -class DIOMainSubmitButton |
| } else { |
| $form hidden mode -value $selfunctions |
| $form submit submit -value $selfunctions -class DIOMainSubmitButton |
| } |
| puts "</TD></TR>" |
| |
| if {![::rivet::lempty $numresults]} { |
| puts "<TR><TD CLASS=DIOForm>Results per page: " |
| $form select num -values $numresults -class DIOMainNumResults |
| puts "</TD></TR>" |
| } |
| |
| $form end |
| puts "</TABLE>" |
| } |
| |
| method sql_order_by_syntax {} { |
| if {[info exists response(sort)] && ![::rivet::lempty $response(sort)]} { |
| return " ORDER BY $response(sort)" |
| } |
| |
| if {![::rivet::lempty $defaultsortfield]} { |
| return " ORDER BY $defaultsortfield" |
| } |
| } |
| |
| method sql_limit_syntax {} { |
| if {$pagesize <= 0} { return } |
| |
| set offset "" |
| if {[info exists response(page)]} { |
| set offset [expr ($response(page) - 1) * $pagesize] |
| } |
| return [$DIO sql_limit_syntax $pagesize $offset] |
| } |
| |
| |
| method Search {} { |
| set searchField $FieldTextMap($response(by)) |
| |
| set what $response(query) |
| if {[info exists response(how)] && [string length $response(how)]} { |
| set what "$response(how)$what" |
| } |
| |
| DisplayRequest "-$searchField $what" |
| } |
| |
| method List {} { |
| DisplayRequest "" |
| } |
| |
| method Add {} { |
| showform |
| } |
| |
| method Edit {} { |
| if {![fetch $response(query) array]} { |
| puts "That record does not exist in the database." |
| return |
| } |
| |
| set_field_values array |
| |
| showform |
| } |
| |
| ## |
| ## When we save, we want to set all the fields' values and then get |
| ## them into a new array. We do this because we want to clean any |
| ## unwanted variables out of the array but also because some fields |
| ## have special handling for their values, and we want to make sure |
| ## we get the right value. |
| ## |
| method Save {} { |
| if {[info exists response(cancel.x)]} { |
| Cancel |
| return |
| } |
| |
| ## We need to see if the key exists. If they are adding a new |
| ## entry, we just want to see if the key exists. If they are |
| ## editing an entry, we need to see if they changed the keyfield |
| ## while editing. If they didn't change the keyfield, there's no |
| ## reason to check it. |
| if {$response(DIODfromMode) == "Add"} { |
| set key [$DIO makekey response] |
| fetch $key a |
| } else { |
| set key $response(DIODkey) |
| set newkey [$DIO makekey response] |
| |
| ## If we have a new key, and the newkey doesn't exist in the |
| ## database, we are moving this record to a new key, so we |
| ## need to delete the old key. |
| if {$key != $newkey} { |
| if {![fetch $newkey a]} { |
| # no record already exists with the new key, |
| # do a special update |
| set_field_values response |
| get_field_values updateArray |
| update_with_explicit_key $key updateArray |
| headers redirect $document |
| return |
| } |
| } |
| } |
| |
| # if we got here and array "a" exists, they're trying to alter a key |
| # to a key that already exists |
| if {[array exists a]} { |
| puts "That record already exists in the database." |
| return |
| } |
| |
| set_field_values response |
| get_field_values storeArray |
| store storeArray |
| headers redirect $document |
| } |
| |
| method Delete {} { |
| if {![fetch $response(query) array]} { |
| puts "That record does not exist in the database." |
| return |
| } |
| |
| if {!$confirmdelete} { |
| DoDelete |
| return |
| } |
| |
| puts "<CENTER>" |
| puts {<TABLE CLASS="DIODeleteConfirm">} |
| puts "<TR>" |
| puts {<TD COLSPAN=2 CLASS="DIODeleteConfirm">} |
| puts "Are you sure you want to delete this record from the database?" |
| puts "</TD>" |
| puts "</TR>" |
| puts "<TR>" |
| puts {<TD ALIGN="center" CLASS="DIODeleteConfirmYesButton">} |
| set f [::form #auto] |
| $f start |
| foreach fld [array names hidden] { |
| $f hidden $fld -value $hidden($fld) |
| } |
| $f hidden mode -value DoDelete |
| $f hidden query -value $response(query) |
| $f submit submit -value Yes -class DIODeleteConfirmYesButton |
| $f end |
| puts "</TD>" |
| puts {<TD ALIGN="center" CLASS="DIODeleteConfirmNoButton">} |
| set f [::form #auto] |
| $f start |
| foreach fld [array names hidden] { |
| $f hidden $fld -value $hidden($fld) |
| } |
| $f submit submit -value No -class "DIODeleteConfirmNoButton" |
| $f end |
| puts "</TD>" |
| puts "</TR>" |
| puts "</TABLE>" |
| puts "</CENTER>" |
| } |
| |
| method DoDelete {} { |
| delete $response(query) |
| |
| headers redirect $document |
| } |
| |
| method Details {} { |
| if {![fetch $response(query) array]} { |
| puts "That record does not exist in the database." |
| return |
| } |
| |
| set_field_values array |
| |
| showview |
| } |
| |
| method Cancel {} { |
| headers redirect $document |
| } |
| |
| ### |
| ## Define variable functions for each variable. |
| ### |
| |
| method fields {{list ""}} { |
| if {[::rivet::lempty $list]} { return $fields } |
| foreach field $list { |
| if {[lsearch $allfields $field] < 0} { |
| return -code error "Field $field does not exist." |
| } |
| } |
| set fields $list |
| } |
| |
| method searchfields {{list ""}} { |
| if {[::rivet::lempty $list]} { return $searchfields } |
| foreach field $list { |
| if {[lsearch $allfields $field] < 0} { |
| return -code error "Field $field does not exist." |
| } |
| } |
| set searchfields $list |
| } |
| |
| method rowfields {{list ""}} { |
| if {[::rivet::lempty $list]} { return $rowfields } |
| foreach field $list { |
| if {[lsearch $allfields $field] < 0} { |
| return -code error "Field $field does not exist." |
| } |
| } |
| set rowfields $list |
| } |
| |
| method filter {field {value ""}} { |
| if [string length $value] { |
| set filters($field) [uplevel 1 [list namespace which $value]] |
| } else { |
| if [info exists filters($field)] { |
| return $filters($field) |
| } else { |
| return "" |
| } |
| } |
| } |
| |
| method hidden {name {value ""}} { |
| if [string length $value] { |
| set hidden($name) $value |
| } else { |
| if [info exists hidden($name)] { |
| return $hidden($name) |
| } else { |
| return "" |
| } |
| } |
| } |
| |
| method DIO {{string ""}} { configvar DIO $string } |
| method DIOResult {{string ""}} { configvar DIOResult $string } |
| |
| method title {{string ""}} { configvar title $string } |
| method functions {{string ""}} { configvar functions $string } |
| method pagesize {{string ""}} { configvar pagesize $string } |
| method form {{string ""}} { configvar form $string } |
| method cleanup {{string ""}} { configvar cleanup $string } |
| method confirmdelete {{string ""}} { configvar confirmdelete $string } |
| |
| method css {{string ""}} { configvar css $string } |
| method persistentmain {{string ""}} { configvar persistentmain $string } |
| method alternaterows {{string ""}} { configvar alternaterows $string } |
| method allowsort {{string ""}} { configvar allowsort $string } |
| method sortfields {{string ""}} { configvar sortfields $string } |
| method topnav {{string ""}} { configvar topnav $string } |
| method bottomnav {{string ""}} { configvar bottomnav $string } |
| method numresults {{string ""}} { configvar numresults $string } |
| method defaultsortfield {{string ""}} { configvar defaultsortfield $string } |
| |
| method rowfunctions {{string ""}} { configvar rowfunctions $string } |
| |
| ## OPTIONS ## |
| |
| public variable DIO "" |
| public variable DIOResult "" |
| |
| public variable title "" |
| public variable fields "" |
| public variable searchfields "" |
| public variable functions "Search List Add Edit Delete Details" |
| public variable pagesize 25 |
| public variable form "" |
| public variable cleanup 1 |
| public variable confirmdelete 1 |
| |
| public variable css "diodisplay.css" { |
| if {![::rivet::lempty $css]} { |
| catch {unset cssArray} |
| read_css_file |
| } |
| } |
| |
| public variable persistentmain 1 |
| public variable alternaterows 1 |
| public variable allowsort 1 |
| public variable sortfields "" |
| public variable topnav 1 |
| public variable bottomnav 1 |
| public variable numresults "" |
| public variable defaultsortfield "" |
| |
| public variable rowfields "" |
| public variable rowfunctions "Details Edit Delete" |
| |
| public variable response |
| public variable cssArray |
| public variable document "" |
| public variable allfields "" |
| public variable FieldTextMap |
| public variable allfunctions { |
| Search |
| List |
| Add |
| Edit |
| Delete |
| Details |
| Main |
| Save |
| DoDelete |
| Cancel |
| } |
| |
| private variable rowcount |
| private variable filters |
| private variable hidden |
| |
| } ; ## ::itcl::class DIODisplay |
| |
| catch { ::itcl::delete class ::DIODisplayField } |
| |
| # |
| # DIODisplayField object -- defined for each field we're displaying |
| # |
| ::itcl::class ::DIODisplayField { |
| |
| constructor {args} { |
| ## We want to simulate Itcl's configure command, but we want to |
| ## check for arguments that are not variables of our object. If |
| ## they're not, we save them as arguments to the form when this |
| ## field is displayed. |
| import_keyvalue_pairs data $args |
| foreach var [array names data] { |
| if {![info exists $var]} { |
| lappend formargs -$var $data($var) |
| } else { |
| set $var $data($var) |
| } |
| } |
| |
| # if text (field description) isn't set, prettify the actual |
| # field name and use that |
| if {[::rivet::lempty $text]} { set text [pretty [split $name _]] } |
| } |
| |
| destructor { |
| |
| } |
| |
| method destroy {} { |
| ::itcl::delete object $this |
| } |
| |
| # |
| # get_css_class - ask the parent DIODIsplay object to look up |
| # a CSS class entry |
| # |
| method get_css_class {tag default class} { |
| return [$display get_css_class $tag $default $class] |
| } |
| |
| # |
| # get_css_tag -- set tag to select or textarea if type is select |
| # or textarea, else to input |
| # |
| method get_css_tag {} { |
| switch -- $type { |
| "select" { |
| set tag select |
| } |
| "textarea" { |
| set tag textarea |
| } |
| default { |
| set tag input |
| } |
| } |
| } |
| |
| # |
| # pretty -- prettify a list of words by uppercasing the first letter |
| # of each word |
| # |
| method pretty {string} { |
| set words "" |
| foreach w $string { |
| lappend words \ |
| [string toupper [string index $w 0]][string range $w 1 end] |
| } |
| return [join $words " "] |
| } |
| |
| method configvar {varName string} { |
| if {[::rivet::lempty $string]} { return [set $varName] } |
| configure -$varName $string |
| } |
| |
| # |
| # showview - emit a table row of either DIOViewRow, DIOViewRowAlt, |
| # DIOViewRow-fieldname (this object's field name), or |
| # DIOViewRowAlt-fieldname, a table data field of either |
| # DIOViewHeader or DIOViewHeader-fieldname, and then a |
| # value of class DIOViewField or DIOViewField-fieldname |
| # |
| method showview {{alt ""}} { |
| set class [get_css_class TR DIOViewRow$alt DIOViewViewRow$alt-$name] |
| puts "<TR CLASS=\"$class\">" |
| |
| set class [get_css_class TD DIOViewHeader DIOViewHeader-$name] |
| puts "<TD CLASS=\"$class\">$text:</TD>" |
| |
| set class [get_css_class TD DIOViewField DIOViewField-$name] |
| puts "<TD CLASS=\"$class\">$value</TD>" |
| |
| puts "</TR>" |
| } |
| |
| # |
| # showform -- like showview, creates a table row and table data, but |
| # if readonly isn't set, emits a form field corresponding to the type |
| # of this field |
| # |
| method showform {} { |
| puts "<TR>" |
| |
| set class [get_css_class TD DIOFormHeader DIOFormHeader-$name] |
| puts "<TD CLASS=\"$class\">$text:</TD>" |
| |
| set class [get_css_class TD DIOFormField DIOFormField-$name] |
| puts "<TD CLASS=\"$class\">" |
| if {$readonly} { |
| puts "$value" |
| } else { |
| set tag [get_css_tag] |
| set class [get_css_class $tag DIOFormField DIOFormField-$name] |
| |
| if {$type == "select"} { |
| $form select $name -values $values -value $value -class $class |
| } else { |
| eval $form $type $name -value [list $value] $formargs -class $class |
| } |
| } |
| puts "</TD>" |
| puts "</TR>" |
| } |
| |
| # methods that give us method-based access to get and set the |
| # object's variables... |
| method display {{string ""}} { configvar display $string } |
| method form {{string ""}} { configvar form $string } |
| method formargs {{string ""}} { configvar formargs $string } |
| method name {{string ""}} { configvar name $string } |
| method text {{string ""}} { configvar text $string } |
| method type {{string ""}} { configvar type $string } |
| method value {{string ""}} { configvar value $string } |
| method readonly {{string ""}} { configvar readonly $string } |
| |
| public variable display "" |
| public variable form "" |
| public variable formargs "" |
| |
| # values - for fields of type "select" only, the values that go in |
| # the popdown (or whatever) selector |
| public variable values "" |
| |
| # name - the field name |
| public variable name "" |
| |
| # text - the description text for the field. if not specified, |
| # it's constructed from a prettified version of the field name |
| public variable text "" |
| |
| # value - the default value of the field |
| public variable value "" |
| |
| # type - the data type of the field |
| public variable type "text" |
| |
| # readonly - if 1, we don't allow the value to be changed |
| public variable readonly 0 |
| |
| } ; ## ::itcl::class DIODisplayField |
| |
| catch { ::itcl::delete class ::DIODisplayField_boolean } |
| |
| # |
| # DIODisplayField_boolen -- superclass of DIODisplayField that overrides |
| # a few methods to specially handle booleans |
| # |
| ::itcl::class ::DIODisplayField_boolean { |
| inherit ::DIODisplayField |
| |
| constructor {args} {eval configure $args} { |
| eval configure $args |
| } |
| |
| method add_true_value {string} { |
| lappend trueValues $string |
| } |
| |
| # |
| # showform -- emit a form field for a boolean |
| # |
| method showform {} { |
| puts "<TR>" |
| |
| set class [get_css_class TD DIOFormHeader DIOFormHeader-$name] |
| puts "<TD CLASS=\"$class\">$text:</TD>" |
| |
| set class [get_css_class TD DIOFormField DIOFormField-$name] |
| puts "<TD CLASS=\"$class\">" |
| if {$readonly} { |
| if {[boolean_value]} { |
| puts $true |
| } else { |
| puts $false |
| } |
| } else { |
| if {[boolean_value]} { |
| $form default_value $name $true |
| } else { |
| $form default_value $name $false |
| } |
| eval $form radiobuttons $name \ |
| -values [list "$true $false"] $formargs |
| } |
| puts "</TD>" |
| puts "</TR>" |
| } |
| |
| # |
| # showview -- emit a view for a boolean |
| # |
| method showview {{alt ""}} { |
| set class [get_css_class TR DIOViewRow$alt DIOViewRow$alt-$name] |
| puts "<TR CLASS=\"$class\">" |
| |
| set class [get_css_class TD DIOViewHeader DIOViewHeader-$name] |
| puts "<TD CLASS=\"$class\">$text:</TD>" |
| |
| set class [get_css_class TD DIOViewField DIOViewField-$name] |
| puts "<TD CLASS=\"$class\">" |
| if {[boolean_value]} { |
| puts $true |
| } else { |
| puts $false |
| } |
| puts "</TD>" |
| |
| puts "</TR>" |
| } |
| |
| # |
| # boolean_value -- return 1 if value is found in the values list, else 0 |
| # |
| method boolean_value {} { |
| set val [string tolower $value] |
| if {[lsearch -exact $values $val] > -1} { return 1 } |
| return 0 |
| } |
| |
| method value {{string ""}} { configvar value $string } |
| |
| public variable true "Yes" |
| public variable false "No" |
| public variable values "1 y yes t true on" |
| |
| public variable value "" { |
| if {[boolean_value]} { |
| set value $true |
| } else { |
| set value $false |
| } |
| } |
| |
| } ; ## ::itcl::class ::DIODisplayField_boolean |
| |
| |