|
#!/usr/bin/perl -w # # ascalpost.cgi v0.11 --crb3 03jun02/22apr04/04apr07 # "pocket astrologer" style CGI calendar generator, a CGI front end for # astrolog. (htt://www.astrolog.org, Astara@msn.com) # based on: calpost.cgi v0.01 --crb3 03jun02 # # the big reason for this program is Void Of Course moon calendaring. a VOC # is when the moon has made its last major angle to a planet while within # its current sign, and extends until the moon enters the next sign. VOC # periods tend to be "tractionless" and "unilluminated" -- lunar/emotional # energies tend to diffuse rather than sum-to-focus, and a decision made # during a VOC will usually have to be checked for things that were missed. # # VOC processing ignores asteroids. that's how the cosmic muffin handled # it; hope it's right. # # v0.1 --crb3 27sep02: # - textcolor red for VOC, green for moon's entrance to next sign (end of VOC) # # v0.2 --crb3 01oct02: # fetch in the month prior as well as the current and following months. # process for VOC, then discard all days prior to calendar-start. # # v0.3 --crb3 05oct02 # - yellow bgcolor for the current day # # v0.4 --crb3 17jan03: # - tip in graphic icons (however homebrew/cheesy) for the lunar quarters. # # v0.5 --crb3 01mar03: # - redo the last/this/next month fetching using absolute-date numeric args # to astrolog, rather than the -m/+m stuff (which it botches by applying # a fixed 30-day offset). the code is a little simpler, and it no longer # stumbles trying to produce a calendar for March. # - clean up the first/last quarter detection a little. # # v0.6 --crb3 16may03 # - add browser-cachetime calculation so the right day stays highlighted # in a browser parked on the page # # v0.7 --crb3 14jul03 # - finish lowercasing the HTML and make a stab at making sure it's xhtml. # - a non-Demonhouse header for folks on other networks # - bumped version numbers by 10 to stop being ridiculous # - GIMPed a "powered by Astrolog" logo # # v0.8 --crb3 28aug03 # - cleanup, speedup, with a hash for zod and slices for splits, in # quartermoon-pasting # # v0.9 --crb3 21jan04 # - clean up idiotic botch of a leapyear function # # v0.10 --crb3 22apr04 # - add in bolding eyecatch for S/R, S/D events (for us Mercurial types) # # v0.11 --crb3 04Apr07 # - catch up with LAN-local version # - add eyecatch bolding for lunar quarters too (for us loonies) # - clean up VOC filtering to catch sun/moon angles # - add lunar festivals, and bolding for the solar ones # - a little speedup using a little more Perl learning # ## # ----------------------------------------------------------------------- # LICENSE AND DISCLAIMER # # This program is copyright (C) 2002-2007 C. R. Bryan III and is made # available under the terms of the GNU General Public License. It comes with # absolutely no warranty of functionality, serviceability, suitability or # informativeness. It works on my server. If it breaks on yours you get to # keep both halves. It presents partially preprocessed astrological data; # what you do with that information, and the consequences of such action, # are entirely up to you. I find it useful; YMMV. # # ----------------------------------------------------------------------- # $keyline="Sun Moon Mercury Venus Mars Jupiter Saturn Uranus Neptune Pluto Pallas Ceres Vesta Chiron " ."(direct-in) [retrograde-in] Stationary/Direct Stationary/Retrograde<br />" ."Aries Taurus Gemini Cancer Leo Virgo Libra Scorpio " ."Sagittarius Capricorn Aquarius Pisces"; #$siz="m"; $outfname="-"; # cgi use defaults to STDOUT $firstday=1; # sunday==0 $wks2do=6; #$idy=$imo= $iyr=$idow=$idoy=0; # integer date, day-of-week/year values #$isinfile=0; $infname="Monthly Indoor Weather Report"; $astrolog="/usr/local/bin/astrolog"; $imgpath="/images"; $VOC="<font color=\"red\">VOC</font>"; $imgsize="height=\"32\" width=\"32\""; $imgtype="gif"; $moonfull=" <img src=\"$imgpath/moonfull.$imgtype\" $imgsize> "; $moondark=" <img src=\"$imgpath/moondark.$imgtype\" $imgsize> "; $moonfq=" <img src=\"$imgpath/moonfq.$imgtype\" $imgsize> "; $moonlq=" <img src=\"$imgpath/moonlq.$imgtype\" $imgsize> "; # build a hash (p.14 Effective Perl Programming) @zod{ qw/Ari Tau Gem Can Leo Vir Lib Sco Sag Cap Aqu Pis/ }=(0..11); @plh{ qw/Sun Mer Ven Mar Jup Sat Ura Nep Plu/ } = (0..8); #@pl=qw/Sun Mercury Venus Mars Jupiter Saturn Uranus Neptune Pluto/; $hbgcolor="#FFFFFF"; $ismo_bgcol="#CFCFCF"; # a lighter grey for this month $ntmo_bgcol="#C0C0C0"; # adjacent-month grey $fram_bgcol="#A9A9A9"; # frame-background grey $tday_bgcol="#FFFFCC"; # hightlight today in yellow $nrmtxt_col="#000000"; # normal text is black @dys = qw/sun mon tue wed thu fri sat/; @mons = qw/jan feb mar apr may jun jul aug sep oct nov dec/; #@monlens = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31); @mondys=(0, 31, (28+31), (31+28+31), (30+31+28+31), (31+30+31+28+31), (30+31+30+31+28+31), (31+30+31+30+31+28+31), (31+31+30+31+30+31+28+31), (30+31+31+30+31+30+31+28+31), (31+30+31+31+30+31+30+31+28+31), (30+31+30+31+31+30+31+30+31+28+31), (31+30+31+30+31+31+30+31+30+31+28+31),); # # highlight string match setup # ($sec,$min,$hour,$mday,$mon,$yr,,,,) = localtime(); $yr += 1900; # abs year $mon++; # $mon now 1-based $thismonth=$mon; $todoy = &date2doy($yr,$mon,$mday); $htoday=sprintf("%4.04d_%3.03d",$yr,$todoy); # # figure out browser cache expiring so the user's browser will # reload when the date changes. # $fudge=2; # minutes, get it solidly past 00:00:00 $cachetime = (23-$hour) *3600 + (59-$min) *60 + (59-$sec) + ($fudge*60); # # fetch in the month prior as well as the current and following months. # process for VOC, then discard all days prior to calendar-start. to do that # right, we have to know now what the starting date of the calendar display # is going to be, so we can discard the right days. # # grab and adjust values for the newer style of last/next month invocation. # $lasyr=$yr; $lasmon=$mon-1; if($mon==0){ $lasyr--; $lasmon=12; } $nxyr=$yr; $nxmon=$mon+1; if($nxmon > 12){ $nxyr++; $nxmon=1; } # grab last month's listings. @as=`$astrolog -dm -qd $lasmon 1 $lasyr`; # # strip that now, before the array balloons any further, to strike out # day-entries that don't belong in the calendar. right now that's # dirt-simple in concept: starting from the latest entries in the array and # working backwards, step through until we've stepped past the first day of # the calendar week, and delete everything prior. my $backdow=ucfirst($dys[$firstday]); # target is camelcased $backdow = "(".$backdow.") "; # textual wrapper my $backstate=0; # 0: not yet found the weekstart day for(my $b=$#as;$b>0;$b--){ if($backstate==0){ $backstate=1 if index($as[$b],$backdow)>-1; }elsif($backstate==1){ # 1: found the weekstart day $backstate=2 unless index($as[$b],$backdow)>-1; }else{ # 2: now prior to weekstart. splice(@as,0,$b+2); # wham, gone. $b=0; # break out of just the forloop, thanks. } } # # now for this month and next month. # push(@as,`$astrolog -dm -qd $thismonth 1 $yr 0:0`); push(@as,`$astrolog -dm -qd $nxmon 1 $nxyr 0:0`); # # running backwards through the array, paste in VOC info. # reversing the list used in a foreach loop is in fact slightly # slower than the countdown-through-offsets method used here, # according to Benchmark. # for($v=0,$b=$#as;$b>=0;$b--){ # # no appreciable benchmark change from including the precheck indexing, # but I know it often speeds up this kind of thing. i leave it in. # --crb3 27jul04 # $as[$b] =~ s/Mercury/Mer/ if index($as[$b],'Mercury')>-1; $as[$b] =~ s/Venus/Ven/ if index($as[$b],'Venus')>-1; $as[$b] =~ s/Mars/Mar/ if index($as[$b],'Mars')>-1; $as[$b] =~ s/Jupiter/Jup/ if index($as[$b],'Jupiter')>-1; $as[$b] =~ s/Saturn/Sat/ if index($as[$b],'Saturn')>-1; $as[$b] =~ s/Uranus/Ura/ if index($as[$b],'Uranus')>-1; $as[$b] =~ s/Neptune/Nep/ if index($as[$b],'Neptune')>-1; $as[$b] =~ s/Pluto/Plu/ if index($as[$b],'Pluto')>-1; $as[$b] =~ s/Pallas/Pal/ if index($as[$b],'Pallas')>-1; $as[$b] =~ s/Ceres/Cer/ if index($as[$b],'Ceres')>-1; $as[$b] =~ s/Chiron/Chi/ if index($as[$b],'Chiron')>-1; $as[$b] =~ s/Vesta/Ves/ if index($as[$b],'Vesta')>-1; if(index($as[$b],'Moon') >-1 and index($as[$b],'-->') >-1){ # moon changes sign $as[$b] =~ s/(Moon\s+\(\w+\)\s+\-{2}\>\s+\w+)/\<font color\=\"green\"\>$1\<\/font\>/; # " $v=1; }elsif($v and index(($line=$as[$b]),' Moon') >-1){ # VOC ($pt1,$pt2)=(split(/\s+/,substr($as[$b],24)))[1,5]; $pt0 = ($pt1 eq 'Moon' ? $pt2 : $pt1); if(exists($plh{$pt0})){ $as[$b] =~ s/\n$/ $VOC\n/; $v=0; } } } # # now format-and-squirt. this part converts the array into # something suitable as input for cal, ripping dates off the # lines and substituting a date header at the start of each # day's group. # $olddate=""; foreach $line (@as){ ($dy,$line)=unpack("\@6A10A*",$line); # discard dow, grab a date $dy =~ s/\s+//g; # that might have spaces in it if($dy ne $olddate){ ($m,$dd,$y)=split('/',$dy,3); $hname=sprintf("%4.04d_%3.03d",$y,date2doy($y,$m,$dd)); $d{$hname}=""; # new hash entry $olddate=$dy; } # # highlight planetary stationary (retrograde/direct) points, # solar festivals (solstices and equinoxes) and lunar quarters. # bolding is enough eyecatch for this. # if( (index($line,'S/D')>-1) or (index($line,'S/R')>-1) or (index($line,' Moon)') >-1) or index($line,'Equinox')>-1 or index($line,'Solstice')>-1 ){ # moon quarters, solar festivals $line = "<b>$line</b>"; } if( index($line,'<font size')>-1){ # avoid stomping on NOW fonting $d{$hname} .= "<tr><td>$line</td></tr>\n"; }else{ $d{$hname} .= "<tr><td><font size=\"-1\">$line</font></td></tr>\n"; } } undef(@as); # in case perl doesn't discard it # # paste in lunar quarter icons as appropriate # foreach $ky (keys %d){ $ln=$d{$ky}; if(index($ln,'Full Moon')>-1){ $ln =~ s/\<tr\>\<td\>//; $d{$ky} = '<tr><td>' . $moonfull . $ln; }elsif(index($ln,'New Moon')>-1){ $ln =~ s/\<tr\>\<td\>//; $d{$ky} = '<tr><td>' . $moondark . $ln; }elsif(index($ln,'Half Moon')>-1){ $whack = (split( /(Sun \(\w{3}\) Squ \(\w{3}\) Moon)/,$ln,3))[1]; ($sunv,$moonv)=(split(/(\(\w{3}\))/,$whack,5))[1,3]; $b4=$zod{substr($sunv,1,3)}; # get numeric values for these $a4=$zod{substr($moonv,1,3)}; # three-letter names $ln =~ s/\<tr\>\<td\>//; $b4 += 12 unless $b4 > 2; if($b4-3==$a4 or $a4+3==$b4){ $d{$ky} = '<tr><td>' . $moonlq . $ln; }else{ $d{$ky} = '<tr><td>' . $moonfq . $ln; } } } # # 01oct02: here's where we've been determining start-of-calendar, # from the data itself. we can leave this in, even though it's # redundant, because it's useful for file-driven calendars. # $first=(sort keys (%d))[0]; # find the earliest one ($iyr,$idoy)=split('_',$first,2); $idow=date2dow(doy2date($iyr,$idoy)); # what day-of-week? if($firstday != $idow){ # same as calendric first-day? $idow += 7 if($idow < $firstday); # if not, find that date. $dif = $idow - $firstday; $idoy -= $dif; if($idoy < 0){ # step back the calendar start $iyr--; $idoy += (is_leapyr($iyr) ? 366 : 365); } } # emit the fool thing... open(OFIL,">$outfname") or die "can't make outfile $outfname\n"; print OFIL <<EOT; Content-type: text/html <html> <head> <meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1"> <meta http-equiv="pragma" content="no-cache"> <meta http-equiv="refresh" content="$cachetime"> <meta name="generator" content="ascalpost.cgi"> <title>$infname</title> </head> <body text="#000000" bgcolor="$fram_bgcol" link="#0000EE" vlink="#CC0000" alink="#FFFF00"> <center> <table align="center" cellpadding="15"> <tr> <td><h2>$infname</h2></td> </tr> </table> </center> <hr width="95%" align="center"> <p align="center" bgcolor="$ntmo_bgcol"><font size="-1">$keyline</font></p> <hr width="95%" align="center"> <table width="95%" border="1" align="center"> <tr> EOT # " <--syntax balancing for joe for($a=$firstday,$b=0;$b<7;$a++,$a %= 7, $b++){ print OFIL " <td width=\"14%\" align=\"center\" bgcolor=\"$hbgcolor\">$dys[$a]</td>\n"; } print OFIL " </tr>\n"; for($wkcnt=0;$wkcnt<$wks2do;$wkcnt++){ # WEEKS print OFIL " <tr>\n"; for($dycnt=0;$dycnt<7;$dycnt++){ # 7DAYS ($y,$m,$d)=doy2date($iyr,$idoy); $hname=sprintf("%4.04d_%3.03d",$iyr,$idoy); $hcolr = ( ($hname eq $htoday) ? ("bgcolor=\"$tday_bgcol\" color=\"$nrmtxt_col\"") : ( ($m == $thismonth) ? ("bgcolor=\"$ismo_bgcol\" color=\"$nrmtxt_col\"") : ("bgcolor=\"$ntmo_bgcol\" color=\"$nrmtxt_col\"") ) ); $MIL=sprintf("%2.02d%s%4.04d",$d,$mons[$m-1],$y); $Mdow=$dys[date2dow($y,$m,$d)]; print OFIL " <td width=\"14%\" $hcolr valign=\"top\">\n "; print OFIL "<p align=\"center\" width=\"14%\">$Mdow <!-- $hname --> $MIL</p>\n"; if(exists($d{$hname})){ print OFIL " <table>\n "; $ladd=""; if(index($MIL,'01feb') >-1){ $ladd = "Imbolc"; }elsif(index($MIL,'01aug') >-1){ $ladd = "Lammas"; }elsif(index($MIL,'31oct') >-1){ $ladd = "Samhain"; }elsif(index($MIL,'30apr') >-1){ $ladd = "Beltane"; } print OFIL "<tr><td align=\"center\"><i>$ladd</i></td></tr>" if length($ladd); print OFIL $d{$hname}; print OFIL " </table>\n"; }else{ print OFIL " \n"; } print OFIL " </td>\n"; $idoy++; if($idoy > (is_leapyr($iyr) ? 366 : 365)){ $iyr++; $idoy=1; } } print OFIL " </tr>\n"; } # # finish up the calendar table. after that comes 'powered by' # badges. the Astrolog one I made came with ascalpost; the # others are on your system, or should be edited to refer to # badges that _are_ on your system. I've seen one ascalpost # setup in the wild with a beastie sticker; I do prefer not to # witness a four-color-nappie Windows one in its place, but... # Perl is BASIC's promise of a universal language, fulfilled. # print OFIL <<EOT; </table> <hr width="95%" align="center"> <center> <font size="-1"> generated by <a href="http://www.stormbringer.org/pers/crb3/cgi/#ascalpost">ascalpost.cgi</a> by crb3, front end for <a href="http://www.astrolog.org">Astrolog</a> by Walter Pullen </font> </b> </center> <br> <table align="center"> <tr><td> <img src="/images/poweredby.png" height="31" width="88" alt="Powered by Red Hat Linux"> </td><td> </td><td> <img src="/images/astrologpb-192x64.png" height="64" width="192" alt="Powered by Astrolog"> </td><td> </td><td> <img src="/images/apache_pb.gif" height="32" width="259" alt="Powered by Apache"> </td></tr> </table> </body> </html> EOT close(OFIL); ###-------------------- sub calheader { my($a,$b); print OFIL "<tr>"; for($a=$firstday,$b=0;$b<7;$b++,$a++,$a%=7){ print OFIL "<th width=\"14%\" align=\"center\">".$dys[$a]."</th>\n"; } print OFIL "</tr>\n"; } sub is_leapyr { my $y=abs(shift(@_)); return(0) if($y%4); return(0) if(!($y%100) and ($y%400)); return(1); } # # The following formula, which is for the Gregorian calendar only, may be # more convenient for computer programming. Note that in some programming # languages the remainder operation can yield a negative result if given a # negative operand, so mod 7 may not translate to a simple remainder. # # W = (k + floor(2.6m - 0.2) - 2C + Y + floor(Y/4) + floor(C/4)) mod 7 # # where floor() denotes the integer floor function, # k is day (1 to 31) # m is month (1 = March, ..., 10 = December, 11 = Jan, 12 = Feb) # Treat Jan & Feb as months of the preceding year # C is century (1987 has C = 19) # Y is year (1987 has Y = 87 except Y = 86 for Jan & Feb) # W is week day (0 = Sunday, ..., 6 = Saturday) # # Here the century and 400 year corrections are built into the formula. # The floor(2.6m - 0.2) term relates to the repetitive pattern that the # 30-day months show when March is taken as the first month. # # date2dow. # take integer date (yr4, mo[1-12], dy[1-31?], return day-of-week(0-6). # sub date2dow { my($y,$m,$d)=@_; my($c,$k); #setup $y-- if($m<3); $c = int($y/100); $y %= 100; $m--; # months go 0-based $m += 10; $m %= 12; # roll to 0=march $m++; # back to 1-based #alg $k = $d; $k += int(($m*2.6)-0.2); $k -= 2*$c; $k += $y; $k += int($y/4); $k += int($c/4); $k %= 7; # 0=sun return($k); } %mns=(jan=>0,feb=>1,mar=>2,apr=>3,may=>4,jun=>5,jul=>6,aug=>7,sep=>8,oct=>9,nov=>10,dec=>11); # # MIL2day. # convert a MIL date, with or without dashes, to day, month and year integers. # # sub MIL2day { my $mil=shift(@_); my($yr,$tmo,$mo,$dy); $mil =~ s/\^.+$//; # whack off any time $mil =~ s/\-//g; # compact it from 00-mon-00 to 00mon00 # (just to reduce it to one format) $dy=substr($mil,0,2); $yr=substr($mil,5); $tmo=lc(substr($mil,2,3)); # lowercase it for comparison $mo=$mns{$tmo}+1; if($yr < 1000){ $yr += ($yr < 50 ? 2000 : 1900); } return($yr,$mo,$dy); } # # date2doy. # given three integers for day, month and fullyear, where 01jan is 1,1, # return the date's day-of-the-year count, where 01jan is 1. # sub date2doy { my($yr,$mo,$dy)=(@_); my($doy); $mo--; # back to 0-based $doy=$mondys[$mo]+$dy; # index into lengths-table $doy++ if(is_leapyr($yr) and $mo>1); # adjust for leapyear return($doy); } # # doy2date. # given year and day-of-year count, return yr,mo,dy. # sub doy2date { my $yr=0 + shift(@_); # coerce incoming args to numeric my $doy=0 + shift(@_); my($mo,$dy); my $skip=0; if(is_leapyr($yr)){ # leapyear adjustments if($doy == $mondys[2]+1){ $mo=2; $dy=29; $skip=1; }elsif($doy > $mondys[2]){ # ly adjust $doy--; } } unless($skip){ for($mo=0;$mo<12;$mo++){ last if $doy <= $mondys[$mo+1]; } $dy=$doy-$mondys[$mo]; $mo++; } return($yr,$mo,$dy); } |
Grab the tarball here |
| Syntax highlighting using Syntax::Highlight::Engine::Kate |