#/packages/lang/tcl/localization-procs.tcl ad_library { Routines for localizing numbers, dates and monetary amounts
This is free software distributed under the terms of the GNU Public License. Full text of the license is available from the GNU Project: http://www.fsf.org/copyleft/gpl.html @creation-date 30 September 2000 @author Jeff Davis (davis@xarg.net) @author Ashok Argent-Katwala (akatwala@arsdigita.com) @cvs-id $Id: localization-procs.tcl,v 1.29.2.11 2020/05/18 21:13:20 gustafn Exp $ } ad_proc -public lc_parse_number { num locale {integer_only_p 0} } { Converts a number to its canonical representation by stripping everything but the decimal separator and trimming left 0's so it won't be octal. It can process the following types of numbers:
Takes a grouping specifier and inserts the given separator into the string. Given a separator of : and a number of 123456789 it returns:
grouping Formatted Value {3 -1} 123456:789 {3} 123:456:789 {3 2 -1} 1234:56:789 {3 2} 12:34:56:789 {-1} 123456789@param num Number @param grouping Grouping specifier @param sep Thousands separator @param num_re Regular expression for valid numbers @return Number formatted with thousand separator } { # with empty separator or grouping string we behave # posixly if {$grouping eq "" || $sep eq "" } { return $num } # we need to sanitize the subspec regsub -all -- "(\[&\\\\\])" $sep "\\\\\\1" sep set match "^(-?$num_re+)(" set group [lindex $grouping 0] while { $group > 0} { set re "$match[string repeat $num_re $group])" if { ![regsub -- $re $num "\\1$sep\\2" num] } { break } if {[llength $grouping] > 1} { set grouping [lrange $grouping 1 end] } set group [lindex $grouping 0] } return $num } ad_proc -public lc_numeric { num {fmt {}} {locale ""} } { Given a number and a locale return a formatted version of the number for that locale. @param num Number in canonical form @param fmt Format string used by the Tcl format command (should be restricted to the form "%.Nf" if present). @param locale Locale @return Localized form of the number } { if {$fmt ne ""} { set out [format $fmt $num] } else { set out $num } set sep [lc_get -locale $locale "thousands_sep"] set dec [lc_get -locale $locale "decimal_point"] set grouping [lc_get -locale $locale "grouping"] # Fall back on en_US if grouping is not on valid format if { $locale ne "en_US" && ![regexp {^[0-9 -]+$} $grouping] } { ns_log Warning "lc_numeric: acs-lang.localization-grouping key has invalid value $grouping for locale $locale" set sep , set dec . set grouping 3 } regsub {\.} $out $dec out return [lc_sepfmt $out $grouping $sep] } ad_proc -deprecated clock_to_ansi { seconds } { Convert a time in the Tcl internal clock seconds format to ANSI format, usable by lc_time_fmt. DEPRECATED: this proc does not comply with naming convention enforced by acs-tcl.naming__proc_naming automated test @author Lars Pind (lars@pinds.com) @return ANSI (YYYY-MM-DD HH24:MI:SS) formatted date. @see lc_time_fmt @see lc_clock_to_ansi } { return [lc_clock_to_ansi $seconds] } ad_proc -public lc_clock_to_ansi { seconds } { Convert a time in the Tcl internal clock seconds format to ANSI format, usable by lc_time_fmt. @author Lars Pind (lars@pinds.com) @return ANSI (YYYY-MM-DD HH24:MI:SS) formatted date. @see lc_time_fmt } { return [clock format $seconds -format "%Y-%m-%d %H:%M:%S"] } ad_proc -public lc_get { {-locale ""} key } { Get a certain format string for the current locale. @param key the key of for the format string you want. @return the format string for the current locale. @author Lars Pind (lars@pinds.com) } { # All localization message keys have a certain prefix set message_key "acs-lang.localization-$key" # Set upvar level to 0 so that no attempt is made to interpolate variables # into the string # Set translator_mode_p to 0 so we don't dress the message up with a link to translate return [lang::message::lookup $locale $message_key {} {} 0 0] } ad_proc -public lc_time_fmt { datetime fmt {locale ""} } { Formats a time for the specified locale. @param datetime A time string in one of the following formats as from clock tcl command specifications: "%Y-%m-%d %H:%M:%S", "%Y-%m-%d %H:%M" and "%Y-%m-%d". Database timestamps such as "2019-12-16 12:50:14.049896+01" are also tolerated, by normalizing them to "2019-12-16 12:50:14". Note that in this case all information about timezone and fractions of second will be discarded. @param fmt An ISO 14652 LC_TIME style formatting string. The highlighted functions localize automatically based on the user's locale; other strings will use locale-specific text but not necessarily locale-specific formatting.
%a FDCC-set's abbreviated weekday name. %A FDCC-set's full weekday name. %b FDCC-set's abbreviated month name. %B FDCC-set's full month name. %c FDCC-set's appropriate date and time representation. %C Century (a year divided by 100 and truncated to integer) as decimal number (00-99). %d Day of the month as a decimal number (01-31). %D Date in the format mm/dd/yy. %e Day of the month as a decimal number (1-31 in at two-digit field with leading@param locale Locale identifier must be in the locale database @error Fails if given a non-existent locale or a malformed datetime. Impossible dates will be treated as per clock scan behavior and e.g. 29 Feb 1999 will be translated to 1st March, Monday, as it wasn't a leap year. The clock api takes care of the proper handling of Julian/Gregorian dates. @see clock @see http://www.tondering.dk/claus/calendar.html @see man strftime on a UNIX shell prompt for more date format abbreviations. @return A date formatted for a locale } { if { $datetime eq "" } { return "" } if { $locale eq "" } { set locale [ad_conn locale] } set datetime [string range [string trim $datetime] 0 18] foreach format { "%Y-%m-%d %H:%M:%S" "%Y-%m-%d %H:%M" "%Y-%m-%d" } { set invalid_format_p [catch { set date_clock [clock scan $datetime -format $format] }] if {!$invalid_format_p} { break } } if {$invalid_format_p} { error "Invalid date: $datetime" } set date_tokens [list] foreach token [clock format $date_clock -format "%Y %m %d %H %M %S %w"] { lappend date_tokens [util::trim_leading_zeros $token] } lassign $date_tokens \ lc_time_year \ lc_time_month \ lc_time_days \ lc_time_hours \ lc_time_minutes \ lc_time_seconds \ lc_time_day_no # # Keep the results of lc_time_fmt_compile in the per-thread cache # (namespaced variable) # return [subst [acs::per_thread_cache eval -key acs-lang:lc_time_fmt_compile($fmt,$locale) { lc_time_fmt_compile $fmt $locale }]] } ad_proc -public lc_time_fmt_compile { fmt locale } { Compiles ISO 14652 LC_TIME style formatting string to variable substitutions and proc calls. @param fmt An ISO 14652 LC_TIME style formatting string. @param locale Locale identifier must be in the locale database @return A string that should be subst'ed in the lc_time_fmt proc after local variables have been set. } { set to_process $fmt set compiled_string "" while {[regexp -- {^(.*?)%(.)(.*)$} $to_process match done_portion percent_modifier remaining]} { switch -exact -- $percent_modifier { x { append compiled_string $done_portion set to_process "[lc_get -locale $locale d_fmt]$remaining" } X { append compiled_string $done_portion set to_process "[lc_get -locale $locale t_fmt]$remaining" } c { append compiled_string $done_portion set to_process "[lc_get -locale $locale d_t_fmt]$remaining" } q { append compiled_string $done_portion set to_process "[lc_get -locale $locale dlong_fmt]$remaining" } Q { append compiled_string $done_portion set to_process "[lc_get -locale $locale dlongweekday_fmt]$remaining" } default { append compiled_string "${done_portion}$::lang::util::percent_match($percent_modifier)" set to_process $remaining } } } # What is left to_process must be (%.)-less, so it should be included without transformation. append compiled_string $to_process return $compiled_string } ad_proc -public lc_time_utc_to_local { time_value {tz ""} } { Converts a Universal Time to local time for the specified timezone. @param time_value UTC time in the ISO datetime format. @param tz Timezone that must exist in tz_data table. @return Local time } { if { $tz eq "" } { set tz [lang::conn::timezone] } set local_time $time_value ad_try { set local_time [db_exec_plsql utc_to_local {}] } on error {errorMsg} { ad_log Warning "lc_time_utc_to_local: Query exploded on time conversion from UTC, probably just an invalid date, $time_value: $errorMsg" } if {$local_time eq ""} { # If no conversion possible, log it and assume local is as given (i.e. UTC) ns_log Notice "lc_time_utc_to_local: Timezone adjustment in ad_localization.tcl found no conversion to UTC for $time_value $tz" } return $local_time } ad_proc -public lc_time_local_to_utc { time_value {tz ""} } { Converts a local time to a UTC time for the specified timezone. @param time_value Local time in the ISO datetime format, YYYY-MM-DD HH24:MI:SS @param tz Timezone that must exist in tz_data table. @return UTC time. } { if { $tz eq "" } { set tz [lang::conn::timezone] } set utc_time $time_value ad_try { set utc_time [db_exec_plsql local_to_utc {}] } on error {errorMsg} { ad_log Warning "lc_time_local_to_utc: Query exploded on time conversion to UTC, probably just an invalid date, $time_value: $errorMsg" } if {$utc_time eq ""} { # If no conversion possible, log it and assume local is as given (i.e. UTC) ns_log Notice "lc_time_local_to_utc: Timezone adjustment in ad_localization.tcl found no conversion to local time for $time_value $tz" } return $utc_time } ad_proc -public lc_time_system_to_conn { time_value } { Converts a date from the system (database) to the connection's timezone, using the OpenACS timezone setting and user's preference @param time_value Timestamp from the database in the ISO datetime format. @return Timestamp in conn's local time, also in ISO datetime format. } { if { ![ad_conn isconnected] } { return $time_value } set system_tz [lang::system::timezone] set conn_tz [lang::conn::timezone] if { $conn_tz eq "" || $system_tz eq $conn_tz } { return $time_value } return [lc_time_tz_convert -from $system_tz -to $conn_tz -time_value $time_value] } ad_proc -public lc_time_conn_to_system { time_value } { Converts a date from the connection's timezone to the system (database) timezone, using the OpenACS timezone setting and user's preference @param time_value Timestamp from conn input in the ISO datetime format. @return Timestamp in the database's time zone, also in ISO datetime format. } { if { ![ad_conn isconnected] } { return $time_value } set system_tz [lang::system::timezone] set conn_tz [lang::conn::timezone] if { $conn_tz eq "" || $system_tz eq $conn_tz } { return $time_value } return [lc_time_tz_convert -from $conn_tz -to $system_tz -time_value $time_value] } ad_proc -public lc_time_tz_convert { {-from:required} {-to:required} {-time_value:required} } { Converts a date from one timezone to another. @param time_value Timestamp in the 'from' timezone, in the ISO datetime format. @return Timestamp in the 'to' timezone, also in ISO datetime format. } { ad_try { set time_value [db_exec_plsql convert {}] } on error {errorMsg} { ad_log Warning "lc_time_tz_convert: Error converting timezone: $errorMsg" } return $time_value } ad_proc -public lc_list_all_timezones { } { @return list of pairs containing all timezone names and offsets. Data drawn from acs-reference package timezones table } { return [db_list_of_lists all_timezones {}] } ad_proc -private lc_time_drop_meridian { hours } { Converts HH24 to HH12. } { if {$hours > 12} { incr hours -12 } elseif {$hours == 0} { set hours 12 } return $hours } ad_proc -private lc_wrap_sunday { day_no } { To go from 0(Sun) - 6(Sat) to 1(Mon) - 7(Sun) } { if {$day_no==0} { return 7 } else { return $day_no } } ad_proc -private lc_time_name_meridian { locale hours } { Returns locale data depending on AM or PM. } { if {$hours > 11} { return [lc_get -locale $locale "pm_str"] } else { return [lc_get -locale $locale "am_str"] } } ad_proc -private lc_leading_space {num} { Inserts a leading space for numbers less than 10. } { if {$num < 10} { return " $num" } else { return $num } } ad_proc -private lc_leading_zeros { the_integer n_desired_digits } { Adds leading zeros to an integer to give it the desired number of digits } { return [format "%0${n_desired_digits}d" $the_integer] } ad_proc -public lc_content_size_pretty { {-size "0"} {-precision "1"} {-standard "decimal"} } { Transforms data size, provided in non-negative bytes, to KB, MB... up to YB. @param size Size in bytes @param precision Numbers in the fractional part @param standard Standard to use for binary prefix. Three standards are supported currently by this proc: - decimal (default): SI (base-10, 1000 bytes = 1kB) - binary: IEC (base-2, 1024 bytes = 1KiB) - legacy: JEDEC (base-2, 1024 bytes = 1KB) @return Size in given standard units (e.g. '5.2 MB') @author Héctor Romojarofill). %E Month number as a decimal number (1-12 in at two-digit field with leading fill). %f Weekday as a decimal number (1(Monday)-7). %F is replaced by the date in the format YYYY-MM-DD (ISO 8601 format) %h A synonym for %b. %H Hour (24-hour clock) as a decimal number (00-23). %I Hour (12-hour clock) as a decimal number (01-12). %j Day of the year as a decimal number (001-366). %m Month as a decimal number (01-13). %M Minute as a decimal number (00-59). %n A character. %p FDCC-set's equivalent of either AM or PM. %r Hours and minutes using 12-hour clock AM/PM notation, e.g. '06:12 AM'. %q Long date without weekday (OpenACS addition to the standard) %Q Long date with weekday (OpenACS addition to the standard) %S Seconds as a decimal number (00-61). %t A character. %T 24-hour clock time in the format HH:MM:SS. %u Week number of the year as a decimal number with two digits and leading zero, according to "week" keyword. %U Week number of the year (Sunday as the first day of the week) as a decimal number (00-53). %w Weekday as a decimal number (0(Sunday)-6). %W Week number of the year (Monday as the first day of the week) as a decimal number (00-53). %x FDCC-set's appropriate date representation. %X FDCC-set's appropriate time representation. %y Year (offset from %C) as a decimal number (00-99). %Y Year with century as a decimal number. %Z The connection's timezone, e.g. 'America/New_York'. %% A character.