Skip to content
Permalink
master
Switch branches/tags
Go to file
 
 
Cannot retrieve contributors at this time
412 lines (347 sloc) 11.5 KB
#!/usr/bin/env perl
#
# CLI for the Lawrence Public Library bibliocommons site.
# Current features:
# * list all checked out books for a user
#
# Create a ~/.lfk-library.yml file with entries
# for each user credential set you want to query.
# Example:
# --
# patron_name:
# username: foo
# password: bar
#
# Released to public domain by author Peter Karman, 2016.
#
# Installation requires:
#
# % cpan WWW::Mechanize YAML::Tiny HTML::TreeBuilder::XPath
# % cpan Text::Table::Any Text::Table::Tiny JSON IO::Prompt::Simple
# % cpan LWP::Protocol::https Text::Table::HTML Email::Stuffer
use strict;
use warnings;
use v5.10;
use Carp;
use Data::Dump qw( dump );
use Getopt::Long;
use WWW::Mechanize;
use YAML::Tiny;
use HTML::TreeBuilder::XPath;
use Text::Table::Any;
use JSON;
use IO::Prompt::Simple;
use Email::Stuffer;
use Encode;
#use LWP::ConsoleLogger::Everywhere;
my $usage = "$0 [--all | patron_name] [--renew]\n";
my $CHECK_ALL;
my $RENEW;
my $VERBOSE;
my $DEBUG;
my $PROMPT = 1;
my $HTML;
my $NOTIFY;
GetOptions(
'html' => \$HTML,
"all" => \$CHECK_ALL,
"renew" => \$RENEW,
"prompt!" => \$PROMPT,
"verbose" => \$VERBOSE,
"debug" => \$DEBUG,
"notify=s" => \$NOTIFY,
) or die $usage;
die $usage unless $CHECK_ALL or @ARGV;
my $conf_file = "$ENV{HOME}/.lfk-library.yml";
my $config = YAML::Tiny->read($conf_file)->[0];
my @patrons = $CHECK_ALL ? ( sort keys %$config ) : @ARGV;
my $base_url = 'https://lawrence.bibliocommons.com';
my $login_url = "$base_url/user/login?destination=https://lplks.org";
my $checked_out_url = "$base_url/v2/checkedout";
my $renewal_url
= "https://gateway.bibliocommons.com/v2/libraries/lawrence/checkouts";
my $TABLE_HEADER = [ '#', 'Title', 'Due Date', 'Holds', 'eBook' ];
# global var for queuing overdue or due soon items
my @NOTIFY_QUEUE = ($TABLE_HEADER);
# global cache for patron profiles
my %PATRON_PROFILES = ();
# global cache for patron checked out page
my %PATRON_PAGES = ();
###########################################################################
# functions
sub notify {
my $body = Text::Table::Any::table(
rows => \@NOTIFY_QUEUE,
header_row => 1,
encode => 0,
backend => table_backend(),
);
if ($DEBUG) {
say "NOTIFY EMAIL $NOTIFY";
say $body;
return;
}
Email::Stuffer->to($NOTIFY)->from( $ENV{EMAIL} )
->subject( $ENV{SUBJECT} || 'LFK Library Due' )->html_body($body)
->send_or_die;
}
sub format_title {
my ( $title, $href ) = @_;
if ($HTML) {
return sprintf( "<a href='%s%s'>%s</a>", $base_url, $href, $title );
}
else {
return $title;
}
}
sub table_backend {
return 'Text::Table::HTML' if $HTML;
return 'Text::Table::Tiny';
}
sub login {
my ( $www, $who ) = @_;
$www->get($login_url);
my $response = $www->submit_form(
form_number => 4,
fields => {
name => $config->{$who}->{username},
user_pin => $config->{$who}->{password}
}
);
#$VERBOSE and say "$who login response: " . $response->decoded_content;
unless ( $www->success ) {
die "Failed to authenticate: " . $www->status;
}
return $config->{$who}->{username};
}
sub checked_out_items {
my ($www) = @_;
$www->get($checked_out_url);
#$VERBOSE and say "checked_out_url: $checked_out_url";
my $html_tree
= HTML::TreeBuilder::XPath->new_from_content( $www->content );
return $html_tree->findnodes(
'//div[contains(@class, "cp-batch-actions-list-item")]');
}
sub build_report_table {
my ( $www, $checked_out, $who ) = @_;
my $count = 0;
my @rows = ( [@$TABLE_HEADER] );
push @{ $rows[0] }, 'Renewed' if $RENEW;
for my $item ( $checked_out->get_nodelist ) {
my $item_html = $item->as_HTML;
# digital checkouts are skipped
next if $item_html =~ m/EPUB|MP3/;
next if $item_html =~ m/Digital titles cannot be renewed/;
#$VERBOSE and say $item->as_HTML;
my $biblio = $item->find_by_attribute( 'class', 'cp-bib-brief' )
|| $item->find_by_attribute( 'class', 'cp-borrowing-bib-brief' );
if ( !$biblio ) {
warn "Cannot find cp-bib-brief for $item_html";
next;
}
$VERBOSE and say $biblio->as_HTML;
my $item_link = $biblio->look_down( '_tag' => 'a' );
if ( !$item_link ) {
say "No item link for " . $item->as_HTML;
next;
}
my $title = $item_link->look_down( 'class', 'title-content' )
->as_trimmed_text;
my $format_div
= $biblio->find_by_attribute( 'class', 'cp-format-info' );
my $is_ebook = $format_div->as_HTML =~ m/eBook|Audiobook/;
$VERBOSE and say $title;
my $pending_holds
= $item->find_by_attribute( 'class', 'cp-held-copies-count' );
if ($pending_holds) {
$pending_holds = $pending_holds->as_trimmed_text;
$pending_holds =~ s/ \w+ waiting//;
}
else {
# some caching bug on site prevents holds from always showing up
# on the summary list page. So check the item subscription stats page.
my $href = $item_link->attr('href');
my ($item_id) = ( $href =~ m,/item/show/(\d+), );
#say $href;
#say $item_id;
my $url = sprintf( "%s/item/show_circulation_widget/%s.json",
$base_url, $item_id );
$VERBOSE and say $url;
my $resp = $www->get($url);
my $resp_meta = decode_json $resp->decoded_content;
my $tree = HTML::TreeBuilder::XPath->new_from_content(
$resp_meta->{'html'} );
my $holds
= $tree->find_by_attribute( 'testid', 'text_holdcopies' );
$holds = $holds->as_trimmed_text if $holds;
$holds =~ s/ \w+ waiting// if $holds;
$VERBOSE and say "holds: $holds";
$pending_holds = $holds if $holds;
}
my $due_div
= HTML::TreeBuilder::XPath->new_from_content(
$item->find_by_attribute( 'class', 'checkedout-status' )
->as_HTML );
$VERBOSE and say $due_div->as_XML_indented;
my $duedate = find_element_maybe(
$due_div,
class => 'cp-checked-out-due-on',
class => 'cp-short-formatted-date'
);
my $duedate_soon = find_element_maybe(
$due_div,
class => 'cp-due-date-notice',
class => 'due-date-notice'
);
my $due = $duedate || $duedate_soon;
my $due_when = $due->as_trimmed_text( extra_chars => '\xA0' );
my $days_remaining = 0;
if ($duedate_soon) {
$days_remaining = $duedate_soon->as_trimmed_text;
$days_remaining =~ s/ days? remaining//;
if ( $days_remaining =~ m/days? overdue/ ) {
$days_remaining =~ s/ days? overdue//;
$days_remaining *= -1;
}
elsif ( $days_remaining =~ m/^a month/ ) {
$days_remaining = 30;
}
elsif ( $days_remaining =~ m/today/ ) {
$days_remaining = 0;
}
elsif ( $days_remaining =~ m/months remaining/ ) {
$days_remaining = 60;
}
}
if ($DEBUG) {
say "duedate=" . $duedate->as_HTML;
say "duedate_soon=" . $duedate_soon->as_HTML;
say "days_remaining=" . $days_remaining;
say "due_when=" . $due_when;
}
my $row = [
++$count, format_title( $title, $item_link->attr('href') ),
$due_when, $pending_holds, ( $is_ebook ? 'x' : '' )
];
if ( $NOTIFY
&& !$RENEW
&& $days_remaining < 5 )
{
push @NOTIFY_QUEUE, [ @$row, $who ];
}
if ( !$pending_holds
&& $RENEW
&& $duedate_soon
&& $days_remaining < 5 )
{
my $confirmation;
if ($PROMPT) {
$confirmation = prompt "renew $title (due $due_when)",
{ anyone => [qw/y n/] };
}
else {
$confirmation = 'y';
}
if ( $confirmation eq 'n' ) {
push @$row, 'skipped renewal';
}
elsif ( renew_item( $www, $item, $who ) ) {
push @$row, 'renewed';
}
else {
push @$row, 'renewal failed' unless $is_ebook;
push @NOTIFY_QUEUE, $row;
}
}
push @rows, $row;
}
return \@rows;
}
sub find_element_maybe {
my ( $el, %pairs ) = @_;
my $num_pairs = scalar( keys %pairs );
my $count = 0;
while ( my ( $key, $value ) = each %pairs ) {
$el = $el->look_down( $key, $value );
last unless $el;
$count++;
}
return $el;
}
sub find_item_id {
my ($item) = @_;
my $checkbox = $item->look_down( class => qr/cp-checkbox/ );
my $input = $checkbox->look_down( _tag => 'input' );
return $input->attr('value');
}
sub renew_item {
my ( $www, $item, $who ) = @_;
if ( $item->as_HTML =~ m/Cannot Renew/ ) {
return;
}
my $item_id = find_item_id($item);
# parse the react json blob from the page to find the user id
my $patron = get_patron_profile($who);
#say dump($patron);
my $user_id = $patron->{reduxStoreData}->{auth}->{currentUserId} + 0;
my $renewal_req = encode_json(
{ accountId => $user_id, checkoutIds => [$item_id], renew => \1 } );
#say $renewal_req;
my $request = HTTP::Request->new(
PATCH => $renewal_url,
[ 'Content-Type' => 'application/json',
'Accept' => 'application/json'
],
$renewal_req
);
#say $request->as_string;
my $agent = LWP::UserAgent->new();
my $resp = $www->request($request);
my $response = $resp->decoded_content;
say $response;
return if $response =~ /overdrive\.com/;
my $renewal_meta = decode_json $response;
$www->update_html( $renewal_meta->{html} );
$response = $www->submit_form();
my $renewed_resp = $response->decoded_content;
if ( $renewed_resp
=~ m/This item has been renewed the maximum number of times allowed/ )
{
return 0;
}
$VERBOSE and say $www->success;
$VERBOSE and say $response->decoded_content;
return $www->success;
}
sub get_patron_profile {
my ($who) = @_;
return $PATRON_PROFILES{$who} if $PATRON_PROFILES{$who};
my $html = $PATRON_PAGES{$who};
my ($payload) = ( $html =~ m/({"airbrakeConfig":.+?})<\/script>/s );
my $profile = decode_json( Encode::encode_utf8($payload) );
$PATRON_PROFILES{$who} = $profile;
return $profile;
}
#########################################################################
# main loop
say "<h1>LFK Library Report</h1>" if $HTML;
for my $who (@patrons) {
my $www = WWW::Mechanize->new(
agent => 'lfk-library-bot/1.0 <peter@peknet.com>' );
my $username = login( $www, $who );
my $checked_out = checked_out_items($www);
$PATRON_PAGES{$who} = $www->content;
my $rows = build_report_table( $www, $checked_out, $who );
say $HTML ? "<h2>$who $username</h2>" : "$who $username";
next unless @$rows > 1;
print Text::Table::Any::table(
rows => $rows,
header_row => 1,
encode => 0,
backend => table_backend(),
);
}
if ( $NOTIFY && scalar(@NOTIFY_QUEUE) > 1 ) {
notify();
}