ad_library {
    Helper test Tcl procedures.

    @author Peter Marklund (peter@collaboraid.biz)
    @creation-date 18 October 2002
}

namespace eval lang::test {}

ad_proc -private lang::test::get_dir {} {
    The test directory of the acs-lang package (where this file resides).

    @author Peter Marklund (peter@collaboraid.biz)
    @creation-date 28 October 2002
} {
    return "[acs_package_root_dir acs-lang]/tcl/test"
}

ad_proc -private lang::test::assert_browser_locale {accept_language expect_locale} {
    Assert that with given accept language header lang::conn::browser_locale returns
    the expected locale.

    @author Peter Marklund
} {
    ns_set update [ns_conn headers] "Accept-Language" $accept_language
    set browser_locale [lang::conn::browser_locale]
    aa_equals "accept-language header \"$accept_language\"" $browser_locale $expect_locale
}

ad_proc -private lang::test::test_package_key {} {
    return "acs-lang-test-tmp"
}

ad_proc -private lang::test::setup_test_package {} {
    set package_key [test_package_key]
    set package_name "acs-lang temporary test package"
    set package_dir [file join [acs_root_dir] packages $package_key]
    file mkdir $package_dir

    set info_file_path "${package_dir}/${package_key}.info"
    set info_file_contents "<?xml version=\"1.0\"?>
<package key=\"$package_key\" url=\"http://www.openacs.org/acs-repository/apm/packages/$package_key\" type=\"apm_service\">
    <package-name>$package_name</package-name>
    <pretty-plural>$package_name</pretty-plural>
    <initial-install-p>f</initial-install-p>
    <singleton-p>f</singleton-p>
    
    <version name=\"1.0\" url=\"http://www.openacs.org/acs-repository/download/apm/$package_key-1.0.apm\">
        <owner url=\"mailto:peter@collaboraid.biz\">Peter Marklund</owner>
        <summary>Temporary acs-lang test package</summary>
        <release-date>2003-11-07</release-date>
        <vendor url=\"http://www.collaboraid.biz\">Collaboraid</vendor>
        <description format=\"text/plain\">Temporary test package created by acs-lang test case.</description>
    </version>
</package>
"
    template::util::write_file $info_file_path $info_file_contents

    # Install the test package without catalog files
    apm_package_install \
        -enable \
        [apm_package_info_file_path $package_key]
    aa_true "Package install: package enabled" \
        [expr [lsearch -exact [apm_enabled_packages] $package_key] != -1]
}

ad_proc -private lang::test::teardown_test_package {} {
    apm_package_delete -remove_files=1 [test_package_key]
}

ad_proc -private lang::test::check_import_result {
    {-package_key:required}
    {-locale:required}
    {-upgrade_array:required}
    {-base_array:required}
    {-db_array:required}
    {-file_array:required}
} {
    This proc checks that the properties of messages in the database
    are what we expect after a message catalog import or upgrade.

    @author Peter Marklund
} {
    upvar $upgrade_array upgrade_expect
    upvar $base_array base_messages
    upvar $db_array db_messages
    upvar $file_array file_messages

    # Check that we have the expected message properties in the database after upgrade        
    foreach message_key [lsort [array names upgrade_expect]] {
        array set expect_property $upgrade_expect($message_key) 
        switch $expect_property(message) {
            db {
                set expect_message $db_messages($message_key)
            }
            file {
                set expect_message $file_messages($message_key)
            }
            base {
                set expect_message $base_messages($message_key)
            }
        }

        array unset message_actual
        lang::message::get \
            -package_key $package_key \
            -message_key $message_key \
            -locale $locale \
            -array message_actual

        # Check message properties
        aa_equals "Import check: $message_key - lang_messages.message" $message_actual(message) $expect_message
        aa_equals "Import check: $message_key - lang_messages.deleted_p" $message_actual(deleted_p) $expect_property(deleted_p)
        aa_equals "Import check: $message_key - lang_messages.conflict_p" $message_actual(conflict_p) $expect_property(conflict_p)
        aa_equals "Import check: $message_key - lang_messages.upgrade_status" \
            $message_actual(upgrade_status) $expect_property(upgrade_status)
        if {$expect_property(sync_time) eq "not_null"} {
            aa_true "Import check: $message_key - lang_messages.sync_time not null" \
                [expr {$message_actual(sync_time) ne ""}] 
        } else {
            aa_true "Import check: $message_key - lang_messages.sync_time null" \
                [expr {$message_actual(sync_time) eq ""}]
        }
    }
}

