PageRenderTime 57ms CodeModel.GetById 23ms RepoModel.GetById 1ms app.codeStats 0ms

/tags/v2-98/mh/bin/dailystrips

#
Perl | 1390 lines | 1082 code | 217 blank | 91 comment | 205 complexity | 2a05508a6fcb44e1cd7dc090cb55932f MD5 | raw file
Possible License(s): GPL-2.0, LGPL-2.0, GPL-3.0
  1. #!/usr/bin/perl
  2. #
  3. # Program Summary:
  4. #
  5. # Name: dailystrips
  6. # Description: creates an HTML page containing a number of online comics, with an easily exensible framework
  7. # Author: Andrew Medico <amedico@amedico.dhs.org>
  8. # Created: 23 Nov 2000, 23:33 EST
  9. # Last Modified: 24 Aug 2003, 16:55
  10. # Current Revision: 1.0.28
  11. #
  12. # Set up
  13. use strict;
  14. no strict qw(refs);
  15. use LWP::UserAgent;
  16. use HTTP::Request;
  17. use POSIX qw(strftime);
  18. use Getopt::Long;
  19. use File::Copy;
  20. # Variables
  21. my (%options, $version, $time_today, @localtime_today, @localtime_yesterday, @localtime_tomorrow, $long_date, $short_date,
  22. $short_date_yesterday, $short_date_tomorrow, @get, @strips, %defs, $known_strips, %groups, $known_groups, %classes, $val,
  23. $link_tomorrow, $no_dateparse, @base_dirparts);
  24. $version = "1.0.28";
  25. $time_today = time;
  26. # Get options
  27. GetOptions(\%options, 'quiet|q','verbose','output=s','lite','local|l','noindex',
  28. 'archive|a','dailydir|d','stripdir','save|s','nostale','date=s',
  29. 'new|n','defs=s','nopersonal','basedir=s','list','proxy=s',
  30. 'proxyauth=s','noenvproxy','nospaces','useragent=s','version|v','help|h',
  31. 'avantgo', 'random','nosystem','stripnav','nosymlinks','titles=s',
  32. 'retries=s','clean=s','updates=s','noupdates') or exit 1;
  33. # Process options:
  34. # Note: Blocks have been ordered so that we only do as much as absolutely
  35. # necessary if an error is encountered (i.e. do not load defs if --version
  36. # specified)
  37. # Help and version override anything else
  38. if ($options{'help'}) {
  39. print
  40. "Usage: $0 [OPTION] STRIPS
  41. STRIPS can be a mix of strip names and group names
  42. (group names must be preceeded by an '\@' symbol)
  43. 'all' may be used to retrieve all known strips,
  44. or use option --list to list available strips and groups
  45. Options:
  46. -q --quiet Turn off progress messages
  47. --verbose Turn on extra progress information, overrides -q
  48. --list List available strips
  49. --random Download a random strip
  50. --defs FILE Use alternate strips definition file
  51. --nopersonal Ignore ~/.dailystrips.defs
  52. --nosystem Ignore system-wide definitions
  53. --updates Read updated defs from FILE instead of
  54. ~/.dailystrips-updates.def
  55. --noupdates Ignore updated defs file
  56. --output FILE Output HTML to FILE instead of STDOUT
  57. (does not apply to local mode)
  58. --lite Output a reduced HTML page
  59. --stripnav Add links for navigation within the page
  60. --titles STRING Customize HTML output
  61. -l --local Output HTML to file and save strips locally
  62. --noindex Disable symlinking current page to index.html
  63. (local mode only)
  64. -a --archive Generate archive.html as a list of all days,
  65. (local mode only)
  66. -d --dailydir Create a separate directory for each day's images
  67. (local mode only)
  68. --stripdir Create a separate directory for each strip's
  69. images (local mode only)
  70. -s --save If it appears that a particular strip has been
  71. downloaded, does not attempt to re-download it
  72. (local mode only)
  73. --nostale If a new strip is not available, displays an error
  74. in the HTML output instead of showing the old image
  75. --nosymlinks Do not use symlinks for day-to-day duplicates
  76. --date DATE Use value DATE instead of local time
  77. (DATE is parsed by Date::Parse function)
  78. --avantgo Format images for viewing with Avantgo on PDAs
  79. (local mode only)
  80. --basedir DIR Work in specified directory instead of current
  81. directory (program will look here for previous HTML
  82. file and save new files here, etc.)
  83. --proxy host:port Use specified HTTP proxy server (overrides
  84. environment proxy, if set)
  85. --proxyauth user:pass Set username and password for proxy server
  86. --noenvproxy Ignore the http_proxy environment variable, if set
  87. --nospaces Remove spaces from image filenames (local mode
  88. only)
  89. --useragent STRING Set User-Agent: header to STRING (default is none)
  90. --retries NUM When downloading items, retry NUM times instead of
  91. default 3 times
  92. --clean NUM Keep only the latest NUM days of files; remove all
  93. older files
  94. -v --version Print version number
  95. ";
  96. if ($^O =~ /Win32/ ) {
  97. print
  98. "Additional Win32 Notes:
  99. Windows lacks a number of features and programs found on *NIX, so a number of
  100. changes must be made to the program's operation:
  101. 1. --date and --avantgo are not available
  102. 2. Personal and update definition files may or may not work
  103. 3. System-wide definition files are not supported
  104. ";
  105. } # ' please emacs perlmode
  106. print "\nBugs and comments to dailystrips\@amedico.dhs.org\n";
  107. exit;
  108. }
  109. if ($options{'version'}) {
  110. print "dailystrips version $version\n";
  111. exit;
  112. }
  113. if ($options{'date'}) {
  114. eval "require Date::Parse";
  115. if ($@ ne "") {
  116. die "Error: cannot use --date - Date::Parse not installed\n";
  117. } else {
  118. import Date::Parse;
  119. }
  120. unless ($time_today = str2time($options{'date'})) {
  121. die "Error: invalid date specified\n";
  122. }
  123. }
  124. # setup time variables (needed during defs parsing)
  125. @localtime_today = localtime $time_today;
  126. #long_date = strftime("\%A, \%B \%e, \%Y", @localtime_today);
  127. $long_date = strftime("\%A, \%B \%d, \%Y", @localtime_today);
  128. $short_date = strftime("\%Y.\%m.\%d", @localtime_today);
  129. @localtime_yesterday = localtime($time_today - ( 24 * 60 * 60 ));
  130. $short_date_yesterday = strftime("\%Y.\%m.\%d", @localtime_yesterday);
  131. @localtime_tomorrow = localtime ($time_today + 24 * 60 * 60);
  132. $short_date_tomorrow = strftime("\%Y.\%m.\%d", @localtime_tomorrow);
  133. # Get strip definitions now - info used below
  134. unless ($options{'defs'}) {
  135. if ($^O =~ /Win32/ ) {
  136. $options{'defs'} = 'strips.def';
  137. } else {
  138. $options{'defs'} = '/usr/share/dailystrips/strips.def';
  139. }
  140. }
  141. &get_defs($options{'defs'});
  142. # Load updated defs file
  143. unless (defined $options{'updates'})
  144. {
  145. $options{'updates'} = &get_homedir() . "/.dailystrips-updates.def";
  146. }
  147. unless($options{'noupdates'})
  148. {
  149. if (-r $options{'updates'}) {
  150. &get_defs($options{'updates'});
  151. }
  152. }
  153. # Get system configurable strip definitions now
  154. unless ($options{'nosystem'}) {
  155. unless (($^O =~ /Win32/) or (! -r '/etc/dailystrips.defs')) {
  156. &get_defs('/etc/dailystrips.defs');
  157. }
  158. }
  159. unless ($options{'nopersonal'}){
  160. my $personal_defs = &get_homedir() . "/.dailystrips.defs";
  161. if (-r $personal_defs) {
  162. &get_defs($personal_defs);
  163. }
  164. }
  165. $known_strips = join('|', sort keys %defs);
  166. $known_groups = join('|', sort keys %groups);
  167. if ($options{'random'}) {
  168. my @known_strips_array = keys %defs;
  169. push(@get, $known_strips_array[(rand $#known_strips_array)]);
  170. undef @known_strips_array;
  171. } else {
  172. # Only strips/groups to download remain in @ARGV
  173. # Unconfigured options were already trapped by Getopts with an 'unknown option'
  174. # error
  175. for (@ARGV) {
  176. if (/^($known_strips|all)$/io) {
  177. if ($_ eq "all") {
  178. push (@get, split(/\|/, $known_strips));
  179. } else {
  180. push(@get, $_);
  181. }
  182. } elsif (/^@/) {
  183. if (/^@($known_groups)$/io) {
  184. push(@get, split(/;/, $groups{$1}{'strips'}));
  185. } else {
  186. die "Error: unknown group: $_\n";
  187. }
  188. } else {
  189. die "Error: unknown strip: $_\n";
  190. }
  191. }
  192. }
  193. if ($options{'list'}) {
  194. format =
  195. @<<<<<<<<<<<<<<<<<<<<<<<< @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  196. $_, $val
  197. .
  198. print "Available strips:\n";
  199. for (split(/\|/, $known_strips)) {
  200. $val = $defs{$_}{'name'};
  201. write;
  202. }
  203. print "\nAvailable groups:\n";
  204. for (split(/\|/, $known_groups)) {
  205. $val = $groups{$_}{'desc'};
  206. write;
  207. }
  208. exit;
  209. }
  210. if ($options{'dailydir'} and $options{'stripdir'}) {
  211. die "Error: --dailydir and --stripdir cannot be used together\n";
  212. }
  213. #Set proxy
  214. if ($options{'proxy'}) {
  215. $options{'proxy'} =~ /^(http:\/\/)?(.*?):(.+?)\/?$/i;
  216. unless ($2 and $3) {
  217. die "Error: incorrectly formatted proxy server ('http://server:port' expected)\n";
  218. }
  219. $options{'proxy'} = "http://$2:$3";
  220. }
  221. if (!$options{'noenvproxy'} and !$options{'proxy'} and $ENV{'http_proxy'} ) {
  222. $ENV{'http_proxy'} =~ /(http:\/\/)?(.*?):(.+?)\/?$/i;
  223. unless ($2 and $3) {
  224. die "Error: incorrectly formatted proxy server environment variable\n('http://server:port' expected)\n";
  225. }
  226. $options{'proxy'} = "http://$2:$3";
  227. }
  228. if ($options{'proxyauth'}) {
  229. unless ($options{'proxyauth'} =~ /^.+?:.+?$/) {
  230. die "Error: incorrectly formatted proxy credentials ('user:pass' expected)\n";
  231. }
  232. }
  233. # Handle/validate other options
  234. if ($options{'clean'} =~ m/\D/) {
  235. die "Error: 'clean' value must be numeric\n";
  236. }
  237. if ($options{'retries'} =~ m/\D/) {
  238. die "Error: 'retries' value must be numeric\n";
  239. }
  240. unless ($options{'retries'}) {
  241. $options{'retries'} = 3;
  242. }
  243. if ($options{'basedir'}) {
  244. unless (chdir $options{'basedir'}) {
  245. die "Error: could not change directory to $options{'basedir'}\n";
  246. }
  247. }
  248. if ($options{'titles'}) {
  249. $options{'titles'} .= " ";
  250. }
  251. unless (@get) {
  252. die "Error: no strip specified (--list to list available strips)\n";
  253. }
  254. # verbose overrides quiet
  255. if ($options{'verbose'} and $options{'quiet'}) {
  256. undef $options{'quiet'};
  257. }
  258. # Un-needed vars
  259. undef $known_strips; undef $known_groups; undef $val;
  260. # Go
  261. unless ($options{'quiet'}) {
  262. warn "dailystrips $version starting:\n";
  263. }
  264. # Report proxy settings
  265. if ($options{'proxy'}) {
  266. if ($options{'verbose'}) {
  267. warn "Using proxy server $options{'proxy'}\n";
  268. }
  269. if ($options{'verbose'} and $options{'proxy_auth'}) {
  270. warn "Using proxy server authentication\n";
  271. }
  272. }
  273. if ($options{'local'}) {
  274. unless ($options{'quiet'}) {
  275. warn "Operating in local mode\n";
  276. }
  277. if ($options{'dailydir'}) {
  278. unless ($options{'quiet'}) {
  279. warn "Operating in daily directory mode\n";
  280. }
  281. unless (-d $short_date) {
  282. # any issues with masks and Win32?
  283. unless(mkdir ($short_date, 0755)) {
  284. die "Error: could not create today's directory ($short_date/)\n";
  285. }
  286. }
  287. }
  288. unless(open(STDOUT, ">dailystrips-$short_date.html")) {
  289. die "Error: could not open HTML file (dailystrips-$short_date.html) for writing\n";
  290. }
  291. unless ($options{'date'}) {
  292. unless ($options{'noindex'}) {
  293. unless ($^O =~ /Win32/) {
  294. unlink("index.html");
  295. system("ln -s dailystrips-$short_date.html index.html");
  296. }
  297. }
  298. }
  299. if ($options{'archive'}) {
  300. unless (-e "archive.html") {
  301. # Doesn't exist.. create
  302. open(ARCHIVE, ">archive.html") or die "Error: could not create archive.html\n";
  303. print ARCHIVE
  304. "<html>
  305. <head>
  306. <title>$options{'titles'}dailystrips archive</title>
  307. </head>
  308. <body bgcolor=\"#ffffff\" text=\"#000000\" link=\"#0000ff\" vlink=\"#ff00ff\" alink=\"#ff0000\">
  309. <p align=\"center\">\n
  310. <font face=\"helvetica,arial\" size=\"14pt\">$options{'titles'}dailystrips archive</font>
  311. </p>
  312. <p>
  313. <font face=\"helvetica,arial\">
  314. <!--insert below-->
  315. </font>
  316. </p>
  317. </body>
  318. </html>";
  319. close(ARCHIVE);
  320. }
  321. open(ARCHIVE, "<archive.html") or die "Error: could not open archive.html for reading\n";
  322. my @archive = <ARCHIVE>;
  323. close(ARCHIVE);
  324. unless (grep(/<a href="dailystrips-$short_date.html">/, @archive)) {
  325. for (@archive) {
  326. if (s/(<!--insert below-->)/$1\n<a href="dailystrips-$short_date.html">$long_date<\/a><br>/) {
  327. unless(open(ARCHIVE, ">archive.html")) {
  328. die "Error: could not open archive.html for writing\n";
  329. }
  330. print ARCHIVE @archive;
  331. close(ARCHIVE);
  332. last;
  333. }
  334. }
  335. }
  336. }
  337. # Update previous day's file with a "Next Day" link to today's file
  338. if (open(PREVIOUS, "<dailystrips-$short_date_yesterday.html")) {
  339. my @previous_page = <PREVIOUS>;
  340. close(PREVIOUS);
  341. # Don't bother if no tag exists in the file (because it has already been updated)
  342. if (grep(/<!--nextday-->/, @previous_page)) {
  343. my $match_count;
  344. for (@previous_page) {
  345. if (s/<!--nextday-->/ | <a href="dailystrips-$short_date.html">Next day<\/a>/) {
  346. $match_count++;
  347. last if ($match_count == 2);
  348. }
  349. }
  350. if (open(PREVIOUS, ">dailystrips-$short_date_yesterday.html")) {
  351. print PREVIOUS @previous_page;
  352. close(PREVIOUS);
  353. } else {
  354. warn "Warning: could not open dailystrips-$short_date_yesterday.html for writing\n";
  355. }
  356. } else {
  357. warn "Warning: did not find any tag in previous day's file to make today's link\n";
  358. }
  359. } else {
  360. warn "Warning: could not open dailystrips-$short_date_yesterday.html for reading\n";
  361. }
  362. } elsif ($options{'output'}) {
  363. unless ($options{'quiet'}) {
  364. warn "Writing to file $options{'output'}\n";
  365. }
  366. unless (open(STDOUT, ">$options{'output'}")) {
  367. die "Error: Could not open output file ($options{'output'}) for writing\n";
  368. }
  369. }
  370. # Download image URLs
  371. unless ($options{'quiet'}) {
  372. if ($options{'verbose'}) {
  373. warn "\nRetrieving URLS:\n"
  374. } else {
  375. print STDERR "\nRetrieving URLS..."
  376. }
  377. }
  378. for (@get) {
  379. if ($options{'verbose'}) { warn "Retrieving URL for $_\n" }
  380. &get_strip($_);
  381. }
  382. unless ($options{'quiet'}) {
  383. if ($options{'verbose'}) {
  384. warn "Retrieving URLS: done\n"
  385. } else {
  386. warn "done\n"
  387. }
  388. }
  389. if (-e "dailystrips-$short_date_tomorrow.html") {
  390. $link_tomorrow = " | <a href=\"dailystrips-$short_date_tomorrow.html\">Next day</a>"
  391. } else {
  392. $link_tomorrow = "<!--nextday-->"
  393. }
  394. # Generate HTML page
  395. if ($options{'lite'}) {
  396. print "<font face=\"helvetica\" size=\"+2\"><b><u>$options{'titles'}dailystrips for $long_date</u></b></font><br><br>\n";
  397. } else {
  398. my $topanchor;
  399. if ($options{'stripnav'}) {
  400. $topanchor = "\n<a name=\"top\">\n";
  401. }
  402. print
  403. "<html>
  404. <head>
  405. <title>$options{'titles'}dailystrips for $long_date</title>
  406. </head>
  407. <body bgcolor=\"#ffffff\" text=\"#000000\" link=\"#ff00ff\">
  408. $topanchor
  409. <center>
  410. <font face=\"helvetica\" size=\"+2\"><b><u>$options{'titles'}dailystrips for $long_date</u></b></font>
  411. </center>
  412. <p><font face=\"helvetica\">
  413. &lt; <a href=\"dailystrips-$short_date_yesterday.html\">Previous day</a>$link_tomorrow";
  414. if ($options{'archive'}) {
  415. print " | <a href=\"archive.html\">Archives</a>";
  416. }
  417. print
  418. " &gt;
  419. </font></p>
  420. ";
  421. if ($options{'stripnav'}) {
  422. print "<font face=\"helvetica\">Strips:</font><br>\n";
  423. for (@strips) {
  424. my ($strip, $name) = (split(/;/, $_))[0,1];
  425. print "<a href=\"#$strip\">$name</A>&nbsp;&nbsp;";
  426. }
  427. print "\n<br><br>";
  428. }
  429. print "\n\n<table border=\"0\">\n";
  430. }
  431. if ($options{'local'} and !$options{'quiet'}) {
  432. if ($options{'verbose'}) {
  433. warn "\nDownloading strip files:\n"
  434. } else {
  435. print STDERR "Downloading strip files...";
  436. }
  437. }
  438. for (@strips) {
  439. my ($strip, $name, $homepage, $img_addr, $referer, $prefetch, $artist) = split(/;/, $_);
  440. my ($img_line, $local_name, $local_name_dir, $local_name_file, $local_name_ext, $image, $ext,
  441. $local_name_yesterday, $local_name_yesterday_dir, $local_name_yesterday_file, $local_name_yesterday_ext);
  442. if ($options{'verbose'} and $options{'local'}) {
  443. warn "Downloading strip file for " . lc((split(/;/, $_))[0]) . "\n";
  444. }
  445. if ($img_addr =~ "^unavail") {
  446. if ($options{'verbose'}) {
  447. warn "Error: $strip: could not retrieve URL\n";
  448. }
  449. $img_line = "[Error - unable to retrieve URL]";
  450. } else {
  451. if ($options{'local'}) {
  452. # local mode - download strips
  453. $img_addr =~ /http:\/\/(.*)\/(.*)\.(.*?)([?&].+)?$/;
  454. if (defined $3) { $ext = ".$3" }
  455. # prepare file names
  456. if ($options{'stripdir'}) {
  457. $local_name_yesterday = "$name/$short_date_yesterday$ext";
  458. $local_name_yesterday_dir = "$name/";
  459. $local_name_yesterday_file = $short_date_yesterday;
  460. $local_name_yesterday_ext = $ext;
  461. $local_name = "$name/$short_date$ext";
  462. $local_name_dir = "$name/";
  463. $local_name_file = "$short_date";
  464. $local_name_ext = "$ext";
  465. } elsif ($options{'dailydir'}) {
  466. $local_name_yesterday = "$short_date_yesterday/$name-$short_date_yesterday$ext";
  467. $local_name_yesterday_dir = "$short_date_yesterday/";
  468. $local_name_yesterday_file = "$name-$short_date_yesterday";
  469. $local_name_yesterday_ext = "$ext";
  470. $local_name = "$short_date/$name-$short_date$ext";
  471. $local_name_dir = "$short_date/";
  472. $local_name_file = "$name-$short_date";
  473. $local_name_ext = "$ext";
  474. } else {
  475. $local_name_yesterday = "$name-$short_date_yesterday$ext";
  476. $local_name_yesterday_dir = "./";
  477. $local_name_yesterday_file = "$name-$short_date_yesterday";
  478. $local_name_yesterday_ext = "$ext";
  479. $local_name = "$name-$short_date$ext";
  480. $local_name_dir = "./";
  481. $local_name_file = "$name-$short_date";
  482. $local_name_ext = "$ext";
  483. }
  484. if ($options{'nospaces'}) {
  485. # impossible to tell for sure if previous day's file
  486. # used --nospaces or not, but this should work more
  487. # often
  488. $local_name_yesterday =~ s/\s+//g;
  489. $local_name_yesterday_dir =~ s/\s+//g;
  490. $local_name_yesterday_file =~ s/\s+//g;
  491. $local_name =~ s/\s+//g;
  492. $local_name_dir =~ s/\s+//g;
  493. $local_name_file =~ s/\s+//g;
  494. }
  495. # do ops that depend on file name
  496. if ($options{'stripdir'}) {
  497. unless (-d $local_name_dir) {
  498. # any issues with masks and Win32?
  499. mkdir $local_name_dir, 0755;
  500. }
  501. }
  502. if ($options{'save'} and -e $local_name) {
  503. # already have a suitable local file - skip downloading
  504. if ($options{'avantgo'}) {
  505. $img_line = &make_avantgo_table($local_name, $ext);
  506. } else {
  507. $img_addr = $local_name;
  508. $img_addr =~ s/ /\%20/go;
  509. if ($options{'stripnav'}) {
  510. $img_line = "<img src=\"$img_addr\" alt=\"$name\"><br><a href=\"#top\">Return to top</a>";
  511. } else {
  512. $img_line = "<img src=\"$img_addr\" alt=\"$name\">";
  513. }
  514. }
  515. } else {
  516. # need to download
  517. if ($prefetch) {
  518. if (&http_get($prefetch, $referer) =~ m/^ERROR/) {
  519. warn "Error: $strip: could not download prefetch URL\n";
  520. $image = "ERROR";
  521. } else {
  522. $image = &http_get($img_addr, $referer);
  523. }
  524. } else {
  525. $image = &http_get($img_addr, $referer);
  526. #$image = &http_get($img_addr, "");
  527. }
  528. if ($image =~ /^ERROR/) {
  529. # couldn't get the image
  530. # FIXME: what to do if a file for the day has already been
  531. # downloaded, but downloading fails when script is run again
  532. # that day? maybe reuse existing file instead of throwing
  533. # error?
  534. if (-e $local_name) {
  535. # an image file for today already exists.. jump to outputting code
  536. #warn "DEBUG: couldn't download strip, but we already have it\n";
  537. goto HAVE_IMAGE;
  538. } else {
  539. if ($options{'verbose'}) {
  540. warn "Error: $strip: could not download strip\n";
  541. }
  542. }
  543. $img_line = "[Error - unable to download image]";
  544. } else {
  545. HAVE_IMAGE:
  546. # got the image
  547. if ($^O =~ /Win32/) {
  548. # can't do any diff checking on windows (easily, that is - it is doable)
  549. open(IMAGE, ">$local_name");
  550. binmode(IMAGE);
  551. print IMAGE $image;
  552. close(IMAGE);
  553. $img_addr = $local_name;
  554. $img_addr =~ s/ /\%20/go;
  555. if ($options{'stripnav'}) {
  556. $img_line = "<img src=\"$img_addr\" alt=\"$name\"><br><a href=\"#top\">Return to top</a>";
  557. } else {
  558. $img_line = "<img src=\"$img_addr\" alt=\"$name\">";
  559. }
  560. } else {
  561. # FIXME: only download to .tmp if earlier file exists
  562. open(IMAGE, ">$local_name.tmp");
  563. binmode(IMAGE);
  564. print IMAGE $image;
  565. close(IMAGE);
  566. if (-e $local_name and system("diff \"$local_name\" \"$local_name.tmp\" >/dev/null 2>&1") == 0) {
  567. # already downloaded the same strip earlier today
  568. unlink("$local_name.tmp");
  569. if ($options{'avantgo'}) {
  570. $img_line = &make_avantgo_table($local_name, $ext);
  571. } else {
  572. $img_addr = $local_name;
  573. $img_addr =~ s/ /\%20/go;
  574. if ($options{'stripnav'}) {
  575. $img_line = "<img src=\"$img_addr\" alt=\"$name\"><br><a href=\"#top\">Return to top</a>";
  576. } else {
  577. $img_line = "<img src=\"$img_addr\" alt=\"$name\">";
  578. }
  579. }
  580. } elsif (system("diff \"$local_name_yesterday\" \"$local_name.tmp\" >/dev/null 2>&1") == 0) {
  581. # same strip as yesterday
  582. if ($options{'nosymlinks'}) {
  583. system("mv","$local_name.tmp","$local_name");
  584. } else {
  585. unlink("$local_name.tmp");
  586. if ($options{'stripdir'} or $options{'dailydir'}) {
  587. system("ln -s \"../$local_name_yesterday\" \"$local_name\" >/dev/null 2>&1");
  588. } else {
  589. system("ln -s \"$local_name_yesterday\" \"$local_name\" >/dev/null 2>&1");
  590. }
  591. }
  592. if ($options{'nostale'}) {
  593. $img_line = "[Error - new strip not available]";
  594. } else {
  595. $img_addr = $local_name;
  596. $img_addr =~ s/ /\%20/go;
  597. if ($options{'stripnav'}) {
  598. $img_line = "<img src=\"$img_addr\" alt=\"$name\"><br><a href=\"#top\">Return to top</a>";
  599. } else {
  600. $img_line = "<img src=\"$img_addr\" alt=\"$name\">";
  601. }
  602. }
  603. } else {
  604. # completely new strip
  605. # possible to get here by:
  606. # -downloading a strip for the first time in a day
  607. # -downloading an updated strip that replaces an old one downloaded at
  608. # an earlier time on the same day
  609. system("mv","$local_name.tmp","$local_name");
  610. if ($options{'avantgo'}) {
  611. &make_avantgo_files($local_name, $local_name_ext);
  612. $img_line = &make_avantgo_table($local_name, $ext);
  613. } else {
  614. $img_addr = $local_name;
  615. $img_addr =~ s/ /\%20/go;
  616. if ($options{'stripnav'}) {
  617. $img_line = "<img src=\"$img_addr\" alt=\"$name\"><br><a href=\"#top\">Return to top</a>";
  618. } else {
  619. $img_line = "<img src=\"$img_addr\" alt=\"$name\">";
  620. }
  621. }
  622. }
  623. }
  624. }
  625. }
  626. } else {
  627. # regular mode - just give addresses to strips on their webserver
  628. if ($options{'stripnav'}) {
  629. $img_line = "<img src=\"$img_addr\" alt=\"$name\"><br><a href=\"#top\">Return to top</a>";
  630. } else {
  631. $img_line = "<img src=\"$img_addr\" alt=\"$name\">";
  632. }
  633. }
  634. }
  635. if ($artist) {
  636. $artist = " by $artist";
  637. }
  638. if ($options{'lite'}){
  639. print
  640. "<font face=\"helvetica\" size=\"+1\"><b><a href=\"$homepage\">$name</a>$artist</b></font><br>
  641. $img_line<br>
  642. <br>
  643. ";
  644. } else {
  645. my $stripanchor;
  646. if ($options{'stripnav'}) {
  647. $stripanchor = "<a name=\"$strip\">";
  648. }
  649. print
  650. " <tr>
  651. <td>
  652. <font face=\"helvetica\" size=\"+1\"><b>$stripanchor<a href=\"$homepage\">$name</a>$artist</b></font>
  653. </td>
  654. </tr>
  655. <tr>
  656. <td>
  657. $img_line
  658. <p>&nbsp;</p>
  659. </td>
  660. </tr>
  661. ";
  662. }
  663. }
  664. if ($options{'local'} and !$options{'quiet'}) {
  665. if ($options{'verbose'}) {
  666. warn "Downloading strip files: done\n"
  667. } else {
  668. warn "done\n"
  669. }
  670. }
  671. unless ($options{'lite'}) {
  672. print
  673. "</table>
  674. <p><font face=\"helvetica\">
  675. &lt; <a href=\"dailystrips-$short_date_yesterday.html\">Previous day</a>$link_tomorrow";
  676. if ($options{'archive'}) {
  677. print " | <a href=\"archive.html\">Archives</a>";
  678. }
  679. print
  680. " &gt;
  681. </font></p>
  682. <font face=\"helvetica\">Generated by dailystrips $version</font>
  683. </body>
  684. </html>
  685. ";
  686. }
  687. if (!$options{'date'} and !$options{'noindex'} and $^O =~ /Win32/) {
  688. # no symlinks on windows.. just make a copy of the file
  689. close(STDOUT);
  690. copy("dailystrips-$short_date.html","index.html");
  691. }
  692. # Clean out old files, if requested
  693. if ($options{'clean'}) {
  694. unless ($options{'quiet'}) {
  695. print STDERR "Cleaning files older than $options{'clean'} days...";
  696. }
  697. unless (system("perl -S dailystrips-clean --quiet $options{'clean'}")) {
  698. unless ($options{'quiet'}) {
  699. print STDERR "done\n";
  700. }
  701. }
  702. else {
  703. warn "failed\nWarning: could not run dailystrips-clean script\n";
  704. }
  705. }
  706. sub http_get {
  707. my ($url, $referer) = @_;
  708. my ($request, $response, $status);
  709. # default value
  710. #unless ($retries) {
  711. # $retries = 3;
  712. #}
  713. if ($referer eq "") {$referer = $url;}
  714. my $headers = new HTTP::Headers;
  715. $headers->proxy_authorization_basic(split(/:/, $options{'proxyauth'}));
  716. $headers->referer($referer);
  717. my $ua = LWP::UserAgent->new;
  718. $ua->agent($options{'useragent'});
  719. $ua->proxy('http', $options{'proxy'});
  720. for (1 .. $options{'retries'}) {
  721. # main request
  722. $request = HTTP::Request->new('GET', $url, $headers);
  723. $response = $ua->request($request);
  724. ($status = $response->status_line()) =~ s/^(\d+)/$1:/;
  725. if ($response->is_error()) {
  726. if ($options{'verbose'}) {
  727. warn "Warning: could not download $url: $status (attempt $_ of $options{'retries'})\n";
  728. }
  729. } else {
  730. return $response->content;
  731. }
  732. }
  733. # if we get here, URL retrieval completely failed
  734. warn "Warning: failed to download $url\n";
  735. return "ERROR: $status";
  736. }
  737. sub get_strip {
  738. my ($strip) = @_;
  739. my ($page, $addr);
  740. if ($options{'date'} and $defs{$strip}{'provides'} eq "latest") {
  741. if ($options{'verbose'}) {
  742. warn "Warning: strip $strip not compatible with --date, skipping\n";
  743. }
  744. next;
  745. }
  746. if ($defs{$strip}{'type'} eq "search") {
  747. $page = &http_get($defs{$strip}{'searchpage'});
  748. if ($page =~ /^ERROR/) {
  749. if ($options{'verbose'}) {
  750. warn "Error: $strip: could not download searchpage $defs{$strip}{'searchpage'}\n";
  751. }
  752. $addr = "unavail-server";
  753. } else {
  754. $page =~ /$defs{$strip}{'searchpattern'}/si;
  755. my @regexmatch;
  756. for (1..9) {
  757. $regexmatch[$_] = ${$_};
  758. #warn "regex match #$_: ${$_}\n";
  759. }
  760. unless (${$defs{$strip}{'matchpart'}}) {
  761. if ($options{'verbose'}) {
  762. warn "Error: $strip: searchpattern $defs{$strip}{'searchpattern'} did not match anything in searchpage $defs{$strip}{'searchpage'}\n";
  763. }
  764. $addr = "unavail-nomatch";
  765. } else {
  766. my $match = ${$defs{$strip}{'matchpart'}};
  767. if ($defs{$strip}{'imageurl'}) {
  768. $addr = $defs{$strip}{'imageurl'};
  769. $addr =~ s/\$match_(\d)/$regexmatch[$1]/ge;
  770. $addr =~ s/\$match/$match/ge;
  771. } else {
  772. $addr = $defs{$strip}{'baseurl'} . $match . $defs{$strip}{'urlsuffix'};
  773. }
  774. }
  775. }
  776. } elsif ($defs{$strip}{'type'} eq "generate") {
  777. $addr = $defs{$strip}{'baseurl'} . $defs{$strip}{'imageurl'};
  778. }
  779. unless ($addr =~ /^(http:\/\/|unavail)/io) { $addr = "http://" . $addr }
  780. push(@strips,"$strip;$defs{$strip}{'name'};$defs{$strip}{'homepage'};$addr;$defs{$strip}{'referer'};$defs{$strip}{'prefetch'};$defs{$strip}{'artist'}");
  781. }
  782. sub get_defs {
  783. my $defs_file = shift;
  784. my ($strip, $class, $sectype, $group);
  785. my $line;
  786. unless(open(DEFS, "<$defs_file")) {
  787. die "Error: could not open strip definitions file $defs_file\n";
  788. }
  789. my @defs_file = <DEFS>;
  790. close(DEFS);
  791. if ($options{'verbose'}) {
  792. warn "Loading definitions from file $defs_file\n";
  793. }
  794. for (@defs_file) {
  795. $line++;
  796. chomp;
  797. s/#(.*)//; s/^\s*//; s/\s*$//;
  798. next if $_ eq "";
  799. if (!$sectype) {
  800. if (/^strip\s+(\w+)$/i)
  801. {
  802. if (defined ($defs{$1}))
  803. {
  804. undef $defs{$1};
  805. }
  806. $strip = $1;
  807. $sectype = "strip";
  808. }
  809. elsif (/^class\s+(.*)$/i)
  810. {
  811. if (defined ($classes{$1}))
  812. {
  813. undef $classes{$1};
  814. }
  815. $class = $1;
  816. $sectype = "class";
  817. }
  818. elsif (/^group\s+(.*)$/i)
  819. {
  820. if (defined ($groups{$1}))
  821. {
  822. undef $groups{$1};
  823. }
  824. $group = $1;
  825. $sectype = "group";
  826. }
  827. elsif (/^(.*)/)
  828. {
  829. die "Error: Unknown keyword '$1' at $defs_file line $line\n";
  830. }
  831. }
  832. elsif (/^end$/i)
  833. {
  834. if ($sectype eq "class")
  835. {
  836. undef $class
  837. }
  838. elsif ($sectype eq "strip")
  839. {
  840. if ($defs{$strip}{'useclass'}) {
  841. my $using_class = $defs{$strip}{'useclass'};
  842. # import vars from class
  843. for (qw(homepage searchpage searchpattern baseurl imageurl urlsuffix referer prefetch artist)) {
  844. if ($classes{$using_class}{$_} and !$defs{$strip}{$_}) {
  845. my $classvar = $classes{$using_class}{$_};
  846. $classvar =~ s/(\$[0-9])/$defs{$strip}{$1}/g;
  847. $classvar =~ s/\$strip/$strip/g;
  848. $defs{$strip}{$_} = $classvar;
  849. }
  850. }
  851. for (qw(type matchpart provides)) {
  852. if ($classes{$using_class}{$_} and !$defs{$strip}{$_}) {
  853. $defs{$strip}{$_} = $classes{$using_class}{$_};
  854. }
  855. }
  856. }
  857. #substitute auto vars for real vals here/set defaults
  858. unless ($defs{$strip}{'searchpage'}) {$defs{$strip}{'searchpage'} = $defs{$strip}{'homepage'}}
  859. unless ($defs{$strip}{'referer'}) {
  860. if ($defs{$strip}{'searchpage'}) {
  861. $defs{$strip}{'referer'} = $defs{$strip}{'searchpage'}
  862. } else {
  863. $defs{$strip}{'referer'} = $defs{$strip}{'homepage'}
  864. }
  865. }
  866. #other vars in definition
  867. for (qw(homepage searchpage searchpattern imageurl baseurl urlsuffix referer prefetch)) {
  868. if ($defs{$strip}{$_}) {
  869. $defs{$strip}{$_} =~ s/\$(name|homepage|searchpage|searchpattern|imageurl|baseurl|referer|prefetch)/$defs{$strip}{$1}/g;
  870. }
  871. }
  872. #dates
  873. for (qw(homepage searchpage searchpattern imageurl baseurl urlsuffix referer prefetch)) {
  874. if ($defs{$strip}{$_}) {
  875. $defs{$strip}{$_} =~ s/(\%(-?)[a-zA-Z])/strftime("$1", @localtime_today)/ge;
  876. }
  877. }
  878. # <code:> stuff
  879. for (qw(homepage searchpage searchpattern imageurl baseurl urlsuffix referer)) {
  880. if ($defs{$strip}{$_}) {
  881. $defs{$strip}{$_} =~ s/<code:(.*?)(?<!\\)>/&my_eval($1)/ge;
  882. }
  883. }
  884. #sanity check vars
  885. for (qw(name homepage type)) {
  886. unless ($defs{$strip}{$_}) {
  887. die "Error: strip $strip has no '$_' value\n";
  888. }
  889. }
  890. for (qw(homepage searchpage baseurl imageurl)){
  891. if ($defs{$strip}{$_} and $defs{$strip}{$_} !~ /^http:\/\//io) {
  892. die "Error: strip $strip has invalid $_\n"
  893. }
  894. }
  895. if ($defs{$strip}{'type'} eq "search") {
  896. unless ($defs{$strip}{'searchpattern'}) {
  897. die "Error: strip $strip has no 'searchpattern' value in $defs_file\n";
  898. }
  899. unless ($defs{$strip}{'searchpattern'} =~ /\(.+\)/) {
  900. die "Error: strip $strip has no parentheses in searchpattern\n";
  901. }
  902. unless ($defs{$strip}{'matchpart'}) {
  903. #die "Error: strip $strip has no 'matchpart' value in $defs_file\n";
  904. $defs{$strip}{'matchpart'} = 1;
  905. }
  906. if ($defs{$strip}{'imageurl'} and ($defs{$strip}{'baseurl'} or $defs{$strip}{'urlsuffix'})) {
  907. die "Error: strip $strip: cannot use both 'imageurl' at the same time as 'baseurl'\nor 'urlsuffix'\n";
  908. }
  909. } elsif ($defs{$strip}{'type'} eq "generate") {
  910. unless ($defs{$strip}{'imageurl'}) {
  911. die "Error: strip $strip has no 'imageurl' value in $defs_file\n";
  912. }
  913. }
  914. unless ($defs{$strip}{'provides'}) {
  915. die "Error: strip $strip has no 'provides' value in $defs_file\n";
  916. }
  917. #debugger
  918. #foreach my $strip (keys %defs) {
  919. # foreach my $key (qw(homepage searchpage searchpattern imageurl baseurl referer prefetch)) {
  920. # warn "DEBUG: $strip:$key=$defs{$strip}{$key}\n";
  921. # }
  922. # #warn "DEBUG: $strip:name=$defs{$strip}{'name'}\n";
  923. #}
  924. undef $strip;
  925. }
  926. elsif ($sectype eq "group")
  927. {
  928. chop $groups{$group}{'strips'};
  929. unless ($groups{$group}{'desc'}) {
  930. $groups{$group}{'desc'} = "[No description]";
  931. }
  932. undef $group;
  933. }
  934. undef $sectype;
  935. }
  936. elsif ($sectype eq "class") {
  937. if (/^homepage\s+(.+)$/i) {
  938. $classes{$class}{'homepage'} = $1;
  939. }
  940. elsif (/^type\s+(.+)$/i)
  941. {
  942. unless ($1 =~ /^(search|generate)$/io) {
  943. die "Error: invalid type at $defs_file line $line\n";
  944. }
  945. $classes{$class}{'type'} = $1;
  946. }
  947. elsif (/^searchpage\s+(.+)$/i)
  948. {
  949. $classes{$class}{'searchpage'} = $1;
  950. }
  951. elsif (/^searchpattern\s+(.+)$/i)
  952. {
  953. $classes{$class}{'searchpattern'} = $1;
  954. }
  955. elsif (/^matchpart\s+(.+)$/i)
  956. {
  957. unless ($1 =~ /^(\d)$/) {
  958. die "Error: invalid 'matchpart' at $defs_file line $line\n";
  959. }
  960. $classes{$class}{'matchpart'} = $1;
  961. }
  962. elsif (/^baseurl\s+(.+)$/i)
  963. {
  964. $classes{$class}{'baseurl'} = $1;
  965. }
  966. elsif (/^urlsuffix\s+(.+)$/i)
  967. {
  968. $classes{$class}{'urlsufix'} = $1;
  969. }
  970. elsif (/^imageurl\s+(.+)$/i)
  971. {
  972. $classes{$class}{'imageurl'} = $1;
  973. }
  974. elsif (/^referer\s+(.+)$/i)
  975. {
  976. $classes{$class}{'referer'} = $1;
  977. }
  978. elsif (/^prefetch\s+(.+)$/i)
  979. {
  980. $classes{$class}{'prefetch'} = $1;
  981. }
  982. elsif (/^provides\s+(.+)$/i)
  983. {
  984. unless ($1 =~ /^(any|latest)$/i) {
  985. die "Error: invalid 'provides' at $defs_file line $line\n";
  986. }
  987. $classes{$class}{'provides'} = $1;
  988. }
  989. elsif (/^artist\s+(.+)$/i)
  990. {
  991. $classes{$class}{'artist'} = $1;
  992. }
  993. elsif (/^(.+)\s+?/)
  994. {
  995. die "Unknown keyword '$1' at $defs_file line $line\n";
  996. }
  997. }
  998. elsif ($sectype eq "strip") {
  999. if (/^name\s+(.+)$/i)
  1000. {
  1001. $defs{$strip}{'name'} = $1;
  1002. }
  1003. elsif (/^useclass\s+(.+)$/i)
  1004. {
  1005. unless (defined $classes{$1}) {
  1006. die "Error: strip $strip references invalid class $1 at $defs_file line $line\n";
  1007. }
  1008. $defs{$strip}{'useclass'} = $1;
  1009. }
  1010. elsif (/^homepage\s+(.+)$/i) {
  1011. $defs{$strip}{'homepage'} = $1;
  1012. }
  1013. elsif (/^type\s+(.+)$/i)
  1014. {
  1015. unless ($1 =~ /^(search|generate)$/i) {
  1016. die "Error: invalid 'type' at $defs_file line $line\n";
  1017. }
  1018. $defs{$strip}{'type'} = $1;
  1019. }
  1020. elsif (/^searchpage\s+(.+)$/i)
  1021. {
  1022. $defs{$strip}{'searchpage'} = $1;
  1023. }
  1024. elsif (/^searchpattern\s+(.+)$/i)
  1025. {
  1026. $defs{$strip}{'searchpattern'} = $1;
  1027. }
  1028. elsif (/^matchpart\s+(.+)$/i)
  1029. {
  1030. unless ($1 =~ /^(\d+)$/) {
  1031. die "Error: invalid 'matchpart' at $defs_file line $line\n";
  1032. }
  1033. $defs{$strip}{'matchpart'} = $1;
  1034. }
  1035. elsif (/^baseurl\s+(.+)$/i)
  1036. {
  1037. $defs{$strip}{'baseurl'} = $1;
  1038. }
  1039. elsif (/^urlsuffix\s+(.+)$/i)
  1040. {
  1041. $defs{$strip}{'urlsuffix'} = $1;
  1042. }
  1043. elsif (/^imageurl\s+(.+)$/i)
  1044. {
  1045. $defs{$strip}{'imageurl'} = $1;
  1046. }
  1047. elsif (/^referer\s+(.+)$/i)
  1048. {
  1049. $defs{$strip}{'referer'} = $1;
  1050. }
  1051. elsif (/^prefetch\s+(.+)$/i)
  1052. {
  1053. $defs{$strip}{'prefetch'} = $1;
  1054. }
  1055. elsif (/^(\$\d)\s+(.+)$/)
  1056. {
  1057. $defs{$strip}{$1} = $2;
  1058. }
  1059. elsif (/^provides\s+(.+)$/i)
  1060. {
  1061. unless ($1 =~ /^(any|latest)$/i) {
  1062. die "Error: invalid 'provides' at $defs_file line $line\n";
  1063. }
  1064. $defs{$strip}{'provides'} = $1;
  1065. }
  1066. elsif (/^artist\s+(.+)$/i)
  1067. {
  1068. $defs{$strip}{'artist'} = $1;
  1069. }
  1070. elsif (/^(.+)\s+?/)
  1071. {
  1072. die "Error: Unknown keyword '$1' at $defs_file line $line, in strip $strip\n";
  1073. }
  1074. } elsif ($sectype eq "group") {
  1075. if (/^desc\s+(.+)$/i)
  1076. {
  1077. $groups{$group}{'desc'} = $1;
  1078. }
  1079. elsif (/^include\s+(.+)$/i)
  1080. {
  1081. $groups{$group}{'strips'} .= join(';', split(/\s+/, $1)) . ";";
  1082. }
  1083. elsif (/^exclude\s+(.+)$/i)
  1084. {
  1085. $groups{$group}{'nostrips'} .= join(';', split(/\s+/, $1)) . ";";
  1086. }
  1087. elsif (/^(.+)\s+?/)
  1088. {
  1089. die "Error: Unknown keyword '$1' at $defs_file line $line, in group $group\n";
  1090. }
  1091. }
  1092. }
  1093. # Post-processing validation
  1094. for $group (keys %groups) {
  1095. my (@strips, %nostrips, @okstrips);
  1096. if (defined($groups{$group}{'nostrips'})) {
  1097. @strips = sort(keys(%defs));
  1098. foreach (split (/;/,$groups{$group}{'nostrips'})) {
  1099. $nostrips{$_} = 1;
  1100. }
  1101. } else {
  1102. @strips = split(/;/, $groups{$group}{'strips'});
  1103. %nostrips = (); #empty
  1104. }
  1105. foreach (@strips) {
  1106. unless ($defs{$_}) {
  1107. warn "Warning: group $group references non-existant strip $_\n";
  1108. }
  1109. next if ($nostrips{$_});
  1110. push (@okstrips,$_);
  1111. }
  1112. $groups{$group}{'strips'} = join(';',@okstrips);
  1113. }
  1114. }
  1115. sub my_eval {
  1116. my ($code) = @_;
  1117. $code =~ s/\\\>/\>/g;
  1118. return eval $code;
  1119. #print STDERR "DEBUG: eval returned: " . scalar(eval $code) . ", errors: $!\n";
  1120. }
  1121. sub make_avantgo_table {
  1122. my ($file, $file_ext) = @_;
  1123. my ($rows, $cols, $table);
  1124. my $dimensions = `identify \"$file\"`;
  1125. $dimensions =~ m/^$file (\d+)x(\d+)/;
  1126. my $width = $1; my $height = $2;
  1127. if (int($width/160) != ($width/160)) {
  1128. $cols = int($width/160) + 1;
  1129. } else {
  1130. $cols = $width/160;
  1131. }
  1132. if (int($height/160) != ($height/160)) {
  1133. $rows = int($height/160) + 1;
  1134. } else {
  1135. $rows = $height/160;
  1136. }
  1137. my $file_base = $file; $file_base =~ s/$file_ext$//;
  1138. $file_base =~ s/ /\%20/g;
  1139. $table = "<table border=0 cellspacing=0 cellpadding=0>";
  1140. foreach my $row (0 .. ($rows-1)) {
  1141. $table .= "<tr>";
  1142. foreach my $col (0 .. ($cols-1)) {
  1143. $table .= "<td><img src=$file_base-" . (($row * $cols) + $col) . "$file_ext></td>";
  1144. }
  1145. $table .= "</tr>";
  1146. }
  1147. $table .= "</table>";
  1148. return $table;
  1149. }
  1150. sub make_avantgo_files {
  1151. my ($file, $file_ext) = @_;
  1152. my $file_base = $file; $file_base =~ s/$file_ext$//;
  1153. system("convert -crop 160x160 \"$file\" \"$file_base-\%d$file_ext\"");
  1154. }
  1155. sub get_homedir
  1156. {
  1157. if ($^O =~ /Win32/ )
  1158. {
  1159. my $dir = $ENV{'USERPROFILE'};
  1160. if ($dir eq "") {$dir = $ENV{'WINDIR'};}
  1161. $dir =~ s|\\|/|g;
  1162. return $dir;
  1163. }
  1164. else
  1165. {
  1166. return (getpwuid($>))[7];
  1167. }
  1168. }