Index: openacs-4/packages/acs-tcl/tcl/openacs-kernel-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/openacs-kernel-procs.tcl,v diff -u -r1.6 -r1.7 --- openacs-4/packages/acs-tcl/tcl/openacs-kernel-procs.tcl 1 Nov 2003 08:45:37 -0000 1.6 +++ openacs-4/packages/acs-tcl/tcl/openacs-kernel-procs.tcl 27 Feb 2005 22:45:39 -0000 1.7 @@ -7,134 +7,147 @@ @cvs-id $Id$ } -namespace eval oacs_util { +namespace eval oacs_util {} - ad_proc -public process_objects_csv { - {-object_type:required} - {-file:required} - {-header_line 1} - {-override_headers {}} - {-constants ""} - } { - This processes a CVS of objects - } { - # FIXME: We should catch the error here - set csv_stream [open $file r] +ad_proc -public oacs_util::process_objects_csv { + {-object_type:required} + {-file:required} + {-header_line 1} + {-override_headers {}} + {-constants ""} +} { + This processes a CSV of objects, taking the csv and calling package_instantiate_object + for each one. - # Check if there are headers - if {![empty_string_p $override_headers]} { - set headers $override_headers - } else { - if {!$header_line} { - return -code error "There is no header!" - } + @return a list of the created object_ids +} { + # FIXME: We should catch the error here + set csv_stream [open $file r] - # get the headers - ns_getcsv $csv_stream headers + # Check if there are headers + if {![empty_string_p $override_headers]} { + set headers $override_headers + } else { + if {!$header_line} { + return -code error "There is no header!" } - set list_of_object_ids [list] - - # Process the file - db_transaction { - while {1} { - # Get a line - set n_fields [ns_getcsv $csv_stream one_line] - - # end of things - if {$n_fields == -1} { - break - } - - # Process the row - set extra_vars [ns_set create] - for {set i 0} {$i < $n_fields} {incr i} { - set varname [string tolower [lindex $headers $i]] - set varvalue [lindex $one_line $i] - - # Set the value - ns_log debug "oacs_util::process_objects_csv: setting $varname to $varvalue" - ns_set put $extra_vars $varname $varvalue - } - - # Add in the constants - if {![empty_string_p $constants]} { - # This modifies extra_vars, without touching constants - ns_set merge $constants $extra_vars - } - - # Create object and go for it - set object_id [package_instantiate_object -extra_vars $extra_vars $object_type] - lappend list_of_object_ids $object_id - - # Clean Up - ns_set free $extra_vars - } - } - - # Return the list of objects - return $list_of_object_ids + # get the headers + ns_getcsv $csv_stream headers } - ad_proc -public csv_foreach { - {-file:required} - {-header_line 1} - {-override_headers {}} - {-array_name:required} - code_block - } { - # FIXME: We should catch the error here - set csv_stream [open $file r] + set list_of_object_ids [list] - # Check if there are headers - if {![empty_string_p $override_headers]} { - set headers $override_headers - } else { - if {!$header_line} { - return -code error "There is no header!" - } - - # get the headers - ns_getcsv $csv_stream headers - } - - # Upvar Magic! - upvar 1 $array_name row_array - + # Process the file + db_transaction { while {1} { # Get a line set n_fields [ns_getcsv $csv_stream one_line] - + # end of things if {$n_fields == -1} { break } - + # Process the row + set extra_vars [ns_set create] for {set i 0} {$i < $n_fields} {incr i} { set varname [string tolower [lindex $headers $i]] set varvalue [lindex $one_line $i] - set row_array($varname) $varvalue + + # Set the value + ns_log debug "oacs_util::process_objects_csv: setting $varname to $varvalue" + ns_set put $extra_vars $varname $varvalue } - # Now we are ready to process the code block - set errno [catch { uplevel 1 $code_block } error] - - # Error? - if {$errno > 0} { - return -code $error + # Add in the constants + if {![empty_string_p $constants]} { + # This modifies extra_vars, without touching constants + ns_set merge $constants $extra_vars } + + # Create object and go for it + set object_id [package_instantiate_object -extra_vars $extra_vars $object_type] + lappend list_of_object_ids $object_id + + # Clean Up + ns_set free $extra_vars } } - ad_proc -public vars_to_ns_set { - {-ns_set:required} - {-var_list:required} - } { - foreach var $var_list { - upvar $var one_var - ns_set put $ns_set $var $one_var - } + # Return the list of objects + return $list_of_object_ids +} + +ad_proc -public oacs_util::csv_foreach { + {-file:required} + {-header_line 1} + {-override_headers {}} + {-array_name:required} + code_block +} { + reads a csv and executes code block for each row in the csv. + + @param file the csv file to read. + @param header_line the line with the list of var names + @param override_headers the list of variables in the csv + @param array_name the name of the array to set with the values from the csv as each line is read. +} { + # FIXME: We should catch the error here + set csv_stream [open $file r] + + # Check if there are headers + if {![empty_string_p $override_headers]} { + set headers $override_headers + } else { + if {!$header_line} { + return -code error "There is no header!" + } + + # get the headers + ns_getcsv $csv_stream headers } + # Upvar Magic! + upvar 1 $array_name row_array + + while {1} { + # Get a line + set n_fields [ns_getcsv $csv_stream one_line] + + # end of things + if {$n_fields == -1} { + break + } + + # Process the row + for {set i 0} {$i < $n_fields} {incr i} { + set varname [string tolower [lindex $headers $i]] + set varvalue [lindex $one_line $i] + set row_array($varname) $varvalue + } + + # Now we are ready to process the code block + set errno [catch { uplevel 1 $code_block } error] + + # Error? + if {$errno > 0} { + return -code $error + } + } } + +ad_proc -public oacs_util::vars_to_ns_set { + {-ns_set:required} + {-var_list:required} +} { + Does an ns_set put on each variable named in var_list + + @param var_list list of variable names in the calling scope + @param ns_set an ns_set id that already exists. +} { + foreach var $var_list { + upvar $var one_var + ns_set put $ns_set $var $one_var + } +}