DATE.pm
########################################################################################################################### sub date_() { return date(@_); } sub date() { my($ref,$pat)=@_; my $REF=$ref; $ref=~s/\s+/ /sg; $ref=~s/^ | $//g; my @t=($ref=~s/(\d{4}-\d{2}-\d{2})//)? getYMD($1) : getYMD(); $t[0]+=-1 if($ref=~s/last year//); # ($ref=~s/this year//); $t[0]+= 1 if($ref=~s/next year//); $t[1] = 1 if($ref=~s/first month of//); $t[0]+=1,$t[1] =-1 if($ref=~s/last month of//); $t[1]+=-1 if($ref=~s/last month//); # ($ref=~s/this month//); $t[1]+= 1 if($ref=~s/next month//); $t[2] = 1 if($ref=~s/first day of//); $t[1]+= 1,$t[2] =-1 if($ref=~s/last day of//); $t[2]+=-1 if($ref=~s/last day|yesterday//); # ($ref=~s/this day|today|now//); $t[2]+= 1 if($ref=~s/next day|tomorrow//); my @d=(0,0,0); $d[0]+= $1*($2?-1:1) if($ref=~s/([+-]?\d+) years?( ago)?//); $d[1]+= $1*($2?-1:1) if($ref=~s/([+-]?\d+) months?( ago)?//); $d[2]+=7*$1*($2?-1:1) if($ref=~s/([+-]?\d+) weeks?( ago)?//); $d[2]+= $1*($2?-1:1) if($ref=~s/([+-]?\d+) days?( ago)?//); # print ERR DJM(MJD($t[0]+$d[0],$t[1]+$d[1],$t[2]+$d[2])).' / '.qx(date -d "$REF" "+%Y-%m-%d").$REF."\n\n"; return strfdate($pat,str2time($t[0]+$d[0] ,$t[1]+$d[1] ,$t[2]+$d[2])) if($pat=~/%/); return DJM(MJD($t[0]+$d[0] ,$t[1]+$d[1] ,$t[2]+$d[2])); } ########################################################################################################################### sub str2time { use integer; my $t=MJD(@_); $t-=MJD('19700101'); return $t*24*60*60; } sub strfdate { # 0 1 2 3 4 5 6 @a=('Sonntag','Montag','Dienstag','Mittwoch','Donnerstag','Freitag','Samstag'); @b=('','JÀnner','Februar','MÀrz','April','Mai','Juni','Juli','August','September','Oktober','November','Dezember'); my($r,$t,$o)=@_; $t||=time(); $o*=86400; # offset = Days my($S,$M,$H,$d,$m,$y,$w,$j)=localtime($t+$o); $m++; $r=~s/%R/%H:%M/g; $r=~s/%T/%H:%M:%S/g; $r=~s/%X/%H:%M:%S/g; $r=~s/%F/%Y-%m-%d/g; $r=~s/%x/%Y-%m-%d/g; $r=~s/%u/sprintf("%d",1+($w+6)%7);/ge; # Mo=1 $r=~s/%w/sprintf("%d", ($w+1) );/ge; # So=1 $r=~s/%a/i18n(substr($a[$w],0,2));/ge; $r=~s/%A/i18n( $a[$w] );/ge; $r=~s/%b/i18n(substr($b[$m],0,3));/ge; $r=~s/%B/i18n( $b[$m] );/ge; $r=~s/%Y/sprintf("%04d",$y+1900 );/ge; $r=~s/%y/sprintf("%04d",$y% 100 );/ge; $r=~s/%V/sprintf("%02d",weekOfYear($y+1900,$m,$d));/ge; $r=~s/%j/sprintf("%02d",$j);/ge; $r=~s/%m/sprintf("%02d",$m);/ge; $r=~s/%d/sprintf("%02d",$d);/ge; $r=~s/%e/sprintf("%2d" ,$d);/ge; $r=~s/%H/sprintf("%02d",$H);/ge; $r=~s/%k/sprintf("%2d", $H);/ge; $r=~s/%M/sprintf("%02d",$M);/ge; $r=~s/%S/sprintf("%02d",$S);/ge; return $r; } sub getYMD ### [now|yyyymmdd|yyyy-mm-dd|(yyyy,mm,dd)] => (y,m,d) { my($y,$m,$d); if(@_==0) { (undef,undef,undef,$d,$m,$y)=localtime(); $y+=1900; $m++; return ($y,$m,$d); } elsif(@_==1 && $_[0]=~/^(\d\d\d\d)(-?)(\d\d)\2(\d\d)/ ) { return ($1,$3,$4); } elsif(@_==3 && $_[0] =~ /^\d+$/ && $_[1] =~ /^-?\d+$/ && $_[2] =~ /^-?\d+$/) { return @_; } } sub MJD ### [now|yyyymmdd|yyyy-mm-dd|(yyyy,mm,dd)] => julian { use integer; my ($y,$m,$d)=getYMD(@_); while($m>12) { $m-=12; $y++ } while($m< 3) { $m+=12; $y-- } return $y*365+$y/4-$y/100+$y/400-306+($m+1)*306/10-122+$d-678576; } sub DJM ### julian => yyyymmdd { my $mjd=shift; my $jd =$mjd + 2400000.5; my $jd0=int($jd+0.5); my $b=int(($jd0-1867216.25)/36524.25); my $c=$jd0+($b-int($b/4))+1402; my $d=int(($c+0.9)/365.25); my $e=365*$d+int($d/4); my $f=int(($c-$e+123)/30.6001); my $day=$c-$e+123-int(30.6001*$f); my $month=($f-2)%12+1; my $year=$d-4716+($month<3); return sprintf("%d-%02d-%02d",$year,$month,$day); } ###########################################################################################################################
perl Modul als Ersatz für qx{date ...} (4.4kB)
Download