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\/µL/ig; # /ul $formatted =~ s/10\/(6|9)\/(l|kg)/10$1<\/sup>\/$2/ig; # 10/9/l; 10/6/kg; etc $formatted =~ s/10\^(\d)/10$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;