#!/usr/bin/perl -w

# delicious_checker.pl
# This simple script will pull down your del.icio.us tags and then try to
# HEAD each of them. It will then print out a list of which ones worked
# and which didn't.
# if invoked with a -b then only broken links will be displayed.
# 2005/01/17 Dean Wilson 
# Homepage: http://www.unixdaemon.net/delicious_checker.html
# version 0.2

use strict;
use warnings;
use File::Basename;
use Getopt::Std;
use LWP::UserAgent;
use Net::Delicious;

# toggle debug mode
my $DEBUG = 0;

# get any options provided
my %opts;
# u or h = show help. -b only show broken links
getopts('uhb', \%opts);

# die early if we can.
&usage if ($opts{'u'} || $opts{'h'}); #request for help

# add your user details here
my $username = '';
my $password = '';

# set up the network modules. Net::Delicious requires a password to work :(
my $del = Net::Delicious->new({user=>$username, pswd=>$password});
my $browser = create_lwp_browser();



# do the work and check the remote pages
my ($working, $broken, $odd) = get_status_codes($del, $browser);



if (defined $opts{'b'}) {
  warn "Only displaying broken links...\n" if $DEBUG;
  display_broken($broken);
} else {
  display_working($working);
  display_broken($broken);
  display_oddities($odd);
}

#------------------------#
# subs, funcs and utils
#------------------------#

sub get_status_codes {
  my $del = shift;
  my $browser = shift;

  # set up the containers. Note redirects are followed automaticly
  my %working; # anything that returns a 200
  my %broken; # anything that returns a 4** or 5**
  my %odd; # anything that returns a 1**. 
  
  foreach my $p ($del->all_posts()) {
  #foreach my $p ($del->recent_posts({count => 2})) { # for testing
    # make this get or head? get more reliable head saves bandwidth
    my $response = $browser->head($p->href());

    warn "Working on ", $p->description(), "...\n" if $DEBUG;

    if ($response->is_success) {
      $working{$p->description() . " -- [" . $p->href() . "]"} = $response->status_line();
    } elsif ($response->is_error) {
      $broken{$p->description() . " -- [" . $p->href() . "]"} = $response->status_line();
    } else {
      $odd{$p->description() . " -- [" . $p->href() . "]"} = $response->status_line();
    }
  }
  return (\%working, \%broken, \%odd);
}

#------------------------#

sub create_lwp_browser {
  # set any LWP settings here.  agent, proxies, follow redirects etc
  
  my $browser = LWP::UserAgent->new;
  # default time out per URL checked.
  $browser->timeout(30);
  $browser->agent('del.icio.us che.ck.er.pl/0.1');

  return $browser;
}

#------------------------#

sub display_working {
  # this is where you should do any fancy formatting you desire
  my $working_links = shift;

  print "#------------- Working Links -------------#\n" if (%$working_links);
  foreach my $mark (keys %$working_links) {
    print "$mark worked fine\n";
  }
}

#------------------------#

sub display_broken {
  # this is where you should do any fancy formatting you desire
  my $broken_links = shift;

  print "#------------- Broken Links -------------#\n" if (%$broken_links);
  foreach my $mark (keys %$broken_links) {
    print "$mark was broke\n";
  }
}

#------------------------#

sub display_oddities {
  # this is where you should do any fancy formatting you desire
  my $odd_links = shift;

  print "#------------- Odd Links -------------#\n" if (%$odd_links);
  foreach my $mark (keys %$odd_links) {
    print "$mark was $odd_links->{$mark}\n";
  }
}

#------------------------#

sub usage {
  # this means we got called with -h or -u
  my $app = basename($0);

print<<EOU;
  Usage: $app [-b]
    -h|-u\thelp and usage (this text)
    -b\t only show broken links
EOU

exit(1);
}

#------------------------#