Add PhoneList.pm.
authorJason Stephenson <jstephenson@mvlc.org>
Thu, 26 May 2011 14:30:10 +0000 (10:30 -0400)
committerBen Shum <bshum@biblio.org>
Thu, 26 Sep 2013 00:47:21 +0000 (20:47 -0400)
A simple WWW module to list patrons who have holds with their phone
numbers and barcodes. The format is as requested by a specific library
for their automated calling program.

Future modifications may include the ability to rearrange the output
columns and provide formats for some data.

Signed-off-by: Jason Stephenson <jstephenson@mvlc.org>
Signed-off-by: Lebbeous Fogle-Weekley <lebbeous@esilibrary.com>
Signed-off-by: Ben Shum <bshum@biblio.org>
Open-ILS/examples/apache/eg.conf.in
Open-ILS/examples/apache/eg_startup.in
Open-ILS/examples/apache/eg_vhost.conf.in
Open-ILS/src/perlmods/lib/OpenILS/WWW/PhoneList.pm [new file with mode: 0644]
Open-ILS/src/perlmods/lib/OpenILS/WWW/PhoneList/Base.pm [new file with mode: 0644]
Open-ILS/src/perlmods/lib/OpenILS/WWW/PhoneList/Holds.pm [new file with mode: 0644]
Open-ILS/src/perlmods/lib/OpenILS/WWW/PhoneList/Overdues.pm [new file with mode: 0644]

index acc495c..faa26a0 100644 (file)
@@ -19,6 +19,7 @@ PerlChildInitHandler OpenILS::WWW::Reporter::child_init
 PerlChildInitHandler OpenILS::WWW::SuperCat::child_init
 PerlChildInitHandler OpenILS::WWW::AddedContent::child_init
 PerlChildInitHandler OpenILS::WWW::AutoSuggest::child_init
+PerlChildInitHandler OpenILS::WWW::PhoneList::child_init
 
 # ----------------------------------------------------------------------------------
 # Set some defaults for our working directories
index 12f4ea5..1d77c05 100755 (executable)
@@ -13,6 +13,7 @@ use OpenILS::WWW::TemplateBatchBibUpdate qw( @sysconfdir@/opensrf_core.xml );
 use OpenILS::WWW::EGWeb;
 use OpenILS::WWW::IDL2js ('@sysconfdir@/opensrf_core.xml');
 use OpenILS::WWW::FlatFielder;
+use OpenILS::WWW::PhoneList ('@sysconfdir@/opensrf_core.xml');
 
 # - Uncomment the following 2 lines to make use of the IP redirection code
 # - The IP file should to contain a map with the following format:
index 66819b8..1000461 100644 (file)
@@ -546,6 +546,9 @@ RewriteRule . - [E=locale:%1]
     Options +ExecCGI
     PerlSendHeader On
     allow from all
+    <IfModule mod_headers.c>
+        Header onsuccess set Cache-Control no-cache
+    </IfModule>
 </Location>
 
 # ----------------------------------------------------------------------------------
