- Added parser and fixed test case

tcl/intranet-csv-import-parser-procs.tcl

@@ -36,15 +36,39 @@ ad_proc -public im_csv_import_parser_user_name {
        return [list $arg $err]
     }
 
-    set sql "
-        select  party_id
-        from    parties p
-        where   lower(p.email) = lower('$arg')
-    "
-    set party_id [db_string party_id_from_name $sql -default ""]
+    set user_id ""
     set err ""
-    if {"" == $party_id} { set err "Didn't find user with email ='$arg'" }
-    return [list $party_id $err]
+
+    # Check by email
+    if {"" eq $user_id} {
+	set sql "
+	        select  min(party_id)
+	        from    parties p
+	        where   lower(p.email) = lower('$arg')
+	"
+	set user_id [db_string user_id_from_email $sql -default ""]
+    }
+
+    # Check by (Windows) username 
+    if {"" eq $user_id} {
+	set user_id [db_string user_id_from_username "
+		select	min(user_id)
+		from	users
+		where	lower(trim(username)) = lower(trim(:name))
+	" -default ""]
+    }
+
+    # Check by full first + last name
+    if {"" == $user_id} {
+	set user_id [db_string user_id_from_first_last_name "
+		select	min(person_id)
+		from	persons
+		where	lower(trim(im_name_from_user_id(person_id))) = lower(trim(:name))
+	" -default ""]
+    }
+
+    if {"" == $user_id} { set err "Didn't find user with email, username or full name ='$arg'" }
+    return [list $user_id $err]
 }
 
 
@@ -95,6 +119,40 @@ ad_proc -public im_csv_import_parser_project_nr {
 }
 
 
+ad_proc -public im_csv_import_parser_date { 
+    {-parser_args "" }
+    arg 
+} {
+    Generic date parser - front-end for all available date formats
+} {
+    set result [im_csv_import_parser_date_european -parser_args $parser_args $arg]
+    if {"" eq [lindex $result 1]} { return $result }
+
+    set result [im_csv_import_parser_date_european_dashes -parser_args $parser_args $arg]
+    if {"" eq [lindex $result 1]} { return $result }
+
+    set result [im_csv_import_parser_date_american -parser_args $parser_args $arg]
+    if {"" eq [lindex $result 1]} { return $result }
+
+    return [list "" "Could not figure out the format of this data field"]
+}
+
+ad_proc -public im_csv_import_parser_boolean { 
+    {-parser_args "" }
+    arg 
+} {
+    Boolean - argument is mapped to SQL boolean: 't' or 'f'
+} {
+    set arg [string tolower [string trim $arg]]
+    switch $arg {
+	"" { return [list "" ""] }
+	"t" - "1" { return [list "t" ""] }
+	"f" - "0" { return [list "f" ""] }
+    }
+    return [list "" "Could not determine boolean value of arg='$arg'"]
+}
+
+
 ad_proc -public im_csv_import_parser_date_european { 
     {-parser_args "" }
     arg 
@@ -109,6 +167,7 @@ ad_proc -public im_csv_import_parser_date_european {
     return [list "" "Error parsing European date format '$arg': expected 'dd.mm.yyyy'. If the error remains, try to import ANSI dates (2015-01-01) and set parser to 'No change'"]
 }
 
+
 ad_proc -public im_csv_import_parser_date_european_dashes { 
     {-parser_args "" }
     arg 
@@ -139,6 +198,36 @@ ad_proc -public im_csv_import_parser_date_american {
 }
 
 
+ad_proc -public im_csv_import_parser_number {
+    {-parser_args "" }
+    arg 
+} {
+    Parses a generic number. 
+    There may be ambiguities between American and European number formats
+    with decimal and thousands separators
+} {
+    if {[string is integer $arg]} { return [list $arg ""] }
+    # Now we know that there is a "." or a "," in the number
+
+    # Check for a number with one or two decimal digits
+    if {[regexp {^([0-9\.\,]*)([\.\,])([0-9]{1,2})$} $arg match main separator fraction]} {
+	if {"." eq $separator} {
+	    # American number format - remove "," from the main part of the number
+	    set main [string map -nocase {"," ""} $main]
+	    if {[string is integer $main]} { return [list "$main.$fraction" ""] }
+	    # "$main" is not an integer - no idea what is is...
+	} else {
+	    # European number format - remove "." from the main part of the number
+	    set main [string map -nocase {"." ""} $main]
+	    if {[string is integer $main]} { return [list "$main.$fraction" ""] }
+	    # "$main" is not an integer - no idea what is is...
+	}
+	return [list "$main.$fraction" ""]
+    }
+
+    return [list 0 "Could not decide if this is a European or a US number - please use a specific parser"]
+}
+
 ad_proc -public im_csv_import_parser_number_european {
     {-parser_args "" }
     arg 
@@ -216,3 +305,50 @@ ad_proc -public im_csv_import_parser_hard_coded {
     return [list $arg ""]
 }
 
+
+ad_proc -public im_csv_import_parser_project_parent_nrs { 
+    {-parser_args "" }
+    arg 
+} {
+    Returns a project_id from a list of project_nr's
+} {
+    set arg [string tolower [string trim $arg]]
+    set parent_id ""
+
+    # Loop through the list of parent_nrs
+    foreach parent_nr $arg {
+
+	set parent_sql "parent_id = $parent_id"
+	if {"" eq $parent_id} { set parent_sql "parent_id is null" }
+	set project_id [db_string pid "select project_id from im_projects where $parent_sql and lower(project_nr) = :parent_nr" -default ""]
+	if {"" eq $project_id} {
+	    return [list "" "Didn't find project with project_nr='$parent_nr' and parent_id='$parent_id'"]
+	}
+	set parent_id $project_id
+    }
+    return [list $parent_id ""]
+}
+
+
+ad_proc -public im_csv_import_parser_conf_item_parent_nrs { 
+    {-parser_args "" }
+    arg 
+} {
+    Returns a project_id from a list of project_nr's
+} {
+    set arg [string tolower [string trim $arg]]
+    set parent_id ""
+
+    # Loop through the list of parent_nrs
+    foreach parent_nr $arg {
+
+	set parent_sql "conf_item_parent_id = $parent_id"
+	if {"" eq $parent_id} { set parent_sql "conf_item_parent_id is null" }
+	set project_id [db_string pid "select conf_item_id from im_conf_items where $parent_sql and lower(conf_item_nr) = :parent_nr" -default ""]
+	if {"" eq $project_id} {
+	    return [list "" "Didn't find conf_item with conf_item_nr='$parent_nr' and parent_id='$parent_id'"]
+	}
+	set parent_id $project_id
+    }
+    return [list $parent_id ""]
+}

www/import-2.adp

@@ -3,7 +3,7 @@
 <property name="context">@context_bar;literal@</property>
 <property name="main_navbar_label">@main_navbar_label;literal@</property>
 
-<form enctype="multipart/form-data" method=POST action="import-@redirect_object_type@.tcl" id="@form_id@">
+<form enctype="multipart/form-data" method=POST action="import-@redirect_object_type@.tcl">
 <%= [export_vars -form {object_type return_url import_filename}] %>
 
 <if @object_type@ eq im_hour>

www/import-2.tcl

@@ -4,91 +4,33 @@ ad_page_contract {
     Starts the analysis process for the file imported
     @author frank.bergmann@project-open.com
 } {
-    { return_url "" }
+    { return_url "/intranet/" }
     { main_navbar_label "" }
     object_type
     upload_file
     object_type
 }
 
-# ---------------------------------------------------------------------
-# Note: 
-# ---------------------------------------------------------------------
-
-# This script uses jquery-save-as-you-type in order to store 
-# the user settings for mapping. This way a user does not need   
-# to start all over again if an import fails. 
-# The script stores ALL form vars so please add any new vars 
-# added to the form that should not be stored to the 
-# "exclude" section see (.adp file) to avoid side effects. 
-
-template::head::add_javascript -src "/intranet-csv-import/js/jquery-save-as-you-type/source/sayt.min.jquery.js" -order 1000
-template::head::add_javascript -src "/intranet-csv-import/js/jquery-save-as-you-type/dependencies/jquery-cookie.js" -order 1000
-
 # ---------------------------------------------------------------------
 # Default & Security
 # ---------------------------------------------------------------------
 
-set current_user_id [auth::require_login]
 set page_title [lang::message::lookup "" intranet-cvs-import.Upload_Objects "Upload Objects"]
 set context_bar [im_context_bar "" $page_title]
-set admin_p [im_is_user_site_wide_or_intranet_admin $current_user_id]
-
+set current_user_id [auth::require_login]
 # fraber 130225: Permissions are now handled by the import-* files
-# if {!$admin_p} {
-#     ad_return_complaint 1 "Only administrators have the right to import objects"
-#     ad_script_abort
-# }
 
-# Get the file from the user.
-# number_of_bytes is the upper-limit
+# Get the file from the user. number_of_bytes is the upper-limit
 set max_n_bytes [parameter::get -package_id [apm_package_id_from_key im_package_filestorage_id] -parameter "MaxNumberOfBytes" -default 0]
 set tmp_filename [ns_queryget upload_file.tmpfile]
-
 im_security_alert_check_tmpnam -location "import-2.tcl" -value $tmp_filename
 
-if { $max_n_bytes && ([file size $tmp_filename] > $max_n_bytes) } {
+if {$max_n_bytes && ([file size $tmp_filename] > $max_n_bytes)} {
     ad_return_complaint 1 "Your file is larger than the maximum permissible upload size:  
     [util_commify_number $max_n_bytes] bytes"
     ad_script_abort
 }
 
-# Empty return_url?
-# Choose depending on the object type...
-# Varied form_id's tio support 'jquery-save-as-you-type'
-if {"" == $return_url} {
-    switch $object_type {
-	im_company { 
-	    set return_url "/intranet/companies/index" 
-	    set form_id "intranet-csv-import-import2-companies"
-	}
-	im_conf_item { 
-	    set return_url "/intranet-helpdesk/index" 
-            set form_id "intranet-csv-import-import2-confitems"	    
-	}
-	im_project { 
-	    set return_url "/intranet/projects/index" 
-            set form_id "intranet-csv-import-import2-projects"
-	}
-	person { 
-	    set return_url "/intranet/users/index" 
-            set form_id "intranet-csv-import-import2-users"
-	}
-	im_hour { 
-	    set return_url "/intranet/index" 
-            set form_id "intranet-csv-import-import2-hours"
-	}
-        im_membership {
-            set return_url "/intranet/index"
-            set form_id "intranet-csv-import-import2-memberships"
-        }
-	default { 
-	    set return_url "/intranet" 
-            set form_id "intranet-csv-import-import2-other"
-	}
-    }
-}
-
 # strip off the C:\directories... crud and just get the file name
 if {![regexp {([^//\\]+)$} $upload_file match filename]} {
     # couldn't find a match
@@ -140,8 +82,8 @@ set header_len [llength $headers]
 set values_lol [im_csv_get_values $lines_content $separator]
 
 # Check if there are lines with less then 4 elements
-# set error [im_csv_import_check_list_of_lists $values_lol]
-# if {"" != $error} { ad_return_complaint 1 $error }
+set error [im_csv_import_check_list_of_lists $values_lol]
+if {"" != $error} { ad_return_complaint 1 $error }
 
 # Take a sample of max_row rows from the file and show
 set max_row 10
@@ -169,6 +111,13 @@ set object_type_pairs [list "" ""]
 foreach field $object_fields { lappend object_type_pairs [string tolower $field] [string tolower $field] }
 lappend object_type_pairs "hard_coded" "Hard Coded Functionality"
 
+
+
+# --------------------------------------------------
+# Main Loop
+# Try to guess the mapping and the parser for each field
+# --------------------------------------------------
+
 set cnt 0
 foreach header_name $headers {
     ns_log Notice "import-2: otype=$object_type, field_name=$header_name"
@@ -186,14 +135,16 @@ foreach header_name $headers {
 
     # Guess the object's field to which to map.
     set object_field_best_guess [im_csv_import_guess_map -object_type $object_type -field_name $header_name -sample_values $parser_sample_values]
-    ns_log Notice "import-2: otype=$object_type, field_name=$header_name => field=$object_field_best_guess"
+    ns_log Notice "import-2: im_csv_import_guess_map -object_type $object_type -field_name $header_name -sample_values {$parser_sample_values}"
+    ns_log Notice "import-2: => $object_field_best_guess"
     set guess_parser_field_name $header_name
     if {"" != $object_field_best_guess} { set guess_parser_field_name $object_field_best_guess }
 
 
     # Guess the parser how to convert the field values
     set defs [im_csv_import_guess_parser -object_type $object_type -field_name $guess_parser_field_name -sample_values $parser_sample_values]
-    ns_log Notice "import-2: otype=$object_type, field_name=$header_name => parser=$defs"
+    ns_log Notice "import-2: im_csv_import_guess_parser -object_type $object_type -field_name $guess_parser_field_name -sample_values {$parser_sample_values}"
+    ns_log Notice "import-2: => $defs"
     set default_parser [lindex $defs 0]
     set default_parser_args [lindex $defs 1]
     set override_map [lindex $defs 2]