acs-datetime-procs.tcl

Does not contain a contract.

Location:

/packages/acs-datetime/tcl/acs-datetime-procs.tcl

Related Files

• packages/acs-datetime/tcl/acs-datetime-procs.xql
• packages/acs-datetime/tcl/acs-datetime-procs.tcl

[ hide source ] | [ make this the default ]

File Contents

# /packages/acs-datetime/tcl/acs-datetime-procs.tcl

ad_library {

    Tcl library for the ACS Date-Time service package

    @author  ron@arsdigita.com
    @creation-date 2000-11-21
    @cvs-id  $Id: acs-datetime-procs.tcl,v 1.19.2.8 2023/03/23 16:14:43 antoniop Exp $
}

d_proc -public dt_systime {
    {-format "%Y-%m-%d %H:%M:%S"}
    {-gmt f}
} {
    @param gmt returns the time in GMT.
    @return current server time in the standard format "yyyy-mm-dd hh:mi:ss".
} {
    return [clock format [clock seconds] -format $format -gmt $gmt]
}

d_proc -public dt_sysdate {
    {-format "%Y-%m-%d"}
} {
    @return current server date in the standard format "yyyy-mm-dd"
} {
    return [clock format [clock seconds] -format $format]
}

d_proc -public dt_valid_time_p {
    time
} {
    @return 1 if "time" is a valid time specification, 0 otherwise.
} {
    if {[catch { clock scan $time }]} {
        return 0
    } else {
        return 1
    }
}

d_proc -deprecated dt_format {
    {-format "%Y-%m-%d %H:%M:%S"}
    {-gmt f}
    time
} {
    This proc should not be used, because it does not take internationalization into account. Use lc_time_fmt instead.

    @see lc_time_fmt
} {
    return [clock format [clock scan $time] -format $format -gmt $gmt]
}

ad_proc -public dt_month_names {} {
    @return the calendar month names as a Tcl list (January, February, ...)

    @see lc_get
} {
    return [lc_get mon]
}

ad_proc -public dt_month_abbrev {} {
    @return the calendar month names as a Tcl list (Jan, Feb, ...)

    @see lc_get
} {
    return [lc_get abmon]
}

d_proc -public dt_ansi_to_julian_single_arg {
    ansi
    {era ""}
} {
    Splits the ANSI date into year, month and day, and calls dt_ansi_to_julian
    to transform it to Julian.

    @return the ANSI date as Julian

    @see dt_ansi_to_julian
} {
    set date_list [dt_ansi_to_list $ansi]

    set year [util::trim_leading_zeros [lindex $date_list 0]]
    set month [util::trim_leading_zeros [lindex $date_list 1]]
    set day [util::trim_leading_zeros [lindex $date_list 2]]

    return [dt_ansi_to_julian $year $month $day $era]
}

d_proc -public dt_ansi_to_julian {
    year
    month
    day
    {era ""}
} {
    @param era this argument is obsolete and passing it to the proc
               will generate a warning.

    @return the ANSI date as Julian or -1 in the case
            of an invalid ANSI date argument (year less than
            4713 BCE, greater than 9999 CE, or equal to 0)
} {
    if {$era ne ""} {
        ad_log warning "'era' argument is obsolete"
    }

    try {
        return [clock format [clock scan ${year}-${month}-${day} -format %Y-%m-%d] -format %J]
    } on error {errmsg} {
        ad_log warning "Cannot convert ${year}-${month}-${day} to Julian date: $errmsg"
        return -1
    }
}

d_proc -public dt_julian_to_ansi {
    julian_date
} {
    @return julian_date formatted as "yyyy-mm-dd"
} {
    return [clock format [clock scan $julian_date -format %J] -format %Y-%m-%d]
}