@@ -571,6 +574,25 @@ RewriteRule ^/conify/([a-z]{2}-[A-Z]{2})/global/(.*)$ /conify/global/$2 [E=local
     allow from all
 </Location>
 
+# ----------------------------------------------------------------------------------
+# The PhoneList lives here
+# ----------------------------------------------------------------------------------
+<Location /phonelist>
+    SetHandler perl-script
+    AuthType Basic
+    AuthName "PhoneList Login"
+    require valid-user
+    PerlOptions +GlobalRequest
+    PerlSetVar OILSProxyPermissions "STAFF_LOGIN"
+    PerlHandler OpenILS::WWW::PhoneList
+    PerlAuthenHandler OpenILS::WWW::Proxy::Authen
+    Options +ExecCGI
+    PerlSendHeader On
+    allow from all
+    <IfModule mod_headers.c>
+        Header onsuccess set Cache-Control no-cache
+    </IfModule>
+</Location>
 <Location /vandelay-upload>
     SetHandler perl-script
     PerlHandler OpenILS::WWW::Vandelay::spool_marc
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/WWW/PhoneList.pm b/Open-ILS/src/perlmods/lib/OpenILS/WWW/PhoneList.pm
new file mode 100644 (file)
index 0000000..a654f56
--- /dev/null
@@ -0,0 +1,132 @@
+# ---------------------------------------------------------------
+# Copyright (C) 2011 Merrimack Valley Library Consortium
+# Jason Stephenson <jstephenson@mvlc.org>
+
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License
+# as published by the Free Software Foundation; either version 2
+# of the License, or (at your option) any later version.
+
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+# ---------------------------------------------------------------
+
+package OpenILS::WWW::PhoneList;
+use strict;
+use warnings;
+use bytes;
+
+use Apache2::Log;
+use Apache2::Const -compile => qw(OK FORBIDDEN HTTP_NO_CONTENT :log);
+use APR::Const    -compile => qw(:error SUCCESS);
+use APR::Table;
+
+use Apache2::RequestRec ();
+use Apache2::RequestIO ();
+use Apache2::RequestUtil;
+use CGI;
+
+use OpenSRF::System;
+use OpenSRF::Utils::SettingsClient;
+use OpenSRF::Utils::Logger qw/$logger/;
+use OpenILS::Utils::Fieldmapper;
+use OpenILS::Application::AppUtils;
+
+use Text::CSV; # Still only support CSV output.
+
+# Our submodules.
+use OpenILS::WWW::PhoneList::Holds;
+use OpenILS::WWW::PhoneList::Overdues;
+
+my $U = 'OpenILS::Application::AppUtils';
+
+my $bootstrap;
+
+sub import {
+    my $self = shift;
+    $bootstrap = shift;
+}
+
+sub child_init {
+    OpenSRF::System->bootstrap_client(config_file => $bootstrap);
+    my $idl = OpenSRF::Utils::SettingsClient->new->config_value("IDL");
+    Fieldmapper->import(IDL => $idl);
+    OpenILS::Utils::CStoreEditor->init;
+}
+
+sub handler {
+    my $r = shift;
+    my $cgi = new CGI;
+    my $authid = $cgi->cookie('ses') || $cgi->param('ses');
+    my $user = $U->simplereq('open-ils.auth', 'open-ils.auth.session.retrieve', $authid);
+    if (!$user || (ref($user) eq 'HASH' && $user->{ilsevent} == 1001)) {
+        return Apache2::Const::FORBIDDEN;
+    }
+
+    my $ou_id = $cgi->cookie("ws_ou") || $cgi->param("ws_ou") || $user->home_ou;
+
+    # Look for optional addcount parameter. If it is present add a
+    # count column to the end of the csv ouput with a count of the
+    # patron's hold items.
+    my $addcount = defined($cgi->param('addcount'));
+
+    # Member staff asked for the option to ignore a patron's
+    # preference to receive both a phone and email notice, and skip
+    # them if it looks like they will get an email notice, too.
+    # So we made it an option on the query string.
+    my $skipemail = defined($cgi->param('skipemail'));
+
+    # Build the args hashref to initialize our functional submodule:
+    my $args = {
+                'authtoken' => $authid,
+                'user' => $user->id,
+                'work_ou' => $ou_id,
+               };
+
+    # Default module to load is Holds.
+    my $module = 'OpenILS::WWW::PhoneList::Holds';
+
+    # If the overdue parameter is specified, we us the Overdues module
+    # and get the number of days from the due date. If no number of
+    # days is given, or if the argument to overdue is not a number,
+    # then we use a default of 14.
+    if (defined($cgi->param('overdue'))) {
+        $module = 'OpenILS::WWW::PhoneList::Overdues';
+        $args->{'days'} =
+            ($cgi->param('overdue') =~ /^[0-9]+$/) ? $cgi->param('overdue')
+                : 14;
+        $args->{'skipemail'} = $skipemail;
+    } else {
+        $args->{'addcount'} = $addcount;
+        $args->{'skipemail'} = $skipemail;
+    }
+
+    # Load the module.
+    my $source = $module->new($args);
+
+    # check for user permissions:
+    return Apache2::Const::FORBIDDEN unless($source->checkperms);
+
+    # Tell the source to run its query.
+    if ($source->query()) {
+        my $csv = Text::CSV->new();
+        $r->headers_out->set("Content-Disposition" => "attachment; filename=phone.csv");
+        $r->content_type("text/plain");
+        # Print the columns
+        if ($csv->combine(@{$source->columns})) {
+            $r->print($csv->string . "\n");
+        }
+        # Print the results
+        $r->print($csv->string . "\n") while ($csv->combine(@{$source->next}));
+    }
+    else {
+        # Query failed, so we'll return no content error.
+        return Apache2::Const::HTTP_NO_CONTENT;
+    }
+
+    return Apache2::Const::OK;
+}
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/WWW/PhoneList/Base.pm b/Open-ILS/src/perlmods/lib/OpenILS/WWW/PhoneList/Base.pm
new file mode 100644 (file)
index 0000000..a33aef1
--- /dev/null
@@ -0,0 +1,85 @@
+# ---------------------------------------------------------------
+# Copyright (C) 2011 Merrimack Valley Library Consortium
+# Jason Stephenson <jstephenson@mvlc.org>
+
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License
+# as published by the Free Software Foundation; either version 2
+# of the License, or (at your option) any later version.
+
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+# ---------------------------------------------------------------
+package OpenILS::WWW::PhoneList::Base;
+
+use strict;
+use warnings;
+use Carp;
+# A base class for generating phone list output.
+
+use OpenILS::Application::AppUtils;
+
+my %fields = (
+              columns => [],
+              perms => [],
+              user => undef,
+              authtoken => undef,
+              work_ou => undef,
+             );
+
+sub new {
+    my $invocant = shift;
+    my $args = shift;
+    my $class = ref($invocant) || $invocant;
+    my $self = {
+                _permitted => \%fields,
+                %fields,
+               };
+    bless($self, $class);
+    $self->authtoken($args->{authtoken});
+    $self->user($args->{user});
+    $self->work_ou($args->{work_ou});
+    return $self;
+}
+
+sub checkperms {
+    my $self = shift;
+    my $rv = 0;
+    if ($self->perms && $self->user && $self->authtoken && $self->work_ou) {
+        my $r = OpenILS::Application::AppUtils->simplereq('open-ils.actor', 'open-ils.actor.user.perm.check', $self->authtoken, $self->user, $self->work_ou, $self->perms);
+        $rv = 1 unless(@$r);
+    }
+    return $rv;
+}
+
+# Return empty array ref.
+sub next {
+    return [];
+}
+
+# Always return false.
+sub query {
+    return 0;
+}
+
+sub AUTOLOAD {
+    my $self = shift;
+    my $class = ref($self) or croak "$self is not an object";
+    my $name = our $AUTOLOAD;
+
+    $name =~ s/.*://;
+
+    unless (exists $self->{_permitted}->{$name}) {
+        croak "Can't access '$name' field of class '$class'";
+    }
+
+    if (@_) {
+        return $self->{$name} = shift;
+    } else {
+        return $self->{$name};
+    }
+}
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/WWW/PhoneList/Holds.pm b/Open-ILS/src/perlmods/lib/OpenILS/WWW/PhoneList/Holds.pm
new file mode 100644 (file)
index 0000000..b5df719
--- /dev/null
@@ -0,0 +1,159 @@
+# ---------------------------------------------------------------
+# Copyright (C) 2011 Merrimack Valley Library Consortium
+# Jason Stephenson <jstephenson@mvlc.org>
+
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License
+# as published by the Free Software Foundation; either version 2
+# of the License, or (at your option) any later version.
+
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+# ---------------------------------------------------------------
+package OpenILS::WWW::PhoneList::Holds;
+
+use strict;
+use warnings;
+
+use OpenSRF::Utils::Logger qw/$logger/;
+use OpenSRF::Utils::JSON;
+use OpenILS::Application::AppUtils;
+use OpenILS::Utils::Fieldmapper;
+use OpenILS::Utils::CStoreEditor qw/:funcs/;
+use OpenILS::WWW::PhoneList::Base;
+
+my $U = 'OpenILS::Application::AppUtils';
+
+BEGIN {
+    our @ISA = ('OpenILS::WWW::PhoneList::Base');
+}
+
+my %fields = (
+              addcount => 0,
+              skipemail => 0,
+             );
+
+sub new {
+    my $class = shift;
+    my $args = shift;
+    my $self = $class->SUPER::new($args);
+    foreach my $element (keys %fields) {
+        $self->{_permitted}->{$element} = $fields{$element};
+    }
+    @{$self}{keys %fields} = values %fields;
+    $self->perms(['VIEW_USER', 'VIEW_HOLD', 'VIEW_HOLD_NOTIFICATION', 'CREATE_HOLD_NOTIFICATION']);
+    $self->addcount($args->{addcount}) if (defined($args->{addcount}));
+    $self->skipemail($args->{skipemail}) if (defined($args->{skipemail}));
+    my $columns = ['Name', 'Phone', 'Barcode'];
+    push(@{$columns}, 'Count') if ($self->addcount);
+    $self->columns($columns);
+    return $self;
+}
+
+sub query {
+    my $self = shift;
+    my $ou_id = $self->work_ou;
+
+    # Hold results in an array ref.
+    $self->{results} = [];
+
+    my $raw_query =<<"    QUERY";
+{
+"select": { "au": [ "first_given_name", "family_name", "email" ],
+            "ac": [ "barcode" ],
+            "ahr": [ "phone_notify", "id", "email_notify" ] },
+
+"from": { "au" : { "ac" : { "fkey":"card", "field":"id" },
+                   "ahr": { "fkey":"id", "field":"usr" } } },
+
+"where": { "+ahr": { "pickup_lib": { "in": {"select": {"aou":[{"transform":"actor.org_unit_descendants","column":"id","result_field":"id","alias":"id"}]},
+                                            "from":"aou",
+                                            "where":{"id":$ou_id}}},
+                     "cancel_time":null,
+                     "fulfillment_time":null,
+                     "-and": [{"phone_notify": {"<>": null}}, {"phone_notify":{"<>":""}}],
+                     "shelf_time":{"<>":null},
+                     "capture_time":{"<>":null},
+                     "current_copy":{"<>":null},
+                     "id": { "not in": { "from":"ahn",
+                                         "select": { "ahn": [ "hold" ] },
+                                         "where": { "method":"phone" } } } } },
+"order_by": { "ac": [ "barcode" ], "ahr": [ "phone_notify" ] }
+}
+    QUERY
+
+    my $q = OpenSRF::Utils::JSON->JSON2perl($raw_query);
+    my $e = new_editor(authtoken=>$self->authtoken);
+    my $info = $e->json_query($q);
+    if ($info && @$info) {
+        my ($bc, $pn,$count,$name, $skipme);
+        $bc = "";
+        $pn = "";
+        $count = 0;
+        $skipme = 1; # Assume we skip until we have a notice w/out email.
+        foreach my $i (@$info) {
+            if ($i->{barcode} ne $bc || $i->{phone_notify} ne $pn) {
+                if ($count > 0 && $skipme == 0) {
+                    my $phone = $pn;
+                    $phone =~ s/-//g;
+                    my $out = [$name, $phone, $bc];
+                    push(@$out, $count) if ($self->addcount);
+                    push(@{$self->{results}}, $out);
+                    $count = 0;
+                }
+                if ($i->{first_given_name} eq 'N/A' || $i->{first_given_name} eq '') {
+                    $name = $i->{family_name};
+                }
+                else {
+                    $name = $i->{first_given_name} . ' ' . $i->{family_name};
+                }
+                $bc = $i->{barcode};
+                $pn = $i->{phone_notify};
+                $skipme = 1; # Assume we skip until we have a notice w/out email.
+            }
+            unless ($self->skipemail && $i->{email} && $i->{email_notify} eq 't') {
+                my $ahn = Fieldmapper::action::hold_notification->new;
+                $ahn->hold($i->{id});
+                $ahn->notify_staff($self->user);
+                $ahn->method('phone');
+                $ahn->note('PhoneList.pm');
+                $logger->activity("Attempting notification creation hold: " . $ahn->hold . " method: " . $ahn->method . " note: " . $ahn->note);
+                my $notification = $U->simplereq('open-ils.circ', 'open-ils.circ.hold_notification.create', $self->authtoken, $ahn);
+                if (ref($notification)) {
+                    $logger->error("Error creating notification: " . $notification->{textcode});
+                }
+                else {
+                    $logger->activity("Created ahn: $notification");
+                }
+                #patron has at least 1 phone-only notice, so we print.
+                $skipme = 0;
+            }
+            $count++;
+        }
+        # Get that last one, since we only print when barcode and/or
+        # phone changes.
+        if ($count > 0 && $skipme == 0) {
+            my $phone = $pn;
+            $phone =~ s/-//g;
+            my $out = [$name, $phone, $bc];
+            push(@$out, $count) if ($self->addcount);
+            push(@{$self->{results}}, $out);
+            $count = 0;
+        }
+    }
+    return scalar @{$self->{results}};
+}
+
+sub next {
+    my $self = shift;
+    if (@{$self->{results}}) {
+        return shift @{$self->{results}};
+    }
+    else {
+        return [];
+    }
+}
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/WWW/PhoneList/Overdues.pm b/Open-ILS/src/perlmods/lib/OpenILS/WWW/PhoneList/Overdues.pm
new file mode 100644 (file)
index 0000000..eb98df2
--- /dev/null
@@ -0,0 +1,174 @@
+# ---------------------------------------------------------------
+# Copyright (C) 2011 Merrimack Valley Library Consortium
+# Jason Stephenson <jstephenson@mvlc.org>
+
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License
+# as published by the Free Software Foundation; either version 2
+# of the License, or (at your option) any later version.
+
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+# ---------------------------------------------------------------
+package OpenILS::WWW::PhoneList::Overdues;
+
+use strict;
+use warnings;
+
+use OpenSRF::Utils::Logger qw/$logger/;
+use OpenILS::Application::AppUtils;
+use OpenILS::Utils::Fieldmapper;
+use OpenILS::Utils::CStoreEditor qw/:funcs/;
+use OpenILS::WWW::PhoneList::Base;
+
+my $U = 'OpenILS::Application::AppUtils';
+
+BEGIN {
+    our @ISA = ('OpenILS::WWW::PhoneList::Base');
+}
+
+my %fields = (
+              skipemail => 0,
+              days => 14,
+             );
+
+sub new {
+    my $class = shift;
+    my $args = shift;
+    my $self = $class->SUPER::new($args);
+    foreach my $element (keys %fields) {
+        $self->{_permitted}->{$element} = $fields{$element};
+    }
+    @{$self}{keys %fields} = values %fields;
+    $self->perms(['VIEW_USER', 'VIEW_CIRCULATIONS']);
+    $self->skipemail($args->{skipemail}) if (defined($args->{skipemail}));
+    $self->days($args->{days});
+    my $columns = ['Name', 'Phone', 'Barcode', 'Titles'];
+    $self->columns($columns);
+
+    # Results in an array ref.
+    $self->{results} = [];
+
+    return $self;
+}
+
+sub query {
+    my $self = shift;
+    my $ou_id = $self->work_ou;
+
+    # Need a CStoreEditor to run some queries:
+    my $e = new_editor(authtoken => $self->{authtoken});
+
+    # Get org_unit and descendant ids for the main search:
+    my $query =
+        {
+         "select" =>
+         {
+          "aou"=>
+          [
+           {
+            "transform"=>"actor.org_unit_descendants",
+            "column"=>"id",
+            "result_field"=>"id",
+            "alias"=>"id"
+           }
+          ]
+         },
+         "from"=>"aou",
+         "where"=>{"id"=>$ou_id}
+        };
+
+    my $result = $e->json_query($query);
+    my $where = [];
+    if (defined($result) && ref($result) eq 'ARRAY') {
+        foreach my $r (@$result) {
+            push (@$where, $r->{id});
+        }
+    } else {
+        $where = $ou_id;
+    }
+
+    # Set the due date to $self->days() ago.
+    my $when = DateTime->now();
+    $when->subtract(days => $self->days());
+    # All due dates are set to 23:59:59 in Evergreen.
+    $when->set(hour => 23, minute => 59, second => 59);
+
+    # This is what we're here for, the main search call to get fleshed
+    # circulation information for items that were due $where $when
+    # days ago.
+    my $circs = $e->search_action_circulation(
+        [
+         {
+          circ_lib => $where,
+          checkin_time => undef,
+          due_date => $when->iso8601()
+         },
+         {
+          flesh => 4,
+          flesh_fields =>
+          {
+           circ => ['usr', 'target_copy'],
+           au => ['card'],
+           acp => ['call_number'],
+           acn => ['record'],
+           bre => ['simple_record']
+          }
+         }
+        ], {substream => 1});
+
+    # Add any results to our internal results array.
+    if (defined($circs) && ref($circs) eq 'ARRAY') {
+        my $stuff = {};
+        foreach my $circ (@$circs) {
+            next if ($self->skipemail() && $circ->usr->email());
+            next unless($circ->usr->day_phone());
+            my $barcode = $circ->usr->card->barcode();
+            my $title = $circ->target_copy->call_number->record->simple_record->
+                title();
+            if (defined($stuff->{$barcode})) {
+                $stuff->{$barcode}->{titles} .= ':' . $title;
+            } else {
+                my $phone = $circ->usr->day_phone();
+                my $name = $self->_get_usr_name($circ);
+                $stuff->{$barcode}->{phone} = $phone;
+                $stuff->{$barcode}->{name} = $name;
+                $stuff->{$barcode}->{titles} = $title;
+            }
+        }
+        foreach my $key (keys %$stuff) {
+            push (@{$self->{results}},
+                        [ $stuff->{$key}->{name}, $stuff->{$key}->{phone},
+                          $key, $stuff->{$key}->{titles} ]);
+        }
+    }
+
+    # Clean up?
+    $e->finish;
+
+    return scalar @{$self->{results}};
+}
+
+sub next {
+    my $self = shift;
+    if (@{$self->{results}}) {
+        return shift @{$self->{results}};
+    }
+    else {
+        return [];
+    }
+}
+
+# some helper functions:
+sub _get_usr_name {
+    my $self = shift;
+    my $circ = shift;
+    my $first_name = $circ->usr->first_given_name();
+    my $last_name = $circ->usr->family_name();
+    return ($first_name eq 'N/A' || $first_name eq '') ? $last_name
+        : $first_name . ' ' . $last_name;
+}
+
+1;