#!/usr/bin/perl -w

#
# See http://develooper.com/ufget/ for installation instructions.
#
# For the impatient:
#
#   Save this file as ufget and run the command
#
#      chmod a+x ufget
#
#  You can then run ufget as ./ufget   
#

use strict;
use Config;
use Getopt::Long;
use Carp;
use vars qw($VERSION);

$VERSION = "1.51";

=pod

=head1 NAME

ufget

=head1 SYNOPSIS

./ufget localfile

=head1 DESCRIPTION

Fetches the latest Userfriendly comic strip from
userfriendly.org. Supports mirroring so we don't download the whole
file unless it's changed.

=head1 OPTIONS

All options can be negated by preceding them with "no". For example
--noverbose.

If you include %DATE% in the filename it will be replaced with the
current date (in PST time, as userfriendly seems to be running
PST). Likewise %DATEDIR% will create a year/month/ directory
structure.

Examples:

  ./ufget ~/public_html/uf/uf%DATE%.gif
  ./ufget ~/public_html/uf/%DATEDIR%/%DATE%.gif


=over 4

=item --verbose

Don't report how it went if everything was okay.

=item --check-version

Check if we are running the latest version of ufget.

=item --upgrade

Fetch and install the latest version of ufget.

=item --htmlfile filename

Create the specified file with the days image file and a link to
userfriendly.org. This is useful for inclusion from another page as a
server side include. (Your browsers start page for example :-) )

If you have the optional module Image::Size installed the <IMG SRC...>
tag will include the width= and height= parameters.

If you have the optional module Date::Format installed the link to
userfriendly will be directly to the days fast archive page at
userfriendly.org.

=item --htmlbase

Set to the virtual directory where the days file will be downloaded if
not to the same directory as the --htmlfile will appear on. Useful
with the %DATEDIR% feature or if your images are on a different server
than the html.

Examples:

  ./ufget --htmlfile uf.html --htmlbase http://example.com/ufarc/ uf%DATE%.gif
  ./ufget --htmlfile uf.html --htmlbase uf/%DATEDIR% uf/%DATEDIR%/%DATE%

=back

=head1 SUPPORT

See http://develooper.com/ufget/

=head1 COPYRIGHT

This program is Copyright 2000 Ask Bjoern Hansen. It is distributed
under the same terms as Perl.

=cut

sub run {
  my @ar = @_;
  my $parms = ref $ar[-1] eq "HASH" ? pop @ar : {};

  print "Running: ", join(" ",@ar), "\n" unless $parms->{silent};

  return 1 if system (@ar) == 0;

  my $exit_value = $? >> 8;
  my $msg = "system @ar failed: $exit_value ($?)";
  croak $msg unless $parms->{failok};
  print "$msg\n";
  return 0;
}

sub load_module {
  my $module = shift;
  my $parms = ref $_[-1] eq "HASH" ? pop @_ : {};

  (my $module_file = "$module.pm") =~ s!::!/!g;

  eval {
    require $module_file;
    $module->import;
  };

  if ($@ =~ /locate $module_file/) {
    return 0 if ($parms->{fail_ok});
    die qq[\nYou need to install the $module module\n\nTry running\n\n  perl -MCPAN -e 'install "$module"'\n\nas root\n\n];
  }        

  die $@ if $@;

  return 1;
}

sub check_version {
  my $version_available = get ("http://updates.develooper.com/ufget/VERSION?$VERSION");
  return 0 unless $version_available
    and ($version_available =~ m/^(\d+\.\d+)/m)[0] > $VERSION;
  print "\nNew version of dnetcup available at http://develooper.com/ufget/\n";
  print "or use to --upgrade to do it automagically.\n";
  print "\n$version_available\n";
  return 1;
}

sub upgrade {
  return unless check_version;
  if (mirror ("http://develooper.com/ufget/ufget", $0) == 200) {
    chmod 0755, $0 or warn "Could not fix modes on $0";
    print "ufget upgraded. please run again to use the new version\n";
    exit;
  }
}


my %opts = (
  "version-check" => 1,
  "upgrade"       => 0,
  "verbose"       => 0,
  "htmlfile"      => "",
  "htmlbase"      => "",
);

GetOptions(\%opts,
           'version-check',
           'upgrade',
           'verbose',
           'htmlfile=s',
           'htmlbase=s',
          );

(my $localfile) = @ARGV;

help() unless $localfile;

if ($localfile =~ m/%DATE(DIR)?%/i) {
  load_module("Date::Format");
  $localfile =~ s/%DATE%/time2str("%Y%m%d", time, "PST")/ie;
  $localfile =~ s!%DATEDIR%!time2str("%Y/%m/", time, "PST")!ie;
  $localfile =~ s!//+!/!g;
  (my $dir = $localfile) =~ s![^/]*$!!;
  run "mkdir -p $dir", {silent => 1};
}

if ($opts{htmlbase} and $opts{htmlbase} =~ m/%DATE(DIR)?%/i) {
  load_module("Date::Format");
  $opts{htmlbase} =~ s/%DATE%/time2str("%Y%m%d", time, "PST")/ie;
  $opts{htmlbase} =~ s!%DATEDIR%!time2str("%Y/%m/", time, "PST")!ie;
  $opts{htmlbase} =~ s%//+(?!:)%/%g;
}


load_module("LWP::Simple");

if ($opts{"upgrade"}) {
  upgrade;
}
elsif ($opts{"version-check"}) {
  check_version;
}

my $static_page = get("http://www.userfriendly.org/static/")
  or die "Could not fetch http://www.userfriendly.org/static/";

my ($image_url) = ($static_page =~ m/ALT="Latest Strip" .*? SRC="([^"]*)"/)[0];

my $rv = mirror($image_url, $localfile);

die "Could not mirror $image_url to $localfile.\nCheck that $localfile is writeable\n"
  if $rv == 500;

if ($opts{htmlfile} and $rv == 200) {

  my $date;

  if (load_module("Date::Format", {fail_ok => 1})) {
    $date = time2str("%Y%m%d",time,"PST");
  }

  my $uf_link = "http://www.userfriendly.org/static/";

  $uf_link = "http://ars.userfriendly.org/cartoons/?id=$date&mode=classic"
    if $date;

  my $img_size = load_module("Image::Size", {fail_ok=>1})
    ? Image::Size::html_imgsize($localfile) : "";

  my $img_link = $opts{htmlbase} . ($localfile =~ m!.*?([^/]+)$!)[0];

  open HF, ">$opts{htmlfile}"
    or die "Could not open $opts{htmlfile} for writing: $!\n";

  print HF <<EOL;
<table border=0>
<tr><td>
<a href="$uf_link">
<img src="$img_link" border=0 $img_size></a></td></tr>
<tr><td align="right"><font size="-2">
<a href="http://freshmeat.net/projects/ufget/">ufget</a>
<a href="http://develooper.com/ufget/">.</a></font></td></tr>
</table>
EOL

  close HF;
}

exit unless $opts{verbose};

if ($rv == 200) {
  print "$image_url downloaded to $localfile\n";
} elsif ($rv == 304) {
  print "$localfile up to date\n";
} else {
  print "mirror of $image_url to $localfile returned $rv\n";
}

exit;

sub help {
  run "perldoc $0";
  exit;
}