d_proc -public dt_ansi_to_pretty {
    {ansi_date ""}
} {
    Converts an ANSI date into a localzed one.

    With no argument, it returns the current date based on server time.

    Works for both date and date-time strings.

    @param ansi_date    Date in ANSI format (for example, 1998-09-05)
    @return             Localized date (for example, on 'en_US', 05/09/98)
} {
    if {$ansi_date eq ""} {
        set ansi_date [dt_sysdate]
    }

    return [lc_time_fmt $ansi_date "%x"]
}

d_proc -public dt_ansi_to_list {
    {ansi_date ""}
} {
    Parses the given ansi_date string into a list of year, month, day,
    hour, minute, and second. Works for any date than can be parsed
    by clock scan.
} {
    if {$ansi_date eq ""} {
        set ansi_date [dt_systime]
    }

    foreach item [split [clock format [clock scan $ansi_date] -format "%Y %m %d %H %M %S"] " "] {
        lappend date_info [util::trim_leading_zeros $item]
    }

    return $date_info
}

d_proc -public dt_num_days_in_month {
    year
    month
} {
    @return the numbers of days for the given month/year
} {
    if {$month == 0} {
        set month 01
    } elseif {$month == 12} {
        incr year
        set month 01
    } elseif {$month == 13} {
        incr year
        set month 02
    } else {
        incr month
    }

    return [clock format [clock scan "last day" -base [clock scan $year-$month-01]] -format %d]
}

d_proc -public dt_first_day_of_month {
    year
    month
} {
    @return the weekday number of the first day for the given month/year
} {
    # calendar widgets are expecting integers 1-7, so we must adjust
    return [expr {[clock format [clock scan $year-$month-01] -format %w] + 1}]
}

d_proc -public dt_next_month {
    year
    month
} {
    @return the ANSI date for the next month
} {
    try {
        return [clock format [clock add [clock scan $year-$month-01] 1 month] -format %Y-%m-%d]
    } on error {errmsg} {
        ad_log warning "Cannot get next month date for $year-$month"
        return ""
    }
}

d_proc -public dt_prev_month {
    year
    month
} {
    @return the ANSI date for the previous month
} {
    try {
        return [clock format [clock add [clock scan $year-$month-01] -1 month] -format %Y-%m-%d]
    } on error {errmsg} {
        ad_log warning "Cannot get previous month date for $year-$month"
        return ""
    }
}

d_proc -public dt_next_month_name {
    year
    month
} {
    @return Localized name of the next month
} {
    try {
        return [lc_time_fmt [lc_clock_to_ansi [clock add [clock scan $year-$month-01] 1 month]] "%B"]
    } on error {errmsg} {
        ad_log warning "Cannot get name of previous month for $year-$month"
        return ""
    }
}

d_proc -public dt_prev_month_name {
    year
    month
} {
    @return Localized name of the previous month
} {
    try {
        return [lc_time_fmt [lc_clock_to_ansi [clock add [clock scan $year-$month-01] -1 month]] "%B"]
    } on error {errmsg} {
        ad_log warning "Cannot get name of previous month for $year-$month"
        return ""
    }
}

