package My_Utils ; use strict ; use File::Basename; use My_Config ; BEGIN { use Exporter () ; #use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); use vars qw($VERSION @ISA @EXPORT @EXPORT_OK); $VERSION = '0.20'; @ISA = qw(Exporter); @EXPORT = qw( NOW MINUTE HOUR DAY WEEK YEAR MONTH QUARTER nameDate relDate YYYY_MM_DD_hh_mm_ss YYYY_MM_DD_hh_mm YYYYMMDDhhmmss YYYYMMDDhhmm ping IPadd_by_IPnum IPnum_by_IPadd IPsort $MINUTE $HOUR $DAY $WEEK $YEAR $MONTH $QUARTER ) ; # @EXPORT_OK = qw( ) ; } use vars @EXPORT_OK ; use vars qw( $MINUTE $HOUR $DAY $WEEK $YEAR $MONTH $QUARTER ) ; =pod Copyright (c) 2000-2001 John Stumbles and the University of Reading. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. C H A N G E H I S T O R Y =========================== 0.20 08Feb01 IPsort changed to function which is passed a list and returns sorted list of IPadds (normal $a $b passing mechanism to sort function doesn't seem to work when function is inside module) 0.12 08Feb01 IPsort tests for undefined values 0.11 05Feb01 added digits parameter to YYYYMMDDhhmmss function to return arbitrary length timestamp 0.10 30Jan01 created Utils.pm from utils.pl =cut my %relDate ; # cache my %IPnum_by_IPadd ; # cache ############################################################################## sub NOW { return time() ; } $MINUTE = 60 ; sub MINUTE { $MINUTE ; } $HOUR = 3600 ; sub HOUR { $HOUR ; } $DAY = 86400 ; sub DAY { $DAY ; } $WEEK = 604800 ; sub WEEK { $WEEK ; } $YEAR = 31536000 ; sub YEAR { $YEAR ; } $MONTH = 2628000 ; sub MONTH { $MONTH ; } $QUARTER = 7884000 ; sub QUARTER { $QUARTER ;} return 1; ############################################################################## sub ping { my $devIP = shift or return 1 ; my $PING = $CONFIG{PROG}{PING} or die "CONFIG{PROG}{PING} not defined in config file\n" ; # ping with 1 second timeout to see if host is up: return 1 if (`$PING $devIP 1` =~ /is alive/) ; return 0; } ############################################################################## sub IPadd_by_IPnum { my $IPnum = shift or return 0; # must be an easier way (maybe printf as hex, unpack as array & print?) # but for now do the hard way! my $i4 = $IPnum % 256 ; # 4th octet $IPnum >>= 8 ; # / 256 my $i3 = $IPnum % 256 ; # 3rd octet $IPnum >>= 8 ; # / 256 my $i2 = $IPnum % 256 ; # 2nd octet $IPnum >>= 8 ; # / 256 # 1st octet return sprintf "%u.%u.%u.%u", $IPnum, $i2, $i3, $i4 ; } ############################################################################## sub IPnum_by_IPadd { my $IPadd = shift or return 0; if ($IPnum_by_IPadd{$IPadd}) { return $IPnum_by_IPadd{$IPadd} ; } # in cache? my ($a1,$a2,$a3,$a4)=(0,0,0,0) ; ($a1,$a2,$a3,$a4)=split(/\./,$IPadd); return 0 unless defined $a3 ; return ((((($a1 << 8) + $a2) << 8) + $a3) << 8) + ($a4 or 0) ; } ############################################################################## sub nameDate # returns given time (current time if none given) as 'day DD mon YYYY hh:mm' { my $t = (shift or time()) ; # current time if none given my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday) = localtime ($t); sprintf ("%s %2.2u %s %4.4u %2.2u:%2.2u", (qw(Sun Mon Tue Wed Thu Fri Sat))[$wday], $mday, (qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec))[$mon], $year+1900, $hour, $min); } ############################################################################## sub relDate { my ($t, $now) = @_ ; return ' 'x12 unless $t ; return $relDate{$t} if ($relDate{$t}) ; # lookup in cache first $now = time() unless $now ; my ($t_sec,$t_min,$t_hour,$t_mday,$t_mon,$t_year,$t_wday,$t_yday) = localtime ($t); my ($now_sec,$now_min,$now_hour,$now_mday,$now_mon,$now_year,$now_wday,$now_yday) = localtime ($now); if ($now_year == $t_year) # same year? { if ($now_mon == $t_mon) # same month? { if ($now_yday == $t_yday) # same day? { return $relDate{$t} = sprintf "today %2.2u:%2.2u" , $t_hour, $t_min; # 'today hh:mm' } # (else) same month: return $relDate{$t} = sprintf "%3s %2.2u %2.2u:%2.2u", (qw(Sun Mon Tue Wed Thu Fri Sat))[$t_wday], $t_mday, $t_hour, $t_min; # 'day DD hh:mm' } # (else) same year return $relDate{$t} = sprintf "%3s %2.2u %2.2u:%2.2u", (qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec))[$t_mon], $t_mday, $t_hour, $t_min; # 'mon DD hh:mm' } # (else) more than a year ago return $relDate{$t} = sprintf "%s/%2.2u/%2.2u ", $t_year+1900, $t_mon+1, $t_mday ; # cache for later # 'YYYY/MM/DD ' } ############################################################################## sub YYYY_MM_DD_hh_mm_ss { my ($t, $nullpattern) = @_ ; $nullpattern = '----/--/-- : : ' unless defined ($nullpattern) ; return $nullpattern unless $t ; # return time2str "%Y/%m/%d %T",$t; # return time2str "%Y/%m/%d %H:%M:%S",$t; my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday) = localtime ($t); return sprintf ("%4.4u/%2.2u/%2.2u %2.2u:%2.2u:%2.2u", $year+1900, $mon+1, $mday, $hour, $min, $sec); } ############################################################################## sub YYYY_MM_DD_hh_mm { my ($t, $nullpattern) = @_ ; $nullpattern = '----/--/-- : : ' unless defined ($nullpattern) ; return $nullpattern unless $t ; # return time2str "%Y/%m/%d %H:%M",$t; my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday) = localtime ($t); return sprintf ("%4.4u/%2.2u/%2.2u %2.2u:%2.2u:%2.2u", $year+1900, $mon+1, $mday, $hour, $min, $sec); } ################################################################################################### sub YYYYMMDDhhmmss # return current date + time in string of format YYYYMMDDhhmmss { my $t = (shift or time()) ; my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday) = localtime ($t); my $digits = shift ; return sprintf ("%2.2u%2.2u%2.2u%2.2u%2.2u%2.2u", $year+1900, $mon+1, $mday, $hour, $min, $sec) unless $digits ; # default return substr(sprintf ("%2.2u%2.2u%2.2u%2.2u%2.2u%2.2u", $year+1900, $mon+1, $mday, $hour, $min, $sec), 0, $digits) ; } ################################################################################################### sub YYYYMMDDhhmm # return current date + time in string of format YYYYMMDDhhmm { my $t = (shift or time()) ; my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday) = localtime ($t); return sprintf ("%2.2u%2.2u%2.2u%2.2u%2.2u", $year+1900, $mon+1, $mday, $hour, $min); } ################################################################################################### sub IPsort { return () unless scalar (@_) ; return sort { my ($a1,$a2,$a3,$a4)=split(/\./,$a); return 1 unless $b; my ($b1,$b2,$b3,$b4)=split(/\./,$b); # return ($a1 <=> $b1) or ($a2 <=> $b2) or ($a3 <=> $b3) or ($a4 <=> $b4) ; if ($a1 == $b1) { if ($a2 == $b2) { if ($a3 == $b3) { return ($a4 <=> $b4); } return ($a3 <=> $b3); } return ($a2 <=> $b2); } return ($a1 <=> $b1); } @_ ; } __END__ ############################################################################## sub files_differ # returns true if files differ { my ($file_a, $file_b) = @_; # Get stat info for both files. my ($b_dev,$b_ino,$b_mode,$b_nlink,$b_uid,$b_gid,$b_rdev,$b_size,$b_atime,$b_mtime,$b_ctime,$b_blksize,$b_blocks) = stat($file_b); unless (-f _) { return 255; } my ($a_dev,$a_ino,$a_mode,$a_nlink,$a_uid,$a_gid,$a_rdev,$a_size,$a_atime,$a_mtime,$a_ctime,$a_blksize,$a_blocks) = stat($file_a); unless (-f _) { return 255; } # Quick check on size and mode. if ($b_size != $a_size) { return 1; } if ($b_mode != $a_mode) { return 1; } # Already linked? (Perhaps symbolically?) # Compare dev/inode numbers. if ($b_dev == $a_dev && $b_ino == $a_ino) { return 0; } # Now compare the two files. unless (open(FILE_B,"$file_b")) { return 255; } unless (open(FILE_A,"$file_a")) { return 255; } my $blksize = $b_blksize || 8192; my ($a_buf, $b_buf) ; while (read(FILE_A,$a_buf,$blksize)) { read(FILE_B,$b_buf,$blksize); if ($a_buf ne $b_buf) { return 1; } } # Okay, the same return 0; }