/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
- #!/usr/bin/perl
- #
- # Program Summary:
- #
- # Name: dailystrips
- # Description: creates an HTML page containing a number of online comics, with an easily exensible framework
- # Author: Andrew Medico <amedico@amedico.dhs.org>
- # Created: 23 Nov 2000, 23:33 EST
- # Last Modified: 24 Aug 2003, 16:55
- # Current Revision: 1.0.28
- #
- # Set up
- use strict;
- no strict qw(refs);
- use LWP::UserAgent;
- use HTTP::Request;
- use POSIX qw(strftime);
- use Getopt::Long;
- use File::Copy;
- # Variables
- my (%options, $version, $time_today, @localtime_today, @localtime_yesterday, @localtime_tomorrow, $long_date, $short_date,
- $short_date_yesterday, $short_date_tomorrow, @get, @strips, %defs, $known_strips, %groups, $known_groups, %classes, $val,
- $link_tomorrow, $no_dateparse, @base_dirparts);
- $version = "1.0.28";
- $time_today = time;
- # Get options
- GetOptions(\%options, 'quiet|q','verbose','output=s','lite','local|l','noindex',
- 'archive|a','dailydir|d','stripdir','save|s','nostale','date=s',
- 'new|n','defs=s','nopersonal','basedir=s','list','proxy=s',
- 'proxyauth=s','noenvproxy','nospaces','useragent=s','version|v','help|h',
- 'avantgo', 'random','nosystem','stripnav','nosymlinks','titles=s',
- 'retries=s','clean=s','updates=s','noupdates') or exit 1;
- # Process options:
- # Note: Blocks have been ordered so that we only do as much as absolutely
- # necessary if an error is encountered (i.e. do not load defs if --version
- # specified)
- # Help and version override anything else
- if ($options{'help'}) {
- print
- "Usage: $0 [OPTION] STRIPS
- STRIPS can be a mix of strip names and group names
- (group names must be preceeded by an '\@' symbol)
- 'all' may be used to retrieve all known strips,
- or use option --list to list available strips and groups
- Options:
- -q --quiet Turn off progress messages
- --verbose Turn on extra progress information, overrides -q
- --list List available strips
- --random Download a random strip
- --defs FILE Use alternate strips definition file
- --nopersonal Ignore ~/.dailystrips.defs
- --nosystem Ignore system-wide definitions
- --updates Read updated defs from FILE instead of
- ~/.dailystrips-updates.def
- --noupdates Ignore updated defs file
- --output FILE Output HTML to FILE instead of STDOUT
- (does not apply to local mode)
- --lite Output a reduced HTML page
- --stripnav Add links for navigation within the page
- --titles STRING Customize HTML output
- -l --local Output HTML to file and save strips locally
- --noindex Disable symlinking current page to index.html
- (local mode only)
- -a --archive Generate archive.html as a list of all days,
- (local mode only)
- -d --dailydir Create a separate directory for each day's images
- (local mode only)
- --stripdir Create a separate directory for each strip's
- images (local mode only)
- -s --save If it appears that a particular strip has been
- downloaded, does not attempt to re-download it
- (local mode only)
- --nostale If a new strip is not available, displays an error
- in the HTML output instead of showing the old image
- --nosymlinks Do not use symlinks for day-to-day duplicates
- --date DATE Use value DATE instead of local time
- (DATE is parsed by Date::Parse function)
- --avantgo Format images for viewing with Avantgo on PDAs
- (local mode only)
- --basedir DIR Work in specified directory instead of current
- directory (program will look here for previous HTML
- file and save new files here, etc.)
- --proxy host:port Use specified HTTP proxy server (overrides
- environment proxy, if set)
- --proxyauth user:pass Set username and password for proxy server
- --noenvproxy Ignore the http_proxy environment variable, if set
- --nospaces Remove spaces from image filenames (local mode
- only)
- --useragent STRING Set User-Agent: header to STRING (default is none)
- --retries NUM When downloading items, retry NUM times instead of
- default 3 times
- --clean NUM Keep only the latest NUM days of files; remove all
- older files
- -v --version Print version number
- ";
- if ($^O =~ /Win32/ ) {
- print
- "Additional Win32 Notes:
- Windows lacks a number of features and programs found on *NIX, so a number of
- changes must be made to the program's operation:
- 1. --date and --avantgo are not available
- 2. Personal and update definition files may or may not work
- 3. System-wide definition files are not supported
- ";
- } # ' please emacs perlmode
- print "\nBugs and comments to dailystrips\@amedico.dhs.org\n";
- exit;
- }
- if ($options{'version'}) {
- print "dailystrips version $version\n";
- exit;
- }
- if ($options{'date'}) {
- eval "require Date::Parse";
- if ($@ ne "") {
- die "Error: cannot use --date - Date::Parse not installed\n";
- } else {
- import Date::Parse;
- }
- unless ($time_today = str2time($options{'date'})) {
- die "Error: invalid date specified\n";
- }
- }
- # setup time variables (needed during defs parsing)
- @localtime_today = localtime $time_today;
- #long_date = strftime("\%A, \%B \%e, \%Y", @localtime_today);
- $long_date = strftime("\%A, \%B \%d, \%Y", @localtime_today);
- $short_date = strftime("\%Y.\%m.\%d", @localtime_today);
- @localtime_yesterday = localtime($time_today - ( 24 * 60 * 60 ));
- $short_date_yesterday = strftime("\%Y.\%m.\%d", @localtime_yesterday);
- @localtime_tomorrow = localtime ($time_today + 24 * 60 * 60);
- $short_date_tomorrow = strftime("\%Y.\%m.\%d", @localtime_tomorrow);
- # Get strip definitions now - info used below
- unless ($options{'defs'}) {
- if ($^O =~ /Win32/ ) {
- $options{'defs'} = 'strips.def';
- } else {
- $options{'defs'} = '/usr/share/dailystrips/strips.def';
- }
- }
- &get_defs($options{'defs'});
- # Load updated defs file
- unless (defined $options{'updates'})
- {
- $options{'updates'} = &get_homedir() . "/.dailystrips-updates.def";
- }
- unless($options{'noupdates'})
- {
- if (-r $options{'updates'}) {
- &get_defs($options{'updates'});
- }
- }
- # Get system configurable strip definitions now
- unless ($options{'nosystem'}) {
- unless (($^O =~ /Win32/) or (! -r '/etc/dailystrips.defs')) {
- &get_defs('/etc/dailystrips.defs');
- }
- }
- unless ($options{'nopersonal'}){
- my $personal_defs = &get_homedir() . "/.dailystrips.defs";
- if (-r $personal_defs) {
- &get_defs($personal_defs);
- }
- }
- $known_strips = join('|', sort keys %defs);
- $known_groups = join('|', sort keys %groups);
- if ($options{'random'}) {
- my @known_strips_array = keys %defs;
- push(@get, $known_strips_array[(rand $#known_strips_array)]);
- undef @known_strips_array;
- } else {
- # Only strips/groups to download remain in @ARGV
- # Unconfigured options were already trapped by Getopts with an 'unknown option'
- # error
- for (@ARGV) {
- if (/^($known_strips|all)$/io) {
- if ($_ eq "all") {
- push (@get, split(/\|/, $known_strips));
- } else {
- push(@get, $_);
- }
- } elsif (/^@/) {
- if (/^@($known_groups)$/io) {
- push(@get, split(/;/, $groups{$1}{'strips'}));
- } else {
- die "Error: unknown group: $_\n";
- }
- } else {
- die "Error: unknown strip: $_\n";
- }
- }
- }
- if ($options{'list'}) {
- format =
- @<<<<<<<<<<<<<<<<<<<<<<<< @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
- $_, $val
- .
- print "Available strips:\n";
- for (split(/\|/, $known_strips)) {
- $val = $defs{$_}{'name'};
- write;
- }
-
- print "\nAvailable groups:\n";
- for (split(/\|/, $known_groups)) {
- $val = $groups{$_}{'desc'};
- write;
- }
- exit;
- }
- if ($options{'dailydir'} and $options{'stripdir'}) {
- die "Error: --dailydir and --stripdir cannot be used together\n";
- }
- #Set proxy
- if ($options{'proxy'}) {
- $options{'proxy'} =~ /^(http:\/\/)?(.*?):(.+?)\/?$/i;
- unless ($2 and $3) {
- die "Error: incorrectly formatted proxy server ('http://server:port' expected)\n";
- }
-
- $options{'proxy'} = "http://$2:$3";
- }
- if (!$options{'noenvproxy'} and !$options{'proxy'} and $ENV{'http_proxy'} ) {
- $ENV{'http_proxy'} =~ /(http:\/\/)?(.*?):(.+?)\/?$/i;
- unless ($2 and $3) {
- die "Error: incorrectly formatted proxy server environment variable\n('http://server:port' expected)\n";
- }
-
- $options{'proxy'} = "http://$2:$3";
- }
- if ($options{'proxyauth'}) {
- unless ($options{'proxyauth'} =~ /^.+?:.+?$/) {
- die "Error: incorrectly formatted proxy credentials ('user:pass' expected)\n";
- }
- }
- # Handle/validate other options
- if ($options{'clean'} =~ m/\D/) {
- die "Error: 'clean' value must be numeric\n";
- }
- if ($options{'retries'} =~ m/\D/) {
- die "Error: 'retries' value must be numeric\n";
- }
- unless ($options{'retries'}) {
- $options{'retries'} = 3;
- }
- if ($options{'basedir'}) {
- unless (chdir $options{'basedir'}) {
- die "Error: could not change directory to $options{'basedir'}\n";
- }
- }
- if ($options{'titles'}) {
- $options{'titles'} .= " ";
- }
- unless (@get) {
- die "Error: no strip specified (--list to list available strips)\n";
- }
- # verbose overrides quiet
- if ($options{'verbose'} and $options{'quiet'}) {
- undef $options{'quiet'};
- }
- # Un-needed vars
- undef $known_strips; undef $known_groups; undef $val;
- # Go
- unless ($options{'quiet'}) {
- warn "dailystrips $version starting:\n";
- }
- # Report proxy settings
- if ($options{'proxy'}) {
- if ($options{'verbose'}) {
- warn "Using proxy server $options{'proxy'}\n";
- }
-
- if ($options{'verbose'} and $options{'proxy_auth'}) {
- warn "Using proxy server authentication\n";
- }
- }
- if ($options{'local'}) {
- unless ($options{'quiet'}) {
- warn "Operating in local mode\n";
- }
-
- if ($options{'dailydir'}) {
- unless ($options{'quiet'}) {
- warn "Operating in daily directory mode\n";
- }
-
- unless (-d $short_date) {
- # any issues with masks and Win32?
- unless(mkdir ($short_date, 0755)) {
- die "Error: could not create today's directory ($short_date/)\n";
- }
- }
- }
-
- unless(open(STDOUT, ">dailystrips-$short_date.html")) {
- die "Error: could not open HTML file (dailystrips-$short_date.html) for writing\n";
- }
- unless ($options{'date'}) {
- unless ($options{'noindex'}) {
- unless ($^O =~ /Win32/) {
- unlink("index.html");
- system("ln -s dailystrips-$short_date.html index.html");
- }
- }
- }
- if ($options{'archive'}) {
-
- unless (-e "archive.html") {
- # Doesn't exist.. create
- open(ARCHIVE, ">archive.html") or die "Error: could not create archive.html\n";
- print ARCHIVE
- "<html>
- <head>
- <title>$options{'titles'}dailystrips archive</title>
- </head>
- <body bgcolor=\"#ffffff\" text=\"#000000\" link=\"#0000ff\" vlink=\"#ff00ff\" alink=\"#ff0000\">
- <p align=\"center\">\n
- <font face=\"helvetica,arial\" size=\"14pt\">$options{'titles'}dailystrips archive</font>
- </p>
- <p>
- <font face=\"helvetica,arial\">
- <!--insert below-->
- </font>
- </p>
- </body>
- </html>";
- close(ARCHIVE);
- }
-
- open(ARCHIVE, "<archive.html") or die "Error: could not open archive.html for reading\n";
- my @archive = <ARCHIVE>;
- close(ARCHIVE);
- unless (grep(/<a href="dailystrips-$short_date.html">/, @archive)) {
- for (@archive) {
- if (s/(<!--insert below-->)/$1\n<a href="dailystrips-$short_date.html">$long_date<\/a><br>/) {
- unless(open(ARCHIVE, ">archive.html")) {
- die "Error: could not open archive.html for writing\n";
- }
-
- print ARCHIVE @archive;
- close(ARCHIVE);
- last;
- }
- }
- }
- }
-
- # Update previous day's file with a "Next Day" link to today's file
- if (open(PREVIOUS, "<dailystrips-$short_date_yesterday.html")) {
- my @previous_page = <PREVIOUS>;
- close(PREVIOUS);
-
- # Don't bother if no tag exists in the file (because it has already been updated)
- if (grep(/<!--nextday-->/, @previous_page)) {
- my $match_count;
- for (@previous_page) {
- if (s/<!--nextday-->/ | <a href="dailystrips-$short_date.html">Next day<\/a>/) {
- $match_count++;
- last if ($match_count == 2);
- }
- }
-
- if (open(PREVIOUS, ">dailystrips-$short_date_yesterday.html")) {
- print PREVIOUS @previous_page;
- close(PREVIOUS);
- } else {
- warn "Warning: could not open dailystrips-$short_date_yesterday.html for writing\n";
- }
- } else {
- warn "Warning: did not find any tag in previous day's file to make today's link\n";
- }
- } else {
- warn "Warning: could not open dailystrips-$short_date_yesterday.html for reading\n";
- }
- } elsif ($options{'output'}) {
- unless ($options{'quiet'}) {
- warn "Writing to file $options{'output'}\n";
- }
-
- unless (open(STDOUT, ">$options{'output'}")) {
- die "Error: Could not open output file ($options{'output'}) for writing\n";
- }
- }
- # Download image URLs
- unless ($options{'quiet'}) {
- if ($options{'verbose'}) {
- warn "\nRetrieving URLS:\n"
- } else {
- print STDERR "\nRetrieving URLS..."
- }
- }
- for (@get) {
- if ($options{'verbose'}) { warn "Retrieving URL for $_\n" }
- &get_strip($_);
- }
- unless ($options{'quiet'}) {
- if ($options{'verbose'}) {
- warn "Retrieving URLS: done\n"
- } else {
- warn "done\n"
- }
- }
- if (-e "dailystrips-$short_date_tomorrow.html") {
- $link_tomorrow = " | <a href=\"dailystrips-$short_date_tomorrow.html\">Next day</a>"
- } else {
- $link_tomorrow = "<!--nextday-->"
- }
- # Generate HTML page
- if ($options{'lite'}) {
- print "<font face=\"helvetica\" size=\"+2\"><b><u>$options{'titles'}dailystrips for $long_date</u></b></font><br><br>\n";
- } else {
- my $topanchor;
- if ($options{'stripnav'}) {
- $topanchor = "\n<a name=\"top\">\n";
- }
- print
- "<html>
- <head>
- <title>$options{'titles'}dailystrips for $long_date</title>
- </head>
- <body bgcolor=\"#ffffff\" text=\"#000000\" link=\"#ff00ff\">
- $topanchor
- <center>
- <font face=\"helvetica\" size=\"+2\"><b><u>$options{'titles'}dailystrips for $long_date</u></b></font>
- </center>
- <p><font face=\"helvetica\">
- < <a href=\"dailystrips-$short_date_yesterday.html\">Previous day</a>$link_tomorrow";
-
- if ($options{'archive'}) {
- print " | <a href=\"archive.html\">Archives</a>";
- }
-
- print
- " >
- </font></p>
- ";
- if ($options{'stripnav'}) {
- print "<font face=\"helvetica\">Strips:</font><br>\n";
- for (@strips) {
- my ($strip, $name) = (split(/;/, $_))[0,1];
- print "<a href=\"#$strip\">$name</A> ";
- }
- print "\n<br><br>";
- }
- print "\n\n<table border=\"0\">\n";
- }
- if ($options{'local'} and !$options{'quiet'}) {
- if ($options{'verbose'}) {
- warn "\nDownloading strip files:\n"
- } else {
- print STDERR "Downloading strip files...";
- }
- }
- for (@strips) {
- my ($strip, $name, $homepage, $img_addr, $referer, $prefetch, $artist) = split(/;/, $_);
- my ($img_line, $local_name, $local_name_dir, $local_name_file, $local_name_ext, $image, $ext,
- $local_name_yesterday, $local_name_yesterday_dir, $local_name_yesterday_file, $local_name_yesterday_ext);
-
- if ($options{'verbose'} and $options{'local'}) {
- warn "Downloading strip file for " . lc((split(/;/, $_))[0]) . "\n";
- }
-
- if ($img_addr =~ "^unavail") {
- if ($options{'verbose'}) {
- warn "Error: $strip: could not retrieve URL\n";
- }
- $img_line = "[Error - unable to retrieve URL]";
- } else {
- if ($options{'local'}) {
- # local mode - download strips
- $img_addr =~ /http:\/\/(.*)\/(.*)\.(.*?)([?&].+)?$/;
- if (defined $3) { $ext = ".$3" }
- # prepare file names
- if ($options{'stripdir'}) {
- $local_name_yesterday = "$name/$short_date_yesterday$ext";
- $local_name_yesterday_dir = "$name/";
- $local_name_yesterday_file = $short_date_yesterday;
- $local_name_yesterday_ext = $ext;
-
- $local_name = "$name/$short_date$ext";
- $local_name_dir = "$name/";
- $local_name_file = "$short_date";
- $local_name_ext = "$ext";
- } elsif ($options{'dailydir'}) {
- $local_name_yesterday = "$short_date_yesterday/$name-$short_date_yesterday$ext";
- $local_name_yesterday_dir = "$short_date_yesterday/";
- $local_name_yesterday_file = "$name-$short_date_yesterday";
- $local_name_yesterday_ext = "$ext";
-
- $local_name = "$short_date/$name-$short_date$ext";
- $local_name_dir = "$short_date/";
- $local_name_file = "$name-$short_date";
- $local_name_ext = "$ext";
- } else {
- $local_name_yesterday = "$name-$short_date_yesterday$ext";
- $local_name_yesterday_dir = "./";
- $local_name_yesterday_file = "$name-$short_date_yesterday";
- $local_name_yesterday_ext = "$ext";
-
- $local_name = "$name-$short_date$ext";
- $local_name_dir = "./";
- $local_name_file = "$name-$short_date";
- $local_name_ext = "$ext";
- }
-
- if ($options{'nospaces'}) {
- # impossible to tell for sure if previous day's file
- # used --nospaces or not, but this should work more
- # often
- $local_name_yesterday =~ s/\s+//g;
- $local_name_yesterday_dir =~ s/\s+//g;
- $local_name_yesterday_file =~ s/\s+//g;
-
- $local_name =~ s/\s+//g;
- $local_name_dir =~ s/\s+//g;
- $local_name_file =~ s/\s+//g;
- }
-
- # do ops that depend on file name
- if ($options{'stripdir'}) {
- unless (-d $local_name_dir) {
- # any issues with masks and Win32?
- mkdir $local_name_dir, 0755;
- }
- }
-
- if ($options{'save'} and -e $local_name) {
- # already have a suitable local file - skip downloading
- if ($options{'avantgo'}) {
- $img_line = &make_avantgo_table($local_name, $ext);
- } else {
- $img_addr = $local_name;
- $img_addr =~ s/ /\%20/go;
- if ($options{'stripnav'}) {
- $img_line = "<img src=\"$img_addr\" alt=\"$name\"><br><a href=\"#top\">Return to top</a>";
- } else {
- $img_line = "<img src=\"$img_addr\" alt=\"$name\">";
- }
- }
- } else {
- # need to download
- if ($prefetch) {
- if (&http_get($prefetch, $referer) =~ m/^ERROR/) {
- warn "Error: $strip: could not download prefetch URL\n";
- $image = "ERROR";
- } else {
- $image = &http_get($img_addr, $referer);
- }
- } else {
- $image = &http_get($img_addr, $referer);
- #$image = &http_get($img_addr, "");
- }
-
- if ($image =~ /^ERROR/) {
- # couldn't get the image
- # FIXME: what to do if a file for the day has already been
- # downloaded, but downloading fails when script is run again
- # that day? maybe reuse existing file instead of throwing
- # error?
- if (-e $local_name) {
- # an image file for today already exists.. jump to outputting code
- #warn "DEBUG: couldn't download strip, but we already have it\n";
- goto HAVE_IMAGE;
- } else {
- if ($options{'verbose'}) {
- warn "Error: $strip: could not download strip\n";
- }
- }
-
- $img_line = "[Error - unable to download image]";
- } else {
- HAVE_IMAGE:
- # got the image
- if ($^O =~ /Win32/) {
- # can't do any diff checking on windows (easily, that is - it is doable)
- open(IMAGE, ">$local_name");
- binmode(IMAGE);
- print IMAGE $image;
- close(IMAGE);
-
- $img_addr = $local_name;
- $img_addr =~ s/ /\%20/go;
- if ($options{'stripnav'}) {
- $img_line = "<img src=\"$img_addr\" alt=\"$name\"><br><a href=\"#top\">Return to top</a>";
- } else {
- $img_line = "<img src=\"$img_addr\" alt=\"$name\">";
- }
- } else {
- # FIXME: only download to .tmp if earlier file exists
- open(IMAGE, ">$local_name.tmp");
- binmode(IMAGE);
- print IMAGE $image;
- close(IMAGE);
-
- if (-e $local_name and system("diff \"$local_name\" \"$local_name.tmp\" >/dev/null 2>&1") == 0) {
- # already downloaded the same strip earlier today
- unlink("$local_name.tmp");
-
- if ($options{'avantgo'}) {
- $img_line = &make_avantgo_table($local_name, $ext);
- } else {
- $img_addr = $local_name;
- $img_addr =~ s/ /\%20/go;
- if ($options{'stripnav'}) {
- $img_line = "<img src=\"$img_addr\" alt=\"$name\"><br><a href=\"#top\">Return to top</a>";
- } else {
- $img_line = "<img src=\"$img_addr\" alt=\"$name\">";
- }
- }
- } elsif (system("diff \"$local_name_yesterday\" \"$local_name.tmp\" >/dev/null 2>&1") == 0) {
- # same strip as yesterday
- if ($options{'nosymlinks'}) {
- system("mv","$local_name.tmp","$local_name");
- } else {
- unlink("$local_name.tmp");
- if ($options{'stripdir'} or $options{'dailydir'}) {
- system("ln -s \"../$local_name_yesterday\" \"$local_name\" >/dev/null 2>&1");
- } else {
- system("ln -s \"$local_name_yesterday\" \"$local_name\" >/dev/null 2>&1");
- }
- }
-
- if ($options{'nostale'}) {
- $img_line = "[Error - new strip not available]";
- } else {
- $img_addr = $local_name;
- $img_addr =~ s/ /\%20/go;
- if ($options{'stripnav'}) {
- $img_line = "<img src=\"$img_addr\" alt=\"$name\"><br><a href=\"#top\">Return to top</a>";
- } else {
- $img_line = "<img src=\"$img_addr\" alt=\"$name\">";
- }
- }
- } else {
- # completely new strip
- # possible to get here by:
- # -downloading a strip for the first time in a day
- # -downloading an updated strip that replaces an old one downloaded at
- # an earlier time on the same day
- system("mv","$local_name.tmp","$local_name");
-
- if ($options{'avantgo'}) {
- &make_avantgo_files($local_name, $local_name_ext);
- $img_line = &make_avantgo_table($local_name, $ext);
- } else {
- $img_addr = $local_name;
- $img_addr =~ s/ /\%20/go;
- if ($options{'stripnav'}) {
- $img_line = "<img src=\"$img_addr\" alt=\"$name\"><br><a href=\"#top\">Return to top</a>";
- } else {
- $img_line = "<img src=\"$img_addr\" alt=\"$name\">";
- }
- }
- }
- }
- }
- }
- } else {
- # regular mode - just give addresses to strips on their webserver
- if ($options{'stripnav'}) {
- $img_line = "<img src=\"$img_addr\" alt=\"$name\"><br><a href=\"#top\">Return to top</a>";
- } else {
- $img_line = "<img src=\"$img_addr\" alt=\"$name\">";
- }
- }
- }
-
- if ($artist) {
- $artist = " by $artist";
- }
-
- if ($options{'lite'}){
- print
- "<font face=\"helvetica\" size=\"+1\"><b><a href=\"$homepage\">$name</a>$artist</b></font><br>
- $img_line<br>
- <br>
- ";
- } else {
- my $stripanchor;
- if ($options{'stripnav'}) {
- $stripanchor = "<a name=\"$strip\">";
- }
-
- print
- " <tr>
- <td>
- <font face=\"helvetica\" size=\"+1\"><b>$stripanchor<a href=\"$homepage\">$name</a>$artist</b></font>
- </td>
- </tr>
- <tr>
- <td>
- $img_line
- <p> </p>
- </td>
- </tr>
- ";
- }
- }
- if ($options{'local'} and !$options{'quiet'}) {
- if ($options{'verbose'}) {
- warn "Downloading strip files: done\n"
- } else {
- warn "done\n"
- }
- }
- unless ($options{'lite'}) {
- print
- "</table>
- <p><font face=\"helvetica\">
- < <a href=\"dailystrips-$short_date_yesterday.html\">Previous day</a>$link_tomorrow";
- if ($options{'archive'}) {
- print " | <a href=\"archive.html\">Archives</a>";
- }
-
- print
- " >
- </font></p>
- <font face=\"helvetica\">Generated by dailystrips $version</font>
- </body>
- </html>
- ";
- }
- if (!$options{'date'} and !$options{'noindex'} and $^O =~ /Win32/) {
- # no symlinks on windows.. just make a copy of the file
- close(STDOUT);
- copy("dailystrips-$short_date.html","index.html");
- }
- # Clean out old files, if requested
- if ($options{'clean'}) {
- unless ($options{'quiet'}) {
- print STDERR "Cleaning files older than $options{'clean'} days...";
- }
-
- unless (system("perl -S dailystrips-clean --quiet $options{'clean'}")) {
- unless ($options{'quiet'}) {
- print STDERR "done\n";
- }
- }
- else {
- warn "failed\nWarning: could not run dailystrips-clean script\n";
- }
-
-
- }
- sub http_get {
- my ($url, $referer) = @_;
- my ($request, $response, $status);
- # default value
- #unless ($retries) {
- # $retries = 3;
- #}
- if ($referer eq "") {$referer = $url;}
- my $headers = new HTTP::Headers;
- $headers->proxy_authorization_basic(split(/:/, $options{'proxyauth'}));
- $headers->referer($referer);
-
- my $ua = LWP::UserAgent->new;
- $ua->agent($options{'useragent'});
- $ua->proxy('http', $options{'proxy'});
-
- for (1 .. $options{'retries'}) {
- # main request
- $request = HTTP::Request->new('GET', $url, $headers);
- $response = $ua->request($request);
- ($status = $response->status_line()) =~ s/^(\d+)/$1:/;
- if ($response->is_error()) {
- if ($options{'verbose'}) {
- warn "Warning: could not download $url: $status (attempt $_ of $options{'retries'})\n";
- }
- } else {
- return $response->content;
- }
- }
- # if we get here, URL retrieval completely failed
- warn "Warning: failed to download $url\n";
- return "ERROR: $status";
- }
- sub get_strip {
- my ($strip) = @_;
- my ($page, $addr);
-
- if ($options{'date'} and $defs{$strip}{'provides'} eq "latest") {
- if ($options{'verbose'}) {
- warn "Warning: strip $strip not compatible with --date, skipping\n";
- }
-
- next;
- }
-
- if ($defs{$strip}{'type'} eq "search") {
- $page = &http_get($defs{$strip}{'searchpage'});
- if ($page =~ /^ERROR/) {
- if ($options{'verbose'}) {
- warn "Error: $strip: could not download searchpage $defs{$strip}{'searchpage'}\n";
- }
-
- $addr = "unavail-server";
- } else {
- $page =~ /$defs{$strip}{'searchpattern'}/si;
- my @regexmatch;
- for (1..9) {
- $regexmatch[$_] = ${$_};
- #warn "regex match #$_: ${$_}\n";
- }
- unless (${$defs{$strip}{'matchpart'}}) {
- if ($options{'verbose'}) {
- warn "Error: $strip: searchpattern $defs{$strip}{'searchpattern'} did not match anything in searchpage $defs{$strip}{'searchpage'}\n";
- }
-
- $addr = "unavail-nomatch";
- } else {
- my $match = ${$defs{$strip}{'matchpart'}};
- if ($defs{$strip}{'imageurl'}) {
- $addr = $defs{$strip}{'imageurl'};
- $addr =~ s/\$match_(\d)/$regexmatch[$1]/ge;
- $addr =~ s/\$match/$match/ge;
- } else {
- $addr = $defs{$strip}{'baseurl'} . $match . $defs{$strip}{'urlsuffix'};
- }
- }
- }
-
- } elsif ($defs{$strip}{'type'} eq "generate") {
- $addr = $defs{$strip}{'baseurl'} . $defs{$strip}{'imageurl'};
- }
-
- unless ($addr =~ /^(http:\/\/|unavail)/io) { $addr = "http://" . $addr }
-
- push(@strips,"$strip;$defs{$strip}{'name'};$defs{$strip}{'homepage'};$addr;$defs{$strip}{'referer'};$defs{$strip}{'prefetch'};$defs{$strip}{'artist'}");
- }
- sub get_defs {
- my $defs_file = shift;
- my ($strip, $class, $sectype, $group);
- my $line;
-
- unless(open(DEFS, "<$defs_file")) {
- die "Error: could not open strip definitions file $defs_file\n";
- }
-
- my @defs_file = <DEFS>;
- close(DEFS);
-
- if ($options{'verbose'}) {
- warn "Loading definitions from file $defs_file\n";
- }
-
- for (@defs_file) {
- $line++;
-
- chomp;
- s/#(.*)//; s/^\s*//; s/\s*$//;
- next if $_ eq "";
- if (!$sectype) {
- if (/^strip\s+(\w+)$/i)
- {
- if (defined ($defs{$1}))
- {
- undef $defs{$1};
- }
-
- $strip = $1;
- $sectype = "strip";
- }
- elsif (/^class\s+(.*)$/i)
- {
- if (defined ($classes{$1}))
- {
- undef $classes{$1};
- }
-
- $class = $1;
- $sectype = "class";
- }
- elsif (/^group\s+(.*)$/i)
- {
- if (defined ($groups{$1}))
- {
- undef $groups{$1};
- }
-
- $group = $1;
- $sectype = "group";
- }
- elsif (/^(.*)/)
- {
- die "Error: Unknown keyword '$1' at $defs_file line $line\n";
- }
- }
- elsif (/^end$/i)
- {
- if ($sectype eq "class")
- {
- undef $class
- }
- elsif ($sectype eq "strip")
- {
- if ($defs{$strip}{'useclass'}) {
- my $using_class = $defs{$strip}{'useclass'};
-
- # import vars from class
- for (qw(homepage searchpage searchpattern baseurl imageurl urlsuffix referer prefetch artist)) {
- if ($classes{$using_class}{$_} and !$defs{$strip}{$_}) {
- my $classvar = $classes{$using_class}{$_};
- $classvar =~ s/(\$[0-9])/$defs{$strip}{$1}/g;
- $classvar =~ s/\$strip/$strip/g;
- $defs{$strip}{$_} = $classvar;
- }
- }
-
- for (qw(type matchpart provides)) {
- if ($classes{$using_class}{$_} and !$defs{$strip}{$_}) {
- $defs{$strip}{$_} = $classes{$using_class}{$_};
- }
- }
- }
-
- #substitute auto vars for real vals here/set defaults
- unless ($defs{$strip}{'searchpage'}) {$defs{$strip}{'searchpage'} = $defs{$strip}{'homepage'}}
- unless ($defs{$strip}{'referer'}) {
- if ($defs{$strip}{'searchpage'}) {
- $defs{$strip}{'referer'} = $defs{$strip}{'searchpage'}
- } else {
- $defs{$strip}{'referer'} = $defs{$strip}{'homepage'}
- }
- }
-
- #other vars in definition
- for (qw(homepage searchpage searchpattern imageurl baseurl urlsuffix referer prefetch)) {
- if ($defs{$strip}{$_}) {
- $defs{$strip}{$_} =~ s/\$(name|homepage|searchpage|searchpattern|imageurl|baseurl|referer|prefetch)/$defs{$strip}{$1}/g;
- }
- }
-
- #dates
- for (qw(homepage searchpage searchpattern imageurl baseurl urlsuffix referer prefetch)) {
- if ($defs{$strip}{$_}) {
- $defs{$strip}{$_} =~ s/(\%(-?)[a-zA-Z])/strftime("$1", @localtime_today)/ge;
- }
- }
-
- # <code:> stuff
- for (qw(homepage searchpage searchpattern imageurl baseurl urlsuffix referer)) {
- if ($defs{$strip}{$_}) {
- $defs{$strip}{$_} =~ s/<code:(.*?)(?<!\\)>/&my_eval($1)/ge;
- }
- }
-
- #sanity check vars
- for (qw(name homepage type)) {
- unless ($defs{$strip}{$_}) {
- die "Error: strip $strip has no '$_' value\n";
- }
- }
-
- for (qw(homepage searchpage baseurl imageurl)){
- if ($defs{$strip}{$_} and $defs{$strip}{$_} !~ /^http:\/\//io) {
- die "Error: strip $strip has invalid $_\n"
- }
- }
-
- if ($defs{$strip}{'type'} eq "search") {
- unless ($defs{$strip}{'searchpattern'}) {
- die "Error: strip $strip has no 'searchpattern' value in $defs_file\n";
- }
-
- unless ($defs{$strip}{'searchpattern'} =~ /\(.+\)/) {
- die "Error: strip $strip has no parentheses in searchpattern\n";
- }
-
- unless ($defs{$strip}{'matchpart'}) {
- #die "Error: strip $strip has no 'matchpart' value in $defs_file\n";
- $defs{$strip}{'matchpart'} = 1;
- }
-
- if ($defs{$strip}{'imageurl'} and ($defs{$strip}{'baseurl'} or $defs{$strip}{'urlsuffix'})) {
- die "Error: strip $strip: cannot use both 'imageurl' at the same time as 'baseurl'\nor 'urlsuffix'\n";
- }
- } elsif ($defs{$strip}{'type'} eq "generate") {
- unless ($defs{$strip}{'imageurl'}) {
- die "Error: strip $strip has no 'imageurl' value in $defs_file\n";
- }
- }
-
- unless ($defs{$strip}{'provides'}) {
- die "Error: strip $strip has no 'provides' value in $defs_file\n";
- }
-
- #debugger
- #foreach my $strip (keys %defs) {
- # foreach my $key (qw(homepage searchpage searchpattern imageurl baseurl referer prefetch)) {
- # warn "DEBUG: $strip:$key=$defs{$strip}{$key}\n";
- # }
- # #warn "DEBUG: $strip:name=$defs{$strip}{'name'}\n";
- #}
-
- undef $strip;
- }
- elsif ($sectype eq "group")
- {
- chop $groups{$group}{'strips'};
-
- unless ($groups{$group}{'desc'}) {
- $groups{$group}{'desc'} = "[No description]";
- }
-
- undef $group;
- }
-
- undef $sectype;
- }
- elsif ($sectype eq "class") {
- if (/^homepage\s+(.+)$/i) {
- $classes{$class}{'homepage'} = $1;
- }
- elsif (/^type\s+(.+)$/i)
- {
- unless ($1 =~ /^(search|generate)$/io) {
- die "Error: invalid type at $defs_file line $line\n";
- }
-
- $classes{$class}{'type'} = $1;
- }
- elsif (/^searchpage\s+(.+)$/i)
- {
- $classes{$class}{'searchpage'} = $1;
- }
- elsif (/^searchpattern\s+(.+)$/i)
- {
- $classes{$class}{'searchpattern'} = $1;
- }
- elsif (/^matchpart\s+(.+)$/i)
- {
- unless ($1 =~ /^(\d)$/) {
- die "Error: invalid 'matchpart' at $defs_file line $line\n";
- }
-
- $classes{$class}{'matchpart'} = $1;
- }
- elsif (/^baseurl\s+(.+)$/i)
- {
- $classes{$class}{'baseurl'} = $1;
- }
- elsif (/^urlsuffix\s+(.+)$/i)
- {
- $classes{$class}{'urlsufix'} = $1;
- }
- elsif (/^imageurl\s+(.+)$/i)
- {
- $classes{$class}{'imageurl'} = $1;
- }
- elsif (/^referer\s+(.+)$/i)
- {
- $classes{$class}{'referer'} = $1;
- }
- elsif (/^prefetch\s+(.+)$/i)
- {
- $classes{$class}{'prefetch'} = $1;
- }
- elsif (/^provides\s+(.+)$/i)
- {
- unless ($1 =~ /^(any|latest)$/i) {
- die "Error: invalid 'provides' at $defs_file line $line\n";
- }
- $classes{$class}{'provides'} = $1;
- }
- elsif (/^artist\s+(.+)$/i)
- {
- $classes{$class}{'artist'} = $1;
- }
- elsif (/^(.+)\s+?/)
- {
- die "Unknown keyword '$1' at $defs_file line $line\n";
- }
- }
- elsif ($sectype eq "strip") {
- if (/^name\s+(.+)$/i)
- {
- $defs{$strip}{'name'} = $1;
- }
- elsif (/^useclass\s+(.+)$/i)
- {
- unless (defined $classes{$1}) {
- die "Error: strip $strip references invalid class $1 at $defs_file line $line\n";
- }
- $defs{$strip}{'useclass'} = $1;
- }
- elsif (/^homepage\s+(.+)$/i) {
- $defs{$strip}{'homepage'} = $1;
- }
- elsif (/^type\s+(.+)$/i)
- {
- unless ($1 =~ /^(search|generate)$/i) {
- die "Error: invalid 'type' at $defs_file line $line\n";
- }
-
- $defs{$strip}{'type'} = $1;
- }
- elsif (/^searchpage\s+(.+)$/i)
- {
- $defs{$strip}{'searchpage'} = $1;
- }
- elsif (/^searchpattern\s+(.+)$/i)
- {
- $defs{$strip}{'searchpattern'} = $1;
- }
- elsif (/^matchpart\s+(.+)$/i)
- {
- unless ($1 =~ /^(\d+)$/) {
- die "Error: invalid 'matchpart' at $defs_file line $line\n";
- }
-
- $defs{$strip}{'matchpart'} = $1;
- }
- elsif (/^baseurl\s+(.+)$/i)
- {
- $defs{$strip}{'baseurl'} = $1;
- }
- elsif (/^urlsuffix\s+(.+)$/i)
- {
- $defs{$strip}{'urlsuffix'} = $1;
- }
- elsif (/^imageurl\s+(.+)$/i)
- {
- $defs{$strip}{'imageurl'} = $1;
- }
- elsif (/^referer\s+(.+)$/i)
- {
- $defs{$strip}{'referer'} = $1;
- }
- elsif (/^prefetch\s+(.+)$/i)
- {
- $defs{$strip}{'prefetch'} = $1;
- }
- elsif (/^(\$\d)\s+(.+)$/)
- {
- $defs{$strip}{$1} = $2;
- }
- elsif (/^provides\s+(.+)$/i)
- {
- unless ($1 =~ /^(any|latest)$/i) {
- die "Error: invalid 'provides' at $defs_file line $line\n";
- }
-
- $defs{$strip}{'provides'} = $1;
- }
- elsif (/^artist\s+(.+)$/i)
- {
- $defs{$strip}{'artist'} = $1;
- }
- elsif (/^(.+)\s+?/)
- {
- die "Error: Unknown keyword '$1' at $defs_file line $line, in strip $strip\n";
- }
- } elsif ($sectype eq "group") {
- if (/^desc\s+(.+)$/i)
- {
- $groups{$group}{'desc'} = $1;
- }
- elsif (/^include\s+(.+)$/i)
- {
- $groups{$group}{'strips'} .= join(';', split(/\s+/, $1)) . ";";
- }
- elsif (/^exclude\s+(.+)$/i)
- {
- $groups{$group}{'nostrips'} .= join(';', split(/\s+/, $1)) . ";";
- }
- elsif (/^(.+)\s+?/)
- {
- die "Error: Unknown keyword '$1' at $defs_file line $line, in group $group\n";
- }
- }
- }
-
- # Post-processing validation
- for $group (keys %groups) {
- my (@strips, %nostrips, @okstrips);
-
- if (defined($groups{$group}{'nostrips'})) {
- @strips = sort(keys(%defs));
- foreach (split (/;/,$groups{$group}{'nostrips'})) {
- $nostrips{$_} = 1;
- }
- } else {
- @strips = split(/;/, $groups{$group}{'strips'});
- %nostrips = (); #empty
- }
- foreach (@strips) {
- unless ($defs{$_}) {
- warn "Warning: group $group references non-existant strip $_\n";
- }
-
- next if ($nostrips{$_});
- push (@okstrips,$_);
- }
- $groups{$group}{'strips'} = join(';',@okstrips);
- }
-
- }
- sub my_eval {
- my ($code) = @_;
-
- $code =~ s/\\\>/\>/g;
-
- return eval $code;
- #print STDERR "DEBUG: eval returned: " . scalar(eval $code) . ", errors: $!\n";
- }
- sub make_avantgo_table {
- my ($file, $file_ext) = @_;
- my ($rows, $cols, $table);
-
- my $dimensions = `identify \"$file\"`;
-
- $dimensions =~ m/^$file (\d+)x(\d+)/;
- my $width = $1; my $height = $2;
-
- if (int($width/160) != ($width/160)) {
- $cols = int($width/160) + 1;
- } else {
- $cols = $width/160;
- }
-
- if (int($height/160) != ($height/160)) {
- $rows = int($height/160) + 1;
- } else {
- $rows = $height/160;
- }
-
- my $file_base = $file; $file_base =~ s/$file_ext$//;
- $file_base =~ s/ /\%20/g;
-
- $table = "<table border=0 cellspacing=0 cellpadding=0>";
- foreach my $row (0 .. ($rows-1)) {
- $table .= "<tr>";
- foreach my $col (0 .. ($cols-1)) {
- $table .= "<td><img src=$file_base-" . (($row * $cols) + $col) . "$file_ext></td>";
-
- }
- $table .= "</tr>";
- }
- $table .= "</table>";
-
- return $table;
- }
- sub make_avantgo_files {
- my ($file, $file_ext) = @_;
- my $file_base = $file; $file_base =~ s/$file_ext$//;
- system("convert -crop 160x160 \"$file\" \"$file_base-\%d$file_ext\"");
- }
- sub get_homedir
- {
- if ($^O =~ /Win32/ )
- {
- my $dir = $ENV{'USERPROFILE'};
- if ($dir eq "") {$dir = $ENV{'WINDIR'};}
- $dir =~ s|\\|/|g;
- return $dir;
- }
- else
- {
- return (getpwuid($>))[7];
- }
- }