#+begin_src sh :dir /sacha@direct.sachachua.com:~
perl library-new.pl Business
#+end_src

(setq tramp-default-method "plink")

(find-file "/sacha@direct.sachachua.com:~/library-new.pl")

#!/usr/bin/perl
# Displays new books from the Toronto Public Library
#
# Author: Sacha Chua (sacha@sachachua.com)
#
# Usage:
# perl library-new.pl <category> - print books
# perl library-new.pl <file> <username> <password> - request books
#
use Date::Parse;

#!/usr/bin/perl -w
use strict;
use URI::URL;
use WWW::Mechanize;
use WWW::Mechanize::FormFiller;
use WWW::Mechanize::TreeBuilder;
use HTML::TableExtract;
use Data::Dumper;
sub process_account($$$);
sub trim($);
sub to_renew($$);
sub clean_string($);

# Get the arguments
if ($#ARGV < 0) {
    print "Usage:\n";
    print "perl library-new.pl <category/filename> [username] [password]\n";
    exit;
}

my $agent = WWW::Mechanize->new( autocheck => 1 );
my $formfiller = WWW::Mechanize::FormFiller->new();
if ($#ARGV > 0) {
  my $filename = shift(@ARGV);
  my $username = "NOT ACTUALLY MY USERNAME";
  my $password = "NOT ACTUALLY MY PASSWORD";
  print "Requesting books\n";
  request_books($agent, $username, $password, $filename);
} else {
  my $category = shift(@ARGV);
  WWW::Mechanize::TreeBuilder->meta->apply($agent);
  print_new_books($agent, $category);
}


## FUNCTIONS ###############################################

# Perl trim function to remove whitespace from the start and end of the string
sub trim($)
{
  my $string = shift;
  $string =~ s/^\s+//;
  $string =~ s/\s+$//;
  return $string;
}

sub request_books($$$$)
{
  my $agent = shift;
  my $username = shift;
  my $password = shift;
  my $filename = shift;

  # Read titles and IDs
  open(DATA, $filename) or die("Couldn't open file.");
  my @lines = <DATA>;
  close(DATA);

  my %requests = ();

  my $line;
  my $title;
  my $id;
  foreach $line (@lines) {
    ($title, $id) = split /\t/, $line;
    chomp $id;
    $requests{$id} = $title;
  }

  # Log in
  log_in_to_library($agent, $username, $password);
  print "Retrieving checked-out and requested books...";
  # Retrieve my list of checked-out and requested books
  my $current_ids = get_current_ids($agent);

  # Retrieve a stem URL that I can use for requests
  my $base_url = 'https://www.torontopubliclibrary.ca/placehold?itemId=';
  my @already_out;
  my @success;
  my @failure;
  # For each line in the file
  while (($id, $title) = each(%requests)) {
    # Do I already have it checked out or on hold? Skip.
    if ($current_ids->{$id}) {
      push @already_out, $title . " (" . $current_ids->{$id} . ")";
    } else {
      # Request the hold
      my $url = $base_url . $id;
      $agent->get($url);
      $agent->form_name('form_place-hold');
      $agent->submit();
      if ($agent->content =~ /The hold was successfully placed/) {
        # print "Borrowed ", $title, "\n";
        ## Did it successfully get checked out? Save title in success list
        push @success, $title;
      } else {
        # Else, save title and ID in fail list
        push @failure, $title . "\t" . $id;
      }
    }
  }
  # Print out success list
  if ($#success > 0) {
    print "BOOKS REQUESTED:\n";
    foreach my $title (@success) {
      print $title, "\n";
    }
    print "\n";
  }
  # Print out already-out list
  if ($#already_out > 0) {
    print "ALREADY REQUESTED/CHECKED OUT:\n";
    foreach my $s (@already_out) {
      print $s, "\n";
    }
    print "\n";
  }
  # Print out fail list
  if ($#failure > 0) {
    print "COULD NOT REQUEST:\n";
    foreach my $s (@failure) {
      print $s, "\n";
    }
    print "\n";
  }
}

sub get_current_ids($)
{
  my $agent = shift;
  my %current_ids = ();
  my $string = $agent->content;
  while ($string =~ m/TITLE\^([0-9]+)\^/g) {
    $current_ids{$1} = 'requested';
  }
  while ($string =~ m/RENEW\^([0-9]+)\^/g) {
    $current_ids{$1} = 'checked out';
  }
  return \%current_ids;
}

sub print_new_books($$)
{
  my $agent = shift;
  my $category = shift;
  $agent->env_proxy();
  $agent->get('http://oldcatalogue.torontopubliclibrary.ca');
  $agent->follow_link(text_regex => qr/Our Newest Titles/);
  $agent->follow_link(text_regex => qr/$category/i);

  my $continue = 1;
  while ($continue) {
    print_titles_on_page($agent);
    if ($agent->form_with_fields('SCROLL^F')) {
      $agent->click('SCROLL^F');
    } else {
      $continue = 0;
    }
  }
}

# Print out all the entries on this page
sub print_titles_on_page($)
{
  my $agent = shift;
  my @titles = $agent->look_down(sub {
                                $_[0]->tag() eq 'strong' and
                                $_[0]->parent->attr('class') and
                                $_[0]->parent->attr('class') eq 'itemlisting'; });
  foreach my $title (@titles) {
    my $hold = $title->parent->parent->parent->parent->look_down(sub {
                                                          $_[0]->attr('alt') and
                                                          $_[0]->attr('alt') eq 'Place Hold'; });
    my $id = "";
    my $call_no = "";
    if ($hold && $hold->parent && $hold->parent->attr('href') =~ /item_id=([^&]+)&.*?callnum=([^ "&]+)/) {
      $id = $1;
      $call_no = $2;
    }
    print $call_no . "\t" . $title->as_text . "\t" . $id . "\n";
  }
}

sub clean_string($)
{
    my $string = shift;
    $string =~ s#^.*?(<form id="renewitems" [^>]+>)#<html><body>\1#s;
    $string =~ s#</form>.*#</form></html>#s;
    $string =~ s#<table border="0" bordercolor="red".*(<table border="0" bordercolor="blue" cellspacing="0" cellpadding="0">)#\1#s;
    $string =~ s#</table>.*</form>#</table></form>#s;
# Clean up for parsing
    $string =~ s#<!-- Print the date due -->##g;
    $string =~ s#<br> <!-- Displays Date -->##g;
    return $string;
}

sub log_in_to_library($$$) {
    my $agent = shift;
    my $username = shift;
    my $password = shift;
    $agent->get('http://beta.torontopubliclibrary.ca/youraccount');
    $agent->form_name('form_signin');
    $agent->current_form->value('userId', $username);
    $agent->current_form->value('password', $password);
    $agent->submit();
}