d_proc -deprecated dt_widget_datetime {
    {-show_date 1}
    {-date_time_sep " "}
    {-use_am_pm 0}
    {-default none}
    name
    {granularity days}
} {

    @return an HTML form fragment for collecting date-time
    information with names "$name.year", "$name.month", "$name.day",
    "$name.hours", "$name.minutes", "$name.seconds", and "$name.ampm".
    These will be numeric ("ampm" is 0 for am, 1 for pm)

    Default specifies what should be set as the current time in the
    form. Valid defaults are "none", "now", or any valid date string
    that can be converted with clock scan.

    Granularity can be "months" "days" "hours" "halves" "quarters"
    "fives" "minutes" or "seconds".

    Use -show_date 0 for a time entry widget (no dates).

    All HTML widgets will be output *unless* show_date is 0; they will
    be hidden if not needed to satisfy the current granularity
    level. Values default to 1 for MM/DD and 0 for HH/MI/SS/AM if not
    found in the input string or if below the granularity threshold.

    DEPRECATED: modern HTML5 feature make this widget less
    relevant. It is also cumbersome to style and localize.

    @see template::widget::h5time
    @see template::widget::h5date
} {
    set to_precision [dt_precision $granularity]

    set show_day     [expr {$to_precision < 1441}]
    set show_hours   [expr {$to_precision < 61}]
    set show_minutes [expr {$to_precision < 60}]
    set show_seconds [expr {$to_precision < 1}]

    if {$to_precision == 0} {
        set to_precision 1
    }

    switch $default {
        none    { set value [dt_systime] }
        now     { set value [dt_systime] }
        default { set value [lc_time_fmt $default "%Y-%m-%d %H:%M:%S"] }
    }

    set parsed_date [dt_ansi_to_list $value]
    set year        [lindex $parsed_date 0]
    set month       [lindex $parsed_date 1]
    set day         [lindex $parsed_date 2]
    set hours       [lindex $parsed_date 3]
    set minutes     [lindex $parsed_date 4]
    set seconds     [lindex $parsed_date 5]

    # Kludge to get minutes rounded.  Should make general-purpose for
    # the other values too...

    if {$to_precision < 60} {
        set minutes [expr {[dt_round_to_precision $minutes $to_precision] % 60}]
    }

    if {$default eq "none"} {
        set year    ""
        set month   ""
        set day     ""
        set hours   ""
        set minutes ""
        set seconds ""
    }

    if {$show_date} {
        append input [dt_widget_month_names "$name.month" $month]
        append input [dt_widget_maybe_range $show_day "$name.day" 1 31 $day 1 0 1]
        append input "<input name=\"$name.year\" size=5 maxlength=4 value=\"$year\"> $date_time_sep "
    }

    if {$use_am_pm} {
        if { $hours > 12 } {
            append input [dt_widget_maybe_range \
                $show_hours "$name.hours" 1 12 [expr {$hours - 12}] 1 0]
        } elseif {$hours == 0} {
            append input [dt_widget_maybe_range \
                $show_hours "$name.hours" 1 12 12 1 0]
        } else {
            append input [dt_widget_maybe_range \
                $show_hours "$name.hours" 1 12 $hours 1 0]
        }
    } else {
        append input [dt_widget_maybe_range \
            $show_hours "$name.hours" 0 23 $hours 1 0]
    }

    if {$show_minutes} {
        append input ":"
    }

    append input [dt_widget_maybe_range \
            $show_minutes "$name.minutes" 0 59 $minutes $to_precision 1]

    if {$show_seconds} {
        append input ":"
    }

    append input [dt_widget_maybe_range \
            $show_seconds "$name.seconds" 0 59 $seconds 1 1]

    if {$use_am_pm} {
        if {$hours < 12 || ! $show_hours} {
            set am_selected " selected"
            set pm_selected ""
        } else {
            set am_selected ""
            set pm_selected " selected"
        }

        append input "
        <select name=\"${name}.ampm\">
        <option value=0${am_selected}>AM
        <option value=1${pm_selected}>PM
        </select>"
    } else {
        append input [dt_export_value "${name}.ampm" "AM"]
    }

    return $input
}

d_proc -deprecated dt_widget_month_names {
    name
    {selected_month 0}
} {
    DEPRECATED: modern HTML5 feature make this widget less
    relevant. It is also cumbersome to style and localize.

    @see template::widget::h5time
    @see template::widget::h5date

    @return a select widget for months of the year.
} {
    if {$selected_month eq ""} {set selected_month 0}
    if {![string is integer $selected_month]} {error "selected_month must be integer"}
    set month_names [dt_month_names]
    set input       "<option value=_undef>---------"
    incr selected_month -1

    for {set i 0} {$i < 12} {incr i} {
        append input "<option [expr {$i == $selected_month ? "selected" : ""}] value=[expr {$i+1}]>[lindex $month_names $i]\n"
    }

    return "<select name=\"$name\">\n $input \n </select>\n"
}

