Index: openacs-4/packages/acs-lang/tcl/lang-catalog-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-lang/tcl/lang-catalog-procs.tcl,v
diff -u -r1.18 -r1.19
--- openacs-4/packages/acs-lang/tcl/lang-catalog-procs.tcl 8 Aug 2003 12:21:27 -0000 1.18
+++ openacs-4/packages/acs-lang/tcl/lang-catalog-procs.tcl 11 Aug 2003 16:17:27 -0000 1.19
@@ -26,602 +26,602 @@
@cvs-id $Id$
}
-namespace eval lang::catalog {
+namespace eval lang::catalog {}
- ad_proc -private read_file { catalog_filename } {
- Returns the contents of the given catalog file as a string
- reading the file with the charset given in the filename.
-
- @param catalog_file_name The full path of the catalog file to read.
- The basename of the file should be on the form
- package_key.locale.charset.ending where ending
- is either cat or xml (i.e. dotlrn.en_US.iso-8859-1.xml
- or dotlrn.en_US.iso-8859-1.cat). The cat ending
- is for the deprecated tcl-based catalog files.
+ad_proc -private lang::catalog::read_file { catalog_filename } {
+ Returns the contents of the given catalog file as a string
+ reading the file with the charset given in the filename.
+
+ @param catalog_file_name The full path of the catalog file to read.
+ The basename of the file should be on the form
+ package_key.locale.charset.ending where ending
+ is either cat or xml (i.e. dotlrn.en_US.iso-8859-1.xml
+ or dotlrn.en_US.iso-8859-1.cat). The cat ending
+ is for the deprecated tcl-based catalog files.
- @author Jeff Davis
- @author Peter Marklund (peter@collaboraid.biz)
- } {
- if {![regexp {/([^/]*)\.([^/]*)\.(?:xml|cat)$} $catalog_filename match base msg_encoding]} {
- ns_log Warning "Charset info missing in filename assuming $catalog_filename is iso-8859-1"
- set msg_encoding iso-8859-1
- }
-
- set msg_encoding [default_charset_if_unsupported $msg_encoding]
+ @author Jeff Davis
+ @author Peter Marklund (peter@collaboraid.biz)
+} {
+ if {![regexp {/([^/]*)\.([^/]*)\.(?:xml|cat)$} $catalog_filename match base msg_encoding]} {
+ ns_log Warning "Charset info missing in filename assuming $catalog_filename is iso-8859-1"
+ set msg_encoding iso-8859-1
+ }
+
+ set msg_encoding [default_charset_if_unsupported $msg_encoding]
- ns_log Notice "lang::catalog::read_file reading $catalog_filename in $msg_encoding"
- set in [open $catalog_filename]
- fconfigure $in -encoding [ns_encodingforcharset $msg_encoding]
- set catalog_file_contents [read $in]
- close $in
+ ns_log Notice "lang::catalog::read_file reading $catalog_filename in $msg_encoding"
+ set in [open $catalog_filename]
+ fconfigure $in -encoding [ns_encodingforcharset $msg_encoding]
+ set catalog_file_contents [read $in]
+ close $in
- return $catalog_file_contents
- }
+ return $catalog_file_contents
+}
- ad_proc -private default_charset_if_unsupported { charset } {
- Will return the system default charset and issue a warning in the log
- file if the given charset is not supported by tcl. Otherwise
- the given charset is simply returned.
+ad_proc -private lang::catalog::default_charset_if_unsupported { charset } {
+ Will return the system default charset and issue a warning in the log
+ file if the given charset is not supported by tcl. Otherwise
+ the given charset is simply returned.
- @author Jeff Davis
- @author Peter Marklund (peter@collaboraid.biz)
- } {
- set ns_charsets [ns_charsets]
- # Do case insensitive matching
- if {[lsearch -regexp $ns_charsets "(?i)^${charset}\$"] < 0} {
- set default_charset [encoding system]
- ns_log Warning [list lang::catalog::default_charset_if_unsupported - charset $charset \
- not supported by tcl, assuming $default_charset]
- set charset_to_use $default_charset
- } else {
- set charset_to_use $charset
- }
-
- return $charset_to_use
+ @author Jeff Davis
+ @author Peter Marklund (peter@collaboraid.biz)
+} {
+ set ns_charsets [ns_charsets]
+ # Do case insensitive matching
+ if {[lsearch -regexp $ns_charsets "(?i)^${charset}\$"] < 0} {
+ set default_charset [encoding system]
+ ns_log Warning [list lang::catalog::default_charset_if_unsupported - charset $charset \
+ not supported by tcl, assuming $default_charset]
+ set charset_to_use $default_charset
+ } else {
+ set charset_to_use $charset
}
- ad_proc -private 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:
+ return $charset_to_use
+}
-
- 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 "
"
- # Loop over and write the messages to the file
- set message_count "0"
- foreach message_key $message_key_list {
- puts $catalog_file_id " [ad_quotehtml $messages_array($message_key)]"
- incr message_count
- }
+ # Loop over and write the messages to the file
+ set message_count "0"
+ foreach message_key $message_key_list {
+ puts $catalog_file_id " [ad_quotehtml $messages_array($message_key)]"
+ incr message_count
+ }
- # Close the root node and close the file
- puts $catalog_file_id ""
- close $catalog_file_id
+ # Close the root node and close the file
+ puts $catalog_file_id ""
+ close $catalog_file_id
- ns_log Notice "lang::catalog::export_messages_to_file - Wrote $message_count messages to file $file_path"
- }
+ ns_log Notice "lang::catalog::export_messages_to_file - Wrote $message_count messages to file $file_path"
+}
- ad_proc -public reset_upgrade_status_message_keys { package_key } {
- Before a package upgrade the upgrade status of message keys is cleared
- so that upgrade status always reflects the last upgrade.
+ad_proc -public lang::catalog::reset_upgrade_status_message_keys { package_key } {
+ Before a package upgrade the upgrade status of message keys is cleared
+ so that upgrade status always reflects the last upgrade.
- @author Peter Marklund
- } {
- db_dml reset_status {}
- }
+ @author Peter Marklund
+} {
+ db_dml reset_status {}
+}
- ad_proc -public 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).
-
+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.-....xml
- The upgrade status of message keys and messages will be updated during an upgrade.
- Also during package upgrades, before invoking this procedure for the catalog files of a package the upgrade
- status of message keys should be cleared with the proc
- lang::catalog::reset_upgrade_status_message_keys
-
+
+ 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.-....xml
+ The upgrade status of message keys and messages will be updated during an upgrade.
+ Also during package upgrades, before invoking this procedure for the catalog files of a package the upgrade
+ status of message keys should be cleared with the proc
+ lang::catalog::reset_upgrade_status_message_keys
+
- @param file_path The absolute path of the XML file to import messages from.
- The path must be on valid format, see apm_is_catalog_file
+ @param file_path The absolute path of the XML file to import messages from.
+ The path must be on valid format, see apm_is_catalog_file
- @see lang::catalog::parse
- @see lang::message::register
-
- @author Peter Marklund
- } {
- # Check arguments
- assert_catalog_file $file_path
+ @see lang::catalog::parse
+ @see lang::message::register
+
+ @author Peter Marklund
+} {
+ # Check arguments
+ assert_catalog_file $file_path
- # Parse the catalog file and put the information in an array
- array set catalog_array [parse [read_file $file_path]]
+ # Parse the catalog file and put the information in an array
+ array set catalog_array [parse [read_file $file_path]]
- # Extract package_key, locale, and charset from the file path
- array set filename_info [apm_parse_catalog_path $file_path]
- # Setting these variables to improve readability of code in this proc
- set package_key $filename_info(package_key)
- set locale $filename_info(locale)
- set charset $filename_info(charset)
+ # Extract package_key, locale, and charset from the file path
+ array set filename_info [apm_parse_catalog_path $file_path]
+ # Setting these variables to improve readability of code in this proc
+ set package_key $filename_info(package_key)
+ set locale $filename_info(locale)
+ set charset $filename_info(charset)
- # Compare xml package_key with file path package_key - abort if there is a mismatch
- if { ![string equal $package_key $catalog_array(package_key)] } {
- error "lang::catalog::import_messages_from_file - the package_key $catalog_array(package_key) in the file $file_path does not match the package_key $package_key in the filesystem"
- }
+ # Compare xml package_key with file path package_key - abort if there is a mismatch
+ if { ![string equal $package_key $catalog_array(package_key)] } {
+ error "lang::catalog::import_messages_from_file - the package_key $catalog_array(package_key) in the file $file_path does not match the package_key $package_key in the filesystem"
+ }
- # TODO: Check that package_version, locale, and charset in xml match info in filename
- # and warn in logfile if there is a mismatch
+ # TODO: Check that package_version, locale, and charset in xml match info in filename
+ # and warn in logfile if there is a mismatch
- # Figure out if we are upgrading
- if { ![apm_package_installed_p $package_key] } {
- # The package is not installed so we are not upgrading
- set upgrade_p 0
- } else {
- # The package is installed so this is probably an upgrade
- set higher_version_p [apm_higher_version_installed_p $package_key $catalog_array(package_version)]
- # higher_version_p value < 0 means downgrade, value 0 means versions are same, 1 is an upgrade
- # A package downgrade could be considered a form of upgrade. However, in practice versions
- # of the catalog files are sometimes not keeping up with the version in the info file and we don't
- # want that to trigger an upgrade.
- set upgrade_p [ad_decode $higher_version_p 1 1 0]
- }
- ns_log Notice "lang::catalog::import_messages_from_file - Loading messages in file $file_path, [ad_decode $upgrade_p 0 "not upgrading" "upgrading"]"
+ # Figure out if we are upgrading
+ if { ![apm_package_installed_p $package_key] } {
+ # The package is not installed so we are not upgrading
+ set upgrade_p 0
+ } else {
+ # The package is installed so this is probably an upgrade
+ set higher_version_p [apm_higher_version_installed_p $package_key $catalog_array(package_version)]
+ # higher_version_p value < 0 means downgrade, value 0 means versions are same, 1 is an upgrade
+ # A package downgrade could be considered a form of upgrade. However, in practice versions
+ # of the catalog files are sometimes not keeping up with the version in the info file and we don't
+ # want that to trigger an upgrade.
+ set upgrade_p [ad_decode $higher_version_p 1 1 0]
+ }
+ ns_log Notice "lang::catalog::import_messages_from_file - Loading messages in file $file_path, [ad_decode $upgrade_p 0 "not upgrading" "upgrading"]"
- # Get the messages array, and the list of message keys to iterate over
- array set messages_array [lindex [array get catalog_array messages] 1]
- set messages_array_names [array names messages_array]
+ # Get the messages array, and the list of message keys to iterate over
+ array set messages_array [lindex [array get catalog_array messages] 1]
+ set messages_array_names [array names messages_array]
- if { $upgrade_p } {
- # clear out any old upgrade status of messages
- db_dml reset_upgrade_status_messages {}
+ if { $upgrade_p } {
+ # clear out any old upgrade status of messages
+ db_dml reset_upgrade_status_messages {}
- # Mark any messages that are in the system but not in the
- # catalog file as deleted
- all_messages_for_package_and_locale $package_key $locale
- template::util::multirow_foreach all_messages {
- set message_key @all_messages.message_key@
- if { [lsearch -exact $messages_array_names $message_key] < 0 } {
- ns_log Notice "lang::catalog::import_messages_from_file - Marking message $message_key in locale $locale as deleted"
- db_dml mark_message_as_deleted {}
+ # Mark any messages that are in the system but not in the
+ # catalog file as deleted
+ all_messages_for_package_and_locale $package_key $locale
+ template::util::multirow_foreach all_messages {
+ set message_key @all_messages.message_key@
+ if { [lsearch -exact $messages_array_names $message_key] < 0 } {
+ ns_log Notice "lang::catalog::import_messages_from_file - Marking message $message_key in locale $locale as deleted"
+ db_dml mark_message_as_deleted {}
- # One approach to deleted message keys after upgrade is to consider those
- # keys deleted whose messages in all locales have an upgrade status
- # of deleted in the lang_messages table.
- # However in the somewhat unusual case where the package we are upgrading
- # to doesn't have all locales that the old package version does, upgrade
- # status won't be set to deleted for all locales.
- # The workable solution seems to be to consider a key as deleted if its
- # en_US message has the deleted upgrade status.
- if { [string equal $locale "en_US"] } {
- db_dml mark_message_key_as_deleted {}
- }
- }
- }
- }
+ # One approach to deleted message keys after upgrade is to consider those
+ # keys deleted whose messages in all locales have an upgrade status
+ # of deleted in the lang_messages table.
+ # However in the somewhat unusual case where the package we are upgrading
+ # to doesn't have all locales that the old package version does, upgrade
+ # status won't be set to deleted for all locales.
+ # The workable solution seems to be to consider a key as deleted if its
+ # en_US message has the deleted upgrade status.
+ if { [string equal $locale "en_US"] } {
+ db_dml mark_message_key_as_deleted {}
+ }
+ }
+ }
+ }
- # Loop over and register the messages
- array set overwritten_db_messages {}
- foreach message_key $messages_array_names {
- set qualified_key "$package_key.$message_key"
- set new_message $messages_array($message_key)
+ # Loop over and register the messages
+ array set overwritten_db_messages {}
+ foreach message_key $messages_array_names {
+ set qualified_key "$package_key.$message_key"
+ set new_message $messages_array($message_key)
- # If this is an upgrade - save old message if it will be overwritten
- if { $upgrade_p } {
- # Check if the message existed previously
- if { [lang::message::message_exists_p $locale $qualified_key] } {
- # Check if message is updated, avoid variable substitution during lookup by setting upvar_level to 0
- set old_message [lang::message::lookup $locale $qualified_key {} {} 0]
- if { ![string equal $old_message $new_message] } {
- set overwritten_db_messages($message_key) $old_message
- }
- }
- }
+ # If this is an upgrade - save old message if it will be overwritten
+ if { $upgrade_p } {
+ # Check if the message existed previously
+ if { [lang::message::message_exists_p $locale $qualified_key] } {
+ # Check if message is updated, avoid variable substitution during lookup by setting upvar_level to 0
+ set old_message [lang::message::lookup $locale $qualified_key {} {} 0]
+ if { ![string equal $old_message $new_message] } {
+ set overwritten_db_messages($message_key) $old_message
+ }
+ }
+ }
- # Register the new message with the system
- lang::message::register -upgrade=$upgrade_p \
- $catalog_array(locale) \
- $catalog_array(package_key) \
- $message_key \
- $new_message
- }
+ # Register the new message with the system
+ lang::message::register -upgrade=$upgrade_p \
+ $catalog_array(locale) \
+ $catalog_array(package_key) \
+ $message_key \
+ $new_message
+ }
- # Save any messages overwritten in database
- if { $upgrade_p && [array size overwritten_db_messages] > 0 } {
- set system_package_version [system_package_version_name $package_key]
- # Note that export_messages_to_file demands a certain filename format
- set catalog_dir [package_catalog_dir $package_key]
- set filename "[message_backup_file_prefix]${system_package_version}-$catalog_array(package_version)_${package_key}.${locale}.${charset}.xml"
- ns_log Notice "lang::catalog::import_messages_from_file - Saving overwritten messages during upgrade for package $package_key and locale $locale in file $filename"
- export_messages_to_file "${catalog_dir}/${filename}" [array get overwritten_db_messages]
- }
- }
+ # Save any messages overwritten in database
+ if { $upgrade_p && [array size overwritten_db_messages] > 0 } {
+ set system_package_version [system_package_version_name $package_key]
+ # Note that export_messages_to_file demands a certain filename format
+ set catalog_dir [package_catalog_dir $package_key]
+ set filename "[message_backup_file_prefix]${system_package_version}-$catalog_array(package_version)_${package_key}.${locale}.${charset}.xml"
+ ns_log Notice "lang::catalog::import_messages_from_file - Saving overwritten messages during upgrade for package $package_key and locale $locale in file $filename"
+ export_messages_to_file "${catalog_dir}/${filename}" [array get overwritten_db_messages]
+ }
+}
- ad_proc -private system_package_version_name { package_key } {
- Returns the version name of the highest version of the given
- package_key in the system.
- } {
- return [db_string get_version_name {}]
- }
+ad_proc -private lang::catalog::system_package_version_name { package_key } {
+ Returns the version name of the highest version of the given
+ package_key in the system.
+} {
+ return [db_string get_version_name {}]
+}
- ad_proc -public import_from_files { package_key } {
- Import (load) all catalog files of a certain package. Catalog files
- should be stored in the /packages/package_key/catalog directory
- and have the ending .xml (i.e. /package/dotlrn/catalog/dotlrn.en_US.iso-8859-1.xml).
- This procedure invokes lang::catalog::import_messages_from_file.
+ad_proc -public lang::catalog::import_from_files { package_key } {
+ Import (load) all catalog files of a certain package. Catalog files
+ should be stored in the /packages/package_key/catalog directory
+ and have the ending .xml (i.e. /package/dotlrn/catalog/dotlrn.en_US.iso-8859-1.xml).
+ This procedure invokes lang::catalog::import_messages_from_file.
- @param package_key The package key of the package to import catalog files for
+ @param package_key The package key of the package to import catalog files for
- @author Peter Marklund (peter@collaboraid.biz)
- } {
- # Check arguments
- if { [empty_string_p $package_key] } {
- error "lang::catalog::import_from_files - the package_key argument is the empty string"
- }
+ @author Peter Marklund (peter@collaboraid.biz)
+} {
+ # Check arguments
+ if { [empty_string_p $package_key] } {
+ error "lang::catalog::import_from_files - the package_key argument is the empty string"
+ }
- # Get all catalog files of the package
- set glob_pattern [file join [acs_package_root_dir $package_key] catalog *.xml]
- set msg_file_list [glob -nocomplain $glob_pattern]
+ # Get all catalog files of the package
+ set glob_pattern [file join [acs_package_root_dir $package_key] catalog *.xml]
+ set msg_file_list [glob -nocomplain $glob_pattern]
- # Issue a warning and exit if there are no catalog files
- if { [empty_string_p $msg_file_list] } {
- ns_log Warning "lang::catalog::import_from_files - No catalog files found for package $package_key"
- return
- }
+ # Issue a warning and exit if there are no catalog files
+ if { [empty_string_p $msg_file_list] } {
+ ns_log Warning "lang::catalog::import_from_files - No catalog files found for package $package_key"
+ return
+ }
- # Loop over each catalog file
- ns_log Notice "lang::catalog::import_from_files - Starting import of message catalogs: $msg_file_list"
- foreach file_path $msg_file_list {
+ # Loop over each catalog file
+ ns_log Notice "lang::catalog::import_from_files - Starting import of message catalogs: $msg_file_list"
+ foreach file_path $msg_file_list {
- # First make sure this is really a message catalog file and not some other xml file in the catalog
- # directory like a file with saved messages from an upgrade
- if { ![apm_is_catalog_file $file_path] } {
- # If this doesn't seem to be a file with saved messages from a backup - issue a warning as
- # it might be a catalog file on invalid format (for example because of misspelling)
- if { ![is_upgrade_backup_file $file_path] } {
- ns_log Warning "lang::catalog::import_from_files File $file_path is not on valid message catalog format and is therefore ignored"
- }
+ # First make sure this is really a message catalog file and not some other xml file in the catalog
+ # directory like a file with saved messages from an upgrade
+ if { ![apm_is_catalog_file $file_path] } {
+ # If this doesn't seem to be a file with saved messages from a backup - issue a warning as
+ # it might be a catalog file on invalid format (for example because of misspelling)
+ if { ![is_upgrade_backup_file $file_path] } {
+ ns_log Warning "lang::catalog::import_from_files File $file_path is not on valid message catalog format and is therefore ignored"
+ }
- continue
- }
+ continue
+ }
- # Use a catch so that parse failure of one file doesn't cause the import of all files to fail
- if { [catch {import_messages_from_file $file_path} errMsg] } {
- global errorInfo
-
- ns_log Error "lang::catalog::import_from_files - The import of file $file_path failed, error message is:\n\n${errMsg}\n\nstack trace:\n\n$errorInfo\n\n"
- }
+ # Use a catch so that parse failure of one file doesn't cause the import of all files to fail
+ if { [catch {import_messages_from_file $file_path} errMsg] } {
+ global errorInfo
+
+ ns_log Error "lang::catalog::import_from_files - The import of file $file_path failed, error message is:\n\n${errMsg}\n\nstack trace:\n\n$errorInfo\n\n"
}
}
+}
- ad_proc -public -deprecated -warn import_from_tcl_files {
- {package_key "acs-lang"}
- } {
- Import catalog files by evaluating tcl files containing
- invocations of the _mr register procedure. Catalog files
- should be stored in the /packages/package_key/catalog directory
- and have the ending .cat (i.e. /package/dotlrn/catalog/dotlrn.en_US.iso-8859-1.cat).
- This procedure is depreceted and has been superseeded by the procedure
- lang::catalog::import_from_files that imports catalog files on xml syntax.
+ad_proc -public -deprecated -warn lang::catalog::import_from_tcl_files {
+ {package_key "acs-lang"}
+} {
+ Import catalog files by evaluating tcl files containing
+ invocations of the _mr register procedure. Catalog files
+ should be stored in the /packages/package_key/catalog directory
+ and have the ending .cat (i.e. /package/dotlrn/catalog/dotlrn.en_US.iso-8859-1.cat).
+ This procedure is depreceted and has been superseeded by the procedure
+ lang::catalog::import_from_files that imports catalog files on xml syntax.
- @author Jeff Davis
- @author Peter Marklund (peter@collaboraid.biz)
- @return Number of files loaded
+ @author Jeff Davis
+ @author Peter Marklund (peter@collaboraid.biz)
+ @return Number of files loaded
- @see lang::catalog::import_from_files
+ @see lang::catalog::import_from_files
+
+} {
+ set glob_pattern [file join [acs_package_root_dir $package_key] catalog *.cat]
+ ns_log Notice "lang::catalog::import_from_tcl_files - Starting load of the message catalogs $glob_pattern"
- } {
- set glob_pattern [file join [acs_package_root_dir $package_key] catalog *.cat]
- ns_log Notice "lang::catalog::import_from_tcl_files - Starting load of the message catalogs $glob_pattern"
-
- global __lang_catalog_load_package_key
- set __lang_catalog_load_package_key $package_key
+ global __lang_catalog_load_package_key
+ set __lang_catalog_load_package_key $package_key
+
+ set files [glob -nocomplain $glob_pattern]
- set files [glob -nocomplain $glob_pattern]
-
- if {[empty_string_p $files]} {
- ns_log Warning "no files found in message catalog directory"
- } else {
- foreach msg_file $files {
+ if {[empty_string_p $files]} {
+ ns_log Warning "no files found in message catalog directory"
+ } else {
+ foreach msg_file $files {
- set src [read_file $msg_file]
+ set src [read_file $msg_file]
- if {[catch {eval $src} errMsg]} {
- ns_log Warning "Failed loading message catalog $msg_file:\n$errMsg"
- }
+ if {[catch {eval $src} errMsg]} {
+ ns_log Warning "Failed loading message catalog $msg_file:\n$errMsg"
}
}
+ }
+
+ ns_log Notice "lang::catalog::import_from_tcl_files - Finished load of the message catalog"
- ns_log Notice "lang::catalog::import_from_tcl_files - Finished load of the message catalog"
-
- unset __lang_catalog_load_package_key
+ unset __lang_catalog_load_package_key
+
+ return $files
+}
- return $files
- }
-
- ad_proc -public import_from_all_files_and_cache {} {
- Loops over all installed and enabled packages that don't already have messages in the database
- and imports messages from the catalog files of each such package. When this process is done
- the message cache is reloaded. The proc checks if it has been executed before and will
- only execute once.
+ad_proc -public lang::catalog::import_from_all_files_and_cache {} {
+ Loops over all installed and enabled packages that don't already have messages in the database
+ and imports messages from the catalog files of each such package. When this process is done
+ the message cache is reloaded. The proc checks if it has been executed before and will
+ only execute once.
- @author Peter Marklund (peter@collaboraid.biz)
- } {
- # Only execute this proc once
- if { ![nsv_exists lang_catalog_import_from_all_files_and_cache executed_p] } {
- nsv_set lang_catalog_import_from_all_files_and_cache executed_p 1
+ @author Peter Marklund (peter@collaboraid.biz)
+} {
+ # Only execute this proc once
+ if { ![nsv_exists lang_catalog_import_from_all_files_and_cache executed_p] } {
+ nsv_set lang_catalog_import_from_all_files_and_cache executed_p 1
- db_foreach all_enabled_not_loaded_packages {} {
- if { [file isdirectory [file join [acs_package_root_dir $package_key] catalog]] } {
- lang::catalog::import_from_files $package_key
- }
+ db_foreach all_enabled_not_loaded_packages {} {
+ if { [file isdirectory [file join [acs_package_root_dir $package_key] catalog]] } {
+ lang::catalog::import_from_files $package_key
}
-
- lang::message::cache
}
+
+ lang::message::cache
}
-
- ad_proc -private 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
- }
+}
+
+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