- package_key - package_version - locale - charset - messages - An array with message keys as keys and the message texts as values. -+ad_proc -private lang::catalog::parse { catalog_file_contents } { + Parse the given catalog file xml contents and return the data as + an array. The array will contain the following keys: - @author Peter Marklund (peter@collaboraid.biz) - } { +
+ package_key + package_version + locale + charset + messages - An array with message keys as keys and the message texts as values. +- # Check arguments - if { [empty_string_p $catalog_file_contents] } { - error "lang::catalog::parse the catalog_file_contents arguments is the empty string" - } + @author Peter Marklund (peter@collaboraid.biz) +} { - # The names of xml tags and attributes - set MESSAGE_CATALOG_TAG "message_catalog" - set PACKAGE_KEY_ATTR "package_key" - set PACKAGE_VERSION_ATTR "package_version" - set LOCALE_ATTR "locale" - set CHARSET_ATTR "charset" - set MESSAGE_TAG "msg" - set KEY_ATTR "key" + # Check arguments + if { [empty_string_p $catalog_file_contents] } { + error "lang::catalog::parse the catalog_file_contents arguments is the empty string" + } - # Initialize the array to return - array set msg_catalog_array {} + # The names of xml tags and attributes + set MESSAGE_CATALOG_TAG "message_catalog" + set PACKAGE_KEY_ATTR "package_key" + set PACKAGE_VERSION_ATTR "package_version" + set LOCALE_ATTR "locale" + set CHARSET_ATTR "charset" + set MESSAGE_TAG "msg" + set KEY_ATTR "key" - # Parse the xml document - set tree [xml_parse -persist $catalog_file_contents] + # Initialize the array to return + array set msg_catalog_array {} - # Get the message catalog root node - set root_node [xml_doc_get_first_node $tree] - if { ![string equal [xml_node_get_name $root_node] ${MESSAGE_CATALOG_TAG}] } { - error "lang::catalog_parse: Could not find root node ${MESSAGE_CATALOG_TAG}" - } + # Parse the xml document + set tree [xml_parse -persist $catalog_file_contents] - # Set the message catalog root level attributes - set msg_catalog_array(package_key) [get_required_xml_attribute $root_node ${PACKAGE_KEY_ATTR}] - set msg_catalog_array(package_version) [get_required_xml_attribute $root_node ${PACKAGE_VERSION_ATTR}] - set msg_catalog_array(locale) [get_required_xml_attribute $root_node ${LOCALE_ATTR}] - set msg_catalog_array(charset) [get_required_xml_attribute $root_node ${CHARSET_ATTR}] + # Get the message catalog root node + set root_node [xml_doc_get_first_node $tree] + if { ![string equal [xml_node_get_name $root_node] ${MESSAGE_CATALOG_TAG}] } { + error "lang::catalog_parse: Could not find root node ${MESSAGE_CATALOG_TAG}" + } - # Loop over the keys and texts - set message_node_list [xml_node_get_children_by_name $root_node ${MESSAGE_TAG}] - array set key_text_array {} - foreach message_node $message_node_list { - set key [get_required_xml_attribute $message_node ${KEY_ATTR}] - set text [xml_node_get_content $message_node ] - set key_text_array($key) $text - } + # Set the message catalog root level attributes + set msg_catalog_array(package_key) [get_required_xml_attribute $root_node ${PACKAGE_KEY_ATTR}] + set msg_catalog_array(package_version) [get_required_xml_attribute $root_node ${PACKAGE_VERSION_ATTR}] + set msg_catalog_array(locale) [get_required_xml_attribute $root_node ${LOCALE_ATTR}] + set msg_catalog_array(charset) [get_required_xml_attribute $root_node ${CHARSET_ATTR}] - # Add the keys and the texts to the array - set msg_catalog_array(messages) [array get key_text_array] + # Loop over the keys and texts + set message_node_list [xml_node_get_children_by_name $root_node ${MESSAGE_TAG}] + array set key_text_array {} + foreach message_node $message_node_list { + set key [get_required_xml_attribute $message_node ${KEY_ATTR}] + set text [xml_node_get_content $message_node ] + set key_text_array($key) $text + } - return [array get msg_catalog_array] - } + # Add the keys and the texts to the array + set msg_catalog_array(messages) [array get key_text_array] - ad_proc -private get_required_xml_attribute { element attribute } { - Return the value of the given attribute and raise an error if the - value is missing or empty. + return [array get msg_catalog_array] +} - @author Peter Marklund (peter@collaboraid.biz) - } { - set value [xml_node_get_attribute $element $attribute] + ad_proc -private lang::catalog::get_required_xml_attribute { element attribute } { + Return the value of the given attribute and raise an error if the + value is missing or empty. - if { [empty_string_p $value] } { - error "Required attribute \"$attribute\" missing from <[xml_node_get_name $element]>" - } + @author Peter Marklund (peter@collaboraid.biz) + } { + set value [xml_node_get_attribute $element $attribute] - return $value - } + if { [empty_string_p $value] } { + error "Required attribute \"$attribute\" missing from <[xml_node_get_name $element]>" + } - ad_proc -public export_package_to_files { package_key } { - Export all messages of the given package from the database to xml - catalog files. The messages for each locale are stored in its own file. - The catalog files are stored in the - directory /packages/package_key/catalog with a filename on the format - package_key.locale.charset.xml (i.e. dotlrn.en_US.iso-8859-1.xml). + return $value + } - @author Peter Marklund (peter@collaboraid.biz) - } { - # Loop over all locales that the package has messages in - # and write a catalog file for each such locale - db_foreach get_locales_for_package {} { - set charset [ad_locale charset $locale] + ad_proc -public lang::catalog::export_package_to_files { package_key } { + Export all messages of the given package from the database to xml + catalog files. The messages for each locale are stored in its own file. + The catalog files are stored in the + directory /packages/package_key/catalog with a filename on the format + package_key.locale.charset.xml (i.e. dotlrn.en_US.iso-8859-1.xml). - # Get all messages in the current locale and put them in an array list - set messages_list [list] - all_messages_for_package_and_locale $package_key $locale - template::util::multirow_foreach all_messages { - lappend messages_list @all_messages.message_key@ @all_messages.message@ - } + @author Peter Marklund (peter@collaboraid.biz) + } { + # Loop over all locales that the package has messages in + # and write a catalog file for each such locale + db_foreach get_locales_for_package {} { + set charset [ad_locale charset $locale] - # Write the messages to the file - set catalog_file_name "[package_catalog_dir $package_key]/${package_key}.${locale}.${charset}.xml" - export_messages_to_file $catalog_file_name $messages_list - } - } + # Get all messages in the current locale and put them in an array list + set messages_list [list] + all_messages_for_package_and_locale $package_key $locale + template::util::multirow_foreach all_messages { + lappend messages_list @all_messages.message_key@ @all_messages.message@ + } - ad_proc -private all_messages_for_package_and_locale { package_key locale } { - Set a multirow with name all_messages locally in the callers scope with - the columns message_key and message for all message keys that do - not have an upgrade status of deleted. + # Write the messages to the file + set catalog_file_name "[package_catalog_dir $package_key]/${package_key}.${locale}.${charset}.xml" + export_messages_to_file $catalog_file_name $messages_list + } +} - @author Peter Marklund - } { - db_multirow -local -upvar_level 2 all_messages get_messages {} - } - - ad_proc -private package_catalog_dir { package_key } { - Return the catalog directory of the given package. +ad_proc -private lang::catalog::all_messages_for_package_and_locale { package_key locale } { + Set a multirow with name all_messages locally in the callers scope with + the columns message_key and message for all message keys that do + not have an upgrade status of deleted. - @author Peter Marklund (peter@collaboraid.biz) - @creation-date 18 October 2002 - } { - return "[acs_package_root_dir $package_key]/catalog" - } + @author Peter Marklund +} { + db_multirow -local -upvar_level 2 all_messages get_messages {} +} + +ad_proc -private lang::catalog::package_catalog_dir { package_key } { + Return the catalog directory of the given package. - ad_proc -public is_upgrade_backup_file { file_path } { - Given a file path return 1 if the path represents a - file with messages backed up from message catalog upgrade. + @author Peter Marklund (peter@collaboraid.biz) + @creation-date 18 October 2002 +} { + return "[acs_package_root_dir $package_key]/catalog" +} - @author Peter Marklund - } { - array set filename_info [apm_parse_catalog_path $file_path] +ad_proc -public lang::catalog::is_upgrade_backup_file { file_path } { + Given a file path return 1 if the path represents a + file with messages backed up from message catalog upgrade. - if { [array size filename_info] == 0 } { - # Parsing failed - set return_value 0 - } else { - # Parsing succeeded - set prefix $filename_info(prefix) - if { [regexp "^[message_backup_file_prefix]" $prefix match] } { - # The prefix looks right - set return_value 1 - } else { - # Catalog file with unknown prefix - ns_log Warning "lang::catalog::is_upgrade_backup_file - The file $file_path has unknown prefix $prefix" - set return_value 0 - } - } + @author Peter Marklund +} { + array set filename_info [apm_parse_catalog_path $file_path] - return $return_value - } + if { [array size filename_info] == 0 } { + # Parsing failed + set return_value 0 + } else { + # Parsing succeeded + set prefix $filename_info(prefix) + if { [regexp "^[message_backup_file_prefix]" $prefix match] } { + # The prefix looks right + set return_value 1 + } else { + # Catalog file with unknown prefix + ns_log Warning "lang::catalog::is_upgrade_backup_file - The file $file_path has unknown prefix $prefix" + set return_value 0 + } + } - ad_proc -private message_backup_file_prefix {} { - The prefix used for files where we store old messages that were - overwritten during message catalog upgrade. - } { - return "overwritten_messages_upgrade_" - } + return $return_value +} - ad_proc -private assert_catalog_file { catalog_file_path } { - Throws an error if the given path is not valid for a catalog file. +ad_proc -private lang::catalog::message_backup_file_prefix {} { + The prefix used for files where we store old messages that were + overwritten during message catalog upgrade. +} { + return "overwritten_messages_upgrade_" +} - @see apm_is_catalog_file +ad_proc -private lang::catalog::assert_catalog_file { catalog_file_path } { + Throws an error if the given path is not valid for a catalog file. - @author Peter Marklund - } { - if { ![apm_is_catalog_file $catalog_file_path] } { - error "lang::catalog::assert_filename_format - Invalid message catalog path, cannot extract package_key, locale, and charset from file path $catalog_file_path" - } - } + @see apm_is_catalog_file - ad_proc -public export_messages_to_file { file_path messages_list } { + @author Peter Marklund +} { + if { ![apm_is_catalog_file $catalog_file_path] } { + error "lang::catalog::assert_filename_format - Invalid message catalog path, cannot extract package_key, locale, and charset from file path $catalog_file_path" + } +} - Export messages for a certain locale and package from the database - to a given XML catalog file. - If the catalog file already exists it will be backed up to a file with the - same name but the extension .orig added to it. If there is an old backup - file no new backup is done. - - @param file_path The path of the catalog file to write messages to. The - path must be on valid format, see apm_is_catalog_file - and lang::catalog::is_upgrade_backup_file. - The file and the catalog directory will be created if they don't exist. +ad_proc -public lang::catalog::export_messages_to_file { file_path messages_list } { - @param message_list A list with message keys on even indices followed by - corresponding messages on odd indices. + Export messages for a certain locale and package from the database + to a given XML catalog file. + If the catalog file already exists it will be backed up to a file with the + same name but the extension .orig added to it. If there is an old backup + file no new backup is done. + + @param file_path The path of the catalog file to write messages to. The + path must be on valid format, see apm_is_catalog_file + and lang::catalog::is_upgrade_backup_file. + The file and the catalog directory will be created if they don't exist. - @author Peter Marklund (peter@collaboraid.biz) - } { - # Check arguments - if { !([apm_is_catalog_file $file_path] || [is_upgrade_backup_file $file_path]) } { - ns_log Error "lang::catalog::export_messages_to_file - Invalid format of catalog file path $file_path. Refusing to write file" - return - } + @param message_list A list with message keys on even indices followed by + corresponding messages on odd indices. - # Put the messages in an array so it's easier to access them - array set messages_array $messages_list - # Sort the keys so that it's easier to manually read and edit the catalog files - set message_key_list [lsort -dictionary [array names messages_array]] + @author Peter Marklund (peter@collaboraid.biz) +} { + # Check arguments + if { !([apm_is_catalog_file $file_path] || [is_upgrade_backup_file $file_path]) } { + ns_log Error "lang::catalog::export_messages_to_file - Invalid format of catalog file path $file_path. Refusing to write file" + return + } - # Extract package_key, locale, and charset from the file path - array set filename_info [apm_parse_catalog_path $file_path] + # Put the messages in an array so it's easier to access them + array set messages_array $messages_list + # Sort the keys so that it's easier to manually read and edit the catalog files + set message_key_list [lsort -dictionary [array names messages_array]] - # Create the catalog directory if it doesn't exist - set catalog_dir [package_catalog_dir $filename_info(package_key)] - if { ![file isdirectory $catalog_dir] } { - ns_log Notice "lang::catalog::export_messages_to_file - Creating new catalog directory $catalog_dir" - file mkdir $catalog_dir - } + # Extract package_key, locale, and charset from the file path + array set filename_info [apm_parse_catalog_path $file_path] - # Create a backup file first if there isn't one already - set backup_path "${file_path}.orig" - if { [file exists $file_path] && ![file exists $backup_path] } { - ns_log Notice "lang::catalog::export_messages_to_file - Backing up catalog file $file_path" - file copy -- $file_path $backup_path - } else { - ns_log Notice "lang::catalog::export_messages_to_file - Not backing up $file_path as backup file already exists" - } + # Create the catalog directory if it doesn't exist + set catalog_dir [package_catalog_dir $filename_info(package_key)] + if { ![file isdirectory $catalog_dir] } { + ns_log Notice "lang::catalog::export_messages_to_file - Creating new catalog directory $catalog_dir" + file mkdir $catalog_dir + } - # Open the catalog file for writing, truncate if it exists - set catalog_file_id [open $file_path w] - fconfigure $catalog_file_id -encoding [ns_encodingforcharset [default_charset_if_unsupported $filename_info(charset)]] + # Create a backup file first if there isn't one already + set backup_path "${file_path}.orig" + if { [file exists $file_path] && ![file exists $backup_path] } { + ns_log Notice "lang::catalog::export_messages_to_file - Backing up catalog file $file_path" + file copy -- $file_path $backup_path + } else { + ns_log Notice "lang::catalog::export_messages_to_file - Not backing up $file_path as backup file already exists" + } - # Open the root node of the document - set package_version [system_package_version_name $filename_info(package_key)] - puts $catalog_file_id " + # Open the catalog file for writing, truncate if it exists + set catalog_file_id [open $file_path w] + fconfigure $catalog_file_id -encoding [ns_encodingforcharset [default_charset_if_unsupported $filename_info(charset)]] + + # Open the root node of the document + set package_version [system_package_version_name $filename_info(package_key)] + puts $catalog_file_id "
- Import messages for a certain locale and package from a given XML - catalog file to the database. This procedure invokes lang::catalog::parse - to read the catalog file and lang::message::register - to register the messages with the system (updates database and cache). -
+ad_proc -public lang::catalog::import_messages_from_file { + file_path +} { ++ Import messages for a certain locale and package from a given XML + catalog file to the database. This procedure invokes lang::catalog::parse + to read the catalog file and lang::message::register + to register the messages with the system (updates database and cache). +
-- To determine if the import is a message catalog upgrade the package - version of the catalog file will be compared with the highest package version - currently in the system (in the database). If the package version in the - catalog file deviates from what is in the system then the import is considered an upgrade. -
++ To determine if the import is a message catalog upgrade the package + version of the catalog file will be compared with the highest package version + currently in the system (in the database). If the package version in the + catalog file deviates from what is in the system then the import is considered an upgrade. +
-
- For upgrades, changed messages will have their old values (the ones in the
- database that are overwritten) backed up to a file with a name on a format along the lines of
- overwritten_messages_upgrade.
+ For upgrades, changed messages will have their old values (the ones in the
+ database that are overwritten) backed up to a file with a name on a format along the lines of
+ overwritten_messages_upgrade.
- Not a good idea to run this procedure if you have - a large message catalog. Use for testing purposes only. - - @author John Lowry (lowry@arsdigita.com) - - } { - set default_locale [parameter::get -package_id [apm_package_id_from_key acs-lang] -parameter SiteWideLocale] - db_foreach get_untranslated_messages {} { - foreach lang [list es_ES fr_FR de_DE] { - if [catch { - set translated_message [lang_babel_translate $message en_$lang] - } errmsg] { - ns_log Notice "Error translating $message into $lang: $errmsg" - } else { - lang::message::register $lang $package_key $message_key $translated_message - } +} + +ad_proc -private lang::catalog::translate {} { + Translates all untranslated strings in a message catalog + from English into Spanish, French and German + using Babelfish. Quick way to get a multilingual site up and + running if you can live with the quality of the translations. +
+ Not a good idea to run this procedure if you have + a large message catalog. Use for testing purposes only. + + @author John Lowry (lowry@arsdigita.com) + +} { + set default_locale [parameter::get -package_id [apm_package_id_from_key acs-lang] -parameter SiteWideLocale] + db_foreach get_untranslated_messages {} { + foreach lang [list es_ES fr_FR de_DE] { + if [catch { + set translated_message [lang_babel_translate $message en_$lang] + } errmsg] { + ns_log Notice "Error translating $message into $lang: $errmsg" + } else { + lang::message::register $lang $package_key $message_key $translated_message } - } - } + } + } } + ##### # # Backwards compatibility procs Index: openacs-4/packages/acs-lang/tcl/lang-message-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-lang/tcl/lang-message-procs.tcl,v diff -u -N -r1.20 -r1.21 --- openacs-4/packages/acs-lang/tcl/lang-message-procs.tcl 23 Jan 2003 11:06:43 -0000 1.20 +++ openacs-4/packages/acs-lang/tcl/lang-message-procs.tcl 11 Aug 2003 16:17:27 -0000 1.21 @@ -15,426 +15,434 @@ @cvs-id $Id$ } -namespace eval lang::message { +namespace eval lang::message {} - ad_proc -public register { - -upgrade:boolean - locale - package_key - message_key - message - } { -
- Registers a message for a given locale and package. - Inserts the message key into the database if it - doesn't already exists. Inserts the message itself - in the given locale into the database if it doesn't - exist and updates it if it does. Also updates the - cache with the message. -
+ad_proc -public lang::message::register { + -upgrade:boolean + locale + package_key + message_key + message + comment +} { ++ Registers a message for a given locale and package. + Inserts the message key into the database if it + doesn't already exists. Inserts the message itself + in the given locale into the database if it doesn't + exist and updates it if it does. Also updates the + cache with the message. +
-- If we are registering a message as part of an upgrade, appropriate - upgrade status for the message key (added) and the message (updated or - added) will be set. -
++ If we are registering a message as part of an upgrade, appropriate + upgrade status for the message key (added) and the message (updated or + added) will be set. +
- @author Jeff Davis - @author Peter Marklund - @author Bruno Mattarollo (bruno.mattarollo@ams.greenpeace.org) - @author Christian Hvid + @author Jeff Davis + @author Peter Marklund + @author Bruno Mattarollo (bruno.mattarollo@ams.greenpeace.org) + @author Christian Hvid - @see _mr - - @param locale Locale or language of the message. If a language is supplied, - the default locale for the language is looked up. + @see _mr + + @param locale Locale or language of the message. If a language is supplied, + the default locale for the language is looked up. - @param package_key The package key of the package that the message belongs to. - @param message_key The key that identifies the message within the package. - @param message The message text - @param upgrade A boolean switch indicating if this message is registered - as part of a message catalog upgrade or not. The default - (switch not provided) is that we are not upgrading. - } { - # Create a globally unique key for the cache - set key "${package_key}.${message_key}" + @param package_key The package key of the package that the message belongs to. + @param message_key The key that identifies the message within the package. + @param message The message text + @param upgrade A boolean switch indicating if this message is registered + as part of a message catalog upgrade or not. The default + (switch not provided) is that we are not upgrading. +} { + # Create a globally unique key for the cache + set key "${package_key}.${message_key}" - # Insert the message key into the database if it doesn't - # already exist - set key_exists_p [db_string message_key_exists_p {}] + # Insert the message key into the database if it doesn't + # already exist + set key_exists_p [db_string message_key_exists_p {}] - if { ! $key_exists_p } { - set key_upgrade_status [ad_decode $upgrade_p 1 "added" "no_upgrade"] - if { $upgrade_p } { - ns_log Notice "lang::message::register - Giving message key $message_key an upgrade status of $key_upgrade_status" - } - db_dml insert_message_key {} + if { ! $key_exists_p } { + set key_upgrade_status [ad_decode $upgrade_p 1 "added" "no_upgrade"] + if { $upgrade_p } { + ns_log Notice "lang::message::register - Giving message key $message_key an upgrade status of $key_upgrade_status" } + db_dml insert_message_key {} + } - # Qualify the locale variable value with a country code if it is - # just a language - if { [string length $locale] == 2 } { - # It seems to be a language (iso codes are 2 characters) - # We don't do a more throughout check since this is not - # invoked by users. - # let's get the default locale for that language - set locale [util_memoize [list ad_locale_locale_from_lang $locale]] - } + # Qualify the locale variable value with a country code if it is + # just a language + if { [string length $locale] == 2 } { + # It seems to be a language (iso codes are 2 characters) + # We don't do a more throughout check since this is not + # invoked by users. + # let's get the default locale for that language + set locale [util_memoize [list ad_locale_locale_from_lang $locale]] + } - # Different logic for update and insert - if { [nsv_exists lang_message_$locale $key] } { - # Update existing message if the message has changed + # Different logic for update and insert + if { [nsv_exists lang_message_$locale $key] } { + # Update existing message if the message has changed - set old_message [nsv_get lang_message_$locale $key] - if { ![string equal $message $old_message] } { + set old_message [nsv_get lang_message_$locale $key] - lang::audit::changed_message $old_message $package_key $message_key $locale + lang::audit::changed_message $old_message $package_key $message_key $locale $comment - set message_upgrade_status [ad_decode $upgrade_p 1 "updated" "no_upgrade"] - if { $upgrade_p } { - ns_log Notice "lang::message::register - Giving message for key $message_key in locale $locale an upgrade status of $message_upgrade_status" - } + set message_upgrade_status [ad_decode $upgrade_p 1 "updated" "no_upgrade"] + if { $upgrade_p } { + ns_log Notice "lang::message::register - Giving message for key $message_key in locale $locale an upgrade status of $message_upgrade_status" + } - # Trying to avoid hitting Oracle bug#2011927 - if { [empty_string_p [string trim $message]] } { - db_dml lang_message_null_update {} - } else { - db_dml lang_message_update {} -clobs [list $message] - } - nsv_set lang_message_$locale $key $message - } + # Trying to avoid hitting Oracle bug#2011927 + if { [empty_string_p [string trim $message]] } { + db_dml lang_message_null_update {} } else { - # Insert new message + db_dml lang_message_update {} -clobs [list $message] + } + nsv_set lang_message_$locale $key $message - db_transaction { - set message_upgrade_status [ad_decode $upgrade_p 1 "added" "no_upgrade"] - if { $upgrade_p } { - ns_log Notice "lang::message::register - Giving message for key $message_key in locale $locale an upgrade status of $message_upgrade_status" - } + } else { + # Insert new message - # avoiding bug#2011927 from Oracle. - if { [empty_string_p [string trim $message]] } { - db_dml lang_message_insert_null_msg {} - } else { - # LARS: - # We may need to have two different lines here, one for - # Oracle w/clobs, one for PG w/o clobs. - db_dml lang_message_insert {} -clobs [list $message] - } - nsv_set lang_message_$locale $key $message + db_transaction { + set message_upgrade_status [ad_decode $upgrade_p 1 "added" "no_upgrade"] + if { $upgrade_p } { + ns_log Notice "lang::message::register - Giving message for key $message_key in locale $locale an upgrade status of $message_upgrade_status" } + + # avoiding bug#2011927 from Oracle. + if { [empty_string_p [string trim $message]] } { + db_dml lang_message_insert_null_msg {} + } else { + # LARS: + # We may need to have two different lines here, one for + # Oracle w/clobs, one for PG w/o clobs. + db_dml lang_message_insert {} -clobs [list $message] + } + nsv_set lang_message_$locale $key $message } } +} - ad_proc -private get_missing_embedded_vars { - existing_message - new_message - } { - Returns a list of variables that are in an existing message and should - also be in a new message with the same key but a different locale. - The set of embedded variables in the messages for a certain key - should be identical across locales. +ad_proc -private lang::message::get_missing_embedded_vars { + existing_message + new_message +} { + Returns a list of variables that are in an existing message and should + also be in a new message with the same key but a different locale. + The set of embedded variables in the messages for a certain key + should be identical across locales. - @param existing_message The existing message with vars that should - also be in the new message - @param new_message The new message that we are checking for - consistency. + @param existing_message The existing message with vars that should + also be in the new message + @param new_message The new message that we are checking for + consistency. - @return The list of variables in the existing en_US message - that are missing in the new message. + @return The list of variables in the existing en_US message + that are missing in the new message. - @author Peter Marklund (peter@collaboraid.biz) - @creation-date 12 November 2002 - } { - # Loop over the vars in the en_US message - set missing_variable_list [list] - set remaining_message $existing_message - while { [regexp [embedded_vars_regexp] $remaining_message match before_percent \ - percent_match \ - remaining_message] } { - if { [string equal $percent_match "%%"] } { - # A quoted percentage sign - ignore - continue - } else { - # A variable - check that it is in the new message - if { ![regexp "(?:^|\[^%]\)${percent_match}" $new_message match] } { - # The variable is missing - set variable_name [string range $percent_match 1 end-1] - lappend missing_variable_list $variable_name - } + @author Peter Marklund (peter@collaboraid.biz) + @creation-date 12 November 2002 +} { + # Loop over the vars in the en_US message + set missing_variable_list [list] + set remaining_message $existing_message + while { [regexp [embedded_vars_regexp] $remaining_message match before_percent \ + percent_match \ + remaining_message] } { + if { [string equal $percent_match "%%"] } { + # A quoted percentage sign - ignore + continue + } else { + # A variable - check that it is in the new message + if { ![regexp "(?:^|\[^%]\)${percent_match}" $new_message match] } { + # The variable is missing + set variable_name [string range $percent_match 1 end-1] + lappend missing_variable_list $variable_name } } - - return $missing_variable_list } - ad_proc -private format { - localized_message - {value_array_list {}} - {upvar_level 3} - } { - Substitute all occurencies of %array_key% - in the given localized message with the value from a lookup in the value_array_list - with array_key (what's between the percentage sings). If value_array_list is not - provided then attempt to fetch variable values the number of levels up given by - upvar_level (defaults to 3 because this proc is typically invoked from the underscore - lookup proc). + return $missing_variable_list +} - Here is an example: +ad_proc -private lang::message::format { + localized_message + {value_array_list {}} + {upvar_level 3} +} { + Substitute all occurencies of %array_key% + in the given localized message with the value from a lookup in the value_array_list + with array_key (what's between the percentage sings). If value_array_list is not + provided then attempt to fetch variable values the number of levels up given by + upvar_level (defaults to 3 because this proc is typically invoked from the underscore + lookup proc). - 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} + Here is an example: - puts "[format $localized_message $value_list]" - - The output from the example is: + 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} - The frog jumped across the fence. About 50% of the time, he stumbled, or maybe it was %20 %times%. - } { - - array set value_array $value_array_list - set value_array_keys [array names value_array] - set remaining_message $localized_message - set formated_message "" - while { [regexp [embedded_vars_regexp] $remaining_message match before_percent percent_match remaining_message] } { + puts "[format $localized_message $value_list]" - append formated_message $before_percent - - if { [string equal $percent_match "%%"] } { - # A quoted percent sign - append formated_message "%" - } else { - set variable_key [string range $percent_match 1 end-1] + The output from the example is: - if { [llength $value_array_list] > 0 } { - # A substitution list is provided, the key should be in there - - if { [lsearch -exact $value_array_keys $variable_key] == -1 } { - ns_log Warning "lang::message::format: The value_array_list \"$value_array_list\" does not contain the variable name $variable_key found in the message: $localized_message" - - # There is no value available to do the substitution with - # so don't substitute at all - append formated_message $percent_match - } else { - # Do the substitution - - append formated_message [lindex [array get value_array $variable_key] 1] - } - } else { - # No substitution list provided - attempt to fetch variable value - # from scope calling lang::message::lookup - upvar $upvar_level $variable_key variable_value + The frog jumped across the fence. About 50% of the time, he stumbled, or maybe it was %20 %times%. +} { - append formated_message $variable_value + array set value_array $value_array_list + set value_array_keys [array names value_array] + set remaining_message $localized_message + set formated_message "" + while { [regexp [embedded_vars_regexp] $remaining_message match before_percent percent_match remaining_message] } { + + append formated_message $before_percent + + if { [string equal $percent_match "%%"] } { + # A quoted percent sign + append formated_message "%" + } else { + set variable_key [string range $percent_match 1 end-1] + + if { [llength $value_array_list] > 0 } { + # A substitution list is provided, the key should be in there + + if { [lsearch -exact $value_array_keys $variable_key] == -1 } { + ns_log Warning "lang::message::format: The value_array_list \"$value_array_list\" does not contain the variable name $variable_key found in the message: $localized_message" + + # There is no value available to do the substitution with + # so don't substitute at all + append formated_message $percent_match + } else { + # Do the substitution + + append formated_message [lindex [array get value_array $variable_key] 1] } + } else { + # No substitution list provided - attempt to fetch variable value + # from scope calling lang::message::lookup + upvar $upvar_level $variable_key variable_value + + append formated_message $variable_value } } - - # Append text after the last match - append formated_message $remaining_message - - return $formated_message } - - ad_proc -private embedded_vars_regexp {} { - The regexp pattern used to loop over variables embedded in - message catalog texts. - @author Peter Marklund (peter@collaboraid.biz) - @creation-date 12 November 2002 - } { - return {^(.*?)(%%|%[a-zA-Z_\.]+%)(.*)$} - } + # Append text after the last match + append formated_message $remaining_message - ad_proc -public message_exists_p { locale key } { - Return 1 if message exists in given locale, 0 otherwise. + return $formated_message +} - @author Peter Marklund - } { - # Make sure the catalog files have been loaded - lang::catalog::import_from_all_files_and_cache +ad_proc -private lang::message::embedded_vars_regexp {} { + The regexp pattern used to loop over variables embedded in + message catalog texts. - return [nsv_exists lang_message_$locale $key] - } + @author Peter Marklund (peter@collaboraid.biz) + @creation-date 12 November 2002 +} { + return {^(.*?)(%%|%[a-zA-Z_\.]+%)(.*)$} +} - ad_proc -public lookup { - locale - key - {default "TRANSLATION MISSING"} - {substitution_list {}} - {upvar_level 2} - } { - This proc is normally accessed through the _ procedure. - - Returns a translated string for the given locale and message key. - If the user is a translator, inserts tags to link to the translator - interface. This allows a translator to work from the context of a web page. +ad_proc -public lang::message::message_exists_p { locale key } { + Return 1 if message exists in given locale, 0 otherwise. - @param locale Locale (e.g., "en_US") or language (e.g., "en") string. - If locale is the empty string ad_conn locale will be used - if we are in an HTTP connection, otherwise the system locale - (SiteWideLocale) will be used. - @param key Unique identifier for this message. Will be the same - identifier for each locale. All keys belong to a certain - package and should be prefixed with the package key of that package - on the format package_key.message_key (the dot is reserved for separating - the package key, the rest of the key should contain only alpha-numeric - characters and underscores). If the key does not belong to - any particular package it should not contain a dot. A lookup - is always attempted with the exact key given to this proc. - @param default Text to return if there is no message in the message catalog for - the given locale. This argument is optional. If this argument is - not provided or is the empty string then the text returned will - be TRANSLATION MISSING - $key. - @param substitution_list A list of values to substitute into the message. This argument should - only be given for certain messages that contain place holders (on the syntax - %var_name%) for embedding variable values, see lang::message::format. - If this list is not provided and the message has embedded variables, - then the variable values can be fetched with upvar from the scope - calling this proc (see upvar_level). + @author Peter Marklund +} { + # Make sure the catalog files have been loaded + # lang::catalog::import_from_all_files_and_cache + # LARS: Replaced with below: + cache - @param upvar_level If there are embedded variables and no substitution list provided, this - parameter specifies how many levels up to fetch the values of the variables - in the message. The reason the default is 2 is that the lookup proc is - usually invoked by the underscore proc (_). Set upvar level to less than - 1 if you don't want variable interpolation to be done. - - @author Jeff Davis (davis@arsdigita.com) - @author Henry Minsky (hqm@arsdigita.com) - @author Peter Marklund (peter@collaboraid.biz) - @see _ - - @return A localized piece of text. - } { - # Make sure the catalog files have been loaded - lang::catalog::import_from_all_files_and_cache + return [nsv_exists lang_message_$locale $key] +} - if { [empty_string_p $locale] } { - # No locale provided +ad_proc -public lang::message::lookup { + locale + key + {default "TRANSLATION MISSING"} + {substitution_list {}} + {upvar_level 2} +} { + This proc is normally accessed through the _ procedure. - if { [ad_conn isconnected] } { - # We are in an HTTP connection (request) so use that locale - set locale [ad_conn locale] - } else { - # There is no HTTP connection - resort to system locale - set system_locale [parameter::get -package_id [apm_package_id_from_key acs-lang] -parameter SiteWideLocale] - set locale $system_locale - } - } elseif { [string length $locale] == 2 } { - # Only language provided + Returns a translated string for the given locale and message key. + If the user is a translator, inserts tags to link to the translator + interface. This allows a translator to work from the context of a web page. - # let's get the default locale for this language - # The cache is flushed if the default locale for this language is - # changed. - set locale [util_memoize [list ad_locale_locale_from_lang $locale]] - } + @param locale Locale (e.g., "en_US") or language (e.g., "en") string. + If locale is the empty string ad_conn locale will be used + if we are in an HTTP connection, otherwise the system locale + (SiteWideLocale) will be used. + @param key Unique identifier for this message. Will be the same + identifier for each locale. All keys belong to a certain + package and should be prefixed with the package key of that package + on the format package_key.message_key (the dot is reserved for separating + the package key, the rest of the key should contain only alpha-numeric + characters and underscores). If the key does not belong to + any particular package it should not contain a dot. A lookup + is always attempted with the exact key given to this proc. + @param default Text to return if there is no message in the message catalog for + the given locale. This argument is optional. If this argument is + not provided or is the empty string then the text returned will + be TRANSLATION MISSING - $key. + @param substitution_list A list of values to substitute into the message. This argument should + only be given for certain messages that contain place holders (on the syntax + %var_name%) for embedding variable values, see lang::message::format. + If this list is not provided and the message has embedded variables, + then the variable values can be fetched with upvar from the scope + calling this proc (see upvar_level). + + @param upvar_level If there are embedded variables and no substitution list provided, this + parameter specifies how many levels up to fetch the values of the variables + in the message. The reason the default is 2 is that the lookup proc is + usually invoked by the underscore proc (_). Set upvar level to less than + 1 if you don't want variable interpolation to be done. + + @author Jeff Davis (davis@arsdigita.com) + @author Henry Minsky (hqm@arsdigita.com) + @author Peter Marklund (peter@collaboraid.biz) + @see _ - if { [lang::util::translator_mode_p] } { - # Translator mode - set up translate_url - - set key_split [split $key "."] - set package_key_part [lindex $key_split 0] - set message_key_part [lindex $key_split 1] - set return_url [ad_conn url] - if { [ns_getform] != "" } { - append return_url "?[export_entire_form_as_url_vars]" - } - - # return_url is already encoded and HTML quoted - set translate_url "/acs-lang/admin/edit-localized-message?[export_vars { { message_key $message_key_part } { locales $locale } { package_key $package_key_part } return_url }]" + @return A localized piece of text. +} { + # Make sure the catalog files have been loaded + # lang::catalog::import_from_all_files_and_cache + # LARS: Replaced with below: + cache + + if { [empty_string_p $locale] } { + # No locale provided + + if { [ad_conn isconnected] } { + # We are in an HTTP connection (request) so use that locale + set locale [ad_conn locale] + } else { + # There is no HTTP connection - resort to system locale + set system_locale [parameter::get -package_id [apm_package_id_from_key acs-lang] -parameter SiteWideLocale] + set locale $system_locale } + } elseif { [string length $locale] == 2 } { + # Only language provided - if { [message_exists_p $locale $key] } { - # Message exists in the given locale + # let's get the default locale for this language + # The cache is flushed if the default locale for this language is + # changed. + set locale [util_memoize [list ad_locale_locale_from_lang $locale]] + } - set return_value [nsv_get lang_message_$locale $key] - # Do any variable substitutions (interpolation of variables) - if { [llength $substitution_list] > 0 || ($upvar_level >= 1 && [string first "%" $return_value] != -1) } { - set return_value [lang::message::format $return_value $substitution_list [expr $upvar_level + 1]] - } - - if { [lang::util::translator_mode_p] } { - # Translator mode - return a translation link - append return_value "o" - } + if { [lang::util::translator_mode_p] } { + # Translator mode - set up translate_url + + set key_split [split $key "."] + set package_key_part [lindex $key_split 0] + set message_key_part [lindex $key_split 1] + set return_url [ad_conn url] + if { [ns_getform] != "" } { + append return_url "?[export_entire_form_as_url_vars]" + } + + # return_url is already encoded and HTML quoted + set translate_url "/acs-lang/admin/edit-localized-message?[export_vars { { message_key $message_key_part } { locales $locale } { package_key $package_key_part } return_url }]" + } - } else { - # There is no entry in the message catalog for the given locale + if { [message_exists_p $locale $key] } { + # Message exists in the given locale - if { [nsv_exists lang_message_en_US $key] != 0 } { - # The key exists but there is no translation in the current locale + set return_value [nsv_get lang_message_$locale $key] + # Do any variable substitutions (interpolation of variables) + if { [llength $substitution_list] > 0 || ($upvar_level >= 1 && [string first "%" $return_value] != -1) } { + set return_value [lang::message::format $return_value $substitution_list [expr $upvar_level + 1]] + } + + if { [lang::util::translator_mode_p] } { + # Translator mode - return a translation link + append return_value "o" + } - if { ![lang::util::translator_mode_p] } { - # We are not in translator mode + } else { + # There is no entry in the message catalog for the given locale - if { [string equal $default "TRANSLATION MISSING"] } { - set return_value "$default: $key" - } else { - set return_value $default - } - } else { - # Translator mode - return a translation link + if { [nsv_exists lang_message_en_US $key] != 0 } { + # The key exists but there is no translation in the current locale - set us_text [nsv_get lang_message_en_US $key] - # Do any variable substitutions (interpolation of variables) - if { [llength $substitution_list] > 0 || ($upvar_level >= 1 && [string first "%" $us_text] != -1) } { - set us_text [lang::message::format $us_text $substitution_list [expr $upvar_level + 1]] - } - + if { ![lang::util::translator_mode_p] } { + # We are not in translator mode - set return_value "$us_text*" + if { [string equal $default "TRANSLATION MISSING"] } { + set return_value "$default: $key" + } else { + set return_value $default } + } else { + # Translator mode - return a translation link - } { - # The key doesn't exist - this is a programming error + set us_text [nsv_get lang_message_en_US $key] + # Do any variable substitutions (interpolation of variables) + if { [llength $substitution_list] > 0 || ($upvar_level >= 1 && [string first "%" $us_text] != -1) } { + set us_text [lang::message::format $us_text $substitution_list [expr $upvar_level + 1]] + } + - set return_value "NO KEY: $key" - ns_log Error "lang::message::lookup key doesn't exist: $key" + set return_value "$us_text*" } + + } { + # The key doesn't exist - this is a programming error + + set return_value "NO KEY: $key" + ns_log Error "lang::message::lookup key doesn't exist: $key" } + } - return $return_value + return $return_value +} + +ad_proc -private lang::message::translate { + msg + locale +} { + Translates an English string into a different language + using Babelfish. + + Warning - october 2002: This is broken. + + @author Henry Minsky (hqm@mit.edu) + + @param msg String to translate + @param lang Abbreviation for lang in which to translate string + @return Translated string +} { + set lang [string range $locale 0 2] + set marker "XXYYZZXX. " + set qmsg "$marker $msg" + set url "http://babel.altavista.com/translate.dyn?doit=done&BabelFishFrontPage=yes&bblType=urltext&url=" + set babel_result [ns_httpget "$url&lp=$lang&urltext=[ns_urlencode $qmsg]"] + set result_pattern "$marker (\[^<\]*)" + if [regexp -nocase $result_pattern $babel_result ignore msg_tr] { + regsub "$marker." $msg_tr "" msg_tr + return [string trim $msg_tr] + } else { + error "Babelfish translation error" } +} - ad_proc -private translate { - msg - locale - } { - Translates an English string into a different language - using Babelfish. - Warning - october 2002: This is broken. - - @author Henry Minsky (hqm@mit.edu) - - @param msg String to translate - @param lang Abbreviation for lang in which to translate string - @return Translated string - } { - set lang [string range $locale 0 2] - set marker "XXYYZZXX. " - set qmsg "$marker $msg" - set url "http://babel.altavista.com/translate.dyn?doit=done&BabelFishFrontPage=yes&bblType=urltext&url=" - set babel_result [ns_httpget "$url&lp=$lang&urltext=[ns_urlencode $qmsg]"] - set result_pattern "$marker (\[^<\]*)" - if [regexp -nocase $result_pattern $babel_result ignore msg_tr] { - regsub "$marker." $msg_tr "" msg_tr - return [string trim $msg_tr] - } else { - error "Babelfish translation error" - } - } +ad_proc -private lang::message::cache { + {-package_key {}} +} { + Loads the entire message catalog from the database into the cache. +} { + # We segregate messages by language. It might reduce contention + # if we segregage instead by package. Check for problems with ns_info locks. + # LARS TODO: Use a mutex + if { ![nsv_exists lang_message_cache executed_p] } { + nsv_set lang_message_cache executed_p 1 - ad_proc -private cache { - {-package_key {}} - } { - Loads the entire message catalog from the database into the cache. - } { - # We segregate messages by language. It might reduce contention - # if we segregage instead by package. Check for problems with ns_info locks. - global message_cache_loaded_p - set message_cache_loaded_p 1 + ns_log Notice "lang::message::cache - Initializing message cache ..." if { [empty_string_p $package_key] } { set package_where_clause "" @@ -452,9 +460,10 @@ ns_log Notice "lang::message::cache - Initialized message cache with $i rows from database" } - } + + ##### # # Shorthand notation procs _ and _mr