ad_proc -private lang::test::execute_upgrade {
    {-locale:required}
} {
    Executes the logic of the upgrade test case for a certain locale.

    @author Peter Marklund
} {
    set package_key [lang::test::test_package_key]

    # The key numbers correspond to the 14 cases described in the api-doc for lang::catalog::upgrade
    array set base_messages {
        key01 "Key 1"
        key04 "Key 4"
        key05 "Key 5"
        key06 "Key 6"
        key07 "Key 7"
        key10 "Key 10"
        key11 "Key 11"
        key12 "Key 12"
        key13 "Key 13 differ"
        key14 "Key 14 base"
    }

    array set db_messages {
        key02 "Key 2"
        key06 "Key 6 differ"
        key07 "Key 7"
        key08 "Key 8"
        key09 "Key 9"
        key10 "Key 10"
        key11 "Key 11 differ"
        key12 "Key 12"
        key13 "Key 13"
        key14 "Key 14 db"
    }

    array set file_messages {
        key03 "Key 3"
        key04 "Key 4 differ"
        key05 "Key 5"
        key08 "Key 8 differ"
        key09 "Key 9"
        key10 "Key 10"
        key11 "Key 11"
        key12 "Key 12 differ"
        key13 "Key 13"
        key14 "Key 14 file"
    }

    # Add the locale to each message so we can tell messages in
    # different locales apart
    foreach array_name {base_messages db_messages file_messages} {
        foreach message_key [array names $array_name] {
            append ${array_name}($message_key) " $locale"
        }
    }

    array set upgrade_expect {
        key01 {
          message base
          deleted_p t
          conflict_p f
          sync_time not_null
          upgrade_status no_upgrade
        }
        key02 {
          message db
          deleted_p f
          conflict_p f
          sync_time null
          upgrade_status no_upgrade
        }
        key03 {
          message file
          deleted_p f
          conflict_p f
          sync_time not_null
          upgrade_status added
        }
        key04 {
          message file
          deleted_p f
          conflict_p t
          sync_time not_null
          upgrade_status added
        }
        key05 {
          message base
          deleted_p t
          conflict_p f
          sync_time null
          upgrade_status no_upgrade
        }
        key06 {
          message db
          deleted_p t
          conflict_p t
          sync_time not_null
          upgrade_status deleted
        }
        key07 {
          message db
          deleted_p t
          conflict_p f
          sync_time not_null
          upgrade_status deleted
        }
        key08 {
          message file
          deleted_p f
          conflict_p t
          sync_time not_null
          upgrade_status updated
        }
        key09 {
          message db
          deleted_p f
          conflict_p f
          sync_time not_null
          upgrade_status no_upgrade
        }
        key10 {
          message db
          deleted_p f
          conflict_p f
          sync_time not_null
          upgrade_status added
        }
        key11 {
          message db
          deleted_p f
          conflict_p f
          sync_time null
          upgrade_status no_upgrade
        }
        key12 {
          message file
          deleted_p f
          conflict_p f
          sync_time not_null
          upgrade_status updated
        }
        key13 {
          message db
          deleted_p f
          conflict_p f
          sync_time not_null
          upgrade_status no_upgrade
        }
        key14 {
          message file
          deleted_p f
          conflict_p t
          sync_time not_null
          upgrade_status updated
        }
    }

    #
    # Execution plan:
    #
    # 1. Import some messages (base_messages below)
    # 2. Make changes to DB (db_messages below)
    # 3. Make changes to catalog files and import again (file_messages below)
    # 4. Check that merged result is what we expect (upgrade_expect below)
    # 5. Import again
    # 6. Check that we still have the same result (verify idempotent)
    # 7. Resolve some conflicts, but not all
    # 8. Import again
    # 9. Check that we have what's expected then
    #

    aa_log "-------------------------------------------------------------------"
    aa_log "*** Executing upgrade test with locale $locale"
    aa_log "-------------------------------------------------------------------"

    #----------------------------------------------------------------------
    # 1. Import some messages (base_messages)
    #----------------------------------------------------------------------
    aa_log "locale=$locale ----------1. import some messages----------"

    # Write original catalog file
    set catalog_file_path [lang::catalog::get_catalog_file_path \
                                   -package_key $package_key \
                                   -locale $locale]
    lang::catalog::export_to_file $catalog_file_path [array get base_messages]
    aa_true "Initial export: messages exported to file $catalog_file_path" [file exists $catalog_file_path]

    aa_log [template::util::read_file $catalog_file_path]

    # Import the catalog file
    array unset message_count
    array set message_count [lang::catalog::import -package_key $package_key -locales [list $locale]]
    aa_log "Imported messages: [array get message_count]"

    # Check that we have the expected messages in the database
    array unset actual_db_messages
    array set actual_db_messages [lang::catalog::messages_in_db -package_key $package_key -locale $locale]
    foreach message_key [lsort [array names base_messages]] {
        aa_equals "Initial import: message for key $message_key in db same as in file" \
            $actual_db_messages($message_key) $base_messages($message_key)
    }

    #----------------------------------------------------------------------
    # 2. Make changes to DB (db_messages)
    #----------------------------------------------------------------------
    aa_log "locale=$locale ----------2. Make changes to DB----------"

    # Carry out changes to the message catalog in the db
    foreach message_key [lsort [array names upgrade_expect]] {

        set register_p 0
        if { ![info exists db_messages($message_key)] } {
            # Message is not supposed to exist in DB
            if { [info exists base_messages($message_key)] } {
                # Message currently does exist in DB: Delete
                aa_log "Deleting message $message_key"
                lang::message::delete \
                    -package_key $package_key \
                    -message_key $message_key \
                    -locale $locale
            }
        } else {
            # Message is supposed to exist in DB
            # Is it new or changed?
            if { ![info exists base_messages($message_key)] || \
                     $base_messages($message_key) ne $db_messages($message_key) } {
                # Added || updated 
                aa_log "Adding/updating message $message_key"
                lang::message::register \
                    $locale \
                    $package_key \
                    $message_key \
                    $db_messages($message_key)
            }
        }
    }

    #----------------------------------------------------------------------
    # 3. Make changes to catalog files and import again (file_messages)
    #----------------------------------------------------------------------
    aa_log "locale=$locale ----------3. Make changes to catalog files and do first upgrade----------"

    # Update the catalog file
    file delete -force $catalog_file_path
    lang::catalog::export_to_file $catalog_file_path [array get file_messages]
    aa_true "First upgrade: catalog file $catalog_file_path updated" [file exists $catalog_file_path]

    # Execute a first upgrade
    lang::catalog::import -package_key $package_key -locales [list $locale]

    #----------------------------------------------------------------------
    # 4. Check that merged result is what we expect (upgrade_expect)
    #----------------------------------------------------------------------
    aa_log "locale=$locale ----------4. Check merge result of first upgrade----------"
    lang::test::check_import_result \
        -package_key $package_key \
        -locale $locale \
        -upgrade_array upgrade_expect \
        -base_array base_messages \
        -db_array db_messages \
        -file_array file_messages

    #----------------------------------------------------------------------
    # 5. First upgrade (second import)
    #----------------------------------------------------------------------
    aa_log "locale=$locale ----------5. Second upgrade ----------"
    lang::catalog::import -package_key $package_key -locales [list $locale]

    #----------------------------------------------------------------------
    # 6. Check that we still have the same result (verify idempotent)
    #----------------------------------------------------------------------
    aa_log "locale=$locale ----------6. Check merge results of second upgrade (verify idempotent)----------"
    lang::test::check_import_result \
        -package_key $package_key \
        -locale $locale \
        -upgrade_array upgrade_expect \
        -base_array base_messages \
        -db_array db_messages \
        -file_array file_messages

    #----------------------------------------------------------------------
    # 7. Resolve some conflicts, but not all
    #----------------------------------------------------------------------
    aa_log "locale=$locale ----------7. Resolve some conflicts, but not all----------"
    array set conflict_resolutions {
        key06 "key06 resolution message"
        key08 "accept"
    }
    foreach message_key [array names conflict_resolutions] {
        if {$conflict_resolutions($message_key) eq "accept"} {
            # Resolution is an accept - just toggle conflict_p flag
            lang::message::edit $package_key $message_key $locale [list conflict_p f]

            # Set the message to be what's in the database (the accepted message)
            set conflict_resolutions($message_key) [lang::message::get_element \
                                                        -package_key $package_key \
                                                        -message_key $message_key \
                                                        -locale $locale \
                                                        -element message]
        } else {
            # Resolution is an edit
            lang::message::register \
                $locale \
                $package_key \
                $message_key \
                $conflict_resolutions($message_key)
        }
    }

    # TODO: test resolution being to retain the message (just toggle conflict_p)
    # TODO: test resolution being to delete a resurrected message
    # TODO: test other resolution possibilities

    #----------------------------------------------------------------------
    # 8. Third upgrade
    #----------------------------------------------------------------------
    aa_log "locale=$locale ----------8. Do third upgrade----------"
    lang::catalog::import -package_key $package_key -locales [list $locale]

    #----------------------------------------------------------------------
    # 9. Check that we have what's expected then (resolutions are sticky)
    #----------------------------------------------------------------------
    aa_log "locale=$locale ----------9. Check results of third upgrade (that resolutions are sticky)----------"
    foreach message_key [array names conflict_resolutions] {
    
        array unset message_array
        lang::message::get \
            -package_key $package_key \
            -message_key $message_key \
            -locale $locale \
            -array message_array

        aa_equals "$message_key - conflict message that has been resolved in UI has conflict_p=f" \
            $message_array(conflict_p) "f"
        aa_equals "$message_key - the resolved conflict is not clobbered by an additional import" \
            $message_array(message) $conflict_resolutions($message_key)
    }
}

