Index: openacs-4/packages/acs-tcl/acs-tcl.info
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/acs-tcl.info,v
diff -u -r1.13 -r1.14
--- openacs-4/packages/acs-tcl/acs-tcl.info	23 Jan 2002 02:05:06 -0000	1.13
+++ openacs-4/packages/acs-tcl/acs-tcl.info	12 Mar 2002 05:05:23 -0000	1.14
@@ -31,6 +31,7 @@
             <file type="tcl_procs" path="tcl/30-xml-utils-procs.tcl"/>
             <file type="tcl_procs" path="tcl/acs-kernel-procs.tcl"/>
             <file type="query_file" path="tcl/acs-kernel-procs.xql"/>
+            <file type="tcl_procs" path="tcl/openacs-kernel-procs.tcl"/>
             <file type="query_file" db_type="oracle" path="tcl/acs-permissions-procs-oracle.xql"/>
             <file type="query_file" db_type="postgresql" path="tcl/acs-permissions-procs-postgresql.xql"/>
             <file type="tcl_procs" path="tcl/acs-permissions-procs.tcl"/>
Index: openacs-4/packages/acs-tcl/tcl/openacs-kernel-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/Attic/openacs-kernel-procs.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/acs-tcl/tcl/openacs-kernel-procs.tcl	12 Mar 2002 05:04:32 -0000	1.1
@@ -0,0 +1,130 @@
+
+ad_library {
+    A library of additional OpenACS utilities
+
+    @author ben@openforce
+    @creation-date 2002-03-05
+    @cvs-id $Id: openacs-kernel-procs.tcl,v 1.1 2002/03/12 05:04:32 ben Exp $
+}
+
+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]
+
+        # 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
+        }
+
+        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 Notice "OACS-CSV-UPLOAD - 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
+    }
+
+    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]
+
+        # 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
+            }
+        }
+    }
+}