P3X GitList

package Local::Utils;

use Modern::Perl;

use Clone;
use DateTime;
use List::Util;
use Crypt::CBC;
use Digest::SHA1;
use HTML::Escape;
use HTTP::BrowserDetect;
use DateTime::Format::Strptime;
use Scalar::Util 'looks_like_number';
use Data::Printer alias => 'p', use_prototypes => 0;

use Date::Calc qw(Delta_Days);
use Date::Calendar;
use Date::Calendar::Profiles qw( $Profiles ); # warn Dumper $Profiles->{GB};
my %_CACHE_; # for Date::Calendar object

sub symbolise { # transform eg 10/9/l & /ul
    my $string = shift || return; # warn $string;

    my $formatted = HTML::Escape::escape_html($string); # p $formatted;

    $formatted =~ s/(\d)\/ul/$1\/&micro;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
		# p $formatted;
    return $formatted;
}

sub clone { Clone::clone(shift) }

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)
}

sub time_now {
    my $args = shift || {}; # p $args; # optional args for DT constructor
    $args->{time_zone} ||= 'Europe/London';
    # default format "yyyy-mm-dd hr:min:sec" if called as time_now() ie without ->function:
    $args->{formatter} ||= DateTime::Format::Strptime->new( pattern => '%F %T' );
    return DateTime->now(%$args);
}

sub today { time_now(@_) } # just returns time_now()

sub this_year { time_now(@_)->year }

sub delta_days { # Date_Calc method
    my ( $d0, $d1 ) = @_;

    my @d0 = split '-', $d0; # warn Dumper \@d0;
    my @d1 = split '-', $d1; # warn Dumper \@d1;

	my $result = Delta_Days( @d0, @d1 );
	return $result;
}

sub math_sum { List::Util::sum(@_); }

sub encrypt { # Crypt::CBC
    my ($str, $key) = @_;
    my $cipher = Crypt::CBC->new({ key => $key });
    return $cipher->encrypt_hex($str);
}

sub decrypt { # Crypt::CBC
    my ($str, $key) = @_; # p [$str, $key];
    my $cipher = Crypt::CBC->new({ key => $key });
    return $cipher->decrypt_hex($str);
}

sub user_agent {
    my $str = shift;
    my $ua = HTTP::BrowserDetect->new($str);
    return sprintf '%s %s-%s', map $ua->$_,
        qw(os_string browser_string public_version);
}

sub matches {
	my ($var,$const) = @_; # p [$var,$const];

	return ( looks_like_number($const) && looks_like_number($var) )
		? $var == $const
		: $var eq $const;
}

# transforms DateTime object, or (recursive) hashref of keys with value(s) DateTime:
sub datetime_to_string {
    my $r = shift; # say ref $r;
	# return stringified if DT object:
	return "$r" if ref($r) =~ /^DateTime/;
	# return unless hashref:
    return unless ref($r) eq 'HASH';

    for my $key ( keys %$r ) {
        if ( ref($r->{$key}) eq 'HASH' ) { # recursive call for hashrefs
            datetime_to_string( $r->{$key} ); # p $r->{$key};
        }
        if ( ref($r->{$key}) =~ /^DateTime/ ) { # p $r->{$key};
            $r->{$key} = sprintf "%s", $r->{$key}; # quote to force to string
        }
    }
	return $r;
}

sub last_working_date {
    # pass DT object or create new as yesterday:
    my $dt = shift || DateTime->today->subtract(days => 1); # yesterday

    my $calendar = date_calendar();
    my $to_arrayref = sub { [ split '-', shift ] }; # returns arrayref of (yyyy, mm, dd)

    # subtract 1 day per weekend/holiday; is_full() returns true on non-work day:
    $dt->subtract(days => 1) while $calendar->is_full( &$to_arrayref($dt->ymd) );
    return $dt;
}

sub date_calendar {
    return $_CACHE_{calendar} if $_CACHE_{calendar}; # warn 'here';

    my $profile = $Profiles->{GB}; # warn Dumper $profile; # hashref of UK holiday dates
        # $profile->{HollyDay} = '2/Mon/Feb'; # ficticous holiday (eg 2nd Mon in Feb) to test
    my $calendar = Date::Calendar->new($profile); # only happens once at server start
    $_CACHE_{calendar} = $calendar; # to return cache'd Date::Calendar object

=begin # check dates - Easter Sunday calculated in Date::Calc::PP::DateCalc_easter_sunday():
warn $calendar->is_full($_) for (
    [2013,1,1],   # NYD
    [2013,3,29],  # Easter Fri
    [2013,4,1],   # Easter Mon
    [2013,5,6],   # May Day
    [2013,5,27],  # Spring Bank
    [2013,8,26],  # Summer Bank
    [2013,12,25], # Xmas
    [2013,12,26], # Boxing Day

    [2010,12,25], # Xmas - Sat
    [2010,12,26], # Boxing Day - Sun
    [2010,12,27], # Mon - should be holiday
    [2010,12,28], # Tues - should be holiday
    [2010,12,29], # Weds - should not be holiday
);
=cut
    return $calendar;
}

sub dump_query {
# might need to use Local::DB::_replace_omniholder if sql contains '??'
    my ($class, $sql, @bind) = @_; # p $class;

    # $class should be Local::DB or LIMS::Local::DBIxSimple object:
    die "first arg should be a class object able to provide a dbh (DBI::db) object"
        unless ref $class && $class->can('dbh'); # need to call ->quote()

    for my $val (@bind) { # replace each '?' with next element of array:
        $val = $class->dbh->quote($val) # quote anything other than numbers
        # $val = qq!"$val"! # quote anything other than numbers
            unless Scalar::Util::looks_like_number($val); # say $val;
        $sql =~ s/\Q?/$val/;
    }
    $sql =~ s/(FROM|WHERE|ORDER BY|GROUP BY)/\n$1/g;
    $sql =~ s/(LEFT OUTER|INNER)/\n\t$1/g;
    my $lh_parens = "\Q("; # ddp $lh_parens;
    my $rh_parens = "\Q)";
    $sql =~ s/(OR $lh_parens)/\n\t$1/g;
    # $sql =~ s/($lh_parens|$rh_parens)/\n\t$1/g; # also works OK
    # $sql =~ s/(OR|AND)/\n\t$1/g; # doesn't really work
    print '# ', '=' x 80, "\n";
    print $sql, ';', "\n";
    print '# ', '=' x 80, "\n";
}

1;