=begin nd
Class: LIMS::Local::Utils
A collection of functions to perform various common and/or repetitive tasks
required by other applications eg validation of dates, conversion of dates to
other formats, generation of html symbols, trimming white space, etc.
Exports functons into callers namespace using EXPORT_OK.
=cut
package LIMS::Local::Utils;
use strict;
use warnings;
# stopped exporting - methods called explicitly now
# require Exporter;
# our @ISA = qw(Exporter);
use Clone;
use IO::All;
use YAML::Tiny;
use List::Util;
use Math::Round;
use List::Compare;
use Math::SigFigs;
use Data::Traverse;
use Time::ParseDate;
use List::MoreUtils;
use Archive::Extract;
use Text::Wrap qw(wrap);
use Digest::SHA1; # use Digest::MD5 qw(md5_hex sha1_base64)
use DateTime::Format::Strptime;
use DateTime::Format::DateParse;
use CGI::Simple::Standard qw( escapeHTML );
use FindBin qw($RealBin); # works for lims_server.pl & hilis3_convert.pl, but not fastcgi
use DateTime::HiRes;
use DateTime; DateTime->DefaultLocale('en_GB'); # set default locale
use Date::Calc qw(Decode_Date_EU Day_of_Week Add_Delta_Days Delta_Days Today
This_Year Today_and_Now);
use LIMS::Local::Debug;
use Data::Dumper;
# FindBin can't cope with app being called from different locations relative to home dir:
sub find_home {
my $path_to_app;
# NB: $INC[0] set by lims_server.pl 'use lib', or mod_perl config:
foreach (@INC) { # warn 'INC:'. $_ . "\n";
if (-e "$_/LIMS.pm") { # "$_/lib/LIMS.pm"
$path_to_app = $_ and last;
}
} # warn 'PATH_TO_APP:'. $path_to_app;
#open my $fh, '>' . '/home/raj/www/apps/HMDS/trunk/path.log' or die $!;
#print $fh 'path_to_app: ' . $path_to_app, "\n";
#print $fh 'RealBin: ' . $RealBin, "\n";
# if $INC[0] set by lims_server.pl, need to strip trailing 3 dirs:
if ($path_to_app =~ m!(\.\./lib)$!) { # warn 'HERE'; # warn '$INC[0] set by lims_server.pl';
$path_to_app =~ s/(\/\w+\/$1)$//; # eg /path/to/app/script/../lib -> /path/to/app
}
# if $INC[0] set by mod_perl, need to remove trailing /lib:
# CHANGED 'elsif' to 'if' IN CASE TRAILING '/lib' STILL INTACT (eg called from cron):
if ($path_to_app =~ m!(/?lib)$!) { # warn 'HERE'; # warn '$INC[0] set by mod_perl';
$path_to_app =~ s/($1)$//; # eg /path/to/app/lib -> /path/to/app
}
# fix for Win32 - returns empty $path_to_app otherwise
$path_to_app ||= '.'; # warn 'PATH_TO_APP:'. $path_to_app;
return $path_to_app;
}
=begin nd
Function: check_date
Evaluates string with Date::Calc::Decode_Date_EU. Catalyst::Controller::FormBuilder::validate() require a true value for a valid field, so returns true ( 1 ) if date is decipherable and not in future, otherwise returns 0
=cut
sub check_date {
my $date = shift; # warn 'DATE:', $date;
my $future_ok = shift; # warn $future_ok; # optional - allows future dates
# first check we have 4-digit year:
return 0 unless $date =~ /\W\d{4}$/; # check for non-word character (dot, hyphen, space, etc) followed by 4 digits
my $date_is_valid; # becomes true if Decode_Date_EU can decode date (as scalar takes last output from function = day)
# wrap it in eval so we don't die if date IS invalid:
eval { $date_is_valid = Decode_Date_EU($date) }; # DEBUG('date_is_valid:', $date_is_valid);
# if date decoded OK, check it for future (unless allowed):
return 0 unless $date_is_valid; # DEBUG ('date confirmed valid');
return 1 if $future_ok; # ie date is ok & no need to test for future
# returns false if date <= today, true if > today:
my $date_is_future = _date_is_future($date); # warn "date_is_future: $date_is_future";
# need to return true value if date is valid (no error and date not in future):
return ! $date_is_future; # returns opposite of whether date is future
}
=begin
Function: check_date
Evaluates string with Time::ParseDate::parsedate(). Converts a valid (UK-style) date to number of seconds since the epoch (1970-01-01). If called in array context, parsedate() returns an error element which contains the error string if date invalid. Catalyst::Controller::FormBuilder::validate() require a true value for a valid field so cannot return the error code. Method returns true (1) if date is valid, otherwise 0. Only reliable for 4-digit years between 1902 and 2038 (not at all for 2-digit years due to assumptions).
Using Decode_Date_EU method instead
=cut
sub _check_date {
my $date = shift;
# variable: to_seconds
# number of seconds since the epoch (1970-01-01) if date is valid
# variable: $error
# contains error message if date is invalid, otherwise undef
# VALIDATE - force validation; PREFER_PAST - assume past when year or day of week is ambiguous (allows dd-mm-yy when yy >= current yy)
my ( $to_seconds, $error ) =
Time::ParseDate::parsedate( $date, UK => 1, VALIDATE => 1 ); #, PREFER_PAST => 1 - best to have unambiguous dates
# returns true if date >= Today():
my $date_is_future = _date_is_future($date); # DEBUG ("date_is_future: $date_is_future");
# need to return true value if date is valid (no error and date not in future):
return ( $error || $date_is_future ) ? 0 : 1;
}
=begin nd
Function: date_to_mysql
Converts an EU formatted date to MySQL format (yyyy-d-m) if date is decipherable by Decode_Date_EU, or undef if not.
Need to wrap in eval and return undef if @!
=cut
sub date_to_mysql { # could use MySQL::DateFormat->toMySQL, but requires '-' or '/' separators
my $date = shift || return;
return join '-', Decode_Date_EU($date);
}
=begin nd
Function: to_datetime
Converts hashref containing year, month & day values to a DateTime object ( eg 1923-02-01T00:00:00') using DateTime.
Assumes date has been validated with Decode_Date_EU. Gives correct DateTime->ymd for all 4-digit years.
=cut
sub to_datetime {
my $data = shift; # hashref
# return safely if no date params passed:
return unless grep $data->{$_}, qw( day month year );
# check all required values present:
map {
$data->{$_} or die "No $_ value passed to LIMS::Local::Utils::to_datatime() function";
} qw( day month year );
return DateTime->new( year => $data->{year}, month => $data->{month}, day => $data->{day} );
}
=begin nd
Function: to_datetime_using_datecalc
Converts an EU formatted date to a DateTime object ( eg 1923-02-01T00:00:00') using DateTime. Assumes date has been
validated with Decode_Date_EU. Gives correct DateTime->ymd for all 4-digit years.
=cut
sub to_datetime_using_datecalc { # uses Decode_Date_EU & DateTime
my $date = shift || return;
my ( $yr, $month, $day ) = Decode_Date_EU($date);
# eval to protect DT object creation if Decode_Date_EU fails (eg FV_and() in validation):
eval { return DateTime->new( year => $yr, month => $month, day => $day ) };
}
=begin nd
Function: to_datetime_using_parsedate
Converts an EU formatted date to a DateTime object (eg 1983-02-01T00:00:00') using Time::ParseDate() and DateTime::from_epoch().
Can handle abbreviated month names (Jan Feb) and numerical months ( 1 - 12 ). But parsedate can only handle years ranging 1902 to 2038.
Two-digit years unreliable due to assumptions - DateTime->ymd switches from 2000's to 1900's after 38 (ie 38 -> 2038, 39 -> 1902!)
Need to specify time_zone either in parsedate() or from_epoch() methods or dates during BST are ajusted -1hr causing date shift, eg:
13.4.1947 becomes 1947-04-12T23:00:00
=cut
sub to_datetime_using_parsedate { # uses Time::ParseDate
my $date = shift || return;
# dump all time_zones to file:
# my @zones = DateTime::TimeZone->all_names; DEBUG @zones;
# need to specify time_zone here or in from_epoch() or summer dates adjusted -1hr causing date shift:
my ( $to_seconds, $error ) =
Time::ParseDate::parsedate( $date, UK => 1, GMT => 1 );
# this should not happen as date already validated:
die $error if $error;
# need to specify time_zone here or in parsedate(), or summer dates adjusted -1hr causing date shift:
return DateTime->from_epoch( epoch => $to_seconds, ); # time_zone => 'Europe/London'
}
=begin nd
Function: to_datetime_using_strptime
Converts a date to a DateTime object using DateTime::Format::Strptime. Can handle dates
before epoch (1/1/1970), but requires dates to match a specified pattern, eg %d\W%m\W%Y.
Expects pattern supplied.
=cut
sub to_datetime_using_strptime { # uses DateTime::Format::Strptime
my $date = shift || return;
my $pattern = shift; # requires pattern or will die trying to parse date
my %config = (
pattern => $pattern,
locale => 'en_GB',
time_zone => 'GMT',
on_error => 'croak',
);
my $dt = new DateTime::Format::Strptime(%config);
return $dt->parse_datetime($date);
}
sub to_datetime_using_dateparse { # uses DateTime::Format::DateParse
my $date = shift || return;
my $dt = DateTime::Format::DateParse->parse_datetime($date);
return $dt;
}
=begin nd
Function: split_labno
Extracts and returns numerator & 4-digit yr from Lab Number
=cut
sub split_labno {
my $labno = shift or return;
my ( $numerator, $yr ) = $labno =~ m!^[A-Z]?(\d+)/?(\d{2})?$!i;
$yr ||= ( localtime() )[5] - 100; # assume current year if null
return ( $numerator, $yr + 2000 );
}
=begin nd
Function: pretty_nhs_no
Splits and returns NHS number in ddd ddd dddd format
=cut
sub pretty_nhs_no {
local $_ = shift;
my (@nhsno) = /(\d{3})(\d{3})(\d{4})/; # DEBUG (@nhsno);
return sprintf '%s %s %s', @nhsno;
}
=begin nd
Function: sha1_digest
Returns encrypted string:
=cut
sub sha1_digest {
my $str = shift; # warn $str;
my $sha1 = Digest::SHA1->new;
$sha1->add($str);
return $sha1->b64digest; # same as:
# return Digest::SHA1::sha1_base64($str); # Digest::MD5::md5_hex($str)
}
=begin nd
Function: check_nhsno
Validates NHS number using the Modulus 11 algorithm. The tenth digit of an NHS number is a check digit.
+ multiply each of the first nine digits by a weighting factor 1 -> 10, 2 -> 9, 3 -> 8 .. 9 -> 2
+ add the results of each multiplication together
+ divide the total by 11 and establish the remainder
+ subtract the remainder from 11 to give the expected value of the check digit
+ if remainder is less than 10 AND matches the check digit then the submitted NHS number is VALID
Function returns 1 if valid, and undef if invalid or not 10-digits.
See also: http://www.govtalk.gov.uk/gdsc/html/frames/NHSnumber-2-0-Release.htm
=cut
sub check_nhsno {
my $nhsno = shift; # _dump(Dumper $nhsno);
$nhsno =~
s/\s+//g; # remove spaces if nhs_no submitted in nnn nnn nnnn format
return unless length $nhsno == 10; # require 10 consecutive numbers only
my $product;
# sum of (each of the first nine digits * weighting factor):
for ( 0 .. 8 ) { # 1st 9 digits of NHS no
$product += ( substr( $nhsno, $_, 1 ) * ( 10 - $_ ) );
}
# Divide $product by 11 and establish the remainder.
# Subtract the remainder from 11 to give
# the check digit. If the result is 11 then a check digit of 0 is used.
my $check_digit = ( $product % 11 ) # if $product / 11 is non-zero:
? 11 - ( $product % 11 ) # = 11 minus remainder of $product / 11
: 0; # = zero
# returns true (valid) if:
return $check_digit ==
substr( $nhsno, 9, 1 ) # $check_digit matches the 10th digit, and
&& $check_digit != 10; # invalid if $check_digit == 10
}
sub sig_figs { # from http://www.indo.com/distance/dist.pl sub round_to_3():
my $num = shift || return; # warn Dumper $num; # value to round
return $num unless $num > 0; # to protect against submission of '0.' error
my $lg = int( log(abs($num)) / log(10.0) ); # log base 10 of num
my $round = 10 ** ($lg - 2); # warn Dumper [$num, $lg, $round, $num / $round];
return int($num / $round + 0.5) * $round;
}
sub sum_list {
my $vals = shift; # warn Dumper $vals; # arrayref
List::Util::sum(@$vals);
}
sub round_value { Math::Round::round(@_) }
sub format_sig_figs {
my ($num, $n) = @_;
return FormatSigFigs($num, $n);
}
sub get_specimens {
my $str = shift; # warn $str;
# split on any non-word char (don't use \W, don't want '_')
# my @specimens = split /[^A-Za-z]+/, $str; # warn Dumper \@specimens;
my @specimens = split /[\,\.\s]+/, $str; # warn Dumper \@specimens;
return \@specimens;
}
# requires dob & ref_date as dt objects:
sub calculate_age {
my ($dob, $ref_date) = @_; # warn Dumper [$dob, $ref_date];
return 0 unless $dob && $ref_date # also must be DT objects:
&& ref $dob eq 'DateTime' && ref $ref_date eq 'DateTime';
# my $age = $ref_date->year - $dob->year - ( $dob->day_of_year > $ref_date->day_of_year );
my $age = ($ref_date - $dob)->in_units('years'); # warn $age; # DateTime::Duration function
return $age;
}
sub get_unique_elements {
my $array = shift;
my @unique_elements = List::MoreUtils::uniq(@$array);
return \@unique_elements;
}
sub get_array_diff { # returns integer equivalent to number of diffs between 2 arrays
my ($a, $b) = @_; # warn Dumper [$a, $b]; # 2 arrayrefs
my $lc = List::Compare->new($a, $b);
my $symdiff = $lc->get_symmetric_difference; # warn 'symdiff:'.$symdiff;
return $symdiff; # in scalar context is array size
}
sub is_array_subset { # returns true if 1st array is subset of (or same as) 2nd array
my ($a, $b) = @_; # warn Dumper [$a, $b]; # 2 arrayrefs
my $lc = List::Compare->new($a, $b);
my $is_subset = $lc->is_LsubsetR; # warn Dumper $is_subset;
return $is_subset;
}
sub has_array_common_elements { # returns true if any element is common to both arrays
my ($a, $b) = @_; # warn Dumper [$a, $b]; # 2 arrayrefs
my $lc = List::Compare->new($a, $b);
my @ary = $lc->get_intersection; # warn Dumper \@ary;
return scalar @ary; # returns true value if @ary exists
}
sub get_min_val {
my $list = shift;
return List::Util::min(@$list);
}
sub get_max_val {
my $list = shift;
return List::Util::max(@$list);
}
sub calculate_composite_p53 {
my $data = shift; # warn Dumper $data;
my $str = 'p53' . $data->{p53} . 'p21' . $data->{p21}; # warn $str;
$str =~ s!p53\+(/\-)?p21\-!deregulated!; # p53+ or +/-; p21-
$str =~ s!p53\+(/\-)?p21\+(/\-)?!normal!; # p53+ or +/-; p21+ or +/-
$str =~ s!p53\-(p21[\+\-/]+)?!neg!; # p53-; p21 +, +/- or -, or p21 result null
return $str;
}
# convert stones & pounds to kg:
sub convert_imperial {
my $data = shift || return;
my $stones = $data->{imperial_stones} || return; # can't be null
my $kg = $stones * 6.35029318;
if ( my $pounds = $data->{imperial_pounds} ) { # maybe null
$kg += ( $pounds * 0.45359237 );
}
return sprintf '%.1f', $kg;
}
# compares 2 dates using DateTime->compare, returns '-1' if chronological order,
# 0 (empty) if dates the same, '1' if 1st date > 2nd date
sub check_chronological_order {
my ($first_date, $last_date) = @_; # warn Dumper [$first_date, $last_date];
return 0 unless $first_date && $last_date # also must be DT objects:
&& ref $first_date eq 'DateTime' && ref $last_date eq 'DateTime';
my $cmp = DateTime->compare($first_date, $last_date);
}
# turns hashref of multiple depth to single level hashref - will eliminate
# duplicate keys eg id
sub traverse_hash {
my $deep_hashref = shift;
my %h;
Data::Traverse::traverse { $h{$a} = $b } $deep_hashref; # warn Dumper \%h;
return \%h;
}
# return postcode in WWd(d) dWW format (or 0 if invalid):
sub format_postcode {
my $post_code = shift || return 0;
$post_code =~ s/\s//g; # remove all spaces
$post_code = uc $post_code; # lower case
# see also http://github.com/JeremyJones/Regexp--Common/tree/master/lib/
my $regex = qr/^([A-Z]{1,2}[0-9]{1,2})([0-9]{1}[A-Z]{2})$/;
# <http://www.wellho.net/resources/ex.php4?item=q803/pcode>:
# my $regex = qr(^(([A-Z]{1,2})\d[0-9A-Z]?) +(\d[A-Z]{2})$);
# put space back 4th from end
my $formatted_postcode = join ' ', $1, $2 if $post_code =~ $regex;
return $formatted_postcode || 0; # for validator
}
sub get_yaml {
my $args = shift;
my @parts = @{ $args }{ qw(app_root yaml_dir filename) };
my $src_file = sprintf '%s/config/settings/%s/%s.yml', @parts; # warn $src_file;
if (-e $src_file) {
my $yaml;
# eval { # probably want to preserve & output any error
$yaml = YAML::Tiny->read($src_file); # warn Dumper $yaml;
# }; die @$ if @$;
return wantarray() # eg my @yml = get_yaml($args)
? $yaml
: $yaml->[0];
}
return 0; # eg function not configured
}
sub reformat_address {
my $addr = shift || return 0;
my @lines = split /[\,\n]+/, $addr; # split on new-line, comma or both
my @new = map { # doesn't deal with inconsistent use of comma between house number & street name
# capitalise 1st letter of each word in @lines:
join ' ', grep { s/(.*)/ucfirst( lc($1) )/e } split ' ', $_;
} @lines;
return join ', ', grep $_, @new; # reform with comma-space field delimiters
}
# extracts zip contents & returns a contents table
# expects upload dir & <file name>.zip
sub unzip_file {
my $args = shift; # warn Dumper $args;
my $target_dir = $args->{target_dir}; # unzip into upload dir
my $filename = $args->{filename}; # ie <file name>.zip
$filename =~ s/\s/_/g; # substitute spaces
my $src_file = join '/', $target_dir, $filename;
my $unzip = '/usr/bin/unzip';
my @zip_contents = `$unzip -l $src_file`; # get list of files in zip for display
# -a to convert DOS txt file line-endings
# -b to convert all files as binary
# -j to ignore directory structure
# -o to overwrite
# -d or tries & fails to unzip to cgi-bin
# problem with /usr/bin/unzip extracting some binaries as text
# `$unzip -ajo $src_file -d $target_dir` || die "Problem: ", $? >> 8, "\n";
my $archive = Archive::Extract->new(archive => $src_file);
my $ok = $archive->extract(to => $target_dir) or die $archive->error;
return \@zip_contents;
}
=begin nd
Function: delta_business_days
Returns number of business days between two dates (submitted format??).
See Date::Calc - How can I calculate the difference in days between dates, etc
=cut
sub delta_business_days { # Date::Calc - How can I calculate the difference in days between dates, etc
my ( $d0, $d1 ) = @_;
my @d0 = split '-', $d0; # DEBUG (\@d0);
my @d1 = split '-', $d1; # DEBUG (\@d1);
my ( $dow1, $dow2, $diff, $temp );
my $minus = 0;
my $result = Delta_Days( @d0, @d1 );
if ( $result != 0 ) {
if ( $result < 0 ) {
$minus = 1;
$result = -$result;
$dow1 = Day_of_Week(@d1);
$dow2 = Day_of_Week(@d0);
}
else {
$dow1 = Day_of_Week(@d0);
$dow2 = Day_of_Week(@d1);
}
$diff = $dow2 - $dow1;
$temp = $result;
if ( $diff != 0 ) {
if ( $diff < 0 ) {
$diff += 7;
}
$temp -= $diff;
$dow1 += $diff;
if ( $dow1 > 6 ) {
$result--;
if ( $dow1 > 7 ) {
$result--;
}
}
}
if ( $temp != 0 ) {
$temp /= 7;
$result -= ( $temp << 1 );
}
}
if ($minus) { return -$result; }
else { return $result; }
}
sub delta_last_working_day {
my $delta = '-1';
until ( Day_of_Week( Add_Delta_Days( Today(), $delta ) ) < 6 ) {
$delta--;
}
return $delta;
}
sub last_working_day { # receives value calculated in delta_last_working_day(), returns date in EU format
my $delta = shift; # $delta always negative so use Add_Delta_Days:
return join '-', reverse Add_Delta_Days( Today(), $delta );
}
sub symbolise { # transform eg 10/9/l & /ul
my $string = shift || return; # warn $string;
# first escapeHTML:
my $formatted = escapeHTML($string); # warn $estring;
$formatted =~ s/(\d)\/ul/$1\/µL/ig; # /ul
$formatted =~ s/10\/(6|9)\/(l|kg)/10<sup>$1<\/sup>\/$2/ig; # 10/9/l; 10/6/kg; etc
$formatted =~ s/10\^(\d)/10<sup>$1<\/sup>/g; # 10^6; 10^9; etc
# return escapeHTML'd string:
return $formatted;
}
sub clone {
my $data = shift;
my $cloned = Clone::clone($data);
return $cloned;
}
sub deindent { # see Perl Cookbook 1.11 - Indenting Here Documents
my $string = shift || return;
$string =~ s/^[^\S\n]+//gm;
return $string;
}
sub trim { # remove leading & trailing spaces
local $_ = shift || return;
s/^\s+//;
s/\s+$//;
return $_;
}
sub text_wrap {
my ($width, $args) = @_; # col width & array(ref) of args to wrap() function
$Text::Wrap::columns = $width; # set col width
return Text::Wrap::wrap(@$args);
}
sub this_year {
return This_Year; # Date_Calc function
}
sub datetime_formatter {
my $pattern = shift;
return DateTime::Format::Strptime->new( pattern => $pattern );
}
sub time_now {
my $args = shift || {}; # warn Dumper $args; # optional args for DT constructor
$args->{time_zone} ||= 'Europe/London'; # in case time_zone submitted in $args
return DateTime->now(%$args);
}
sub date_and_time_now {
my $args = shift || {}; # warn Dumper $args; # optional args for DT constructor
my $now = time_now($args);
return join ' ', $now->dmy, $now->hms;
}
sub time_now_hires {
my $args = shift || {}; # warn Dumper $args; # optional args for DT constructor
$args->{time_zone} ||= 'Europe/London'; # in case time_zone submitted in $args
return DateTime::HiRes->now(%$args);
}
sub today {
return DateTime->today;
}
# converts 4-digit year to date expression hashref useable by MySQL & SQLite:
sub year_to_date_expression {
my $year = shift || return;
my $first_day_of_year = DateTime->new(year => $year, month => 1, day => 1)->ymd;
my $last_day_of_year = DateTime->new(year => $year, month => 12, day => 31)->ymd;
return { '-between' => [ $first_day_of_year, $last_day_of_year ] };
}
=begin nd
Function: _date_is_future
Expression Delta_Days( @test_date, @today ) evaluates to positive if 2 dates in chronological order, zero if both dates the same,
and negative if first date AFTER second. Function returns true if Delta_Days() evalutes to negative. Uses Date:Calc which can handle dates
> 19/1/2038. Time::ParseDate does not work for dates > 19/1/2038 (UNIX epoch date).
=cut
sub _date_is_future {
my $date = shift; # from check_date()
my @decoded_date = Decode_Date_EU($date); # DEBUG (@decoded_date);
return 1
unless @decoded_date
; # or fatals in Delta_Days() if @decoded_date undef due to invalid date
# return value of expression 'Delta_Days() < 0' - ie true if Delta_Days is negative:
return Delta_Days( @decoded_date, Today() ) < 0;
}
=begin # would work except parse_datetime() assumes eg 21.2.08 = American date - need to supply 21.Feb.08 for EU dates
sub _date_is_future {
my $date = shift;
my $date = DateTime::Format::DateParse->parse_datetime( $date ); DEBUG( $date);
my $today = DateTime->today(); DEBUG $today;
my $delta = DateTime->compare($date, $today); DEBUG "delta:$delta";
}
=cut
=begin # returns true if date > today # NB Time::ParseDate DOES NOT WORK FOR DATES > 19.1.2038 !!
sub _date_is_future {
my $seconds_to_date = shift || return; # $to_seconds from Time::ParseDate::parsedate($date)
my $seconds_to_now = Time::ParseDate::parsedate("today"); # DEBUG("seconds_to_now:$seconds_to_now");
# $delta will be positive if $date before or equal to today, and negative if after today:
my $delta = $seconds_to_now - $seconds_to_date; DEBUG("delta: $seconds_to_now minus $seconds_to_date");
# return true if $delta < 0:
return $delta < 0 ? 1 : 0;
}
=cut
1;