aa_register_case \
    -procs {
	lang::util::replace_temporary_tags_with_lookups
	lang::catalog::export_messages_to_file
	lang::catalog::parse
	lang::catalog::read_file
	lang::util::get_temporary_tags_indices
    } util__replace_temporary_tags_with_lookups {

    A test tcl file and catalog file are created. The temporary tags in the
    tcl file are replaced with message lookups and keys and messages are appended
    to the catalog file.

    @author Peter Marklund (peter@collaboraid.biz)
    @creation-date 18 October 2002
} {
    # Peter NOTE: cannot get this test case to work with the rollback code in automated testing
    # and couldn't track down why. I'm threrefor resorting to manual teardown which is fragile and hairy
    
    # The files involved in the test
    set package_key acs-lang
    set test_dir [lang::test::get_dir]
    set catalog_dir [lang::catalog::package_catalog_dir $package_key]
    set catalog_file "${catalog_dir}/acs-lang.xxx_xx.ISO-8859-1.xml"
    set backup_file_suffix ".orig"
    set catalog_backup_file "${catalog_file}${backup_file_suffix}"
    regexp {^.*(packages/.*)$} $test_dir match test_dir_rel
    set tcl_file "${test_dir_rel}/test-message-tags.tcl"
    set tcl_backup_file "${tcl_file}${backup_file_suffix}"

    # The test messages to use for the catalog file
    array set messages_array [list key_1 text_1 key_2 text_2 key_3 text_3]
    # NOTE: must be kept up-to-date for teardown to work
    set expected_new_keys [list Auto_Key key_1_1] 

    # Write the test tcl file
    set tcl_file_id [open "[acs_root_dir]/$tcl_file" w]    
    set new_key_1 "_"
    set new_text_1 "Auto Key"
    set new_key_2 "key_1"
    set new_text_2 "text_1_different"
    set new_key_3 "key_1"
    set new_text_3 "$messages_array(key_1)"
    puts $tcl_file_id "# The following key should be auto-generated and inserted
    # <#  ${new_key_1} ${new_text_1} #>
    #
    # The following key should be made unique and inserted
    # <#${new_key_2} ${new_text_2}#>
    #
    # The following key should not be inserted in the message catalog
    # <#${new_key_3} ${new_text_3}#>"
    close $tcl_file_id

    # Write the catalog file
    lang::catalog::export_to_file $catalog_file [array get messages_array]

    # We need to force the API to export to the test catalog file
    aa_stub lang::catalog::get_catalog_file_path "
        return $catalog_file
    "

    # Replace message tags in the tcl file and insert into catalog file
    lang::util::replace_temporary_tags_with_lookups $tcl_file

    aa_unstub lang::catalog::get_catalog_file_path

    # Read the contents of the catalog file
    array set catalog_array [lang::catalog::parse [lang::catalog::read_file $catalog_file]]
    array set updated_messages_array [lindex [array get catalog_array messages] 1]

    # Assert that the old messages are unchanged
    foreach old_message_key [array names messages_array] { 
        aa_true "old key $old_message_key should be unchanged" [string equal $messages_array($old_message_key) \
                                                                             $updated_messages_array($old_message_key)]
    }

    # Check that the first new key was autogenerated
    aa_true "check autogenerated key" [string equal $updated_messages_array(Auto_Key) $new_text_1]

    # Check that the second new key was made unique and inserted
    aa_true "check key made unique" [string equal $updated_messages_array(${new_key_2}_1) $new_text_2]

    # Check that the third key was not inserted    
    aa_true "third key not inserted" [string equal [lindex [array get updated_messages_array $new_key_3] 1] \
                                                   $messages_array($new_key_3)]

    # Check that there are no tags left in the tcl file
    set tcl_file_id [open "[acs_root_dir]/$tcl_file" r]
    set updated_tcl_contents [read $tcl_file_id]
    close $tcl_file_id
    aa_true "tags in tcl file replaced" [expr [llength [lang::util::get_temporary_tags_indices $updated_tcl_contents]] == 0]

    # Delete the test message keys
    foreach message_key [concat [array names messages_array] $expected_new_keys] {
        lang::message::unregister $package_key $message_key
    }
    # Delete the catalog files
    file delete $catalog_backup_file
    file delete $catalog_file

    # Delete the tcl files
    file delete "[acs_root_dir]/$tcl_file"
    file delete "[acs_root_dir]/$tcl_backup_file"
}

aa_register_case \
    -procs {
	lang::util::get_hash_indices
    } util__get_hash_indices {

    @author Peter Marklund (peter@collaboraid.biz)
    @creation-date 21 October 2002
} { 
  set multilingual_string "#package1.key1# abc\# #package2.key2#"
  set indices_list [lang::util::get_hash_indices $multilingual_string]
  set expected_indices_list [list [list 0 14] [list 21 35]]

  aa_true "there should be two hash entries" [expr {[llength $indices_list] == 2}]

  set counter 0
  foreach index_item $indices_list {
      set expected_index_item [lindex $expected_indices_list $counter]
      
      aa_true "checking start and end indices of item $counter" \
              [expr [string equal [lindex $index_item 0] [lindex $expected_index_item 0]] && \
              [string equal [lindex $index_item 1] [lindex $expected_index_item 1]]]

      set counter [expr {$counter + 1}]
  }
}

aa_register_case \
    -procs {
	lang::util::convert_adp_variables_to_percentage_signs
	lang::util::convert_percentage_signs_to_adp_variables
    } util__convert_adp_variables_to_percentage_signs {

    @author Peter Marklund (peter@collaboraid.biz)
    @creation-date 25 October 2002
} {
    set adp_chunk "<property name=\"title\">@array.variable_name@ @variable_name2;noquote@ peter@collaboraid.biz</property>"
    set adp_chunk_converted [lang::util::convert_adp_variables_to_percentage_signs $adp_chunk]
    set adp_chunk_expected "<property name=\"title\">%array.variable_name% %variable_name2;noquote% peter@collaboraid.biz</property>"
    aa_equals "adp vars should be subsituted with percentage sings" $adp_chunk_converted $adp_chunk_expected
    set adp_chunk_converted_back [lang::util::convert_percentage_signs_to_adp_variables $adp_chunk_converted]
    aa_equals "after having converted the text with percentage signs back to adp we should have what we started with" $adp_chunk_converted $adp_chunk_expected

    # Test that a string can start with adp vars
    set adp_chunk "@first_names.foobar;noquote@ @last_name@&nbsp;peter@collaboraid.biz"
    set adp_chunk_converted [lang::util::convert_adp_variables_to_percentage_signs $adp_chunk]
    set adp_chunk_expected "%first_names.foobar;noquote% %last_name%&nbsp;peter@collaboraid.biz"
    aa_equals "adp vars should be subsituted with percentage sings" $adp_chunk_converted $adp_chunk_expected
    set adp_chunk_converted_back [lang::util::convert_percentage_signs_to_adp_variables $adp_chunk_converted]
    aa_equals "after having converted the text with percentage signs back to adp we should have what we started with" $adp_chunk_converted $adp_chunk_expected

    set percentage_chunk {You are <a href="%role.character_url%">%role.character_title%</a> (%role.role_pretty%)}
    set percentage_chunk_converted [lang::util::convert_percentage_signs_to_adp_variables $percentage_chunk]
    set percentage_chunk_expected {You are <a href="@role.character_url@">@role.character_title@</a> (@role.role_pretty@)}
    aa_equals "converting percentage vars to adp vars" $percentage_chunk_converted $percentage_chunk_expected
}

aa_register_case \
    -procs {
	lang::util::replace_adp_text_with_message_tags
    } util__replace_adp_text_with_message_tags {

    @author Peter Marklund (peter@collaboraid.biz)
    @creation-date 28 October 2002
} {
    # File paths used
    set adp_file_path "[lang::test::get_dir]/adp_tmp_file.adp"

    # Write the adp test file
    set adp_file_id [open $adp_file_path w]
    puts $adp_file_id "<master src=\"master\">
<property name=\"title\">@first_names@ @last_name@&nbsp;peter@collaboraid.biz</property>
<property name=\"context_bar\">@context_bar@</property>
Test text"
    close $adp_file_id

    # Do the substitutions
    lang::util::replace_adp_text_with_message_tags $adp_file_path "write"

    # Read the changed test file
    set adp_file_id [open $adp_file_path r]
    set adp_contents [read $adp_file_id]
    close $adp_file_id

    set expected_adp_pattern {<master src=\"master\">
<property name=\"title\"><#[a-zA-Z_]+ @first_names@ @last_name@&nbsp;peter@collaboraid.biz#></property>
<property name=\"context_bar\">@context_bar@</property>
<#[a-zA-Z_]+ Test text\s*}

    # Assert proper replacements have been done
    aa_true "replacing adp text with tags" \
            [regexp $expected_adp_pattern $adp_contents match]

    # Remove the adp test file
    file delete $adp_file_path
}

aa_register_case \
	-procs {
	    lang::message::format
	} message__format {

    @author Peter Marklund (peter@collaboraid.biz)
    @creation-date 21 October 2002
} {

    set localized_message "The %frog% jumped across the %fence%. About 50% of the time, he stumbled, or maybe it was %%20 %times%."
    set value_list {frog frog fence fence}

    set subst_message [lang::message::format $localized_message $value_list]
    set expected_message "The frog jumped across the fence. About 50% of the time, he stumbled, or maybe it was %20 %times%."

    aa_equals "the frog should jump across the fence" $subst_message $expected_message

    set my_var(my_key) foo
    set localized_message "A text with an array variable %my_var.my_key% in it"
    set subst_message [lang::message::format $localized_message {} 1]
    set expected_message "A text with an array variable foo in it"
    aa_equals "embedded array variable" $subst_message $expected_message
}

aa_register_case \
	-procs {
	    lang::message::get_embedded_vars
	} message__get_embedded_vars {

    @author Peter Marklund (peter@collaboraid.biz)
    @creation-date 12 November 2002
} {
    set en_us_message "This message contains no vars"
    set new_message "This is a message with some %vars% and some more %variables%"

    set missing_vars_list [util_get_subset_missing \
            [lang::message::get_embedded_vars $new_message] \
            [lang::message::get_embedded_vars $en_us_message]]

    if { ![aa_true "Find missing vars 'vars' and 'variables'" [util_sets_equal_p $missing_vars_list { vars variables }]] } {
        aa_log "Missing variables returned was: '$missing_vars_list'"
        aa_log "en_US Message: '$en_us_message' -> Variables: '[lang::message::get_embedded_vars $en_us_message]'"
        aa_log "Other Message: '$new_message' -> Variables: '[lang::message::get_embedded_vars $new_message]'"
    }

    # This failed on the test servers
    set en_us_message "Back to %ad_url%%return_url%"
    set new_message "Tillbaka till %ad_url%%return_url%"
    set missing_vars_list [util_get_subset_missing \
            [lang::message::get_embedded_vars $new_message] \
            [lang::message::get_embedded_vars $en_us_message]]
    if { ![aa_equals "No missing vars" [llength $missing_vars_list] 0] } {
        aa_log "Missing vars: $missing_vars_list"
    }

    # Testing variables with digits in the variable names
    set en_us_message "Some variables %var1%%var2% again"
    set new_message "Nogle variable %var1%%var2% igen"
    set missing_vars_list [util_get_subset_missing \
            [lang::message::get_embedded_vars $new_message] \
            [lang::message::get_embedded_vars $en_us_message]]
    if { ![aa_equals "No missing vars" [llength $missing_vars_list] 0] } {
        aa_log "Missing vars: $missing_vars_list"
    }    
}

aa_register_case \
	-procs {
	    lang::system::set_locale
	    lang::system::locale
	    lang::system::site_wide_locale
	} locale__test_system_package_setting {
    Tests whether the system package level setting works

    @author Lars Pind (lars@collaboraid.biz)
    @creation-date 2003-08-12
} {
    set use_package_level_locales_p_org [parameter::get -parameter UsePackageLevelLocalesP -package_id [apm_package_id_from_key "acs-lang"]]
    
    parameter::set_value -parameter UsePackageLevelLocalesP -package_id [apm_package_id_from_key "acs-lang"] -value 1


    # There's no foreign key constraint on the locales column, so this should work
    set locale_to_set [ad_generate_random_string]

    set retrieved_locale {}
    
    # We could really use a 'finally' block on 'with_catch' (a block, which gets executed at the end, regardless of whether there was an error or not)
    with_catch errmsg {
        # Let's pick a random unmounted package to test with
        set package_id [apm_package_id_from_key "acs-kernel"]
        
        set org_setting [lang::system::site_wide_locale]
        
        lang::system::set_locale -package_id $package_id $locale_to_set
        
        set retrieved_locale [lang::system::locale -package_id $package_id]
        
    } {
        parameter::set_value -parameter UsePackageLevelLocalesP -package_id [apm_package_id_from_key "acs-lang"] -value $use_package_level_locales_p_org
        
        global errorInfo
        error $errmsg $errorInfo
    }

    parameter::set_value -parameter UsePackageLevelLocalesP -package_id [apm_package_id_from_key "acs-lang"] -value $use_package_level_locales_p_org
    
    aa_true "Retrieved system locale ('$retrieved_locale') equals the one we just set ('$locale_to_set')" [string equal $locale_to_set $retrieved_locale]
}

aa_register_case \
	-procs {
	    lang::conn::browser_locale
	} locale__test_lang_conn_browser_locale {

    @author Peter Marklund
    @creation-date 2003-08-13
} {
    aa_run_with_teardown \
        -rollback \
        -test_code {

        # The tests assume that the danish locale is enabled
        db_dml enable_all_locales {
            update ad_locales
            set enabled_p = 't'
            where locale = 'da_DK'
        }
        util_memoize_flush_regexp {^lang::system::get_locales}

        # First locale is perfect language match
        lang::test::assert_browser_locale "da,en-us;q=0.8,de;q=0.5,es;q=0.3" "da_DK"
    
        # First locale is perfect locale match
        lang::test::assert_browser_locale "da_DK,en-us;q=0.8,de;q=0.5,es;q=0.3" "da_DK"
    
        # Tentative match being discarded
        lang::test::assert_browser_locale "da_BLA,foobar,en" "en_US"
    
        # Tentative match being used
        lang::test::assert_browser_locale "da_BLA,foobar" "da_DK"
    
        # Several tentative matches, all being discarded
        lang::test::assert_browser_locale "da_BLA,foobar,da_BLUB,da_DK" "da_DK"
    }
}


aa_register_case \
	-cats db \
	strange_oracle_problem {
    Strange Oracle problem when selecting by language
    
} {
    set language "da "
    set locale da_DK

    set db_string [db_string select_default_locale { 
        select locale 
        from   ad_locales 
        where  language = :language
    } -default "WRONG"]
    
    aa_false "Does not return 'WRONG'" [string equal $db_string "WRONG"]
}


aa_register_case \
	-procs {
	    lang::user::set_timezone
	    lang::system::set_timezone
	    lang::system::timezone
	} set_get_timezone {

    Test that setting and getting user timezone works
} {
    # We cannot test timezones if they are not installed
    if { [lang::system::timezone_support_p] } {

        # Make sure we have a logged in user
        set org_user_id [ad_conn user_id]

        if { $org_user_id == 0 } {
            set user_id [db_string user { select min(user_id) from users }]
            ad_conn -set user_id $user_id
        } else {
            set user_id $org_user_id
        }

        # Remember originals so we can restore them
        set system_timezone [lang::system::timezone]
        set user_timezone [lang::user::timezone]


        set timezones [lc_list_all_timezones]
        
        set desired_user_timezone [lindex [lindex $timezones [randomRange [expr {[llength $timezones]-1}]]] 0]
        set desired_system_timezone [lindex [lindex $timezones [randomRange [expr {[llength $timezones]-1}]]] 0]
        
        set error_p 0
        with_catch errmsg {
            # User timezone
            lang::user::set_timezone $desired_user_timezone
            aa_equals "User timezone retrieved is the same as the one set" [lang::user::timezone] $desired_user_timezone
            
            # Storage
            set user_id [ad_conn user_id]
            aa_equals "User timezone stored in user_preferences table" \
                [db_string user_prefs { select timezone from user_preferences where user_id = :user_id }] \
                $desired_user_timezone
            
            
            # System timezone
            lang::system::set_timezone $desired_system_timezone
            aa_equals "System timezone retrieved is the same as the one set" [lang::system::timezone] $desired_system_timezone
            
            # Connection timezone
            aa_equals "Using user timezone" [lang::conn::timezone] $desired_user_timezone
            
            ad_conn -set isconnected 0
            aa_equals "Fallback to system timezone when no connection" [lang::conn::timezone] $desired_system_timezone
            ad_conn -set isconnected 1

            lang::user::set_timezone {}
            aa_equals "Fallback to system timezone when no user pref" [lang::conn::timezone] $desired_system_timezone

        } {
            set error_p 1
        }
        
        # Clean up
        lang::system::set_timezone $system_timezone
        lang::user::set_timezone $user_timezone
        ad_conn -set user_id $org_user_id

        if { $error_p } {
            # rethrow the error
            global errorInfo
            error $errmsg $errorInfo
        }
    }
}

aa_register_case \
	-procs {
	    lang::user::set_timezone
	    lang::system::timezone
	} set_timezone_not_logged_in {
    Test that setting and getting user timezone throws an error when user is not logged in
} {
    # We cannot test timezones if they are not installed
    if { [lang::system::timezone_support_p] } {

        set user_id [ad_conn user_id]

        ad_conn -set user_id 0
        aa_equals "Fallback to system timezone when no user" [lang::conn::timezone] [lang::system::timezone]

        set error_p [catch { lang::user::set_timezone [lang::system::timezone] } errmsg]
        aa_true "Error when setting user timezone when user not logged in" $error_p

        # Reset the user_id 
        ad_conn -set user_id $user_id
    }
}

aa_register_case lc_time_fmt_Z_timezone {
    lc_time_fmt %Z returns current connection timezone
} {
    aa_equals "%Z returns current timezone" [lc_time_fmt "2003-08-15 13:40:00" "%Z"] [lang::conn::timezone]
}

aa_register_case \
    -procs {
	lang::message::lookup
    } locale_language_fallback {
    Test that we fall back to 'default locale for language' when requesting a message 
    which exists in default locale for language, but not in the current locale
} {
    # Assuming we have en_US and en_GB
    
    set package_key "acs-lang"
    set message_key [ad_generate_random_string]

    set us_message [ad_generate_random_string]
    set gb_message [ad_generate_random_string]
    
    set error_p 0
    with_catch saved_error {
        lang::message::register "en_US" $package_key $message_key $us_message
        
        aa_equals "Looking up message in GB returns US message" \
            [lang::message::lookup "en_GB" "$package_key.$message_key" "NOT FOUND"] \
            $us_message

        lang::message::register "en_GB" $package_key $message_key $gb_message
        
        aa_equals "Looking up message in GB returns GB message" \
            [lang::message::lookup "en_GB" "$package_key.$message_key" "NOT FOUND"] \
            $gb_message
    } {
        set error_p 1
        global errorInfo
        set saved_errorInfo $errorInfo
    }

    # Clean up
    db_dml delete_msg { delete from lang_messages where package_key = :package_key and message_key = :message_key }
    db_dml delete_key { delete from lang_message_keys where package_key = :package_key and message_key = :message_key }

    if { $error_p } {
        error $saved_error $saved_errorInfo
    }
}

aa_register_case \
    -procs {
	lang::catalog::import
	lang::message::edit
	lang::message::get
    } upgrade {
    Test that a package can be upgraded with new
    catalog files and that the resulting keys and messages
    in the database can then be exported properly.

    What we are testing is a scenario similar to what we have on the OpenACS
    Translation server (http://translate.openacs.org).

    @author Peter Marklund
} {
    # Create the test package in the file system
    lang::test::setup_test_package

    # Can't run this test case with the usual rollback switch since if everthing
    # is wrapped in one transaction then the creation_date of the messages will be the
    # same and the query in lang::catalog::last_sync_messages will return duplicates.
    aa_run_with_teardown \
        -test_code {

        lang::test::execute_upgrade -locale en_US

        lang::system::locale_set_enabled \
            -locale de_DE \
            -enabled_p t

        lang::test::execute_upgrade -locale de_DE

    } -teardown_code {                 
        foreach message_key [array names upgrade_expect] {
            lang::message::unregister $package_key $message_key
        }    
        lang::test::teardown_test_package
    }
}

aa_register_case -procs {
    lang::util::localize
} localize {

    @author Peter Marklund
} {
    set package_key "acs-lang"
    set message_key "__test-key"
    set message "Test message"

    aa_run_with_teardown \
        -rollback \
        -test_code {

            # Create a temporary test message to test with
            lang::message::register en_US $package_key $message_key $message

            # Create some random character strings to surround the embedded key
            set pre_text "a;<ls#;#kdfj'...,mlkjoiu><wgon"
            set post_text "a;lskd<fj'...,mlkjo>iuwgon#"
            set message_key_embedded "#${package_key}.${message_key}#"

            # Test replacements
            set text1 $message_key_embedded
            aa_equals "One message key with no surrounding text" [lang::util::localize $text1] "${message}"

            set text1 "${pre_text}${message_key_embedded}${post_text}"
            aa_equals "One message key with surrounding text" [lang::util::localize $text1] "${pre_text}${message}${post_text}"

            set text1 "${pre_text}${message_key_embedded}"
            aa_equals "One message key with text before" [lang::util::localize $text1] "${pre_text}${message}"

            set text1 "${message_key_embedded}${post_text}"
            aa_equals "One message key with text after" [lang::util::localize $text1] "${message}${post_text}"

            set text1 "${pre_text}${message_key_embedded}${post_text}${pre_text}${message_key_embedded}${post_text}"
            aa_equals "Two message keys with surrounding text" [lang::util::localize $text1] \
                "${pre_text}${message}${post_text}${pre_text}${message}${post_text}"
        } -teardown_code {
            # We need to clear the cache
            lang::message::unregister $package_key $message_key
        }
}
