# $Id$
$VERSION{''.__FILE__} = '$Revision$';
#
# >>Title:: Miscellaneous Library
#
# >>Copyright::
# Copyright (c) 1992-1996, Ian Clatworthy (ianc@mincom.com).
# You may distribute under the terms specified in the LICENSE file.
#
# >>History::
# -----------------------------------------------------------------------
# Date Who Change
# 31-Dec-96 ianc Added TJH's MiscFindImageFile
# 29-Feb-96 ianc SDF 2.000
# -----------------------------------------------------------------------
#
# >>Purpose::
# This library provides miscellaneous routines.
#
# >>Description::
#
# >>Limitations::
#
# >>Resources::
#
# >>Implementation::
#
##### Constants #####
# Default rules indexed on type
%_MISC_DEFAULT_RULE = (
'boolean', '<[01]>',
'integer', '<\d+>',
);
##### Variables #####
#
# >>Description::
# {{Y:misc_date_strings}} contains the string lists used by
# {{Y:MiscDateFormat}} indexed by the symbols (e.g. 'month') used
# by that routine.
#
%misc_date_strings = (
"month" => ["January", "February", "March", "April",
"May", "June", "July", "August",
"September", "October", "November", "December"],
"smonth" => ["Jan", "Feb", "Mar", "Apr", "May", "Jun",
"Jul", "Aug", "Sep", "Oct", "Nov", "Dec"],
"weekday" => ["Sunday", "Monday", "Tuesday", "Wednesday",
"Thursday", "Friday", "Saturday"],
"sweekday" => ["Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat"],
"ampm" => ["am", "pm"],
"AMPM" => ["AM", "PM"]
);
##### Routines #####
#
# >>Description::
# {{Y:MiscCheckRule}} checks a {{rule}} for a value {{$_}}.
# If an execution error is detected, an appropriate error is output.
# The result of the code executed is returned as {{result}}.
# If {{rule}} is an empty string, {{type}} is used to lookup a
# default rule for that type, if any.
# If {{rule}} is still an empty string, 1 is returned.
#
sub MiscCheckRule {
local($_, $rule, $type) = @_;
local($result);
# Get the default rule, if necessary
$rule = $_MISC_DEFAULT_RULE{$type} if $rule eq '';
# For performance, handle common cases directly
return 1 if $rule eq '';
return /^\d+$/ if $rule eq '<\d+>';
return /^[01]$/ if $rule eq '<[01]>';
# convert rule to Perl code, if necessary
#$rule =~ s#^\s*\<(.*)\>\s*$#/^($1)\$/#;
$rule =~ s#^\<(.*)\>$#/^($1)\$/#;
# Return result
&MiscDoAction($rule, "rule");
}
#
# >>Description::
# {{Y:MiscDoAction}} executes a block of Perl code ({{action}}).
# If an execution error is detected, an appropriate error is output
# using {{what}} to name the block of code that failed. The result
# of the code executed is returned as {{result}}. {{action}} is only
# executed if it exists. If it does not, 1 is returned.
#
sub MiscDoAction {
local($action, $what) = @_;
local($result) = 1;
# Do the action, if any
if ($action) {
$result = eval $action;
&AppMsg("error", "error executing $what: $@\nCODE IS:\n$action") if $@;
}
# Return result
$result;
}
#
# >>Description::
# {{Y:MiscTextWrap}} wraps a text string at a margin given by {{wrap}}.
# {{prefix}} is the string to begin each wrapped line.
# {{suffix}} is the string to terminate each wrapped line.
# NB:
# * {{prefix}} is not added to the first line
# * {{suffix}} is not added to the last line
# * {{wrap}} includes {{prefix}} but excludes {{suffix}}
# NE:
#
sub MiscTextWrap {
local($text, $wrap, $prefix, $suffix, $keep_spaces) = @_;
local($newtext);
local($word, @words);
local($prefix_len, $length);
# Prepare for looping through the words
if ($keep_spaces) {
@words = split(/ /, $text);
}
else {
@words = split(/\s+/, $text);
}
$newtext = shift(@words);
$length = length($newtext);
$prefix_len = length($prefix);
# Wrap the text
while (defined($word = shift(@words))) {
if ($length + length($word) < $wrap) {
$newtext .= " $word";
$length += length($word) + 1;
}
elsif (length($word) + length($prefix) > $wrap &&
$length <= length($prefix)) {
$newtext .= " $word";
$length += length($word) + 1;
}
else {
$newtext .= "$suffix\n$prefix$word";
$length = length($word) + $prefix_len;
}
}
# Return result
return $newtext;
}
#
# >>Description::
# {{Y:MiscDateFormat}} formats a date-time value.
# {{fmt}} is a string containing the symbols below.
#
# !block table; format=352
# Symbol:Description:Example
# $day:day number in month:6 or 22
# $day0:day number in month zero-padded:06 or 22
# $month:month name:January
# $smonth:abbreviated month name:Jan
# $monthnum:month number (1..12):6 or 12
# $monthnum0:month number zero-padded (01..12):06 or 12
# $year:year:1995
# $syear:abbreviated year:95
# $weekday:weekday name:Monday
# $sweekday:abbreviated weekday name:Mon
# $hour:hour (1..24):6 or 14
# $hour0:hour zero-padded (01..24):06 or 14
# $shour:hour (1..12):6 or 12
# $shour0:hour zero-padded (01..12):06 or 12
# $ampm:am or pm:am
# $AMPM:AM or PM:PM
# $minute:minute (0..59):0 or 42
# $minute0:minute zero-padded (00..59):00 or 42
# $second:second (0..59):0 or 42
# $second0:second zero-padded (00..59):00 or 42
# !endblock
#
# {{time}} is a number of seconds since January 1, 1970.
# {{msg_type}} is the type of message, if any, to output
# when a bad format is found.
#
sub MiscDateFormat {
local($fmt, $time, $msg_type) = @_;
local($result);
package USER_MISC;
local($day, $day0);
local($month, $smonth, $monthnum, $monthnum0, $_month);
local($year, $syear);
local($weekday, $sweekday, $_wday);
local($hour, $hour0, $shour, $shour0);
local($minute, $minute0);
local($second, $second0);
# Get the quantities
($second, $minute, $hour, $day, $_month, $syear, $_wday) =
localtime($main'time);
$day0 = sprintf("%02d", $day);
$month = $main::misc_date_strings{"month"}[$_month];
$smonth = $main::misc_date_strings{"smonth"}[$_month];
$monthnum = $_month + 1;
$monthnum0 = sprintf("%02d", $monthnum);
$year = $syear + 1900;
$syear = sprintf("%02d", $syear % 100) if $syear > 99;
$weekday = $main::misc_date_strings{'weekday'}[$_wday];
$sweekday = $main::misc_date_strings{'sweekday'}[$_wday];
$hour0 = sprintf("%02d", $hour);
$shour = $hour - 12 if $hour > 12;
$shour = 12 if $shour == 0;
$ampm = $main::misc_date_strings{'ampm'}[$hour >= 12];
$AMPM = $main::misc_date_strings{'AMPM'}[$hour >= 12];
$shour0 = sprintf("%02d", $shour);
$minute0 = sprintf("%02d", $minute);
$second0 = sprintf("%02d", $second);
# format the date-time
$main'result = eval '"' . $main'fmt . '"';
package main;
if ($msg_type && $@) {
&AppMsg($msg_type, "bad datetime format '$fmt'");
}
# result result
return $result;
}
#
# >>Description::
# {{Y:MiscUpperToMixed}} converts a name in an uppercase form (e.g. MY_STRING)
# to a mixed-case form (e.g. MyString).
#
sub MiscUpperToMixed {
local($upper) = @_;
local($mixed);
$mixed = $upper;
substr($mixed, 1) =~ tr/A-Z/a-z/;
$mixed =~ s/_([a-z0-9])/\u$1/g;
return $mixed;
}
#
# >>Description::
# {{Y:MiscMixedToUpper}} converts a name in a mixed-case form (e.g. MyString)
# to an uppercase form (e.g. MY_STRING).
#
sub MiscMixedToUpper {
local($mixed) = @_;
local($upper);
$upper = $mixed;
substr($upper, 1) =~ s/([A-Z])/_$1/g;
$upper =~ tr/a-z/A-Z/;
return $upper;
}
# package return value
1;