#!/usr/bin/perl -wT

## del.icio.us.pl 0.2

## This is free software.  
## It may be modified and/or distributed under 
## the same terms as Perl itself.
## 2003 Wayne Burkett
## http://www.dionidium.com

## Inspired by Paul Hammond's
## blo.gs.pl, which solves a similar problem.
## http://www.paranoidfish.org/projects/blo.gs.pl/

use strict;
use Fcntl qw(:flock);
use XML::Simple;
use LWP::UserAgent;
use HTML::Template;

use vars qw( $VERSION );
$VERSION = '0.2';

## Your del.icio.us user id.
my $id = '';

## Your del.icio.us password.
my $pass = '';

## Path to local directory to cache XML file.  
## This directory must be writable.
my $path = '';

## Cache time.  Default is now 30 minutes, to
## respect del.icio.us's growing popularity.
my $cache = 1800;

## Template path, relative to local directory 
## specified above.  Leave this alone if you're
## using the template that came with this script
## (in the same directory). 
my $template = 'del.icio.us.full.tmpl';

my %opts;
## Optional number of links to display.
## This defaults to the del.icio.us default,
## which is currently 15.
$opts{num} = 15;

## Optional category.  Use this to link to
## feeds of specific tags (for the user
## id entered above).
$opts{tag} = '';

## Optional clean output.  If true, output
## is "cleaned up" (i.e. &, <, and > are 
## converted to their HTML entity
## equivalents).  Set to 0 to turn this
## feature off.
$opts{clean} = 1;

my $xml_file = get_xml($id, $pass, $path, $cache, %opts);
my @entries = parse($xml_file, %opts);
output($path, $template, @entries);

sub err {
  ## Look for better error handling 
  ## in a later version.  A log?
  my $error = shift;
  print STDERR "[del.icio.us.pl] $error\n";
}

sub get_xml {
  my ($id, $pass, $path, $cache, %opts) = @_;
  my $xml_file = "$path/del.icio.us.$id.xml";
  open(FH, ">$xml_file.lock") ||
    err("Couldn't access XML: $!");
  flock(FH, LOCK_EX);
  my $stat = (stat ($xml_file))[9] if (-f $xml_file);
  if (!$stat || ((time() - $stat) > $cache)) {
    my $ua = LWP::UserAgent->new();
    my $xml_url = "http://del.icio.us/api/posts/recent?count=$opts{num}";
    $xml_url .= "&tag=$opts{tag}" if $opts{tag};
    $ua->agent('del.icio.us.pl/' . $VERSION);
    $ua->credentials(
      "del.icio.us:80",
      "del.icio.us API",
      "$id" => "$pass"
    );
    my $res = $ua->mirror($xml_url, $xml_file);
    unless ($res->is_error) {
      my $now = time();
      utime $now, $now, $xml_file;
    } else {
      err("Couldn't access XML for $id.");
    }
  }  
  close FH;
  return $xml_file;
}

sub parse {
  my ($xml_file, %opts) = @_;
  my $xml;
  eval {
    $xml = XMLin($xml_file);
  };
  err("Couldn't load XML: $!") if $@;
  ## Create a data structure
  ## HTML::Template can handle.
  ## e.g.: <post time="2004-02-18T21:36:56Z" 
  ##             href="http://rubhub.com/top10/" 
  ##             tag=" site social xfn xhtml" 
  ##		 description="Rubhub" 
  ##		 extended="The XHTML Friends Network Relationship Lookup Engine"/>
  my @entries = map { 
    clean(values %$_) if $opts{clean};
    my ($y, $mo, $d, $h, $m, $s) = $_->{'time'} =~
      /(\d{4})-(\d{2})-(\d{2})T(\d{2}):(\d{2}):(\d{2})/;
    { link        => $_->{'href'},
      about       => $_->{'description'},
      title       => $_->{'description'},
      description => $_->{'extended'},
      date        => $_->{'time'},
      year => $y, month => $mo, day => $d, 
      hour => $h, minute => $m, second => $s }
  } @{ $xml->{post} }[0 .. ($opts{num} - 1)];
  return @entries;
}

sub output {
  my ($path, $template, @entries) = @_;
  my $tmpl;
  eval {
    $tmpl = new HTML::Template(
      filename => "$path/$template",
      die_on_bad_params => 0  
    ); 
  };
  err("Couldn't load template ($path/$template): $!") if $@;
  print "Content-type: text/html\n\n";
  $tmpl->param( details => \@entries );
  print $tmpl->output;
}

sub clean {
  for (@_) {
    ## Converting '&' is the bare
    ## minimum to prevent breaking 
    ## docs served as XML.  We could
    ## do a lot more here (and might
    ## later).  This version fixes a bug
    ## in handling existing entities.
    s/&(?!#?\w+;)/&#38;/g;
    s/</&lt;/g;
    s/>/&gt;/g;
  }
}