API tools faq
paste
crb3

.wxg2

crb3
Oct 26th, 2016
188
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Perl 20.36 KB | None | 0 0
raw download clone embed print report
  1. #!/usr/bin/perl -w
  2. #
  3. # .wxg2         --crb3 18Mar14/13may15/20aug15
  4. #
  5. # wunderground changed things around. seems an opportune time to
  6. # adjust things a little...
  7. # the less extraneal stuff they send, the less I have to flense
  8. # and the less either side has to expend in bandwidth.
  9. #
  10. # --crb3 07May15:
  11. # especially since they've discontinued the page we were scraping.
  12. # time to get serious about this minimal version.
  13. # --crb3 13May15:
  14. # - Forecast for s/Bedford/Central Middlesex County/
  15. # - add dating to today-labels
  16. # --crb3 20Aug15:
  17. # - WU stops supplying 5-day within the 5day page. go looking;
  18. #   find a suitable 7day at wbz.cbslocal. This time I flense off
  19. #   all the html, then rebuild from hashstructed strings.
  20. #
  21. #
  22. #
  23. #
  24. use strict;
  25.  
  26. my $uagent="Mozilla/5.0 (compatible; GEM; U; CP/M 2.2; en-US; rv:1.0.0; not a spoon)";
  27. my $wget="/usr/bin/wget -U \"$uagent\" -O - ";
  28.  
  29. my $odir="/home/httpd/html/wx/";
  30. #my $odir="/home/httpd/html/wx2/wxg";    # or /var/www/html, or...
  31. my $ofile="wxhr.html";             # "R R WX HR TSUNAMI"
  32. my $baks=16;                       # how many rolled-aside backups to keep
  33.  
  34. # 10-day in minimal mobile form
  35. my $u_mobile10day=
  36.  "http://m.wund.com/cgi-bin/findweather/getForecast?brand=mobile&query=01730";
  37. # lite site, 5-day
  38. my $u_lite5day=
  39. # "http://www.wund.com/cgi-bin/findweather/getForecast?query=01730";
  40.  "http://weather.boston.cbslocal.com/cgi-bin/findweather/getForecast?brand=wbz4V3&query=01730";
  41.  
  42. my $d5file="wxhr.raw5.html";    # will be used for debugging slice 'n' dice
  43. my $dXfile="wxhr.rawX.html";    #  onsite for review
  44.  
  45. my $rightnow=`date`;
  46. chomp $rightnow;
  47.  
  48. my $minsize=1024;
  49. my $localpixdir="/wx";
  50. my $origpixdir="http://icons-[a-z]+.wxug.com/graphics/[a-z]+";
  51. my $origpixdir2="http://icons-[a-z]+.wxug.com(\/[a-z0-9](?=\/))+";
  52.  
  53. my $use_alarm=10;       # wget-fetch wait in minutes. 0 = don't use.
  54.                         # if Net connection can go down (dialup),
  55.                         #  don't hang around waiting for wget.
  56. my $hrage=1.99;         # hours to expire
  57.  
  58. my $refresh=int(($hrage*(60*60)+60)/2);
  59.  
  60. my($chatty,$force,$local_debug,$save_dfile)=(0,0,0,0,0);
  61. my($key,$arg);
  62. while(defined($ARGV[0]) and index($ARGV[0],'-')==0){
  63.   $arg=shift(@ARGV);                    # get any the switches
  64.   $key=substr($arg,1,1);                # get no-arg switches first
  65.   substr($arg,0,2)="";
  66.   if($key eq "v"){                      # verbose?
  67.     $chatty ^= 1;
  68.     next;
  69.   }elsif($key eq "f"){                  # olde enuf or not
  70.     $force^=1;
  71.     next;
  72.   }elsif($key eq "D"){                  # debug mode
  73.     $local_debug^=1;
  74.     next;
  75.   }elsif($key eq "S"){                  # save debug-input file
  76.     $save_dfile^=1;
  77.     next;
  78.   }
  79.   $arg =~ s/^\=//;                      # handles switch=arg
  80.   $arg=shift(@ARGV) if($arg eq "" and ($ARGV[0] !~ /^\-\w/) );
  81. # if $arg eq "";      # handles space-separated switch/arg
  82. #  if($key eq "w"){                      # waits base
  83. #    $waitbase=$arg;
  84. #  }elsif($key eq "l"){                  # number of line to start with
  85. #    $ofsline=0+$arg;
  86. #  }elsif($key eq 'm'){                  # match of line to start with
  87. #    $smatch=$arg;
  88. #  }else{
  89.     warn "$0: unrecognized option -$key $arg\n";
  90. #  }
  91. }
  92.  
  93. unless($chatty){
  94.   $wget .= '-q ';
  95. }
  96.  
  97. #my $pdiv;
  98. $ofile = "debug.$ofile" if $local_debug;
  99. my $opage="$odir/$ofile";
  100. #
  101. # file old enough?
  102. #
  103. my $itsage= -M "$opage";
  104. my $aval=$hrage/24;
  105.  
  106. my($lite5day,$mobile10day);
  107. unless($local_debug){
  108.   if(!$force and ($itsage <= $aval)){
  109.     print "file not old enough yet.\n" if $chatty;
  110.     exit(0);
  111.   }
  112. #
  113. # net up?
  114. #
  115.   unless($force){
  116.     my $netstate=`$wget http://192.168.1.1/netstate.txt`;
  117.     if(index($netstate,'DOWN')>-1){
  118.       print "net not up.\n" if $chatty;
  119.       exit(0);
  120.     }
  121.   }
  122.   $SIG{ALRM}=\&sigalarm_die;    # set ALRM handling
  123. #
  124. # fetch. did it work?
  125. #
  126.   alarm($use_alarm*60) if($use_alarm);
  127.  
  128.   $mobile10day = `$wget \"$u_mobile10day\"`;
  129.   $lite5day = `$wget \"$u_lite5day\"`;
  130.  
  131.   alarm(0) if($use_alarm);
  132.   my $retv=$?>>8;
  133.   my $bad=0;
  134.   if($retv){
  135.     warn "retv = $retv.\n" if $chatty; $bad=1;
  136.   }
  137.   if(length($mobile10day) < $minsize){
  138.     warn "mobile10day too small.\n" if $chatty; $bad=1;
  139.   }
  140.   if(length($lite5day) < $minsize){
  141.     warn "lite5day too small.\n" if $chatty; $bad=1;
  142.   }
  143.   exit(1) if $bad;
  144.  
  145.   if($save_dfile){
  146.     if(open(D,">$odir/$d5file")){
  147.       print D $lite5day;
  148.       close(D);
  149.     }else{
  150.       $bad += 5;
  151.     }
  152.     if(open(D,">$odir/$dXfile")){
  153.       print D $mobile10day;
  154.       close(D);
  155.     }else{
  156.       $bad += 10;
  157.     }
  158.     if($bad){
  159.       warn "couldn't write debugging file $odir/$d5file or $odir/$dXfile\n";
  160.     }
  161.   }
  162. }else{                  # debug run using locally-saved input file
  163.   $lite5day=`cat ./$d5file`;
  164.   $mobile10day=`cat ./$dXfile`;
  165.  
  166.   die "no got!\n" unless(length($lite5day) and length($mobile10day));
  167. }
  168.  
  169. if(0){  #$chatty){
  170.   print "lite5day: "; pr_length($lite5day);
  171.   print "mobile10day: "; pr_length($mobile10day);
  172. }
  173.  
  174. #-----------
  175.  
  176.  
  177.  
  178.  
  179. #
  180. # whack down 5-day to just the data table. we still need to extract
  181. # details from one setting to another, but the garbage is gone.
  182. #
  183. my($pta);
  184. my $bad=0;
  185. #my $s_lite='<h2>Forecast for Bedford (01730)</h2>';
  186. #my $s_lite='<h2>Forecast for Central Middlesex County (01730)</h2>';
  187. my $s_lite='<div id="sevenday">';
  188. my $e_lite='<!-- Google - pmims';
  189. #my $len=length($lite5day);
  190. if( ($pta=index($lite5day,$s_lite)) >-1){
  191.   substr($lite5day,0,$pta)="";
  192.   if( ($pta=index($lite5day,$e_lite)) >-1){
  193.     $pta += length($e_lite);
  194.     substr($lite5day,$pta)="";
  195.   }else{
  196.     $bad=2;
  197.   }
  198. }else{
  199.   $bad=1;
  200. }
  201. die "can't make sense out of the lite5day page (error: $bad).\n" if $bad;
  202.  
  203. my $pc;
  204. if( ($pc=index($lite5day,$e_lite)) >-1){
  205.   while(substr($lite5day,$pc,1) ne "\n" and $pc>0){
  206.     $pc--;
  207.   }
  208.   if($pc>0){
  209.     substr($lite5day,$pc)="";
  210.   }
  211. }
  212. #
  213. # --crb3 20Aug15:
  214. # it says 5day on the tin but we're now flensing a 7day source,
  215. # then throwing away the spare two (because I want 5day dammit).
  216. # thus, $hcnt is 0..6; twice, because of how the source is divved
  217. # (none dare say 'tabled')
  218. #
  219. my $l5day;      # href because the syntax is more consistent
  220. my $hcnt=0;     # hash-count
  221. my $hcmax=6;    # max valid count
  222. my $hst=0;      # hash-building state
  223. foreach my $ln (split(/\r?\n/,$lite5day)){
  224.   if($hst==0){
  225.     if(index($ln,'<div class="desc">')>-1){
  226.       $hst=1;
  227.       next;
  228.     }elsif(index($ln,'<div class="desc_lo">')>-1){
  229.       $hst=6;   # yes there's a gap, it's cuz i'm paranoid
  230.       next;     #  and we're all explicit here anyway
  231.     }
  232.  
  233.   }elsif($hst==1){      # grab next line with dayname in it
  234.     $hst=2;
  235.     $ln =~ s/^\s+//;
  236.     $l5day->{$hcnt}->{n}=$ln;
  237.     next;
  238.   }elsif($hst==2){      # grab next line with wx-icon IMG name in it
  239.     $ln =~ s/^\s+\<img\s.*src\=\"//;
  240.     $ln =~ s/\"\s+\/\>//;       # now is bare graphic url
  241.     $ln =~ s/^http\:.*\///;     # now it's just a gifname
  242.     $l5day->{$hcnt}->{i}=$ln;
  243.     $hst=3;
  244.     next;
  245.   }elsif($hst==3){      # grab next line with short description string in it
  246.     $ln =~ s/\s+\<div class\=\"cond\"\>//;
  247.     $ln =~ s/\<\/div\>.*$//;    # addendum just in case eol rubbish
  248.     $l5day->{$hcnt}->{d}=$ln;
  249.     $hcnt++;
  250.     $hcnt=0 if $hcnt>$hcmax;
  251.     $hst=0;             # done with this day-chain half
  252.     next;
  253.  
  254.   }elsif($hst==6){      # grabbing temp strings
  255.     $ln =~ s/\s+\<div\sclass\=\"day\"\>//;
  256.     $ln =~ s/\<\/div\>.*$//;
  257.     $l5day->{$hcnt}->{hilo}=$ln;
  258.     $hst=7;
  259.     next;
  260.   }elsif($hst==7){
  261.     $ln =~ s/\s+\<div\sclass\=\"cond\"\>//;
  262.     $ln =~ s/\<\/div\>.*$//;
  263.     $l5day->{$hcnt}->{t}=$ln;
  264.     $hst=0;
  265.     $hcnt++;
  266.     $hcnt=0 if $hcnt>$hcmax;
  267.     next;
  268.   }
  269. }
  270. #
  271. # now to build a display from a hashstruct.
  272. #
  273. #
  274. #
  275. $lite5day=<<EOT;
  276.    <h2>5-day Forecast for Bedford</h2>
  277.    <table align="center" width="100%">
  278.     <tr>
  279. EOT
  280.  
  281. foreach $hcnt (0..4){   # only 5day, remember
  282.  
  283.   $l5day->{$hcnt}->{d} =~ s/ /\&nbsp\;/g;
  284.  
  285.   $l5day->{$hcnt}->{i}=
  286.       '<img src="'
  287.       . '/wx/'
  288.       . $l5day->{$hcnt}->{i}
  289.       . '.gif'
  290.       . '" />';
  291.  
  292.   my($h,$l)=split(/\&nbsp\;\/\&nbsp\;/,$l5day->{$hcnt}->{t});
  293.   $l5day->{$hcnt}->{t}=
  294.     '<div><span class="hi">H <span>'
  295.     . $h
  296.     . '</span>&deg;</span> / <span class="lo">L <span>'
  297.     . $l
  298.     . '</span>&deg;</span></div>';
  299.  
  300.   $lite5day .= <<EOT;
  301.   <td valign="top" width="20%" align="center">
  302.    <span><b>$l5day->{$hcnt}->{n}</b></span>
  303.    <div>$l5day->{$hcnt}->{i}</div>
  304.    <div>$l5day->{$hcnt}->{d}</div>
  305.    $l5day->{$hcnt}->{t}
  306.   </td>
  307. EOT
  308.  
  309. }
  310. #   $l5day->{$hcnt}->{hilo}<br />
  311.  
  312. #</tr>
  313. #<tr><td colspan="7"><h2>&nbsp;</h2></td></tr>
  314. $lite5day .= <<EOT;
  315. </table>
  316. EOT
  317.  
  318. my $add = '<h2>&nbsp;</h2>';
  319. #my $add = '<tr><td colspan="2"><h2>&nbsp;</h2></td></tr>';
  320.  
  321. my $fetch=$lite5day.$add."<br />"; #<br />";
  322. my $ptb;
  323. #
  324. # Now for the mobile 10-day.
  325. #
  326. #
  327. my $m_Xday='Forecast as of <b>';        # landmark on this
  328. my $s_Xday='<center>';                  # backstep to this...
  329. my $e_Xday="</td></tr></table>\n";      # search forward to this...
  330. # ...and lose everything outside those two points.
  331.  
  332. if( ($pta=index($mobile10day,$m_Xday)) >-1){
  333.   $ptb=$pta;
  334.   while(substr($mobile10day,$pta,length($s_Xday)) ne $s_Xday and $pta>0){
  335.     $pta--;
  336.   }
  337.   if($pta>0){
  338.     if( ($ptb=index($mobile10day,$e_Xday,$ptb)) >-1){
  339.       $ptb += length($e_Xday);
  340.       substr($mobile10day,$ptb)="";     # lose the tail cruft
  341.       substr($mobile10day,0,$pta)="";   # lose the head cruft
  342.     }else{
  343.       warn "Can't shave mobile10day\n";
  344.     }
  345.   }else{
  346.     warn "Can't parse mobile10day\n";
  347.   }
  348. }else{
  349.   warn "mobile10day doesn't look right at all\n";
  350. }
  351.  
  352. #
  353. # get rid of crud, swapping in tabletopping. draw a fresh bead
  354. # on the top mark first because we shaved things. well, actually
  355. # it's right at the start.
  356. #
  357. #$e_Xday="</center>\n</td>\n</tr>";
  358. $e_Xday="</tr><tr>";
  359. my $r_Xday="\n   <table>\n   <tr><td></td><td></td></tr>\n<tr>";
  360.  
  361. if( ($pta=index($mobile10day,$s_Xday)) ==0){    #>-1){
  362.   if( ($ptb=index($mobile10day,$e_Xday,$pta)) >-1){
  363.     $ptb += length($e_Xday);
  364.     substr($mobile10day,$pta,$ptb-$pta)="";     #$r_Xday;
  365.   }else{
  366.     warn "10day crud end not found\n";
  367.   }
  368. }else{
  369.   warn "10day crud start not found\n";
  370. }
  371.  
  372. #
  373. # get rid of tail-end stuff too
  374. #
  375. $m_Xday="Marine Information";
  376. $s_Xday="<div align";
  377. $e_Xday="</div>";
  378.  
  379. blk_flense(\$mobile10day,$m_Xday,$s_Xday,$e_Xday);
  380.  
  381. $m_Xday="Scientific forecaster";
  382.  
  383. blk_flense(\$mobile10day,$m_Xday,$s_Xday,$e_Xday);
  384.  
  385. $m_Xday="National Weather Service:";
  386. $s_Xday="<br />\n";
  387. #$s_Xday='\t<table border="0" cellspacing="0" cellpadding="0">';
  388. $e_Xday='</table><br />';
  389.  
  390. blk_flense(\$mobile10day,$m_Xday,$s_Xday,$e_Xday);
  391. while($mobile10day =~ /^\r?\n/){
  392.   $mobile10day =~ s/^\r?\n//;
  393. }
  394. $mobile10day =~ s/^\<td align\=\"left\"\>\r?\n?//;
  395.  
  396. #
  397. # Impose our framing to get a more dense display
  398. # -- paste in abs MIL dates while we're at it
  399. # ...maybe even styling.
  400. #
  401.  
  402. my $framing;
  403.  
  404. $framing = $r_Xday;
  405. #$mobile10day =~ s/substr($r_Xday,1)//;
  406.  
  407. $mobile10day =~ s/\r?\n?\<tr\>\r?\n\<td align\=\"left\"\>//;
  408.  
  409. #  $mobile10day =~ s/\<br \/\>\r?\n?$/\r\n/g;
  410.  
  411. while($mobile10day =~ /\r?\n$/){
  412.   $mobile10day =~ s/\r?\n$//;
  413. }
  414.  
  415. if( ($pta=rindex($mobile10day,"</td></tr></table>")) >-1){
  416.   substr($mobile10day,$pta)="";
  417. }
  418.  
  419. if(1){  #$save_dfile){
  420.   my $debugf="/home/httpd/html/wx2/dump10day.html";
  421.   if(open(DUMPF,">$debugf")){
  422.     print DUMPF $mobile10day;
  423.     close(DUMPF);
  424.   }
  425. }
  426.  
  427. my(@lines,$ln,$pic,$dayn,$txt);
  428. my $ct=0;
  429. @lines=split(/\r?\n/,$mobile10day);
  430. while(@lines and !defined($lines[0])){
  431.   shift(@lines);
  432. }       # flush out any leading empties
  433.  
  434. my($dt,%dset,$k,$v);
  435.  
  436. my $fmt="+%A:%a %d%b%y";      # longday:shortday DDmonYY
  437. my $tcnt=0;
  438. my $dofs="";
  439.  
  440. #=" -d \"next $tcnt day\"";
  441.  
  442. $dt=`date $dofs \"$fmt\"`;          # Wednesday:Wed 05Feb14
  443.  
  444.  
  445.  
  446. chomp $dt;
  447. ($k,$v)=split(/\:/,$dt,2);    # split off longday from 'Dow 00Mon00' string
  448. $dset{$k}=$v;           # set up normal, then handle day-labels
  449. $k="Today";
  450. my($dow,$dat) = split(' ',$v,2);
  451. $v = "$k $dat";
  452. $dset{$k}=$v;           # so, no change on dow field
  453. $k="This Afternoon";
  454. $v = "$k $dat";
  455. $dset{$k}=$v;
  456. $k="Tonight";
  457. $v = "$k $dat";
  458. $dset{$k}=$v;
  459.  
  460.  
  461. my $toggle=1;           # set hi for haste in doing the next entry.
  462. while($ct < @lines){
  463.   $dayn=$lines[$ct];
  464.   $pic=$lines[$ct+1];
  465.   $txt=$lines[$ct+2];
  466.   $ct += 3;
  467. #
  468. # we've left a coupla empty lines and i'm tired of this, so...
  469. # rather than try to flense them, trigger a 'next' on them.
  470. # --crb3 09May15: and then special stuff gets tacked on, and
  471. # that's totally variable. So... Shave it at the point where it
  472. # doesn't look pretty. The only brittleness I can see is if WU
  473. # converts to PNGs, and that will take some attention anyway.
  474. #
  475.   unless(defined($pic) and $pic =~ /\.gif\"/){
  476.     $ct -= 3;
  477.     splice(@lines,$ct);
  478.     next;       # or 'last', but it feels better to have the loop end.
  479.   }
  480. #  next unless(defined($pic) and defined($txt));
  481.   $pic =~ s/\<br \/\>$//; # if defined $pic;
  482.   $txt =~ s/\<br \/\>$//; # if defined $txt;
  483.   foreach my $ky (keys %dset){
  484.     $dayn =~ s/$ky/$dset{$ky}/;
  485.   }
  486. #
  487. # do date-convert on $dayn. The clockwork setup here rolls the
  488. # hash, which only ever holds seven days, to stay even with the
  489. # two-per-day entries, plus the uncertainty over whether the
  490. # first day has two entries (for day and night) or one (for
  491. # night). right now, the scraped source has two, but
  492. # historically that's been variable... and I *really* don't want
  493. # to have to keep revisiting this code for minor tweaks. this
  494. # program gets cron-invoked every 2 hrs, and browser refresh is
  495. # tied to that, so effectively this covers all (2)hours of the
  496. # day.
  497. #
  498.   $toggle ^= 1;         # one-bit state-counter
  499.   if(!$toggle){
  500.     $tcnt++;
  501.     $dofs = " -d \"next $tcnt day\"";
  502.     $dt=`date $dofs \"$fmt\"`;          # Wednesday:Wed 05Feb14
  503.     chomp $dt;
  504.     ($k,$v)=split(/\:/,$dt,2);    # split off longday from 'Dow 00Mon00' string
  505.     $dset{$k}=$v;
  506. #
  507. # Paste abs MIL dates into the top5 display too, along with any
  508. # style enforcement...
  509. #
  510. # do the 5-day dating en-passant, just the once when the hash
  511. # first fills up. shortly after this, the hash starts getting
  512. # overwritten by later dates, so this is exactly the right time.
  513. #
  514.     if($tcnt==6){
  515.       foreach my $ky (keys %dset){
  516.         $fetch =~ s/$ky/\<b\>$dset{$ky}\<\/b\>/;
  517.       }
  518.     }
  519.   }
  520.  
  521. #
  522. # shove that completed entry into the buffer and get to work on
  523. # the next one.
  524. #
  525. # swapping back and forth between two buffers, mobile10day and
  526. # framing, is an artifact of debugging which I'm in no hurry to
  527. # eradicate. it's under 100k of text, right? it's not tubby.
  528. #
  529. # <br />
  530. #
  531.   $framing .= <<EOT;
  532.  
  533.     <tr>
  534.      <td align="right" width="10%">
  535.       $pic
  536.      </td>
  537.      <td align="left">
  538.       $dayn
  539.       $txt
  540.      </td>
  541.     </tr>
  542. EOT
  543.   }
  544.  
  545. $framing .= "</td></tr></table>";
  546.  
  547. $mobile10day=$framing;
  548.  
  549. #
  550. # Done with the Xday? Paste that in too.
  551. #
  552. $fetch .= $mobile10day;
  553.  
  554.  
  555. #
  556. # swap in local icons all at once
  557. #
  558.  
  559. my $fic_url="http://icons.wunderground.com/graphics/conds/2005/";
  560. my $lic_url="/wx/";
  561.  
  562. $fetch =~ s/$fic_url/$lic_url/g;
  563.  
  564. $fic_url="http://icons.wunderground.com/graphics/fun_map/";
  565.  
  566. $fetch =~ s/$fic_url/$lic_url/g;
  567.  
  568.  
  569. #
  570. # last thing before emission: rollover earlier fetches.
  571. # turns out they're useful for figuring out what's outside.
  572. # is the retarded pun in the renaming obvious enough?
  573. #
  574. if($baks){
  575.   do_baks($opage,$baks);
  576. }
  577.  
  578. #
  579. # now dump the result.
  580. #
  581. open(H,">$opage") or die "can't open outfile $opage\n";
  582. #my $ln;
  583. while(defined($ln=<DATA>) and index($ln,'__END__')<0){
  584.   if(index($ln,'#PAYLOAD#')>=0){
  585.     print H $fetch;
  586.   }else{
  587.     $ln =~ s/\#UPDATE\#/$rightnow/ if index($ln,'#UPDATE#')>-1;
  588.     $ln =~ s/\#REFRESH\#/$refresh/ if index($ln,'#REFRESH#')>-1;
  589.     print H $ln;
  590.   }
  591. }
  592.  
  593. close(H);
  594.  
  595. #######################################
  596.  
  597.  
  598. # do_baks.
  599. #
  600. # last thing before emission: rollover earlier fetches.
  601. # turns out they're useful for figuring out what's outside.
  602. # is the retarded pun in the renaming obvious enough?
  603. #
  604. # blind-rename: we don't care if there's actually something
  605. # there to rename, just so that anything that is there is
  606. # rolled out of the way of the incoming fresh take.
  607. #
  608. sub do_baks {
  609.   my($opage,$baks)=(@_);
  610.  
  611.   my($bakct,$obak,$inst,$onst,$plume);
  612.  
  613.   ($plume=$opage) =~ s/\.html$//;
  614.   for($bakct = 0+$baks;$bakct>0;$bakct -= 1){
  615.     $obak=($bakct-1);
  616.     $inst=sprintf(".b%d",$bakct);
  617.     $onst=($obak ? sprintf(".b%d",$obak) : "");
  618.     rename("$plume$onst.html","$plume$inst.html");
  619.   }
  620. }
  621.  
  622. #
  623. # sigalarm_die.
  624. #
  625. #
  626. #
  627. sub sigalarm_die {
  628.   my($sig)=shift(@_);
  629.  
  630.   warn "Somebody set up us the SIG$sig bomb.\n" if $chatty;
  631.   die;
  632. }
  633.  
  634. #
  635. # get_daylist.
  636. #
  637. # return a shortform list of the current and upcoming days
  638. # as a hashref. depends on the GNU version of 'date'.
  639. #
  640. sub get_daylist {
  641.  
  642.   my($dt,%dset,$k,$v);
  643.   my $fmt="+%A:%a %d%b%y";      # longday:shortday DDmonYY
  644.   $dt=`date \"$fmt\"`;          # Wednesday:Wed 05Feb14
  645.   chomp $dt;
  646.   ($k,$v)=split(/\:/,$dt,2);    # split off longday from 'Dow 00Mon00' string
  647.   $dset{$k}=$v;
  648.   $dset{'_todayname'}=$k;                       # grab longname
  649.   $dset{'Today'}=$v;
  650.   $dset{'This Afternoon'}=$v;
  651.   $dset{'Tonight'}=$v;
  652.   $dset{'Rest of Tonight'}=$v;  # ...should be nextday?
  653.  
  654.  
  655.   my $tcnt=1;                   # skip today-count
  656.   while($tcnt<7){               # same process for incremental days
  657.     $dt=`date -d \"next $tcnt day\" \"$fmt\"`;
  658.     chomp $dt;
  659.     ($k,$v)=split(/\:/,$dt,2);
  660.     $dset{$k}=$v;
  661.     $tcnt++;
  662.   }
  663.   while($tcnt<14){              # same process for incremental days
  664.     $dt=`date -d \"next $tcnt day\" \"$fmt\"`;
  665.     chomp $dt;
  666.     ($k,$v)=split(/\:/,$dt,2);
  667.     $dset{$k.'2'}=$v;
  668.     $tcnt++;
  669.   }
  670.  
  671.   return(\%dset);
  672. }
  673.  
  674. #
  675. # pr_length.
  676. #
  677. # print length of ref'd buffer.
  678. #
  679. sub pr_length {
  680.   my($ref)=shift;
  681.  
  682.   return unless $chatty;
  683.   my $len=length($$ref);
  684.  
  685.   print "length = $len.\n";
  686. }
  687.  
  688. #
  689. # blk_flense.
  690. #
  691. # factored out: take a landmark, a beginning border, an ending
  692. # border, and the ref'd text-buffer to flense it from. works
  693. # directly on the ref'd buffer; reports 1/0.
  694. #
  695. sub blk_flense {
  696.   my($tref,$landmark,$fedge,$ledge)=(@_);
  697.  
  698.   my($pa,$pb);
  699.   unless( ($pa=index($$tref,$landmark)) >-1){
  700.     return(0);
  701.   }
  702.   $pb=$pa;
  703.   $pa-- while substr($$tref,$pa,length($fedge)) ne $fedge and $pa>=0;
  704.   $pb = index($$tref,$ledge,$pb);
  705. #  $pb++ while substr($$tref,$pb,length($ledge)) ne $ledge and $pb <= length($$tref);
  706.   return(0) if ($pa<0 or $pb<0);        # > length($$tref);
  707.  
  708.   $pb += length($ledge);
  709.   substr($$tref,$pa,$pb-$pa)="";
  710.  
  711.   return(1);
  712. }
  713.  
  714. __DATA__
  715. <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org
  716. <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
  717. <head>
  718.  <meta http-equiv="Content-Type" content="text/html;charset=utf-8" />
  719.  <meta name="generator" content="wxget, chopped down from weatherunderground pages" />
  720.  <meta http-equiv="pragma" content="no-cache">
  721.  <meta http-equiv="refresh" content="#REFRESH#">
  722.   <link rel="stylesheet" type="text/css" href="/wx/Style_v1_2.css" />
  723.   <link rel="stylesheet" type="text/css" href="/wx/wund_base.css" />
  724.   <title>
  725.    5-day forecast for 01730 from WeatherUnderground
  726.   </title>
  727.  </head>
  728.  <body>
  729.   <center>
  730.    <h2>
  731.     5-day forecast for 01730 from WeatherUnderground - Fetched #UPDATE#<br />
  732.    </h2>
  733.    <h4>
  734.    from
  735.     <a href="http://www.wund.com/cgi-bin/findweather/getForecast?query=01730">
  736.    WeatherUnderground (http://www.wund.com)
  737.    </a>&nbsp;-&nbsp;
  738.    <a href="wxhr.b1.html">.</a>&nbsp;
  739.    <a href="wxhr.b2.html">.</a>&nbsp;
  740.    <a href="wxhr.b3.html">.</a>&nbsp;
  741.    <a href="wxhr.b4.html">b4</a>&nbsp;&nbsp;
  742.    <a href="wxhr.b5.html">.</a>&nbsp;
  743.    <a href="wxhr.b6.html">.</a>&nbsp;
  744.    <a href="wxhr.b7.html">.</a>&nbsp;
  745.    <a href="wxhr.b8.html">b8</a>&nbsp;&nbsp;
  746.    <a href="wxhr.b9.html">.</a>&nbsp;
  747.    <a href="wxhr.b10.html">.</a>&nbsp;
  748.    <a href="wxhr.b11.html">.</a>&nbsp;
  749.    <a href="wxhr.b12.html">b12</a>&nbsp;&nbsp;
  750.    <a href="wxhr.b13.html">.</a>&nbsp;
  751.    <a href="wxhr.b14.html">.</a>&nbsp;
  752.    <a href="wxhr.b15.html">.</a>&nbsp;
  753.    <a href="wxhr.b16.html">b16</a>&nbsp;&nbsp;
  754.    <a href="radar.html">radar</a>
  755.    </h4>
  756.    <table align="center" width="60%">
  757.    <tr><td colspan="2">
  758. #PAYLOAD#
  759.    </td></tr>
  760.    </table>
  761.   </center>
  762.  </body>
  763. </html>
  764.  
  765. __END__
Advertisement
Add Comment
Please, Sign In to add comment
Public Pastes
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!