--- /dev/null
+#
+# ILS.pm: Test ILS interface module
+#
+
+package OpenILS::SIP;
+use warnings; use strict;
+
+use Sys::Syslog qw(syslog);
+
+use OpenILS::SIP::Item;
+use OpenILS::SIP::Patron;
+use OpenILS::SIP::Transaction;
+use OpenILS::SIP::Transaction::Checkout;
+use OpenILS::SIP::Transaction::Checkin;
+use OpenILS::SIP::Transaction::FeePayment;
+use OpenILS::SIP::Transaction::Hold;
+use OpenILS::SIP::Transaction::Renew;
+use OpenILS::SIP::Transaction::RenewAll;
+
+
+use OpenSRF::System;
+use OpenILS::Utils::Fieldmapper;
+use OpenSRF::Utils::SettingsClient;
+use OpenILS::Application::AppUtils;
+
+use Digest::MD5 qw(md5_hex);
+
+my $U = 'OpenILS::Application::AppUtils';
+
+# PUT ME IN THE CONFIG XXX
+my %supports = (
+ 'magnetic media' => 1,
+ 'security inhibit' => 0,
+ 'offline operation' => 0
+ );
+
+
+sub new {
+ my ($class, $institution, $login) = @_;
+ my $type = ref($class) || $class;
+ my $self = {};
+
+ syslog("LOG_DEBUG", "new ILS '%s'", $institution->{id});
+ $self->{institution} = $institution;
+
+ my $config = $institution->{implementation_config}->{bootstrap};
+
+ syslog('LOG_DEBUG', "loading bootstrap config: $config");
+
+ local $/ = "\n";
+ OpenSRF::System->bootstrap_client(config_file => $config);
+ syslog('LOG_DEBUG', "bootstrap loaded..");
+
+ $self->{osrf_config} = OpenSRF::Utils::SettingsClient->new;
+
+ Fieldmapper->import($self->{osrf_config}->config_value('IDL'));
+
+ bless( $self, $type );
+
+ return undef unless
+ $self->login( $login->{id}, $login->{password} );
+
+ return $self;
+}
+
+sub login {
+ my( $self, $username, $password ) = @_;
+ syslog('LOG_DEBUG', "OpenILS: Logging in with username $username");
+
+ my $seed = $U->simplereq(
+ 'open-ils.auth',
+ 'open-ils.auth.authenticate.init', $username );
+
+ my $response = $U->simplereq(
+ 'open-ils.auth',
+ 'open-ils.auth.authenticate.complete',
+ {
+ username => $username,
+ password => md5_hex($seed . md5_hex($password)),
+ type => 'opac',
+ }
+ );
+
+ my $key;
+ if( ref($response) eq 'HASH' and $response->{payload}
+ and $key = $response->{payload}->{authtoken} ) {
+ syslog('LOG_INFO', "OpenILS: Login succeeded for $username : authkey = $key");
+
+ } else {
+ syslog('LOG_WARN', "OpenILS: Login failed for $username");
+ }
+
+ return $self->{authtoken} = $key;
+}
+
+
+sub find_patron {
+ my $self = shift;
+ return OpenILS::SIP::Patron->new(@_);
+}
+
+
+sub find_item {
+ my $self = shift;
+ return OpenILS::SIP::Item->new(@_);
+}
+
+
+sub institution {
+ my $self = shift;
+
+ return $self->{institution}->{id};
+}
+
+
+# XXX Get me from the config?
+sub supports {
+ my ($self, $op) = @_;
+ return exists($supports{$op}) ? $supports{$op} : 0;
+}
+
+sub check_inst_id {
+ my ($self, $id, $whence) = @_;
+
+ if ($id ne $self->{institution}->{id}) {
+ syslog("LOG_WARNING", "%s: received institution '%s', expected '%s'",
+ $whence, $id, $self->{institution}->{id});
+ }
+}
+
+
+
+
+# XXX by default, these should come from the config
+sub checkout_ok {
+ return 1;
+}
+
+sub checkin_ok {
+ return 0;
+}
+
+sub status_update_ok {
+ return 1;
+}
+
+sub offline_ok {
+ return 0;
+}
+
+
+##
+## Checkout(patron_id, item_id, sc_renew):
+## patron_id & item_id are the identifiers send by the terminal
+## sc_renew is the renewal policy configured on the terminal
+## returns a status opject that can be queried for the various bits
+## of information that the protocol (SIP or NCIP) needs to generate
+## the response.
+##
+
+sub checkout {
+ my ($self, $patron_id, $item_id, $sc_renew) = @_;
+
+ syslog('LOG_DEBUG', "OpenILS::Checkout attempt: patron=$patron_id, item=$item_id");
+
+ my $xact = OpenILS::SIP::Transaction::Checkout->new( authtoken => $self->{authtoken} );
+ my $patron = OpenILS::SIP::Patron->new($patron_id);
+ my $item = OpenILS::SIP::Item->new($item_id);
+
+ $xact->patron($patron);
+ $xact->item($item);
+
+ if (!$patron) {
+ $xact->screen_msg("Invalid Patron");
+ return $xact;
+ }
+
+ if (!$patron->charge_ok) {
+ $xact->screen_msg("Patron Blocked");
+ return $xact;
+ }
+
+ if( !$item ) {
+ $xact->screen_msg("Invalid Item");
+ return $xact;
+ }
+
+ syslog('LOG_DEBUG', "OpenILS::Checkout data loaded OK, checking out...");
+ $xact->do_checkout();
+
+ if ($item->{patron} && ($item->{patron} ne $patron_id)) {
+ # I can't deal with this right now
+ # XXX check in then check out?
+ $xact->screen_msg("Item checked out to another patron");
+ $xact->ok(0);
+ }
+
+ $xact->desensitize(!$item->magnetic);
+
+ if( $xact->ok ) {
+
+ $xact->editor->commit;
+ syslog("LOG_DEBUG", "OpenILS::Checkout: " .
+ "patron %s checke out %s succeeded", $patron_id, $item_id);
+
+ } else {
+
+ $xact->editor->xact_rollback;
+ syslog("LOG_DEBUG", "OpenILS::Checkout: " .
+ "patron %s checke out %s FAILED, rolling back xact...", $patron_id, $item_id);
+ }
+
+ return $xact;
+}
+
+
+sub checkin {
+ my ($self, $item_id, $trans_date, $return_date,
+ $current_loc, $item_props, $cancel) = @_;
+
+ syslog('LOG_DEBUG', "OpenILS::Checkin on item=$item_id");
+
+ my $patron;
+ my $xact = OpenILS::SIP::Transaction::Checkin->new(authtoken => $self->{authtoken});
+ my $item = OpenILS::SIP::Item->new($item_id);
+
+ $xact->item($item);
+
+ $xact->do_checkin( $trans_date, $return_date, $current_loc, $item_props );
+
+ if ($xact->ok) {
+
+ $xact->patron($patron = OpenILS::SIP::Patron->new($item->{patron}));
+ delete $item->{patron};
+ delete $item->{due_date};
+ syslog('LOG_INFO', "OpenILS: Checkin succeeded");
+ $xact->editor->commit;
+
+ } else {
+
+ $xact->editor->xact_rollback;
+ syslog('LOG_WARNING', "OpenILS: Checkin failed");
+ }
+ # END TRANSACTION
+
+ return $xact;
+}
+
+
+
+
+## If the ILS caches patron information, this lets it free
+## it up
+#sub end_patron_session {
+# my ($self, $patron_id) = @_;
+#
+# # success?, screen_msg, print_line
+# return (1, 'Thank you for using OpenILS!', '');
+#}
+#
+#sub pay_fee {
+# my ($self, $patron_id, $patron_pwd, $fee_amt, $fee_type,
+# $pay_type, $fee_id, $trans_id, $currency) = @_;
+# my $trans;
+# my $patron;
+#
+# $trans = new ILS::Transaction::FeePayment;
+#
+# $patron = new ILS::Patron $patron_id;
+#
+# $trans->transaction_id($trans_id);
+# $trans->patron($patron);
+# $trans->ok(1);
+#
+# return $trans;
+#}
+#
+#sub add_hold {
+# my ($self, $patron_id, $patron_pwd, $item_id, $title_id,
+# $expiry_date, $pickup_location, $hold_type, $fee_ack) = @_;
+# my ($patron, $item);
+# my $hold;
+# my $trans;
+#
+#
+# $trans = new ILS::Transaction::Hold;
+#
+# # BEGIN TRANSACTION
+# $patron = new ILS::Patron $patron_id;
+# if (!$patron
+# || (defined($patron_pwd) && !$patron->check_password($patron_pwd))) {
+# $trans->screen_msg("Invalid Patron.");
+#
+# return $trans;
+# }
+#
+# $item = new ILS::Item ($item_id || $title_id);
+# if (!$item) {
+# $trans->screen_msg("No such item.");
+#
+# # END TRANSACTION (conditionally)
+# return $trans;
+# } elsif ($item->fee && ($fee_ack ne 'Y')) {
+# $trans->screen_msg = "Fee required to place hold.";
+#
+# # END TRANSACTION (conditionally)
+# return $trans;
+# }
+#
+# $hold = {
+# item_id => $item->id,
+# patron_id => $patron->id,
+# expiration_date => $expiry_date,
+# pickup_location => $pickup_location,
+# hold_type => $hold_type,
+# };
+#
+# $trans->ok(1);
+# $trans->patron($patron);
+# $trans->item($item);
+# $trans->pickup_location($pickup_location);
+#
+# push(@{$item->hold_queue}, $hold);
+# push(@{$patron->{hold_items}}, $hold);
+#
+#
+# # END TRANSACTION
+# return $trans;
+#}
+#
+#sub cancel_hold {
+# my ($self, $patron_id, $patron_pwd, $item_id, $title_id) = @_;
+# my ($patron, $item, $hold);
+# my $trans;
+#
+# $trans = new ILS::Transaction::Hold;
+#
+# # BEGIN TRANSACTION
+# $patron = new ILS::Patron $patron_id;
+# if (!$patron) {
+# $trans->screen_msg("Invalid patron barcode.");
+#
+# return $trans;
+# } elsif (defined($patron_pwd) && !$patron->check_password($patron_pwd)) {
+# $trans->screen_msg('Invalid patron password.');
+#
+# return $trans;
+# }
+#
+# $item = new ILS::Item ($item_id || $title_id);
+# if (!$item) {
+# $trans->screen_msg("No such item.");
+#
+# # END TRANSACTION (conditionally)
+# return $trans;
+# }
+#
+# # Remove the hold from the patron's record first
+# $trans->ok($patron->drop_hold($item_id));
+#
+# if (!$trans->ok) {
+# # We didn't find it on the patron record
+# $trans->screen_msg("No such hold on patron record.");
+#
+# # END TRANSACTION (conditionally)
+# return $trans;
+# }
+#
+# # Now, remove it from the item record. If it was on the patron
+# # record but not on the item record, we'll treat that as success.
+# foreach my $i (0 .. scalar @{$item->hold_queue}) {
+# $hold = $item->hold_queue->[$i];
+#
+# if ($hold->{patron_id} eq $patron->id) {
+# # found it: delete it.
+# splice @{$item->hold_queue}, $i, 1;
+# last;
+# }
+# }
+#
+# $trans->screen_msg("Hold Cancelled.");
+# $trans->patron($patron);
+# $trans->item($item);
+#
+# return $trans;
+#}
+#
+#
+## The patron and item id's can't be altered, but the
+## date, location, and type can.
+#sub alter_hold {
+# my ($self, $patron_id, $patron_pwd, $item_id, $title_id,
+# $expiry_date, $pickup_location, $hold_type, $fee_ack) = @_;
+# my ($patron, $item);
+# my $hold;
+# my $trans;
+#
+# $trans = new ILS::Transaction::Hold;
+#
+# # BEGIN TRANSACTION
+# $patron = new ILS::Patron $patron_id;
+# if (!$patron) {
+# $trans->screen_msg("Invalid patron barcode.");
+#
+# return $trans;
+# }
+#
+# foreach my $i (0 .. scalar @{$patron->{hold_items}}) {
+# $hold = $patron->{hold_items}[$i];
+#
+# if ($hold->{item_id} eq $item_id) {
+# # Found it. So fix it.
+# $hold->{expiration_date} = $expiry_date if $expiry_date;
+# $hold->{pickup_location} = $pickup_location if $pickup_location;
+# $hold->{hold_type} = $hold_type if $hold_type;
+#
+# $trans->ok(1);
+# $trans->screen_msg("Hold updated.");
+# $trans->patron($patron);
+# $trans->item(new ILS::Item $hold->{item_id});
+# last;
+# }
+# }
+#
+# # The same hold structure is linked into both the patron's
+# # list of hold items and into the queue of outstanding holds
+# # for the item, so we don't need to search the hold queue for
+# # the item, since it's already been updated by the patron code.
+#
+# if (!$trans->ok) {
+# $trans->screen_msg("No such outstanding hold.");
+# }
+#
+# return $trans;
+#}
+#
+#sub renew {
+# my ($self, $patron_id, $patron_pwd, $item_id, $title_id,
+# $no_block, $nb_due_date, $third_party,
+# $item_props, $fee_ack) = @_;
+# my ($patron, $item);
+# my $trans;
+#
+# $trans = new ILS::Transaction::Renew;
+#
+# $trans->patron($patron = new ILS::Patron $patron_id);
+# if (!$patron) {
+# $trans->screen_msg("Invalid patron barcode.");
+#
+# return $trans;
+# } elsif (!$patron->renew_ok) {
+#
+# $trans->screen_msg("Renewals not allowed.");
+#
+# return $trans;
+# }
+#
+# if (defined($title_id)) {
+# # renewing a title, rather than an item (sort of)
+# # This is gross, but in a real ILS it would be better
+# foreach my $i (@{$patron->{items}}) {
+# $item = new ILS::Item $i;
+# last if ($title_id eq $item->title_id);
+# $item = undef;
+# }
+# } else {
+# foreach my $i (@{$patron->{items}}) {
+# if ($i == $item_id) {
+# # We have it checked out
+# $item = new ILS::Item $item_id;
+# last;
+# }
+# }
+# }
+#
+# if (!defined($item)) {
+# # It's not checked out to $patron_id
+# $trans->screen_msg("Item not checked out to " . $patron->name);
+# } elsif (!$item->available($patron_id)) {
+# $trans->screen_msg("Item has outstanding holds");
+# } else {
+# $trans->item($item);
+# $trans->renewal_ok(1);
+#
+# $trans->desensitize(0); # It's already checked out
+#
+# if ($no_block eq 'Y') {
+# $item->{due_date} = $nb_due_date;
+# } else {
+# $item->{due_date} = time + (14*24*60*60); # two weeks
+# }
+# if ($item_props) {
+# $item->{sip_item_properties} = $item_props;
+# }
+# $trans->ok(1);
+# $trans->renewal_ok(1);
+#
+# return $trans;
+# }
+#
+# return $trans;
+#}
+#
+#sub renew_all {
+# my ($self, $patron_id, $patron_pwd, $fee_ack) = @_;
+# my ($patron, $item_id);
+# my $trans;
+#
+# $trans = new ILS::Transaction::RenewAll;
+#
+# $trans->patron($patron = new ILS::Patron $patron_id);
+# if (defined $patron) {
+# syslog("LOG_DEBUG", "ILS::renew_all: patron '%s': renew_ok: %s",
+# $patron->name, $patron->renew_ok);
+# } else {
+# syslog("LOG_DEBUG", "ILS::renew_all: Invalid patron id: '%s'",
+# $patron_id);
+# }
+#
+# if (!defined($patron)) {
+# $trans->screen_msg("Invalid patron barcode.");
+# return $trans;
+# } elsif (!$patron->renew_ok) {
+# $trans->screen_msg("Renewals not allowed.");
+# return $trans;
+# } elsif (defined($patron_pwd) && !$patron->check_password($patron_pwd)) {
+# $trans->screen_msg("Invalid patron password.");
+# return $trans;
+# }
+#
+# foreach $item_id (@{$patron->{items}}) {
+# my $item = new ILS::Item $item_id;
+#
+# if (!defined($item)) {
+# syslog("LOG_WARNING",
+# "renew_all: Invalid item id associated with patron '%s'",
+# $patron->id);
+# next;
+# }
+#
+# if (@{$item->hold_queue}) {
+# # Can't renew if there are outstanding holds
+# push @{$trans->unrenewed}, $item_id;
+# } else {
+# $item->{due_date} = time + (14*24*60*60); # two weeks hence
+# push @{$trans->renewed}, $item_id;
+# }
+# }
+#
+# $trans->ok(1);
+#
+# return $trans;
+#}
+
+1;
--- /dev/null
+#
+#
+# A Class for hiding the ILS's concept of the item from the OpenSIP
+# system
+#
+
+package OpenILS::SIP::Item;
+
+use strict;
+use warnings;
+
+use Sys::Syslog qw(syslog);
+
+use OpenILS::SIP::Transaction;
+use OpenILS::Application::AppUtils;
+my $U = 'OpenILS::Application::AppUtils';
+
+my %item_db;
+
+sub new {
+ my ($class, $item_id) = @_;
+ my $type = ref($class) || $class;
+ my $self = {};
+ bless $self, $type;
+
+ require OpenILS::Utils::CStoreEditor;
+ my $e = OpenILS::Utils::CStoreEditor->new;
+
+ if(!UNIVERSAL::can($e, 'search_actor_card')) {
+ syslog("LOG_WARNING", "Reloading CStoreEditor...");
+ delete $INC{'OpenILS/Utils/CStoreEditor.pm'};
+ require OpenILS::Utils::CStoreEditor;
+ $e = OpenILS::Utils::CStoreEditor->new;
+ }
+
+
+ # FLESH ME
+ my $copy = $e->search_asset_copy(
+ [
+ { barcode => $item_id },
+ {
+ flesh => 3,
+ flesh_fields => {
+ acp => [ 'circ_lib', 'call_number' ],
+ acn => [ 'owning_lib', 'record' ],
+ }
+ }
+ ]
+ );
+
+ if(!@$copy) {
+ syslog("LOG_DEBUG", "OpenILS: Item '%s' : not found", $item_id);
+ return undef;
+ }
+
+ $copy = $$copy[0];
+
+ # XXX See if i am checked out, if so set $self->{patron} to the user's barcode
+ my ($circ) = $U->fetch_open_circulation($copy->id);
+ if($circ) {
+ my $user = $e->retrieve_actor_user(
+ [
+ $circ->usr,
+ {
+ flesh => 1,
+ flesh_fields => {
+ "au" => [ 'card' ],
+ }
+ }
+ ]
+ );
+
+ $self->{patron} = $user->card->barcode if $user;
+ $self->{patron_object} = $user;
+ }
+
+ $self->{id} = $item_id;
+ $self->{copy} = $copy;
+ $self->{volume} = $copy->call_number;
+ $self->{record} = $copy->call_number->record;
+
+ $self->{mods} = $U->record_to_mvr($self->{record}) if $self->{record}->marc;
+
+ syslog("LOG_DEBUG", "new OpenILS Item('%s'): found with title '%s'",
+ $item_id, $self->title_id);
+
+ return $self;
+}
+
+sub magnetic {
+ my $self = shift;
+ return 0;
+}
+
+sub sip_media_type {
+ my $self = shift;
+ return '001';
+}
+
+sub sip_item_properties {
+ my $self = shift;
+ return "";
+}
+
+sub status_update {
+ my ($self, $props) = @_;
+ my $status = new OpenILS::SIP::Transaction;
+ $self->{sip_item_properties} = $props;
+ $status->{ok} = 1;
+ return $status;
+}
+
+
+sub id {
+ my $self = shift;
+ return $self->{id};
+}
+
+sub title_id {
+ my $self = shift;
+ return ($self->{mods}) ? $self->{mods}->title : $self->{copy}->dummy_title;
+}
+
+sub permanent_location {
+ my $self = shift;
+ return $self->{volume}->owning_lib->name;
+}
+
+sub current_location {
+ my $self = shift;
+ return $self->{copy}->circ_lib->name;
+}
+
+
+# 2 chars 0-99
+sub sip_circulation_status {
+ my $self = shift;
+ return '01';
+}
+
+sub sip_security_marker {
+ return '02';
+}
+
+sub sip_fee_type {
+ return '01';
+}
+
+sub fee {
+ my $self = shift;
+ return 0;
+}
+
+
+sub fee_currency {
+ my $self = shift;
+ 'CAD';
+}
+
+sub owner {
+ my $self = shift;
+ return $self->{volume}->owning_lib->name;
+}
+
+sub hold_queue {
+ my $self = shift;
+ return [];
+}
+
+sub hold_queue_position {
+ my ($self, $patron_id) = @_;
+ return 1;
+}
+
+sub due_date {
+ my $self = shift;
+ return 0;
+}
+
+sub recall_date {
+ my $self = shift;
+ return 0;
+}
+
+sub hold_pickup_date {
+ my $self = shift;
+ return 0;
+}
+
+# message to display on console
+sub screen_msg {
+ my $self = shift;
+ return $self->{screen_msg} || '';
+}
+
+
+# reciept printer
+sub print_line {
+ my $self = shift;
+ return $self->{print_line} || '';
+}
+
+
+# An item is available for a patron if
+# 1) It's not checked out and (there's no hold queue OR patron
+# is at the front of the queue)
+# OR
+# 2) It's checked out to the patron and there's no hold queue
+sub available {
+ my ($self, $for_patron) = @_;
+ return 1;
+}
+
+
+1;
--- /dev/null
+#
+#
+# A Class for hiding the ILS's concept of the patron from the OpenSIP
+# system
+#
+
+package OpenILS::SIP::Patron;
+
+use strict;
+use warnings;
+use Exporter;
+
+use Sys::Syslog qw(syslog);
+use Data::Dumper;
+use Digest::MD5 qw(md5_hex);
+
+use OpenILS::Application::AppUtils;
+my $U = 'OpenILS::Application::AppUtils';
+
+our (@ISA, @EXPORT_OK);
+
+@ISA = qw(Exporter);
+
+@EXPORT_OK = qw(invalid_patron);
+
+sub new {
+ my ($class, $patron_id) = @_;
+ my $type = ref($class) || $class;
+ my $self = {};
+
+ syslog("LOG_DEBUG", "new OpenILS Patron(%s): searching...", $patron_id);
+
+ require OpenILS::Utils::CStoreEditor;
+ my $e = OpenILS::Utils::CStoreEditor->new;
+
+ if(!UNIVERSAL::can($e, 'search_actor_card')) {
+ syslog("LOG_WARNING", "Reloading CStoreEditor...");
+ delete $INC{'OpenILS/Utils/CStoreEditor.pm'};
+ require OpenILS::Utils::CStoreEditor;
+ $e = OpenILS::Utils::CStoreEditor->new;
+ }
+
+
+ my $c = $e->search_actor_card({barcode => $patron_id}, {idlist=>1});
+ my $user;
+
+ if( @$c ) {
+
+ $user = $e->search_actor_user(
+ [
+ { card => $$c[0] },
+ {
+ flesh => 1,
+ flesh_fields => {
+ "au" => [
+ #"cards",
+ "card",
+ "standing_penalties",
+ "addresses",
+ "billing_address",
+ "mailing_address",
+ #"stat_cat_entries",
+ 'profile',
+ ]
+ }
+ }
+ ]
+ );
+
+ $user = (@$user) ? $$user[0] : undef;
+ }
+
+ if(!$user) {
+ syslog("LOG_WARNING", "Unable to find patron %s", $patron_id);
+ return undef;
+ }
+
+ $self->{user} = $user;
+ $self->{id} = $patron_id;
+ $self->{editor} = $e;
+
+ syslog("LOG_DEBUG", "new OpenILS Patron(%s): found patron '%s'", $patron_id);
+
+ bless $self, $type;
+ return $self;
+}
+
+sub id {
+ my $self = shift;
+ return $self->{id};
+}
+
+sub name {
+ my $self = shift;
+ my $u = $self->{user};
+ return $u->first_given_name . ' ' .
+ $u->second_given_name . ' ' . $u->family_name;
+}
+
+sub __addr_string {
+ my $addr = shift;
+ return "" unless $addr;
+ return $addr->street1 .' '.
+ $addr->street2 .' '.
+ $addr->city .' '.
+ $addr->county .' '.
+ $addr->state .' '.
+ $addr->country .' '.
+ $addr->post_code;
+}
+
+sub address {
+ my $self = shift;
+ my $u = $self->{user};
+ my $addr = $u->billing_address;
+ my $str = __addr_string($addr);
+ my $maddr = $u->mailing_address;
+ $str .= "\n" . __addr_string($maddr)
+ if $maddr and $maddr->id ne $addr->id;
+ return $str;
+}
+
+sub email_addr {
+ my $self = shift;
+ return $self->{user}->email;
+}
+
+sub home_phone {
+ my $self = shift;
+ return $self->{user}->day_phone;
+}
+
+sub sip_birthdate {
+ my $self = shift;
+ return $self->{user}->dob;
+}
+
+sub ptype {
+ my $self = shift;
+ return $self->{user}->profile->name;
+}
+
+sub language {
+ my $self = shift;
+ return '000'; # Unspecified
+}
+
+# How much more detail do we need to check here?
+sub charge_ok {
+ my $self = shift;
+ my $u = $self->{user};
+ return ($u->barred ne 't') and ($u->card->active ne 'f');
+}
+
+# How much more detail do we need to check here?
+sub renew_ok {
+ my $self = shift;
+ my $u = $self->{user};
+ return ($u->barred ne 'f') and ($u->card->active ne 'f');
+}
+
+sub recall_ok {
+ my $self = shift;
+ return 0;
+}
+
+sub hold_ok {
+ my $self = shift;
+ return 0;
+}
+
+# return true if the card provided is marked as lost
+sub card_lost {
+ my $self = shift;
+ return 0;
+}
+
+sub recall_overdue {
+ my $self = shift;
+ return 0;
+}
+
+
+sub check_password {
+ my ($self, $pwd) = @_;
+ return md5_hex($pwd) eq $self->{user}->passwd;
+}
+
+
+sub currency {
+ my $self = shift;
+ return 'usd';
+}
+
+
+sub fee_amount {
+ my $self = shift;
+ return 0;
+}
+
+sub screen_msg {
+ my $self = shift;
+ return '';
+}
+
+sub print_line {
+ my $self = shift;
+ return '';
+}
+
+sub too_many_charged {
+ my $self = shift;
+ return 0;
+}
+
+sub too_many_overdue {
+ my $self = shift;
+ if( $self->{user}->standing_penalties ) {
+ return grep { $_->penalty_type eq 'PATRON_EXCEEDS_OVERDUE_COUNT' }
+ @{$self->{user}->standing_penalties};
+ }
+ return 0;
+}
+
+# not completely sure what this means
+sub too_many_renewal {
+ my $self = shift;
+ return 0;
+}
+
+# not relevant, handled by fines/fees
+sub too_many_claim_return {
+ my $self = shift;
+ return 0;
+}
+
+# not relevant, handled by fines/fees
+sub too_many_lost {
+ my $self = shift;
+ return 0;
+}
+
+sub excessive_fines {
+ my $self = shift;
+ if( $self->{user}->standing_penalties ) {
+ return grep { $_->penalty_type eq 'PATRON_EXCEEDS_FINES' }
+ @{$self->{user}->standing_penalties};
+ }
+ return 0;
+}
+
+
+# Until someone suggests otherwise, fees and fines are the same
+
+sub excessive_fees {
+ my $self = shift;
+ if( $self->{user}->standing_penalties ) {
+ return grep { $_->penalty_type eq 'PATRON_EXCEEDS_FINES' }
+ @{$self->{user}->standing_penalties};
+ }
+ return 0;
+}
+
+# not relevant, handled by fines/fees
+sub too_many_billed {
+ my $self = shift;
+ return 0;
+}
+
+
+
+#
+# List of outstanding holds placed
+#
+sub hold_items {
+ my ($self, $start, $end) = @_;
+
+ my $holds = $self->{editor}->search_action_hold_request(
+ { usr => $self->{user}->id, fulfillment_time => undef }
+ );
+
+ my @holds;
+ push( @holds, $self->__hold_to_title($_) ) for @$holds;
+
+ return (defined $start and defined $end) ?
+ [ $holds[($start-1)..($end-1)] ] :
+ \@holds;
+}
+
+sub __hold_to_title {
+ my $self = shift;
+ my $hold = shift;
+ my $e = $self->{editor};
+
+ my( $id, $mods, $title, $volume, $copy );
+
+ if( $hold->hold_type eq 'C' ) {
+ $copy = $e->retrieve_asset_copy($hold->target);
+ }
+
+ if( $copy || $hold->hold_type eq 'V' ) {
+ return $copy->dummy_title if $copy and $copy->call_number == -1;
+ $id = ($copy) ? $copy->call_number : $hold->target;
+ $volume = $e->retrieve_asset_call_number($id);
+ }
+
+ if( $volume || $hold->hold_type eq 'T' ) {
+ $id = ($volume) ? $volume->record : $hold->target;
+ $mods = $U->simplereq(
+ 'open-ils.search',
+ 'open-ils.search.biblio.record.mods_slim.retrieve', $id );
+ }
+
+ if( $hold->hold_type eq 'M' ) {
+ $mods = $U->simplereq(
+ 'open-ils.search',
+ 'open-ils.search.biblio.metarecord.mods_slim.retrieve', $hold->target);
+ }
+
+
+ return ($mods) ? $mods->title : "";
+}
+
+#
+# remove the hold on item item_id from my hold queue.
+# return true if I was holding the item, false otherwise.
+#
+sub drop_hold {
+ my ($self, $item_id) = @_;
+ return 0;
+}
+
+sub overdue_items {
+ my ($self, $start, $end) = @_;
+ my @overdues;
+
+ return (defined $start and defined $end) ?
+ [ $overdues[($start-1)..($end-1)] ] :
+ \@overdues;
+}
+
+sub charged_items {
+ my ($self, $start, $end) = shift;
+ my @charges;
+
+ return (defined $start and defined $end) ?
+ [ $charges[($start-1)..($end-1)] ] :
+ \@charges;
+}
+
+sub fine_items {
+ my ($self, $start, $end) = @_;
+ my @fines;
+ return (defined $start and defined $end) ?
+ [ $fines[($start-1)..($end-1)] ] : \@fines;
+}
+
+# not currently supported
+sub recall_items {
+ my ($self, $start, $end) = @_;
+ return [];
+}
+
+sub unavail_holds {
+ my ($self, $start, $end) = @_;
+ my @holds;
+ return (defined $start and defined $end) ?
+ [ $holds[($start-1)..($end-1)] ] : \@holds;
+}
+
+sub block {
+ my ($self, $card_retained, $blocked_card_msg) = @_;
+ # Mark the card as inactive, set patron alert
+ return $self;
+}
+
+# Testing purposes only
+sub enable {
+ my $self = shift;
+ # Un-mark card as inactive, grep out the patron alert
+ $self->{screen_msg} = "All privileges restored.";
+ return $self;
+}
+
+#
+# Messages
+#
+
+sub invalid_patron {
+ return "Please contact library staff";
+}
+
+sub charge_denied {
+ return "Please contact library staff";
+}
+
+1;
--- /dev/null
+#
+# Transaction: Superclass of all the transactional status objects
+#
+
+package OpenILS::SIP::Transaction;
+
+use Carp;
+use strict; use warnings;
+use Sys::Syslog qw(syslog);
+
+
+my %fields = (
+ ok => 0,
+ patron => undef,
+ item => undef,
+ desensitize => 0,
+ alert => '',
+ transation_id => undef,
+ sip_fee_type => '01', # Other/Unknown
+ fee_amount => undef,
+ sip_currency => 'CAD',
+ screen_msg => '',
+ print_line => '',
+ editor => undef,
+ authtoken => '',
+ );
+
+our $AUTOLOAD;
+
+# returns the global transaction pointer
+#sub get_xact {
+# my $class = shift;
+# return $XACT;
+#}
+#
+#sub session {
+# my( $self, $session ) = @_;
+# $self->{session} = $session if $session;
+# return $self->{session};
+#}
+#
+#
+#sub create_session {
+# my( $self, $patron ) = @_;
+# $self->commit_session if $self->session_is_alive;
+# require OpenILS::Utils::CStoreEditor;
+# return $self->{session} = {
+# editor => OpenILS::Utils::CStoreEditor->new(xact=>1),
+# patron => $patron
+# }
+#}
+#
+#sub commit_session {
+# my $self = shift;
+# if( my $session = $self->session ) {
+# $session->{editor}->commit;
+# delete $$session{editor};
+# delete $$session{patron};
+# }
+#}
+#
+#
+#sub rollback_session {
+# my $self = shift;
+# if( my $session = $self->session ) {
+# $session->{editor}->xact_rollback;
+# delete $$session{editor};
+# delete $$session{patron};
+# }
+#}
+#
+#sub session_is_alive {
+# my $self = shift;
+# return $self->session and $self->session->{editor};
+#}
+
+
+
+sub new {
+ my( $class, %args ) = @_;
+
+ use Data::Dumper;
+ warn 'ARGS = ' . Dumper(\@_);
+
+ warn "AUTH = " . $args{authtoken} . "\n";
+
+ my $self = {
+ _permitted => \%fields,
+ %fields,
+ };
+
+ bless $self, $class;
+ $self->authtoken($args{authtoken});
+
+ syslog('LOG_DEBUG', "OpenILS: Created new transaction with authtoken %s", $self->authtoken);
+
+ require OpenILS::Utils::CStoreEditor;
+ $self->editor(OpenILS::Utils::CStoreEditor->new(
+ xact=>1, authtoken => $self->authtoken));
+
+ return $self;
+}
+
+sub DESTROY {
+ # be cool
+}
+
+sub AUTOLOAD {
+ my $self = shift;
+ my $class = ref($self) or croak "$self is not an object";
+ my $name = $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;
--- /dev/null
+#
+# An object to handle checkin status
+#
+
+package OpenILS::SIP::Transaction::Checkin;
+
+use warnings;
+use strict;
+
+use POSIX qw(strftime);
+
+use OpenILS::SIP;
+use OpenILS::SIP::Transaction;
+use Data::Dumper;
+
+use OpenILS::Application::AppUtils;
+my $U = 'OpenILS::Application::AppUtils';
+
+our @ISA = qw(OpenILS::SIP::Transaction);
+
+my %fields = (
+ magnetic => 0,
+ sort_bin => undef,
+ );
+
+sub new {
+ my $class = shift;;
+ my $self = $class->SUPER::new(@_);
+ my $element;
+
+ foreach $element (keys %fields) {
+ $self->{_permitted}->{$element} = $fields{$element};
+ }
+
+ @{$self}{keys %fields} = values %fields;
+
+ return bless $self, $class;
+}
+
+sub resensitize {
+ my $self = shift;
+ return !$self->{item}->magnetic;
+}
+
+
+sub do_checkin {
+ my $self = shift;
+
+ my $resp = $U->simplereq(
+ 'open-ils.circ',
+ 'open-ils.circ.checkin',
+ $self->{authtoken}, { barcode => $self->{item}->id } );
+
+
+ my $circ = $resp->{payload}->{circ};
+
+ if(!$circ) {
+ warn 'CHECKIN: ' . Dumper($resp) . "\n";
+ $self->ok(0);
+ return 0;
+ }
+
+ $self->{item}->{patron} = $self->editor->search_actor_card(
+ { usr => $circ->usr, active => 't' } )->[0]->barcode;
+
+ $self->ok(1);
+
+ return 1;
+}
+
+
+1;
--- /dev/null
+#
+# An object to handle checkout status
+#
+
+package OpenILS::SIP::Transaction::Checkout;
+
+use warnings;
+use strict;
+
+use POSIX qw(strftime);
+
+use OpenILS::SIP;
+use OpenILS::SIP::Transaction;
+use Sys::Syslog qw(syslog);
+
+use OpenILS::Application::AppUtils;
+my $U = 'OpenILS::Application::AppUtils';
+
+
+our @ISA = qw(OpenILS::SIP::Transaction);
+
+# Most fields are handled by the Transaction superclass
+my %fields = (
+ security_inhibit => 0,
+ due => undef,
+ renew_ok => 0,
+ );
+
+sub new {
+ my $class = shift;
+
+ use Data::Dumper;
+ warn 'ARGS = ' . Dumper(\@_);
+
+ my $self = $class->SUPER::new(@_);
+
+ my $element;
+
+ foreach $element (keys %fields) {
+ $self->{_permitted}->{$element} = $fields{$element};
+ }
+
+ @{$self}{keys %fields} = values %fields;
+
+ return bless $self, $class;
+}
+
+
+# if this item is already checked out to the requested patron,
+# renew the item and set $self->renew_ok to true.
+# XXX if it's a renewal and the renewal is not permitted, set
+# $self->screen_msg("Item on Hold for Another User"); (or somesuch)
+# XXX Set $self->ok(0) on any errors
+sub do_checkout {
+ my $self = shift;
+ syslog('LOG_DEBUG', "OpenILS: performing checkout...");
+
+ my $args = {
+ barcode => $self->{item}->id,
+ patron_barcode => $self->{patron}->id
+ };
+
+ my $resp = $U->simplereq(
+ 'open-ils.circ',
+ 'open-ils.circ.checkout.permit',
+ $self->{authtoken}, $args );
+
+ my $key;
+
+ if( ref($resp) eq 'HASH' and $key = $resp->{payload} ) {
+ syslog('LOG_INFO', "OpenILS: circ permit key => $key");
+
+ } else {
+ syslog('LOG_INFO', "OpenILS: Circ permit failed :\n" . Dumper($resp) );
+ $self->ok(0);
+ return 0;
+ }
+
+ $args = {
+ permit_key => $key,
+ patron_barcode => $self->{patron}->id,
+ barcode => $self->{item}->id
+ };
+
+ $resp = $U->simplereq(
+ 'open-ils.circ',
+ 'open-ils.circ.checkout', $self->{authtoken}, $args );
+
+ # XXX Check for events
+ if( $resp ) {
+ syslog('LOG_INFO', "OpenILS: Checkout succeeded");
+ my $evt = $resp->{ilsevent};
+ my $circ = $resp->{payload}->{circ};
+
+ if(!$circ or $evt ne 0) {
+ $self->ok(0);
+ warn 'CHECKOUT RESPONSE: ' . Dumper($resp) . "\n";
+ return 0;
+ }
+
+ $self->{'due'} = $circ->due_date;
+ $self->ok(1);
+ return 1;
+ }
+
+ return 0;
+}
+
+
+
+1;
projects / Evergreen.git / commitdiff