d_proc -deprecated dt_widget_numeric_range {
    name
    begin
    end
    {default ""}
    {interval 1}
    {with_leading_zeros 0}
} {
    DEPRECATED: this widget would be difficult to style and is
    actually simpler to inline such an idiom in one's tcl or adp
    code. The templating system also provides select widgets that take
    care of validating the selection.

    @see template::widget::select
    @see template::widget::multiselect

    @return an HTML select widget for a numeric range
} {
    if {$with_leading_zeros} {
        set format "%02d"
    } else {
        set format "%d"
    }

    if {$default ne ""} {
        set default [util::trim_leading_zeros $default]
    }

    set input "<option value=_undef>--\n"

    for { set i $begin } { $i <= $end } { incr i $interval} {
        append input "[expr {$i == $default ? "<option selected>" : "<option>"}][format $format $i]\n"
    }

    return "<select name=\"$name\">\n$input</select>"
}

d_proc -deprecated dt_widget_maybe_range {
    {-hide t}
    {-hidden_value "00"}
    {-default ""}
    {-format "%02d"}
    ask_for_value
    name
    start
    end
    default_value
    {interval 1 }
    {with_leading_zeros 0}
    {hidden_value "00"}
} {
    DEPRECATED: this proc was only used inside of now deprecated
    dt_widget_datetime.

    @see dt_widget_datetime

    @return form numeric range, or hidden_value if ask_for_value is false.
} {
    if {!$ask_for_value} {
        # Note that this flattens to hidden_value for hidden fields
        if {$with_leading_zeros} {
            return [dt_export_value $name $hidden_value]
        } else {
            return [dt_export_value $name [util::trim_leading_zeros $hidden_value]]
        }
    }

    return [dt_widget_numeric_range \
        "$name" $start $end $default_value $interval $with_leading_zeros]
}

ad_proc -public dt_interval_check { start end } {

    Checks the values of start and end to see if they form a valid
    time interval.  Returns:

    > 0  if end > start
      0  if end = start
    < 0  if end < start

    Input variables can be any strings that can be converted to times
    using clock scan.
} {
    return [expr {[clock scan $end] - [clock scan $start]}]
}

d_proc -private -deprecated dt_trim_leading_zeros {
    string
} {
    @return a string w/ leading zeros trimmed.

    Used to get around Tcl interpreter problems w/ thinking leading
    zeros are octal. We could just use validate_integer, but it runs
    one extra regexp that we don't need to run.

    @see util::trim_leading_zeros
} {
    return [util::trim_leading_zeros $string]
}

d_proc -private dt_export_value {
    name
    value
} {
    Makes a hidden form item w/ given name and value
} {
    return "<input name=\"$name\" type=hidden value=\"$value\">"
}

d_proc -private dt_round_to_precision {
    number
    precision
} {

    Rounds the given number to the given precision,
    i.e. <tt>calendar_round_to_precision 44 5</tt> will round to the
    nearest 5 and return 45, while <tt>calendar_round_to_precision
    32.678 .1</tt> will round to 32.7.

} {
    return [expr {$precision * round(double($number)/$precision)}]
}

d_proc -private dt_precision {
    granularity
} {
    @return the precision in minutes corresponding to a named granularity.
} {
    switch -exact $granularity {
        months   { set precision 40000}
        days     { set precision 1440}
        hours    { set precision 60}
        halves   { set precision 30}
        quarters { set precision 15}
        fives    { set precision 5}
        minutes  { set precision 1}
        seconds  { set precision 0}
        default  { set precision 15}
    }

    return $precision
}

# Local variables:
#    mode: tcl
#    tcl-indent-level: 4
#    indent-tabs-mode: nil
# End: