--- /dev/null
+package Fieldmapper;
+use OpenSRF::Utils::JSON;
+use Data::Dumper;
+use OpenSRF::Utils::Logger;
+use OpenSRF::Utils::SettingsClient;
+use OpenSRF::System;
+use XML::LibXML;
+use Scalar::Util 'blessed';
+
+my $log = 'OpenSRF::Utils::Logger';
+
+use vars qw/$fieldmap $VERSION/;
+
+#
+# To dump the Javascript version of the fieldmapper struct use the command:
+#
+# PERL5LIB=:~/vcs/ILS/Open-ILS/src/perlmods/lib/ GEN_JS=1 perl -MOpenILS::Utils::Fieldmapper -e 'print "\n";'
+#
+# ... adjusted for your VCS sandbox of choice, of course.
+#
+
+sub classes {
+ return () unless (defined $fieldmap);
+ return keys %$fieldmap;
+}
+
+# Find a Fieldmapper class given the json hint.
+sub class_for_hint {
+ my $hint = shift;
+ foreach (keys %$fieldmap) {
+ return $_ if ($fieldmap->{$_}->{hint} eq $hint);
+ }
+ return undef;
+}
+
+sub get_attribute {
+ my $attr_list = shift;
+ my $attr_name = shift;
+
+ my $attr = $attr_list->getNamedItem( $attr_name );
+ if( defined( $attr ) ) {
+ return $attr->getValue();
+ }
+ return undef;
+}
+
+sub load_fields {
+ my $field_list = shift;
+ my $fm = shift;
+
+ # Get attributes of the field list. Since there is only one
+ # <field> per class, these attributes logically belong to the
+ # enclosing class, and that's where we load them.
+
+ my $field_attr_list = $field_list->attributes();
+
+ my $sequence = get_attribute( $field_attr_list, 'oils_persist:sequence' );
+ if( ! defined( $sequence ) ) {
+ $sequence = '';
+ }
+ my $primary = get_attribute( $field_attr_list, 'oils_persist:primary' );
+
+ # Load attributes into the Fieldmapper ----------------------
+
+ $$fieldmap{$fm}{ sequence } = $sequence;
+ $$fieldmap{$fm}{ identity } = $primary;
+
+ # Load each field -------------------------------------------
+
+ my $array_position = 0;
+ for my $field ( $field_list->childNodes() ) { # For each <field>
+ if( $field->nodeName eq 'field' ) {
+
+ my $attribute_list = $field->attributes();
+
+ my $name = get_attribute( $attribute_list, 'name' );
+ next if( $name eq 'isnew' || $name eq 'ischanged' || $name eq 'isdeleted' );
+ my $required = get_attribute( $attribute_list, 'oils_obj:required' );
+ my $validate = get_attribute( $attribute_list, 'oils_obj:validate' );
+ my $virtual = get_attribute( $attribute_list, 'oils_persist:virtual' );
+ if( ! defined( $virtual ) ) {
+ $virtual = "false";
+ }
+ my $selector = get_attribute( $attribute_list, 'reporter:selector' );
+
+ $$fieldmap{$fm}{fields}{ $name } =
+ { virtual => ( $virtual eq 'true' ) ? 1 : 0,
+ required => ( $required eq 'true' ) ? 1 : 0,
+ position => $array_position,
+ };
+
+ $$fieldmap{$fm}{fields}{ $name }{validate} = qr/$validate/ if (defined($validate));
+
+ # The selector attribute, if present at all, attaches to only one
+ # of the fields in a given class. So if we see it, we store it at
+ # the level of the enclosing class.
+
+ if( defined( $selector ) ) {
+ $$fieldmap{$fm}{selector} = $selector;
+ }
+
+ ++$array_position;
+ }
+ }
+
+ # Load the standard 3 virtual fields ------------------------
+
+ for my $vfield ( qw/isnew ischanged isdeleted/ ) {
+ $$fieldmap{$fm}{fields}{ $vfield } =
+ { position => $array_position,
+ virtual => 1
+ };
+ ++$array_position;
+ }
+}
+
+sub load_links {
+ my $link_list = shift;
+ my $fm = shift;
+
+ for my $link ( $link_list->childNodes() ) { # For each <link>
+ if( $link->nodeName eq 'link' ) {
+ my $attribute_list = $link->attributes();
+
+ my $field = get_attribute( $attribute_list, 'field' );
+ my $reltype = get_attribute( $attribute_list, 'reltype' );
+ my $key = get_attribute( $attribute_list, 'key' );
+ my $class = get_attribute( $attribute_list, 'class' );
+ my $map = get_attribute( $attribute_list, 'map' );
+
+ $$fieldmap{$fm}{links}{ $field } =
+ { class => $class,
+ reltype => $reltype,
+ key => $key,
+ map => $map
+ };
+ }
+ }
+}
+
+sub load_class {
+ my $class_node = shift;
+
+ # Get attributes ---------------------------------------------
+
+ my $attribute_list = $class_node->attributes();
+
+ my $fm = get_attribute( $attribute_list, 'oils_obj:fieldmapper' );
+ $fm = 'Fieldmapper::' . $fm;
+ my $id = get_attribute( $attribute_list, 'id' );
+ my $controller = get_attribute( $attribute_list, 'controller' );
+ my $virtual = get_attribute( $attribute_list, 'virtual' );
+ if( ! defined( $virtual ) ) {
+ $virtual = 'false';
+ }
+ my $tablename = get_attribute( $attribute_list, 'oils_persist:tablename' );
+ if( ! defined( $tablename ) ) {
+ $tablename = '';
+ }
+ my $restrict_primary = get_attribute( $attribute_list, 'oils_persist:restrict_primary' );
+ my $field_safe = get_attribute( $attribute_list, 'oils_persist:field_safe' );
+
+ # Load the attributes into the Fieldmapper --------------------
+
+ $log->debug("Building Fieldmapper class for [$fm] from IDL");
+
+ $$fieldmap{$fm}{ hint } = $id;
+ $$fieldmap{$fm}{ virtual } = ( $virtual eq 'true' ) ? 1 : 0;
+ $$fieldmap{$fm}{ table } = $tablename;
+ $$fieldmap{$fm}{ controller } = [ split ' ', $controller ];
+ $$fieldmap{$fm}{ restrict_primary } = $restrict_primary;
+ $$fieldmap{$fm}{ field_safe } = $field_safe;
+
+ # Load fields and links
+
+ for my $child ( $class_node->childNodes() ) {
+ my $nodeName = $child->nodeName;
+ if( $nodeName eq 'fields' ) {
+ load_fields( $child, $fm );
+ } elsif( $nodeName eq 'links' ) {
+ load_links( $child, $fm );
+ }
+ }
+}
+
+import();
+sub import {
+ my $class = shift;
+ my %args = @_;
+
+ return if (keys %$fieldmap);
+ return if (!OpenSRF::System->connected && !$args{IDL});
+
+ # parse the IDL ...
+ my $parser = XML::LibXML->new();
+ my $file = $args{IDL} || OpenSRF::Utils::SettingsClient->new->config_value( 'IDL' );
+ my $fmdoc = $parser->parse_file( $file );
+ my $rootnode = $fmdoc->documentElement();
+
+ for my $child ( $rootnode->childNodes() ) { # For each <class>
+ my $nodeName = $child->nodeName;
+ if( $nodeName eq 'class' ) {
+ load_class( $child );
+ }
+ }
+
+ #-------------------------------------------------------------------------------
+ # Now comes the evil! Generate classes
+
+ for my $pkg ( __PACKAGE__->classes ) {
+ (my $cdbi = $pkg) =~ s/^Fieldmapper:://o;
+
+ eval <<" PERL";
+ package $pkg;
+ use base 'Fieldmapper';
+ PERL
+
+ if (exists $$fieldmap{$pkg}{proto_fields}) {
+ for my $pfield ( sort keys %{ $$fieldmap{$pkg}{proto_fields} } ) {
+ $$fieldmap{$pkg}{fields}{$pfield} = { position => $pos, virtual => $$fieldmap{$pkg}{proto_fields}{$pfield} };
+ $pos++;
+ }
+ }
+
+ OpenSRF::Utils::JSON->register_class_hint(
+ hint => $pkg->json_hint,
+ name => $pkg,
+ type => 'array',
+ );
+
+ }
+}
+
+sub new {
+ my $self = shift;
+ my $value = shift;
+ $value = [] unless (defined $value);
+ return bless $value => $self->class_name;
+}
+
+sub decast {
+ my $self = shift;
+ return [ @$self ];
+}
+
+sub DESTROY {}
+
+sub AUTOLOAD {
+ my $obj = shift;
+ my $value = shift;
+ (my $field = $AUTOLOAD) =~ s/^.*://o;
+ my $class_name = $obj->class_name;
+
+ my $fpos = $field;
+ $fpos =~ s/^clear_//og ;
+
+ my $pos = $$fieldmap{$class_name}{fields}{$fpos}{position};
+
+ if ($field =~ /^clear_/o) {
+ { no strict 'subs';
+ *{$obj->class_name."::$field"} = sub {
+ my $self = shift;
+ $self->[$pos] = undef;
+ return 1;
+ };
+ }
+ return $obj->$field();
+ }
+
+ die "No field by the name $field in $class_name!"
+ unless (exists $$fieldmap{$class_name}{fields}{$field} && defined($pos));
+
+
+ { no strict 'subs';
+ *{$obj->class_name."::$field"} = sub {
+ my $self = shift;
+ my $new_val = shift;
+ $self->[$pos] = $new_val if (defined $new_val);
+ return $self->[$pos];
+ };
+ }
+ return $obj->$field($value);
+}
+
+sub Selector {
+ my $self = shift;
+ return $$fieldmap{$self->class_name}{selector};
+}
+
+sub Identity {
+ my $self = shift;
+ return $$fieldmap{$self->class_name}{identity};
+}
+
+sub RestrictPrimary {
+ my $self = shift;
+ return $$fieldmap{$self->class_name}{restrict_primary};
+}
+
+sub Sequence {
+ my $self = shift;
+ return $$fieldmap{$self->class_name}{sequence};
+}
+
+sub Table {
+ my $self = shift;
+ return $$fieldmap{$self->class_name}{table};
+}
+
+sub Controller {
+ my $self = shift;
+ return $$fieldmap{$self->class_name}{controller};
+}
+
+sub RequiredField {
+ my $self = shift;
+ my $f = shift;
+ return undef unless ($f);
+ return $$fieldmap{$self->class_name}{fields}{$f}{required};
+}
+
+sub toXML {
+ my $self = shift;
+ return undef unless (ref $self);
+
+ my $opts = shift || {};
+ my $no_virt = $$opts{no_virt}; # skip virtual fields
+ my $skip_fields = $$opts{skip_fields} || {}; # eg. {au => ['passwd']}
+ my @to_skip = @{$$skip_fields{$self->json_hint}}
+ if $$skip_fields{$self->json_hint};
+
+ my $dom = XML::LibXML::Document->new;
+ my $root = $dom->createElement( $self->json_hint );
+ $dom->setDocumentElement( $root );
+
+ my @field_names = $no_virt ? $self->real_fields : $self->properties;
+
+ for my $f (@field_names) {
+ next if ($f eq 'isnew');
+ next if ($f eq 'ischanged');
+ next if ($f eq 'isdeleted');
+ next if (grep {$_ eq $f} @to_skip);
+
+ my $value = $self->$f();
+ my $element = $dom->createElement( $f );
+
+ $value = [$value] if (blessed($value)); # fm object
+
+ if (ref($value)) { # array
+ for my $k (@$value) {
+ if (blessed($k)) {
+ my $subdoc = $k->toXML($opts);
+ next unless $subdoc;
+ my $subnode = $subdoc->documentElement;
+ $dom->adoptNode($subnode);
+ $element->appendChild($subnode);
+ } elsif (ref $k) { # not sure what to do here
+ $element->appendText($k);
+ } else { # meh .. just append, I guess
+ $element->appendText($k);
+ }
+ }
+ } else {
+ $element->appendText($value);
+ }
+
+ $root->appendChild($element);
+ }
+
+ return $dom;
+}
+
+sub ValidateField {
+ my $self = shift;
+ my $f = shift;
+ return undef unless ($f);
+ return 1 if (!exists($$fieldmap{$self->class_name}{fields}{$f}{validate}));
+ return $self->$f =~ $$fieldmap{$self->class_name}{fields}{$f}{validate};
+}
+
+sub class_name {
+ my $class_name = shift;
+ return ref($class_name) || $class_name;
+}
+
+sub real_fields {
+ my $self = shift;
+ my $class_name = $self->class_name;
+ my $fields = $$fieldmap{$class_name}{fields};
+
+ my @f = grep {
+ !$$fields{$_}{virtual}
+ } sort {$$fields{$a}{position} <=> $$fields{$b}{position}} keys %$fields;
+
+ return @f;
+}
+
+sub has_field {
+ my $self = shift;
+ my $field = shift;
+ my $class_name = $self->class_name;
+ return 1 if grep { $_ eq $field } keys %{$$fieldmap{$class_name}{fields}};
+ return 0;
+}
+
+sub properties {
+ my $self = shift;
+ my $class_name = $self->class_name;
+ return keys %{$$fieldmap{$class_name}{fields}};
+}
+
+sub to_bare_hash {
+ my $self = shift;
+
+ my %hash = ();
+ for my $f ($self->properties) {
+ my $val = $self->$f;
+ $hash{$f} = $val;
+ }
+
+ return \%hash;
+}
+
+sub clone {
+ my $self = shift;
+ return $self->new( [@$self] );
+}
+
+sub api_level {
+ my $self = shift;
+ return $fieldmap->{$self->class_name}->{api_level};
+}
+
+sub cdbi {
+ my $self = shift;
+ return $fieldmap->{$self->class_name}->{cdbi};
+}
+
+sub is_virtual {
+ my $self = shift;
+ my $field = shift;
+ return $fieldmap->{$self->class_name}->{proto_fields}->{$field} if ($field);
+ return $fieldmap->{$self->class_name}->{virtual};
+}
+
+sub is_readonly {
+ my $self = shift;
+ my $field = shift;
+ return $fieldmap->{$self->class_name}->{readonly};
+}
+
+sub json_hint {
+ my $self = shift;
+ return $fieldmap->{$self->class_name}->{hint};
+}
+
+
+1;
--- /dev/null
+package ShareStuff::Actor;
+use ShareStuff;
+use base qw/ShareStuff/;
+use strict; use warnings;
+use Data::Dumper;
+$Data::Dumper::Indent = 0;
+use ShareStuff::Event;
+
+use Digest::MD5 qw(md5_hex);
+
+use OpenSRF::EX qw(:try);
+use ShareStuff::AppUtils;
+
+use Fieldmapper;
+use OpenSRF::Utils::Logger qw/$logger/;
+use OpenSRF::Utils qw/:datetime/;
+use OpenSRF::Utils::SettingsClient;
+
+use OpenSRF::Utils::Cache;
+
+use OpenSRF::Utils::JSON;
+use DateTime;
+use DateTime::Format::ISO8601;
+use ShareStuff::Const qw/:const/;
+
+use ShareStuff::CStoreEditor qw/:funcs/;
+use List::Util qw/max reduce/;
+
+use UUID::Tiny qw/:std/;
+
+sub initialize {
+}
+
+my $apputils = "ShareStuff::AppUtils";
+my $U = $apputils;
+
+sub _d { warn "Patron:\n" . Dumper(shift()); }
+
+my $cache;
+my $set_user_settings;
+my $set_ou_settings;
+
+
+#__PACKAGE__->register_method(
+# method => "allowed_test",
+# api_name => "open-ils.actor.allowed_test",
+#);
+#sub allowed_test {
+# my($self, $conn, $auth, $orgid, $permcode) = @_;
+# my $e = new_editor(authtoken => $auth);
+# return $e->die_event unless $e->checkauth;
+#
+# return {
+# orgid => $orgid,
+# permcode => $permcode,
+# result => $e->allowed($permcode, $orgid)
+# };
+#}
+
+__PACKAGE__->register_method(
+ method => "update_user_setting",
+ api_name => "open-ils.actor.patron.settings.update",
+);
+sub update_user_setting {
+ my($self, $conn, $auth, $user_id, $settings) = @_;
+ my $e = new_editor(xact => 1, authtoken => $auth);
+ return $e->die_event unless $e->checkauth;
+
+ $user_id = $e->requestor->id unless defined $user_id;
+
+ unless($e->requestor->id == $user_id) {
+ my $user = $e->retrieve_actor_user($user_id) or return $e->die_event;
+ return $e->die_event unless $e->allowed('UPDATE_USER', $user->home_ou);
+ }
+
+ for my $name (keys %$settings) {
+ my $val = $$settings{$name};
+ my $set = $e->search_actor_user_setting({usr => $user_id, name => $name})->[0];
+
+ if(defined $val) {
+ $val = OpenSRF::Utils::JSON->perl2JSON($val);
+ if($set) {
+ $set->value($val);
+ $e->update_actor_user_setting($set) or return $e->die_event;
+ } else {
+ $set = Fieldmapper::actor::user_setting->new;
+ $set->usr($user_id);
+ $set->name($name);
+ $set->value($val);
+ $e->create_actor_user_setting($set) or return $e->die_event;
+ }
+ } elsif($set) {
+ $e->delete_actor_user_setting($set) or return $e->die_event;
+ }
+ }
+
+ $e->commit;
+ return 1;
+}
+
+
+__PACKAGE__->register_method(
+ method => "set_ou_settings",
+ api_name => "open-ils.actor.org_unit.settings.update",
+ signature => {
+ desc => "Updates the value for a given org unit setting. The permission to update " .
+ "an org unit setting is either the UPDATE_ORG_UNIT_SETTING_ALL, or a specific " .
+ "permission specified in the update_perm column of the config.org_unit_setting_type " .
+ "table's row corresponding to the setting being changed." ,
+ params => [
+ {desc => 'Authentication token', type => 'string'},
+ {desc => 'Org unit ID', type => 'number'},
+ {desc => 'Hash of setting name-value pairs', type => 'object'}
+ ],
+ return => {desc => '1 on success, Event on error'}
+ }
+);
+
+sub set_ou_settings {
+ my( $self, $client, $auth, $org_id, $settings ) = @_;
+
+ my $e = new_editor(authtoken => $auth, xact => 1);
+ return $e->die_event unless $e->checkauth;
+
+ my $all_allowed = $e->allowed("UPDATE_ORG_UNIT_SETTING_ALL", $org_id);
+
+ for my $name (keys %$settings) {
+ my $val = $$settings{$name};
+
+ my $type = $e->retrieve_config_org_unit_setting_type([
+ $name,
+ {flesh => 1, flesh_fields => {'coust' => ['update_perm']}}
+ ]) or return $e->die_event;
+ my $set = $e->search_actor_org_unit_setting({org_unit => $org_id, name => $name})->[0];
+
+ # If there is no relevant permission, the default assumption will
+ # be, "no, the caller cannot change that value."
+ return $e->die_event unless ($all_allowed ||
+ ($type->update_perm && $e->allowed($type->update_perm->code, $org_id)));
+
+ if(defined $val) {
+ $val = OpenSRF::Utils::JSON->perl2JSON($val);
+ if($set) {
+ $set->value($val);
+ $e->update_actor_org_unit_setting($set) or return $e->die_event;
+ } else {
+ $set = Fieldmapper::actor::org_unit_setting->new;
+ $set->org_unit($org_id);
+ $set->name($name);
+ $set->value($val);
+ $e->create_actor_org_unit_setting($set) or return $e->die_event;
+ }
+ } elsif($set) {
+ $e->delete_actor_org_unit_setting($set) or return $e->die_event;
+ }
+ }
+
+ $e->commit;
+ return 1;
+}
+
+__PACKAGE__->register_method(
+ method => "user_settings",
+ authoritative => 1,
+ api_name => "open-ils.actor.patron.settings.retrieve",
+);
+sub user_settings {
+ my( $self, $client, $auth, $user_id, $setting ) = @_;
+
+ my $e = new_editor(authtoken => $auth);
+ return $e->event unless $e->checkauth;
+ $user_id = $e->requestor->id unless defined $user_id;
+
+ my $patron = $e->retrieve_actor_user($user_id) or return $e->event;
+ if($e->requestor->id != $user_id) {
+ return $e->event unless $e->allowed('VIEW_USER', $patron->home_ou);
+ }
+
+ sub get_setting {
+ my($e, $user_id, $setting) = @_;
+ my $val = $e->search_actor_user_setting({usr => $user_id, name => $setting})->[0];
+ return undef unless $val; # XXX this should really return undef, but needs testing
+ return OpenSRF::Utils::JSON->JSON2perl($val->value);
+ }
+
+ if($setting) {
+ if(ref $setting eq 'ARRAY') {
+ my %settings;
+ $settings{$_} = get_setting($e, $user_id, $_) for @$setting;
+ return \%settings;
+ } else {
+ return get_setting($e, $user_id, $setting);
+ }
+ } else {
+ my $s = $e->search_actor_user_setting({usr => $user_id});
+ return { map { ( $_->name => OpenSRF::Utils::JSON->JSON2perl($_->value) ) } @$s };
+ }
+}
+
+
+__PACKAGE__->register_method(
+ method => "ranged_ou_settings",
+ api_name => "open-ils.actor.org_unit_setting.values.ranged.retrieve",
+ signature => {
+ desc => "Retrieves all org unit settings for the given org_id, up to whatever limit " .
+ "is implied for retrieving OU settings by the authenticated users' permissions.",
+ params => [
+ {desc => 'Authentication token', type => 'string'},
+ {desc => 'Org unit ID', type => 'number'},
+ ],
+ return => {desc => 'A hashref of "ranged" settings, event on error'}
+ }
+);
+sub ranged_ou_settings {
+ my( $self, $client, $auth, $org_id ) = @_;
+
+ my $e = new_editor(authtoken => $auth);
+ return $e->event unless $e->checkauth;
+
+ my %ranged_settings;
+ my $org_list = $U->get_org_ancestors($org_id);
+ my $settings = $e->search_actor_org_unit_setting({org_unit => $org_list});
+ $org_list = [ reverse @$org_list ];
+
+ # start at the context org and capture the setting value
+ # without clobbering settings we've already captured
+ for my $this_org_id (@$org_list) {
+
+ my @sets = grep { $_->org_unit == $this_org_id } @$settings;
+
+ for my $set (@sets) {
+ my $type = $e->retrieve_config_org_unit_setting_type([
+ $set->name,
+ {flesh => 1, flesh_fields => {coust => ['view_perm']}}
+ ]);
+
+ # If there is no relevant permission, the default assumption will
+ # be, "yes, the caller can have that value."
+ if ($type && $type->view_perm) {
+ next if not $e->allowed($type->view_perm->code, $org_id);
+ }
+
+ $ranged_settings{$set->name} = OpenSRF::Utils::JSON->JSON2perl($set->value)
+ unless defined $ranged_settings{$set->name};
+ }
+ }
+
+ return \%ranged_settings;
+}
+
+
+
+__PACKAGE__->register_method(
+ api_name => 'open-ils.actor.ou_setting.ancestor_default',
+ method => 'ou_ancestor_setting',
+ signature => {
+ desc => 'Get the org unit setting value associated with the setting name as seen from the specified org unit. ' .
+ 'IF AND ONLY IF an authentication token is provided, this method will make sure that the given ' .
+ 'user has permission to view that setting, if there is a permission associated with the setting.' ,
+ params => [
+ { desc => 'Org unit ID', type => 'number' },
+ { desc => 'setting name', type => 'string' },
+ { desc => 'authtoken (optional)', type => 'string' }
+ ],
+ return => {desc => 'A value for the org unit setting, or undef'}
+ }
+);
+
+# ------------------------------------------------------------------
+# Attempts to find the org setting value for a given org. if not
+# found at the requested org, searches up the org tree until it
+# finds a parent that has the requested setting.
+# when found, returns { org => $id, value => $value }
+# otherwise, returns NULL
+# ------------------------------------------------------------------
+sub ou_ancestor_setting {
+ my( $self, $client, $orgid, $name, $auth ) = @_;
+ return $U->ou_ancestor_setting($orgid, $name, undef, $auth);
+}
+
+__PACKAGE__->register_method(
+ api_name => 'open-ils.actor.ou_setting.ancestor_default.batch',
+ method => 'ou_ancestor_setting_batch',
+ signature => {
+ desc => 'Get org unit setting name => value pairs for a list of names, as seen from the specified org unit. ' .
+ 'IF AND ONLY IF an authentication token is provided, this method will make sure that the given ' .
+ 'user has permission to view that setting, if there is a permission associated with the setting.' ,
+ params => [
+ { desc => 'Org unit ID', type => 'number' },
+ { desc => 'setting name list', type => 'array' },
+ { desc => 'authtoken (optional)', type => 'string' }
+ ],
+ return => {desc => 'A hash with name => value pairs for the org unit settings'}
+ }
+);
+sub ou_ancestor_setting_batch {
+ my( $self, $client, $orgid, $name_list, $auth ) = @_;
+ my %values;
+ $values{$_} = $U->ou_ancestor_setting($orgid, $_, undef, $auth) for @$name_list;
+ return \%values;
+}
+
+
+
+__PACKAGE__->register_method(
+ method => "update_patron",
+ api_name => "open-ils.actor.patron.update",
+ signature => {
+ desc => q/
+ Update an existing user, or create a new one. Related objects,
+ like cards, addresses, survey responses, and stat cats,
+ can be updated by attaching them to the user object in their
+ respective fields. For examples, the billing address object
+ may be inserted into the 'billing_address' field, etc. For each
+ attached object, indicate if the object should be created,
+ updated, or deleted using the built-in 'isnew', 'ischanged',
+ and 'isdeleted' fields on the object.
+ /,
+ params => [
+ { desc => 'Authentication token', type => 'string' },
+ { desc => 'Patron data object', type => 'object' }
+ ],
+ return => {desc => 'A fleshed user object, event on error'}
+ }
+);
+
+sub update_patron {
+ my( $self, $client, $user_session, $patron ) = @_;
+
+ my $session = $apputils->start_db_session();
+
+ $logger->info($patron->isnew ? "Creating new patron..." : "Updating Patron: " . $patron->id);
+
+ my( $user_obj, $evt ) = $U->checkses($user_session);
+ return $evt if $evt;
+
+ $evt = check_group_perm($session, $user_obj, $patron);
+ return $evt if $evt;
+
+ $apputils->set_audit_info($session, $user_session, $user_obj->id, $user_obj->wsid);
+
+ # $new_patron is the patron in progress. $patron is the original patron
+ # passed in with the method. new_patron will change as the components
+ # of patron are added/updated.
+
+ my $new_patron;
+
+ # create/update the patron first so we can use his id
+
+ # $patron is the obj from the client (new data) and $new_patron is the
+ # patron object properly built for db insertion, so we need a third variable
+ # if we want to represent the old patron.
+
+ my $old_patron;
+ my $barred_hook = '';
+
+ if($patron->isnew()) {
+ ( $new_patron, $evt ) = _add_patron($session, _clone_patron($patron), $user_obj);
+ return $evt if $evt;
+ if($U->is_true($patron->barred)) {
+ $evt = $U->check_perms($user_obj->id, $patron->home_ou, 'BAR_PATRON');
+ return $evt if $evt;
+ }
+ } else {
+ $new_patron = $patron;
+
+ # Did auth checking above already.
+ my $e = new_editor;
+ $old_patron = $e->retrieve_actor_user($patron->id) or
+ return $e->die_event;
+ $e->disconnect;
+ if($U->is_true($old_patron->barred) != $U->is_true($new_patron->barred)) {
+ $evt = $U->check_perms($user_obj->id, $patron->home_ou, $U->is_true($old_patron->barred) ? 'UNBAR_PATRON' : 'BAR_PATRON');
+ return $evt if $evt;
+
+ $barred_hook = $U->is_true($new_patron->barred) ?
+ 'au.barred' : 'au.unbarred';
+ }
+ }
+
+ ($new_patron, $evt) = _create_perm_maps($session, $user_session, $patron, $new_patron, $user_obj);
+ return $evt if $evt;
+
+ $apputils->commit_db_session($session);
+
+ return flesh_user($new_patron->id(), new_editor(requestor => $user_obj, xact => 1));
+}
+
+
+sub flesh_user {
+ my $id = shift;
+ my $e = shift;
+ my $home_ou = shift;
+
+ my $fields = [ "settings" ];
+ push @$fields, "home_ou" if $home_ou;
+ my $u = $e->retrieve_actor_user(
+ [
+ $id,
+ {
+ "flesh" => 1,
+ "flesh_fields" => { "au" => $fields }
+ }
+ ]
+ ) or return $e->die_event;
+
+ return $u;
+}
+
+
+
+
+
+
+# clone and clear stuff that would break the database
+sub _clone_patron {
+ my $patron = shift;
+
+ my $new_patron = $patron->clone;
+ # clear these
+ $new_patron->clear_id();
+ $new_patron->clear_isnew();
+ $new_patron->clear_ischanged();
+ $new_patron->clear_isdeleted();
+ $new_patron->clear_permissions();
+
+ return $new_patron;
+}
+
+
+# XXX move to cstore...
+sub _add_patron {
+
+ my $session = shift;
+ my $patron = shift;
+ my $user_obj = shift;
+
+ my $evt = $U->check_perms($user_obj->id, $patron->home_ou, 'CREATE_USER');
+ return (undef, $evt) if $evt;
+
+ my $ex = $session->request(
+ 'open-ils.storage.direct.actor.user.search.usrname', $patron->usrname())->gather(1);
+ if( $ex and @$ex ) {
+ return (undef, ShareStuff::Event->new('USERNAME_EXISTS'));
+ }
+
+ $logger->info("Creating new user in the DB with username: ".$patron->usrname());
+
+ my $id = $session->request(
+ "open-ils.storage.direct.actor.user.create", $patron)->gather(1);
+ return (undef, $U->DB_UPDATE_FAILED($patron)) unless $id;
+
+ $logger->info("Successfully created new user [$id] in DB");
+
+ return ( $session->request(
+ "open-ils.storage.direct.actor.user.retrieve", $id)->gather(1), undef );
+}
+
+
+sub check_group_perm {
+ my( $session, $requestor, $patron ) = @_;
+ my $evt;
+
+ # first let's see if the requestor has
+ # priveleges to update this user in any way
+ if( ! $patron->isnew ) {
+ my $p = $session->request(
+ 'open-ils.storage.direct.actor.user.retrieve', $patron->id )->gather(1);
+
+ # If we are the requestor (trying to update our own account)
+ # and we are not trying to change our profile, we're good
+ if( $p->id == $requestor->id and
+ $p->profile == $patron->profile ) {
+ return undef;
+ }
+
+
+ $evt = group_perm_failed($session, $requestor, $p);
+ return $evt if $evt;
+ }
+
+ # They are allowed to edit this patron.. can they put the
+ # patron into the group requested?
+ $evt = group_perm_failed($session, $requestor, $patron);
+ return $evt if $evt;
+ return undef;
+}
+
+
+sub group_perm_failed {
+ my( $session, $requestor, $patron ) = @_;
+
+ my $perm;
+ my $grp;
+ my $grpid = $patron->profile;
+
+ do {
+
+ $logger->debug("user update looking for group perm for group $grpid");
+ $grp = $session->request(
+ 'open-ils.storage.direct.permission.grp_tree.retrieve', $grpid )->gather(1);
+ return ShareStuff::Event->new('PERMISSION_GRP_TREE_NOT_FOUND') unless $grp;
+
+ } while( !($perm = $grp->application_perm) and ($grpid = $grp->parent) );
+
+ $logger->info("user update checking perm $perm on user ".
+ $requestor->id." for update/create on user username=".$patron->usrname);
+
+ my $evt = $U->check_perms($requestor->id, $patron->home_ou, $perm);
+ return $evt if $evt;
+ return undef;
+}
+
+
+
+sub _update_patron {
+ my( $session, $patron, $user_obj, $noperm) = @_;
+
+ $logger->info("Updating patron ".$patron->id." in DB");
+
+ my $evt;
+
+ if(!$noperm) {
+ $evt = $U->check_perms($user_obj->id, $patron->home_ou, 'UPDATE_USER');
+ return (undef, $evt) if $evt;
+ }
+
+ # update the password by itself to avoid the password protection magic
+ if( $patron->passwd ) {
+ my $s = $session->request(
+ 'open-ils.storage.direct.actor.user.remote_update',
+ {id => $patron->id}, {passwd => $patron->passwd})->gather(1);
+ return (undef, $U->DB_UPDATE_FAILED($patron)) unless defined($s);
+ $patron->clear_passwd;
+ }
+
+ if(!$patron->ident_type) {
+ $patron->clear_ident_type;
+ $patron->clear_ident_value;
+ }
+
+ $evt = verify_last_xact($session, $patron);
+ return (undef, $evt) if $evt;
+
+ my $stat = $session->request(
+ "open-ils.storage.direct.actor.user.update",$patron )->gather(1);
+ return (undef, $U->DB_UPDATE_FAILED($patron)) unless defined($stat);
+
+ return ($patron);
+}
+
+sub verify_last_xact {
+ my( $session, $patron ) = @_;
+ return undef unless $patron->id and $patron->id > 0;
+ my $p = $session->request(
+ 'open-ils.storage.direct.actor.user.retrieve', $patron->id)->gather(1);
+ my $xact = $p->last_xact_id;
+ return undef unless $xact;
+ $logger->info("user xact = $xact, saving with xact " . $patron->last_xact_id);
+ return ShareStuff::Event->new('XACT_COLLISION')
+ if $xact ne $patron->last_xact_id;
+ return undef;
+}
+
+
+sub _check_dup_ident {
+ my( $session, $patron ) = @_;
+
+ return undef unless $patron->ident_value;
+
+ my $search = {
+ ident_type => $patron->ident_type,
+ ident_value => $patron->ident_value,
+ };
+
+ $logger->debug("patron update searching for dup ident values: " .
+ $patron->ident_type . ':' . $patron->ident_value);
+
+ $search->{id} = {'!=' => $patron->id} if $patron->id and $patron->id > 0;
+
+ my $dups = $session->request(
+ 'open-ils.storage.direct.actor.user.search_where.atomic', $search )->gather(1);
+
+
+ return ShareStuff::Event->new('PATRON_DUP_IDENT1', payload => $patron )
+ if $dups and @$dups;
+
+ return undef;
+}
+
+
+sub _add_update_addresses {
+
+ my $session = shift;
+ my $patron = shift;
+ my $new_patron = shift;
+
+ my $evt;
+
+ my $current_id; # id of the address before creation
+
+ my $addresses = $patron->addresses();
+
+ for my $address (@$addresses) {
+
+ next unless ref $address;
+ $current_id = $address->id();
+
+ if( $patron->billing_address() and
+ $patron->billing_address() == $current_id ) {
+ $logger->info("setting billing addr to $current_id");
+ $new_patron->billing_address($address->id());
+ $new_patron->ischanged(1);
+ }
+
+ if( $patron->mailing_address() and
+ $patron->mailing_address() == $current_id ) {
+ $new_patron->mailing_address($address->id());
+ $logger->info("setting mailing addr to $current_id");
+ $new_patron->ischanged(1);
+ }
+
+
+ if($address->isnew()) {
+
+ $address->usr($new_patron->id());
+
+ ($address, $evt) = _add_address($session,$address);
+ return (undef, $evt) if $evt;
+
+ # we need to get the new id
+ if( $patron->billing_address() and
+ $patron->billing_address() == $current_id ) {
+ $new_patron->billing_address($address->id());
+ $logger->info("setting billing addr to $current_id");
+ $new_patron->ischanged(1);
+ }
+
+ if( $patron->mailing_address() and
+ $patron->mailing_address() == $current_id ) {
+ $new_patron->mailing_address($address->id());
+ $logger->info("setting mailing addr to $current_id");
+ $new_patron->ischanged(1);
+ }
+
+ } elsif($address->ischanged() ) {
+
+ ($address, $evt) = _update_address($session, $address);
+ return (undef, $evt) if $evt;
+
+ } elsif($address->isdeleted() ) {
+
+ if( $address->id() == $new_patron->mailing_address() ) {
+ $new_patron->clear_mailing_address();
+ ($new_patron, $evt) = _update_patron($session, $new_patron);
+ return (undef, $evt) if $evt;
+ }
+
+ if( $address->id() == $new_patron->billing_address() ) {
+ $new_patron->clear_billing_address();
+ ($new_patron, $evt) = _update_patron($session, $new_patron);
+ return (undef, $evt) if $evt;
+ }
+
+ $evt = _delete_address($session, $address);
+ return (undef, $evt) if $evt;
+ }
+ }
+
+ return ( $new_patron, undef );
+}
+
+
+# adds an address to the db and returns the address with new id
+sub _add_address {
+ my($session, $address) = @_;
+ $address->clear_id();
+
+ $logger->info("Creating new address at street ".$address->street1);
+
+ # put the address into the database
+ my $id = $session->request(
+ "open-ils.storage.direct.actor.user_address.create", $address )->gather(1);
+ return (undef, $U->DB_UPDATE_FAILED($address)) unless $id;
+
+ $address->id( $id );
+ return ($address, undef);
+}
+
+
+sub _update_address {
+ my( $session, $address ) = @_;
+
+ $logger->info("Updating address ".$address->id." in the DB");
+
+ my $stat = $session->request(
+ "open-ils.storage.direct.actor.user_address.update", $address )->gather(1);
+
+ return (undef, $U->DB_UPDATE_FAILED($address)) unless defined($stat);
+ return ($address, undef);
+}
+
+
+
+sub _add_update_cards {
+
+ my $session = shift;
+ my $patron = shift;
+ my $new_patron = shift;
+
+ my $evt;
+
+ my $virtual_id; #id of the card before creation
+
+ my $cards = $patron->cards();
+ for my $card (@$cards) {
+
+ $card->usr($new_patron->id());
+
+ if(ref($card) and $card->isnew()) {
+
+ $virtual_id = $card->id();
+ ( $card, $evt ) = _add_card($session,$card);
+ return (undef, $evt) if $evt;
+
+ #if(ref($patron->card)) { $patron->card($patron->card->id); }
+ if($patron->card() == $virtual_id) {
+ $new_patron->card($card->id());
+ $new_patron->ischanged(1);
+ }
+
+ } elsif( ref($card) and $card->ischanged() ) {
+ $evt = _update_card($session, $card);
+ return (undef, $evt) if $evt;
+ }
+ }
+
+ return ( $new_patron, undef );
+}
+
+
+# adds an card to the db and returns the card with new id
+sub _add_card {
+ my( $session, $card ) = @_;
+ $card->clear_id();
+
+ $logger->info("Adding new patron card ".$card->barcode);
+
+ my $id = $session->request(
+ "open-ils.storage.direct.actor.card.create", $card )->gather(1);
+ return (undef, $U->DB_UPDATE_FAILED($card)) unless $id;
+ $logger->info("Successfully created patron card $id");
+
+ $card->id($id);
+ return ( $card, undef );
+}
+
+
+# returns event on error. returns undef otherwise
+sub _update_card {
+ my( $session, $card ) = @_;
+ $logger->info("Updating patron card ".$card->id);
+
+ my $stat = $session->request(
+ "open-ils.storage.direct.actor.card.update", $card )->gather(1);
+ return $U->DB_UPDATE_FAILED($card) unless defined($stat);
+ return undef;
+}
+
+
+
+
+# returns event on error. returns undef otherwise
+sub _delete_address {
+ my( $session, $address ) = @_;
+
+ $logger->info("Deleting address ".$address->id." from DB");
+
+ my $stat = $session->request(
+ "open-ils.storage.direct.actor.user_address.delete", $address )->gather(1);
+
+ return $U->DB_UPDATE_FAILED($address) unless defined($stat);
+ return undef;
+}
+
+
+
+sub _add_survey_responses {
+ my ($session, $patron, $new_patron) = @_;
+
+ $logger->info( "Updating survey responses for patron ".$new_patron->id );
+
+ my $responses = $patron->survey_responses;
+
+ if($responses) {
+
+ $_->usr($new_patron->id) for (@$responses);
+
+ my $evt = $U->simplereq( "open-ils.circ",
+ "open-ils.circ.survey.submit.user_id", $responses );
+
+ return (undef, $evt) if defined($U->event_code($evt));
+
+ }
+
+ return ( $new_patron, undef );
+}
+
+sub _clear_badcontact_penalties {
+ my ($session, $old_patron, $new_patron, $user_obj) = @_;
+
+ return ($new_patron, undef) unless $old_patron;
+
+ my $PNM = $ShareStuff::BadContact::PENALTY_NAME_MAP;
+ my $e = new_editor(xact => 1);
+
+ # This ignores whether the caller of update_patron has any permission
+ # to remove penalties, but these penalties no longer make sense
+ # if an email address field (for example) is changed (and the caller must
+ # have perms to do *that*) so there's no reason not to clear the penalties.
+
+ my $bad_contact_penalties = $e->search_actor_user_standing_penalty([
+ {
+ "+csp" => {"name" => [values(%$PNM)]},
+ "+ausp" => {"stop_date" => undef, "usr" => $new_patron->id}
+ }, {
+ "join" => {"csp" => {}},
+ "flesh" => 1,
+ "flesh_fields" => {"ausp" => ["standing_penalty"]}
+ }
+ ]) or return (undef, $e->die_event);
+
+ return ($new_patron, undef) unless @$bad_contact_penalties;
+
+ my @penalties_to_clear;
+ my ($field, $penalty_name);
+
+ # For each field that might have an associated bad contact penalty,
+ # check for such penalties and add them to the to-clear list if that
+ # field has changed.
+ while (($field, $penalty_name) = each(%$PNM)) {
+ if ($old_patron->$field ne $new_patron->$field) {
+ push @penalties_to_clear, grep {
+ $_->standing_penalty->name eq $penalty_name
+ } @$bad_contact_penalties;
+ }
+ }
+
+ foreach (@penalties_to_clear) {
+ # Note that this "archives" penalties, in the terminology of the staff
+ # client, instead of just deleting them. This may assist reporting,
+ # or preserving old contact information when it is still potentially
+ # of interest.
+ $_->standing_penalty($_->standing_penalty->id); # deflesh
+ $_->stop_date('now');
+ $e->update_actor_user_standing_penalty($_) or return (undef, $e->die_event);
+ }
+
+ $e->commit;
+ return ($new_patron, undef);
+}
+
+
+sub _create_stat_maps {
+
+ my($session, $user_session, $patron, $new_patron) = @_;
+
+ my $maps = $patron->stat_cat_entries();
+
+ for my $map (@$maps) {
+
+ my $method = "open-ils.storage.direct.actor.stat_cat_entry_user_map.update";
+
+ if ($map->isdeleted()) {
+ $method = "open-ils.storage.direct.actor.stat_cat_entry_user_map.delete";
+
+ } elsif ($map->isnew()) {
+ $method = "open-ils.storage.direct.actor.stat_cat_entry_user_map.create";
+ $map->clear_id;
+ }
+
+
+ $map->target_usr($new_patron->id);
+
+ #warn "
+ $logger->info("Updating stat entry with method $method and map $map");
+
+ my $stat = $session->request($method, $map)->gather(1);
+ return (undef, $U->DB_UPDATE_FAILED($map)) unless defined($stat);
+
+ }
+
+ return ($new_patron, undef);
+}
+
+sub _create_perm_maps {
+
+ my($session, $user_session, $patron, $new_patron) = @_;
+
+ my $maps = $patron->permissions;
+
+ for my $map (@$maps) {
+
+ my $method = "open-ils.storage.direct.permission.usr_perm_map.update";
+ if ($map->isdeleted()) {
+ $method = "open-ils.storage.direct.permission.usr_perm_map.delete";
+ } elsif ($map->isnew()) {
+ $method = "open-ils.storage.direct.permission.usr_perm_map.create";
+ $map->clear_id;
+ }
+
+
+ $map->usr($new_patron->id);
+
+ #warn( "Updating permissions with method $method and session $user_session and map $map" );
+ $logger->info( "Updating permissions with method $method and map $map" );
+
+ my $stat = $session->request($method, $map)->gather(1);
+ return (undef, $U->DB_UPDATE_FAILED($map)) unless defined($stat);
+
+ }
+
+ return ($new_patron, undef);
+}
+
+
+__PACKAGE__->register_method(
+ method => "set_user_work_ous",
+ api_name => "open-ils.actor.user.work_ous.update",
+);
+
+sub set_user_work_ous {
+ my $self = shift;
+ my $client = shift;
+ my $ses = shift;
+ my $maps = shift;
+
+ my( $requestor, $evt ) = $apputils->checksesperm( $ses, 'ASSIGN_WORK_ORG_UNIT' );
+ return $evt if $evt;
+
+ my $session = $apputils->start_db_session();
+ $apputils->set_audit_info($session, $ses, $requestor->id, $requestor->wsid);
+
+ for my $map (@$maps) {
+
+ my $method = "open-ils.storage.direct.permission.usr_work_ou_map.update";
+ if ($map->isdeleted()) {
+ $method = "open-ils.storage.direct.permission.usr_work_ou_map.delete";
+ } elsif ($map->isnew()) {
+ $method = "open-ils.storage.direct.permission.usr_work_ou_map.create";
+ $map->clear_id;
+ }
+
+ #warn( "Updating permissions with method $method and session $ses and map $map" );
+ $logger->info( "Updating work_ou map with method $method and map $map" );
+
+ my $stat = $session->request($method, $map)->gather(1);
+ $logger->warn( "update failed: ".$U->DB_UPDATE_FAILED($map) ) unless defined($stat);
+
+ }
+
+ $apputils->commit_db_session($session);
+
+ return scalar(@$maps);
+}
+
+
+__PACKAGE__->register_method(
+ method => "set_user_perms",
+ api_name => "open-ils.actor.user.permissions.update",
+);
+
+sub set_user_perms {
+ my $self = shift;
+ my $client = shift;
+ my $ses = shift;
+ my $maps = shift;
+
+ my $session = $apputils->start_db_session();
+
+ my( $user_obj, $evt ) = $U->checkses($ses);
+ return $evt if $evt;
+ $apputils->set_audit_info($session, $ses, $user_obj->id, $user_obj->wsid);
+
+ my $perms = $session->request('open-ils.storage.permission.user_perms.atomic', $user_obj->id)->gather(1);
+
+ my $all = undef;
+ $all = 1 if ($U->is_true($user_obj->super_user()));
+ $all = 1 unless ($U->check_perms($user_obj->id, $user_obj->home_ou, 'EVERYTHING'));
+
+ for my $map (@$maps) {
+
+ my $method = "open-ils.storage.direct.permission.usr_perm_map.update";
+ if ($map->isdeleted()) {
+ $method = "open-ils.storage.direct.permission.usr_perm_map.delete";
+ } elsif ($map->isnew()) {
+ $method = "open-ils.storage.direct.permission.usr_perm_map.create";
+ $map->clear_id;
+ }
+
+ next if (!$all and !grep { $_->perm eq $map->perm and $U->is_true($_->grantable) and $_->depth <= $map->depth } @$perms);
+ #warn( "Updating permissions with method $method and session $ses and map $map" );
+ $logger->info( "Updating permissions with method $method and map $map" );
+
+ my $stat = $session->request($method, $map)->gather(1);
+ $logger->warn( "update failed: ".$U->DB_UPDATE_FAILED($map) ) unless defined($stat);
+
+ }
+
+ $apputils->commit_db_session($session);
+
+ return scalar(@$maps);
+}
+
+
+__PACKAGE__->register_method(
+ method => "user_retrieve_by_barcode",
+ authoritative => 1,
+ api_name => "open-ils.actor.user.fleshed.retrieve_by_barcode",);
+
+sub user_retrieve_by_barcode {
+ my($self, $client, $auth, $barcode, $flesh_home_ou) = @_;
+
+ my $e = new_editor(authtoken => $auth);
+ return $e->event unless $e->checkauth;
+
+ my $card = $e->search_actor_card({barcode => $barcode})->[0]
+ or return $e->event;
+
+ my $user = flesh_user($card->usr, $e, $flesh_home_ou);
+ return $e->event unless $e->allowed(
+ "VIEW_USER", $flesh_home_ou ? $user->home_ou->id : $user->home_ou
+ );
+ return $user;
+}
+
+
+
+__PACKAGE__->register_method(
+ method => "get_user_by_id",
+ authoritative => 1,
+ api_name => "open-ils.actor.user.retrieve",
+);
+
+sub get_user_by_id {
+ my ($self, $client, $auth, $id) = @_;
+ my $e = new_editor(authtoken=>$auth);
+ return $e->event unless $e->checkauth;
+ my $user = $e->retrieve_actor_user($id) or return $e->event;
+ return $e->event unless $e->allowed('VIEW_USER', $user->home_ou);
+ return $user;
+}
+
+
+__PACKAGE__->register_method(
+ method => "get_org_types",
+ api_name => "open-ils.actor.org_types.retrieve",
+);
+sub get_org_types {
+ return $U->get_org_types();
+}
+
+
+__PACKAGE__->register_method(
+ method => "get_user_ident_types",
+ api_name => "open-ils.actor.user.ident_types.retrieve",
+);
+my $ident_types;
+sub get_user_ident_types {
+ return $ident_types if $ident_types;
+ return $ident_types =
+ new_editor()->retrieve_all_config_identification_type();
+}
+
+
+__PACKAGE__->register_method(
+ method => "get_org_unit",
+ api_name => "open-ils.actor.org_unit.retrieve",
+);
+
+sub get_org_unit {
+ my( $self, $client, $user_session, $org_id ) = @_;
+ my $e = new_editor(authtoken => $user_session);
+ if(!$org_id) {
+ return $e->event unless $e->checkauth;
+ $org_id = $e->requestor->ws_ou;
+ }
+ my $o = $e->retrieve_actor_org_unit($org_id)
+ or return $e->event;
+ return $o;
+}
+
+__PACKAGE__->register_method(
+ method => "search_org_unit",
+ api_name => "open-ils.actor.org_unit_list.search",
+);
+
+sub search_org_unit {
+
+ my( $self, $client, $field, $value ) = @_;
+
+ my $list = ShareStuff::AppUtils->simple_scalar_request(
+ "open-ils.cstore",
+ "open-ils.cstore.direct.actor.org_unit.search.atomic",
+ { $field => $value } );
+
+ return $list;
+}
+
+
+# build the org tree
+
+__PACKAGE__->register_method(
+ method => "get_org_tree",
+ api_name => "open-ils.actor.org_tree.retrieve",
+ argc => 0,
+ note => "Returns the entire org tree structure",
+);
+
+sub get_org_tree {
+ my $self = shift;
+ my $client = shift;
+ return $U->get_org_tree($client->session->session_locale);
+}
+
+
+__PACKAGE__->register_method(
+ method => "get_org_descendants",
+ api_name => "open-ils.actor.org_tree.descendants.retrieve"
+);
+
+# depth is optional. org_unit is the id
+sub get_org_descendants {
+ my( $self, $client, $org_unit, $depth ) = @_;
+
+ if(ref $org_unit eq 'ARRAY') {
+ $depth ||= [];
+ my @trees;
+ for my $i (0..scalar(@$org_unit)-1) {
+ my $list = $U->simple_scalar_request(
+ "open-ils.storage",
+ "open-ils.storage.actor.org_unit.descendants.atomic",
+ $org_unit->[$i], $depth->[$i] );
+ push(@trees, $U->build_org_tree($list));
+ }
+ return \@trees;
+
+ } else {
+ my $orglist = $apputils->simple_scalar_request(
+ "open-ils.storage",
+ "open-ils.storage.actor.org_unit.descendants.atomic",
+ $org_unit, $depth );
+ return $U->build_org_tree($orglist);
+ }
+}
+
+
+__PACKAGE__->register_method(
+ method => "get_org_ancestors",
+ api_name => "open-ils.actor.org_tree.ancestors.retrieve"
+);
+
+# depth is optional. org_unit is the id
+sub get_org_ancestors {
+ my( $self, $client, $org_unit, $depth ) = @_;
+ my $orglist = $apputils->simple_scalar_request(
+ "open-ils.storage",
+ "open-ils.storage.actor.org_unit.ancestors.atomic",
+ $org_unit, $depth );
+ return $U->build_org_tree($orglist);
+}
+
+
+__PACKAGE__->register_method(
+ method => "get_standings",
+ api_name => "open-ils.actor.standings.retrieve"
+);
+
+my $user_standings;
+sub get_standings {
+ return $user_standings if $user_standings;
+ return $user_standings =
+ $apputils->simple_scalar_request(
+ "open-ils.cstore",
+ "open-ils.cstore.direct.config.standing.search.atomic",
+ { id => { "!=" => undef } }
+ );
+}
+
+
+__PACKAGE__->register_method(
+ method => "get_my_org_path",
+ api_name => "open-ils.actor.org_unit.full_path.retrieve"
+);
+
+sub get_my_org_path {
+ my( $self, $client, $auth, $org_id ) = @_;
+ my $e = new_editor(authtoken=>$auth);
+ return $e->event unless $e->checkauth;
+ $org_id = $e->requestor->ws_ou unless defined $org_id;
+
+ return $apputils->simple_scalar_request(
+ "open-ils.storage",
+ "open-ils.storage.actor.org_unit.full_path.atomic",
+ $org_id );
+}
+
+
+__PACKAGE__->register_method(
+ method => "patron_adv_search",
+ api_name => "open-ils.actor.patron.search.advanced"
+);
+sub patron_adv_search {
+ my( $self, $client, $auth, $search_hash,
+ $search_limit, $search_sort, $include_inactive, $search_ou ) = @_;
+
+ my $e = new_editor(authtoken=>$auth);
+ return $e->event unless $e->checkauth;
+ return $e->event unless $e->allowed('VIEW_USER');
+
+ # depth boundary outside of which patrons must opt-in, default to 0
+ my $opt_boundary = 0;
+ $opt_boundary = $U->ou_ancestor_setting_value($e->requestor->ws_ou,'org.patron_opt_boundary') if user_opt_in_enabled($self);
+
+ return $U->storagereq(
+ "open-ils.storage.actor.user.crazy_search", $search_hash,
+ $search_limit, $search_sort, $include_inactive, $e->requestor->ws_ou, $search_ou, $opt_boundary);
+}
+
+
+__PACKAGE__->register_method(
+ method => "update_passwd",
+ api_name => "open-ils.actor.user.password.update",
+ signature => {
+ desc => "Update the operator's password",
+ params => [
+ { desc => 'Authentication token', type => 'string' },
+ { desc => 'New password', type => 'string' },
+ { desc => 'Current password', type => 'string' }
+ ],
+ return => {desc => '1 on success, Event on error or incorrect current password'}
+ }
+);
+
+__PACKAGE__->register_method(
+ method => "update_passwd",
+ api_name => "open-ils.actor.user.username.update",
+ signature => {
+ desc => "Update the operator's username",
+ params => [
+ { desc => 'Authentication token', type => 'string' },
+ { desc => 'New username', type => 'string' },
+ { desc => 'Current password', type => 'string' }
+ ],
+ return => {desc => '1 on success, Event on error or incorrect current password'}
+ }
+);
+
+__PACKAGE__->register_method(
+ method => "update_passwd",
+ api_name => "open-ils.actor.user.email.update",
+ signature => {
+ desc => "Update the operator's email address",
+ params => [
+ { desc => 'Authentication token', type => 'string' },
+ { desc => 'New email address', type => 'string' },
+ { desc => 'Current password', type => 'string' }
+ ],
+ return => {desc => '1 on success, Event on error or incorrect current password'}
+ }
+);
+
+sub update_passwd {
+ my( $self, $conn, $auth, $new_val, $orig_pw ) = @_;
+ my $e = new_editor(xact=>1, authtoken=>$auth);
+ return $e->die_event unless $e->checkauth;
+
+ my $db_user = $e->retrieve_actor_user($e->requestor->id)
+ or return $e->die_event;
+ my $api = $self->api_name;
+
+ # make sure the original password matches the in-database password
+ if (md5_hex($orig_pw) ne $db_user->passwd) {
+ $e->rollback;
+ return new ShareStuff::Event('INCORRECT_PASSWORD');
+ }
+
+ if( $api =~ /password/o ) {
+
+ $db_user->passwd($new_val);
+
+ } else {
+
+ # if we don't clear the password, the user will be updated with
+ # a hashed version of the hashed version of their password
+ $db_user->clear_passwd;
+
+ if( $api =~ /username/o ) {
+
+ # make sure no one else has this username
+ my $exist = $e->search_actor_user({usrname=>$new_val},{idlist=>1});
+ if (@$exist) {
+ $e->rollback;
+ return new ShareStuff::Event('USERNAME_EXISTS');
+ }
+ $db_user->usrname($new_val);
+
+ } elsif( $api =~ /email/o ) {
+ $db_user->email($new_val);
+ }
+ }
+
+ $e->update_actor_user($db_user) or return $e->die_event;
+ $e->commit;
+
+ # update the cached user to pick up these changes
+ $U->simplereq('open-ils.auth', 'open-ils.auth.session.reset_timeout', $auth, 1);
+ return 1;
+}
+
+
+
+__PACKAGE__->register_method(
+ method => "check_user_perms",
+ api_name => "open-ils.actor.user.perm.check",
+ notes => <<" NOTES");
+ Takes a login session, user id, an org id, and an array of perm type strings. For each
+ perm type, if the user does *not* have the given permission it is added
+ to a list which is returned from the method. If all permissions
+ are allowed, an empty list is returned
+ if the logged in user does not match 'user_id', then the logged in user must
+ have VIEW_PERMISSION priveleges.
+ NOTES
+
+sub check_user_perms {
+ my( $self, $client, $login_session, $user_id, $org_id, $perm_types ) = @_;
+
+ my( $staff, $evt ) = $apputils->checkses($login_session);
+ return $evt if $evt;
+
+ if($staff->id ne $user_id) {
+ if( $evt = $apputils->check_perms(
+ $staff->id, $org_id, 'VIEW_PERMISSION') ) {
+ return $evt;
+ }
+ }
+
+ my @not_allowed;
+ for my $perm (@$perm_types) {
+ if($apputils->check_perms($user_id, $org_id, $perm)) {
+ push @not_allowed, $perm;
+ }
+ }
+
+ return \@not_allowed
+}
+
+__PACKAGE__->register_method(
+ method => "check_user_perms2",
+ api_name => "open-ils.actor.user.perm.check.multi_org",
+ notes => q/
+ Checks the permissions on a list of perms and orgs for a user
+ @param authtoken The login session key
+ @param user_id The id of the user to check
+ @param orgs The array of org ids
+ @param perms The array of permission names
+ @return An array of [ orgId, permissionName ] arrays that FAILED the check
+ if the logged in user does not match 'user_id', then the logged in user must
+ have VIEW_PERMISSION priveleges.
+ /);
+
+sub check_user_perms2 {
+ my( $self, $client, $authtoken, $user_id, $orgs, $perms ) = @_;
+
+ my( $staff, $target, $evt ) = $apputils->checkses_requestor(
+ $authtoken, $user_id, 'VIEW_PERMISSION' );
+ return $evt if $evt;
+
+ my @not_allowed;
+ for my $org (@$orgs) {
+ for my $perm (@$perms) {
+ if($apputils->check_perms($user_id, $org, $perm)) {
+ push @not_allowed, [ $org, $perm ];
+ }
+ }
+ }
+
+ return \@not_allowed
+}
+
+
+__PACKAGE__->register_method(
+ method => 'check_user_perms3',
+ api_name => 'open-ils.actor.user.perm.highest_org',
+ notes => q/
+ Returns the highest org unit id at which a user has a given permission
+ If the requestor does not match the target user, the requestor must have
+ 'VIEW_PERMISSION' rights at the home org unit of the target user
+ @param authtoken The login session key
+ @param userid The id of the user in question
+ @param perm The permission to check
+ @return The org unit highest in the org tree within which the user has
+ the requested permission
+ /);
+
+sub check_user_perms3 {
+ my($self, $client, $authtoken, $user_id, $perm) = @_;
+ my $e = new_editor(authtoken=>$authtoken);
+ return $e->event unless $e->checkauth;
+
+ my $tree = $U->get_org_tree();
+
+ unless($e->requestor->id == $user_id) {
+ my $user = $e->retrieve_actor_user($user_id)
+ or return $e->event;
+ return $e->event unless $e->allowed('VIEW_PERMISSION', $user->home_ou);
+ return $U->find_highest_perm_org($perm, $user_id, $user->home_ou, $tree );
+ }
+
+ return $U->find_highest_perm_org($perm, $user_id, $e->requestor->ws_ou, $tree);
+}
+
+__PACKAGE__->register_method(
+ method => 'user_has_work_perm_at',
+ api_name => 'open-ils.actor.user.has_work_perm_at',
+ authoritative => 1,
+ signature => {
+ desc => q/
+ Returns a set of org unit IDs which represent the highest orgs in
+ the org tree where the user has the requested permission. The
+ purpose of this method is to return the smallest set of org units
+ which represent the full expanse of the user's ability to perform
+ the requested action. The user whose perms this method should
+ check is implied by the authtoken. /,
+ params => [
+ {desc => 'authtoken', type => 'string'},
+ {desc => 'permission name', type => 'string'},
+ {desc => q/user id, optional. If present, check perms for
+ this user instead of the logged in user/, type => 'number'},
+ ],
+ return => {desc => 'An array of org IDs'}
+ }
+);
+
+sub user_has_work_perm_at {
+ my($self, $conn, $auth, $perm, $user_id) = @_;
+ my $e = new_editor(authtoken=>$auth);
+ return $e->event unless $e->checkauth;
+ if(defined $user_id) {
+ my $user = $e->retrieve_actor_user($user_id) or return $e->event;
+ return $e->event unless $e->allowed('VIEW_PERMISSION', $user->home_ou);
+ }
+ return $U->user_has_work_perm_at($e, $perm, undef, $user_id);
+}
+
+__PACKAGE__->register_method(
+ method => 'user_has_work_perm_at_batch',
+ api_name => 'open-ils.actor.user.has_work_perm_at.batch',
+ authoritative => 1,
+);
+
+sub user_has_work_perm_at_batch {
+ my($self, $conn, $auth, $perms, $user_id) = @_;
+ my $e = new_editor(authtoken=>$auth);
+ return $e->event unless $e->checkauth;
+ if(defined $user_id) {
+ my $user = $e->retrieve_actor_user($user_id) or return $e->event;
+ return $e->event unless $e->allowed('VIEW_PERMISSION', $user->home_ou);
+ }
+ my $map = {};
+ $map->{$_} = $U->user_has_work_perm_at($e, $_) for @$perms;
+ return $map;
+}
+
+
+
+__PACKAGE__->register_method(
+ method => 'check_user_perms4',
+ api_name => 'open-ils.actor.user.perm.highest_org.batch',
+ notes => q/
+ Returns the highest org unit id at which a user has a given permission
+ If the requestor does not match the target user, the requestor must have
+ 'VIEW_PERMISSION' rights at the home org unit of the target user
+ @param authtoken The login session key
+ @param userid The id of the user in question
+ @param perms An array of perm names to check
+ @return An array of orgId's representing the org unit
+ highest in the org tree within which the user has the requested permission
+ The arrah of orgId's has matches the order of the perms array
+ /);
+
+sub check_user_perms4 {
+ my( $self, $client, $authtoken, $userid, $perms ) = @_;
+
+ my( $staff, $target, $org, $evt );
+
+ ( $staff, $target, $evt ) = $apputils->checkses_requestor(
+ $authtoken, $userid, 'VIEW_PERMISSION' );
+ return $evt if $evt;
+
+ my @arr;
+ return [] unless ref($perms);
+ my $tree = $U->get_org_tree();
+
+ for my $p (@$perms) {
+ push( @arr, $U->find_highest_perm_org( $p, $userid, $target->home_ou, $tree ) );
+ }
+ return \@arr;
+}
+
+
+__PACKAGE__->register_method(
+ method => "user_fines_summary",
+ api_name => "open-ils.actor.user.fines.summary",
+ authoritative => 1,
+ signature => {
+ desc => 'Returns a short summary of the users total open fines, ' .
+ 'excluding voided fines Params are login_session, user_id' ,
+ params => [
+ {desc => 'Authentication token', type => 'string'},
+ {desc => 'User ID', type => 'string'} # number?
+ ],
+ return => {
+ desc => "a 'mous' object, event on error",
+ }
+ }
+);
+
+sub user_fines_summary {
+ my( $self, $client, $auth, $user_id ) = @_;
+
+ my $e = new_editor(authtoken=>$auth);
+ return $e->event unless $e->checkauth;
+
+ if( $user_id ne $e->requestor->id ) {
+ my $user = $e->retrieve_actor_user($user_id) or return $e->event;
+ return $e->event unless
+ $e->allowed('VIEW_USER_FINES_SUMMARY', $user->home_ou);
+ }
+
+ return $e->search_money_open_user_summary({usr => $user_id})->[0];
+}
+
+
+__PACKAGE__->register_method(
+ method => "user_opac_vitals",
+ api_name => "open-ils.actor.user.opac.vital_stats",
+ argc => 1,
+ authoritative => 1,
+ signature => {
+ desc => 'Returns a short summary of the users vital stats, including ' .
+ 'identification information, accumulated balance, number of holds, ' .
+ 'and current open circulation stats' ,
+ params => [
+ {desc => 'Authentication token', type => 'string'},
+ {desc => 'Optional User ID, for use in the staff client', type => 'number'} # number?
+ ],
+ return => {
+ desc => "An object with four properties: user, fines, checkouts and holds."
+ }
+ }
+);
+
+sub user_opac_vitals {
+ my( $self, $client, $auth, $user_id ) = @_;
+
+ my $e = new_editor(authtoken=>$auth);
+ return $e->event unless $e->checkauth;
+
+ $user_id ||= $e->requestor->id;
+
+ my $user = $e->retrieve_actor_user( $user_id );
+
+ my ($fines) = $self
+ ->method_lookup('open-ils.actor.user.fines.summary')
+ ->run($auth => $user_id);
+ return $fines if (defined($U->event_code($fines)));
+
+ if (!$fines) {
+ $fines = new Fieldmapper::money::open_user_summary ();
+ $fines->balance_owed(0.00);
+ $fines->total_owed(0.00);
+ $fines->total_paid(0.00);
+ $fines->usr($user_id);
+ }
+
+ my ($holds) = $self
+ ->method_lookup('open-ils.actor.user.hold_requests.count')
+ ->run($auth => $user_id);
+ return $holds if (defined($U->event_code($holds)));
+
+ my ($out) = $self
+ ->method_lookup('open-ils.actor.user.checked_out.count')
+ ->run($auth => $user_id);
+ return $out if (defined($U->event_code($out)));
+
+ $out->{"total_out"} = reduce { $a + $out->{$b} } 0, qw/out overdue long_overdue/;
+
+ return {
+ user => {
+ first_given_name => $user->first_given_name,
+ second_given_name => $user->second_given_name,
+ family_name => $user->family_name,
+ alias => $user->alias,
+ usrname => $user->usrname
+ },
+ fines => $fines->to_bare_hash,
+ checkouts => $out,
+ holds => $holds
+ };
+}
+
+
+##### a small consolidation of related method registrations
+my $common_params = [
+ { desc => 'Authentication token', type => 'string' },
+ { desc => 'User ID', type => 'string' },
+ { desc => 'Transactions type (optional, defaults to all)', type => 'string' },
+ { desc => 'Options hash. May contain limit and offset for paged results.', type => 'object' },
+];
+my %methods = (
+ 'open-ils.actor.user.transactions' => '',
+ 'open-ils.actor.user.transactions.fleshed' => '',
+ 'open-ils.actor.user.transactions.have_charge' => ' that have an initial charge',
+ 'open-ils.actor.user.transactions.have_charge.fleshed' => ' that have an initial charge',
+ 'open-ils.actor.user.transactions.have_balance' => ' that have an outstanding balance',
+ 'open-ils.actor.user.transactions.have_balance.fleshed' => ' that have an outstanding balance',
+);
+
+foreach (keys %methods) {
+ my %args = (
+ method => "user_transactions",
+ api_name => $_,
+ signature => {
+ desc => 'For a given user, retrieve a list of '
+ . (/\.fleshed/ ? 'fleshed ' : '')
+ . 'transactions' . $methods{$_}
+ . ' optionally limited to transactions of a given type.',
+ params => $common_params,
+ return => {
+ desc => "List of objects, or event on error. Each object is a hash containing: transaction, circ, record. "
+ . 'These represent the relevant (mbts) transaction, attached circulation and title pointed to in the circ, respectively.',
+ }
+ }
+ );
+ $args{authoritative} = 1;
+ __PACKAGE__->register_method(%args);
+}
+
+# Now for the counts
+%methods = (
+ 'open-ils.actor.user.transactions.count' => '',
+ 'open-ils.actor.user.transactions.have_charge.count' => ' that have an initial charge',
+ 'open-ils.actor.user.transactions.have_balance.count' => ' that have an outstanding balance',
+);
+
+foreach (keys %methods) {
+ my %args = (
+ method => "user_transactions",
+ api_name => $_,
+ signature => {
+ desc => 'For a given user, retrieve a count of open '
+ . 'transactions' . $methods{$_}
+ . ' optionally limited to transactions of a given type.',
+ params => $common_params,
+ return => { desc => "Integer count of transactions, or event on error" }
+ }
+ );
+ /\.have_balance/ and $args{authoritative} = 1; # FIXME: I don't know why have_charge isn't authoritative
+ __PACKAGE__->register_method(%args);
+}
+
+__PACKAGE__->register_method(
+ method => "user_transactions",
+ api_name => "open-ils.actor.user.transactions.have_balance.total",
+ authoritative => 1,
+ signature => {
+ desc => 'For a given user, retrieve the total balance owed for open transactions,'
+ . ' optionally limited to transactions of a given type.',
+ params => $common_params,
+ return => { desc => "Decimal balance value, or event on error" }
+ }
+);
+
+
+sub user_transactions {
+ my( $self, $client, $auth, $user_id, $type, $options ) = @_;
+ $options ||= {};
+
+ my $e = new_editor(authtoken => $auth);
+ return $e->event unless $e->checkauth;
+
+ my $user = $e->retrieve_actor_user($user_id) or return $e->event;
+
+ return $e->event unless
+ $e->requestor->id == $user_id or
+ $e->allowed('VIEW_USER_TRANSACTIONS', $user->home_ou);
+
+ my $api = $self->api_name();
+
+ my $filter = ($api =~ /have_balance/o) ?
+ { 'balance_owed' => { '<>' => 0 } }:
+ { 'total_owed' => { '>' => 0 } };
+
+ my $method = 'open-ils.actor.user.transactions.history.still_open';
+ $method = "$method.authoritative" if $api =~ /authoritative/;
+ my ($trans) = $self->method_lookup($method)->run($auth, $user_id, $type, $filter, $options);
+
+ if($api =~ /total/o) {
+ my $total = 0.0;
+ $total += $_->balance_owed for @$trans;
+ return $total;
+ }
+
+ ($api =~ /count/o ) and return scalar @$trans;
+ ($api !~ /fleshed/o) and return $trans;
+
+ my @resp;
+ for my $t (@$trans) {
+
+ if( $t->xact_type ne 'circulation' ) {
+ push @resp, {transaction => $t};
+ next;
+ }
+
+ my $circ_data = flesh_circ($e, $t->id);
+ push @resp, {transaction => $t, %$circ_data};
+ }
+
+ return \@resp;
+}
+
+
+__PACKAGE__->register_method(
+ method => "user_transaction_retrieve",
+ api_name => "open-ils.actor.user.transaction.fleshed.retrieve",
+ argc => 1,
+ authoritative => 1,
+ notes => "Returns a fleshed transaction record"
+);
+
+__PACKAGE__->register_method(
+ method => "user_transaction_retrieve",
+ api_name => "open-ils.actor.user.transaction.retrieve",
+ argc => 1,
+ authoritative => 1,
+ notes => "Returns a transaction record"
+);
+
+sub user_transaction_retrieve {
+ my($self, $client, $auth, $bill_id) = @_;
+
+ my $e = new_editor(authtoken => $auth);
+ return $e->event unless $e->checkauth;
+
+ my $trans = $e->retrieve_money_billable_transaction_summary(
+ [$bill_id, {flesh => 1, flesh_fields => {mbts => ['usr']}}]) or return $e->event;
+
+ return $e->event unless $e->allowed('VIEW_USER_TRANSACTIONS', $trans->usr->home_ou);
+
+ $trans->usr($trans->usr->id); # de-flesh for backwards compat
+
+ return $trans unless $self->api_name =~ /flesh/;
+ return {transaction => $trans} if $trans->xact_type ne 'circulation';
+
+ my $circ_data = flesh_circ($e, $trans->id, 1);
+
+ return {transaction => $trans, %$circ_data};
+}
+
+sub flesh_circ {
+ my $e = shift;
+ my $circ_id = shift;
+ my $flesh_copy = shift;
+
+ my $circ = $e->retrieve_action_circulation([
+ $circ_id, {
+ flesh => 3,
+ flesh_fields => {
+ circ => ['target_copy'],
+ acp => ['call_number'],
+ acn => ['record']
+ }
+ }
+ ]);
+
+ my $mods;
+ my $copy = $circ->target_copy;
+
+ if($circ->target_copy->call_number->id == OILS_PRECAT_CALL_NUMBER) {
+ $mods = new Fieldmapper::metabib::virtual_record;
+ $mods->doc_id(OILS_PRECAT_RECORD);
+ $mods->title($copy->dummy_title);
+ $mods->author($copy->dummy_author);
+
+ } else {
+ $mods = $U->record_to_mvr($circ->target_copy->call_number->record);
+ }
+
+ # more de-fleshiing
+ $circ->target_copy($circ->target_copy->id);
+ $copy->call_number($copy->call_number->id);
+
+ return {circ => $circ, record => $mods, copy => ($flesh_copy) ? $copy : undef };
+}
+
+
+__PACKAGE__->register_method(
+ method => "hold_request_count",
+ api_name => "open-ils.actor.user.hold_requests.count",
+ authoritative => 1,
+ argc => 1,
+ notes => 'Returns hold ready/total counts'
+);
+
+sub hold_request_count {
+ my( $self, $client, $authtoken, $user_id ) = @_;
+ my $e = new_editor(authtoken => $authtoken);
+ return $e->event unless $e->checkauth;
+
+ $user_id = $e->requestor->id unless defined $user_id;
+
+ if($e->requestor->id ne $user_id) {
+ my $user = $e->retrieve_actor_user($user_id);
+ return $e->event unless $e->allowed('VIEW_HOLD', $user->home_ou);
+ }
+
+ my $holds = $e->json_query({
+ select => {ahr => ['pickup_lib', 'current_shelf_lib']},
+ from => 'ahr',
+ where => {
+ usr => $user_id,
+ fulfillment_time => {"=" => undef },
+ cancel_time => undef,
+ }
+ });
+
+ return {
+ total => scalar(@$holds),
+ ready => scalar(
+ grep {
+ $_->{current_shelf_lib} and # avoid undef warnings
+ $_->{pickup_lib} eq $_->{current_shelf_lib}
+ } @$holds
+ )
+ };
+}
+
+__PACKAGE__->register_method(
+ method => "checked_out",
+ api_name => "open-ils.actor.user.checked_out",
+ authoritative => 1,
+ argc => 2,
+ signature => {
+ desc => "For a given user, returns a structure of circulations objects sorted by out, overdue, lost, claims_returned, long_overdue. "
+ . "A list of IDs are returned of each type. Circs marked lost, long_overdue, and claims_returned will not be 'finished' "
+ . "(i.e., outstanding balance or some other pending action on the circ). "
+ . "The .count method also includes a 'total' field which sums all open circs.",
+ params => [
+ { desc => 'Authentication Token', type => 'string'},
+ { desc => 'User ID', type => 'string'},
+ ],
+ return => {
+ desc => 'Returns event on error, or an object with ID lists, like: '
+ . '{"out":[12552,451232], "claims_returned":[], "long_overdue":[23421] "overdue":[], "lost":[]}'
+ },
+ }
+);
+
+__PACKAGE__->register_method(
+ method => "checked_out",
+ api_name => "open-ils.actor.user.checked_out.count",
+ authoritative => 1,
+ argc => 2,
+ signature => q/@see open-ils.actor.user.checked_out/
+);
+
+sub checked_out {
+ my( $self, $conn, $auth, $userid ) = @_;
+
+ my $e = new_editor(authtoken=>$auth);
+ return $e->event unless $e->checkauth;
+
+ if( $userid ne $e->requestor->id ) {
+ my $user = $e->retrieve_actor_user($userid) or return $e->event;
+ return $e->event unless($e->allowed('VIEW_CIRCULATIONS', $user->home_ou));
+ }
+
+ my $count = $self->api_name =~ /count/;
+ return _checked_out( $count, $e, $userid );
+}
+
+sub _checked_out {
+ my( $iscount, $e, $userid ) = @_;
+
+ my %result = (
+ out => [],
+ overdue => [],
+ lost => [],
+ claims_returned => [],
+ long_overdue => []
+ );
+ my $meth = 'retrieve_action_open_circ_';
+
+ if ($iscount) {
+ $meth .= 'count';
+ %result = (
+ out => 0,
+ overdue => 0,
+ lost => 0,
+ claims_returned => 0,
+ long_overdue => 0
+ );
+ } else {
+ $meth .= 'list';
+ }
+
+ my $data = $e->$meth($userid);
+
+ if ($data) {
+ if ($iscount) {
+ $result{$_} += $data->$_() for (keys %result);
+ $result{total} += $data->$_() for (keys %result);
+ } else {
+ for my $k (keys %result) {
+ $result{$k} = [ grep { $_ > 0 } split( ',', $data->$k()) ];
+ }
+ }
+ }
+
+ return \%result;
+}
+
+
+
+__PACKAGE__->register_method(
+ method => "checked_in_with_fines",
+ api_name => "open-ils.actor.user.checked_in_with_fines",
+ authoritative => 1,
+ argc => 2,
+ signature => q/@see open-ils.actor.user.checked_out/
+);
+
+sub checked_in_with_fines {
+ my( $self, $conn, $auth, $userid ) = @_;
+
+ my $e = new_editor(authtoken=>$auth);
+ return $e->event unless $e->checkauth;
+
+ if( $userid ne $e->requestor->id ) {
+ return $e->event unless $e->allowed('VIEW_CIRCULATIONS');
+ }
+
+ # money is owed on these items and they are checked in
+ my $open = $e->search_action_circulation(
+ {
+ usr => $userid,
+ xact_finish => undef,
+ checkin_time => { "!=" => undef },
+ }
+ );
+
+
+ my( @lost, @cr, @lo );
+ for my $c (@$open) {
+ push( @lost, $c->id ) if $c->stop_fines eq 'LOST';
+ push( @cr, $c->id ) if $c->stop_fines eq 'CLAIMSRETURNED';
+ push( @lo, $c->id ) if $c->stop_fines eq 'LONGOVERDUE';
+ }
+
+ return {
+ lost => \@lost,
+ claims_returned => \@cr,
+ long_overdue => \@lo
+ };
+}
+
+
+sub _sigmaker {
+ my ($api, $desc, $auth) = @_;
+ $desc = $desc ? (" " . $desc) : '';
+ my $ids = ($api =~ /ids$/) ? 1 : 0;
+ my @sig = (
+ argc => 1,
+ method => "user_transaction_history",
+ api_name => "open-ils.actor.user.transactions.$api",
+ signature => {
+ desc => "For a given User ID, returns a list of billable transaction" .
+ ($ids ? " id" : '') .
+ "s$desc, optionally filtered by type and/or fields in money.billable_xact_summary. " .
+ "The VIEW_USER_TRANSACTIONS permission is required to view another user's transactions",
+ params => [
+ {desc => 'Authentication token', type => 'string'},
+ {desc => 'User ID', type => 'number'},
+ {desc => 'Transaction type (optional)', type => 'number'},
+ {desc => 'Hash of Billable Transaction Summary filters (optional)', type => 'object'}
+ ],
+ return => {
+ desc => 'List of transaction' . ($ids ? " id" : '') . 's, Event on error'
+ },
+ }
+ );
+ $auth and push @sig, (authoritative => 1);
+ return @sig;
+}
+
+my %auth_hist_methods = (
+ 'history' => '',
+ 'history.have_charge' => 'that have an initial charge',
+ 'history.still_open' => 'that are not finished',
+ 'history.have_balance' => 'that have a balance',
+ 'history.have_bill' => 'that have billings',
+ 'history.have_bill_or_payment' => 'that have non-zero-sum billings or at least 1 payment',
+ 'history.have_payment' => 'that have at least 1 payment',
+);
+
+foreach (keys %auth_hist_methods) {
+ __PACKAGE__->register_method(_sigmaker($_, $auth_hist_methods{$_}, 1));
+ __PACKAGE__->register_method(_sigmaker("$_.ids", $auth_hist_methods{$_}, 1));
+ __PACKAGE__->register_method(_sigmaker("$_.fleshed", $auth_hist_methods{$_}, 1));
+}
+
+sub user_transaction_history {
+ my( $self, $conn, $auth, $userid, $type, $filter, $options ) = @_;
+ $filter ||= {};
+ $options ||= {};
+
+ my $e = new_editor(authtoken=>$auth);
+ return $e->die_event unless $e->checkauth;
+
+ if ($e->requestor->id ne $userid) {
+ return $e->die_event unless $e->allowed('VIEW_USER_TRANSACTIONS');
+ }
+
+ my $api = $self->api_name;
+ my @xact_finish = (xact_finish => undef ) if ($api =~ /history\.still_open$/); # What about history.still_open.ids?
+
+ if(defined($type)) {
+ $filter->{'xact_type'} = $type;
+ }
+
+ if($api =~ /have_bill_or_payment/o) {
+
+ # transactions that have a non-zero sum across all billings or at least 1 payment
+ $filter->{'-or'} = {
+ 'balance_owed' => { '<>' => 0 },
+ 'last_payment_ts' => { '<>' => undef }
+ };
+
+ } elsif($api =~ /have_payment/) {
+
+ $filter->{last_payment_ts} ||= {'<>' => undef};
+
+ } elsif( $api =~ /have_balance/o) {
+
+ # transactions that have a non-zero overall balance
+ $filter->{'balance_owed'} = { '<>' => 0 };
+
+ } elsif( $api =~ /have_charge/o) {
+
+ # transactions that have at least 1 billing, regardless of whether it was voided
+ $filter->{'last_billing_ts'} = { '<>' => undef };
+
+ } elsif( $api =~ /have_bill/o) { # needs to be an elsif, or we double-match have_bill_or_payment!
+
+ # transactions that have non-zero sum across all billings. This will exclude
+ # xacts where all billings have been voided
+ $filter->{'total_owed'} = { '<>' => 0 };
+ }
+
+ my $options_clause = { order_by => { mbt => 'xact_start DESC' } };
+ $options_clause->{'limit'} = $options->{'limit'} if $options->{'limit'};
+ $options_clause->{'offset'} = $options->{'offset'} if $options->{'offset'};
+
+ my $mbts = $e->search_money_billable_transaction_summary(
+ [ { usr => $userid, @xact_finish, %$filter },
+ $options_clause
+ ]
+ );
+
+ return [map {$_->id} @$mbts] if $api =~ /\.ids/;
+ return $mbts unless $api =~ /fleshed/;
+
+ my @resp;
+ for my $t (@$mbts) {
+
+ if( $t->xact_type ne 'circulation' ) {
+ push @resp, {transaction => $t};
+ next;
+ }
+
+ my $circ_data = flesh_circ($e, $t->id);
+ push @resp, {transaction => $t, %$circ_data};
+ }
+
+ return \@resp;
+}
+
+
+__PACKAGE__->register_method(
+ method => "retrieve_perms",
+ api_name => "open-ils.actor.permissions.retrieve",
+ notes => "Returns a list of permissions"
+);
+sub retrieve_perms {
+ my( $self, $client ) = @_;
+ return $apputils->simple_scalar_request(
+ "open-ils.cstore",
+ "open-ils.cstore.direct.permission.perm_list.search.atomic",
+ { id => { '!=' => undef } }
+ );
+}
+
+__PACKAGE__->register_method(
+ method => "retrieve_groups",
+ api_name => "open-ils.actor.groups.retrieve",
+ notes => "Returns a list of user groups"
+);
+sub retrieve_groups {
+ my( $self, $client ) = @_;
+ return new_editor()->retrieve_all_permission_grp_tree();
+}
+
+__PACKAGE__->register_method(
+ method => "retrieve_groups_tree",
+ api_name => "open-ils.actor.groups.tree.retrieve",
+ notes => "Returns a list of user groups"
+);
+
+sub retrieve_groups_tree {
+ my( $self, $client ) = @_;
+ return new_editor()->search_permission_grp_tree(
+ [
+ { parent => undef},
+ {
+ flesh => -1,
+ flesh_fields => { pgt => ["children"] },
+ order_by => { pgt => 'name'}
+ }
+ ]
+ )->[0];
+}
+
+
+__PACKAGE__->register_method(
+ method => "add_user_to_groups",
+ api_name => "open-ils.actor.user.set_groups",
+ notes => "Adds a user to one or more permission groups"
+);
+
+sub add_user_to_groups {
+ my( $self, $client, $authtoken, $userid, $groups ) = @_;
+
+ my( $requestor, $target, $evt ) = $apputils->checkses_requestor(
+ $authtoken, $userid, 'CREATE_USER_GROUP_LINK' );
+ return $evt if $evt;
+
+ ( $requestor, $target, $evt ) = $apputils->checkses_requestor(
+ $authtoken, $userid, 'REMOVE_USER_GROUP_LINK' );
+ return $evt if $evt;
+
+ $apputils->simplereq(
+ 'open-ils.storage',
+ 'open-ils.storage.direct.permission.usr_grp_map.mass_delete', { usr => $userid } );
+
+ for my $group (@$groups) {
+ my $link = Fieldmapper::permission::usr_grp_map->new;
+ $link->grp($group);
+ $link->usr($userid);
+
+ my $id = $apputils->simplereq(
+ 'open-ils.storage',
+ 'open-ils.storage.direct.permission.usr_grp_map.create', $link );
+ }
+
+ return 1;
+}
+
+__PACKAGE__->register_method(
+ method => "get_user_perm_groups",
+ api_name => "open-ils.actor.user.get_groups",
+ notes => "Retrieve a user's permission groups."
+);
+
+
+sub get_user_perm_groups {
+ my( $self, $client, $authtoken, $userid ) = @_;
+
+ my( $requestor, $target, $evt ) = $apputils->checkses_requestor(
+ $authtoken, $userid, 'VIEW_PERM_GROUPS' );
+ return $evt if $evt;
+
+ return $apputils->simplereq(
+ 'open-ils.cstore',
+ 'open-ils.cstore.direct.permission.usr_grp_map.search.atomic', { usr => $userid } );
+}
+
+__PACKAGE__->register_method(
+ method => 'fetch_patron_note',
+ api_name => 'open-ils.actor.note.retrieve.all',
+ authoritative => 1,
+ signature => q/
+ Returns a list of notes for a given user
+ Requestor must have VIEW_USER permission if pub==false and
+ @param authtoken The login session key
+ @param args Hash of params including
+ patronid : the patron's id
+ pub : true if retrieving only public notes
+ /
+);
+
+sub fetch_patron_note {
+ my( $self, $conn, $authtoken, $args ) = @_;
+ my $patronid = $$args{patronid};
+
+ my($reqr, $evt) = $U->checkses($authtoken);
+ return $evt if $evt;
+
+ my $patron;
+ ($patron, $evt) = $U->fetch_user($patronid);
+ return $evt if $evt;
+
+ if($$args{pub}) {
+ if( $patronid ne $reqr->id ) {
+ $evt = $U->check_perms($reqr->id, $patron->home_ou, 'VIEW_USER');
+ return $evt if $evt;
+ }
+ return $U->cstorereq(
+ 'open-ils.cstore.direct.actor.usr_note.search.atomic',
+ { usr => $patronid, pub => 't' } );
+ }
+
+ $evt = $U->check_perms($reqr->id, $patron->home_ou, 'VIEW_USER');
+ return $evt if $evt;
+
+ return $U->cstorereq(
+ 'open-ils.cstore.direct.actor.usr_note.search.atomic', { usr => $patronid } );
+}
+
+__PACKAGE__->register_method(
+ method => 'create_user_note',
+ api_name => 'open-ils.actor.note.create',
+ signature => q/
+ Creates a new note for the given user
+ @param authtoken The login session key
+ @param note The note object
+ /
+);
+sub create_user_note {
+ my( $self, $conn, $authtoken, $note ) = @_;
+ my $e = new_editor(xact=>1, authtoken=>$authtoken);
+ return $e->die_event unless $e->checkauth;
+
+ my $user = $e->retrieve_actor_user($note->usr)
+ or return $e->die_event;
+
+ return $e->die_event unless
+ $e->allowed('UPDATE_USER',$user->home_ou);
+
+ $note->creator($e->requestor->id);
+ $e->create_actor_usr_note($note) or return $e->die_event;
+ $e->commit;
+ return $note->id;
+}
+
+
+__PACKAGE__->register_method(
+ method => 'delete_user_note',
+ api_name => 'open-ils.actor.note.delete',
+ signature => q/
+ Deletes a note for the given user
+ @param authtoken The login session key
+ @param noteid The note id
+ /
+);
+sub delete_user_note {
+ my( $self, $conn, $authtoken, $noteid ) = @_;
+
+ my $e = new_editor(xact=>1, authtoken=>$authtoken);
+ return $e->die_event unless $e->checkauth;
+ my $note = $e->retrieve_actor_usr_note($noteid)
+ or return $e->die_event;
+ my $user = $e->retrieve_actor_user($note->usr)
+ or return $e->die_event;
+ return $e->die_event unless
+ $e->allowed('UPDATE_USER', $user->home_ou);
+
+ $e->delete_actor_usr_note($note) or return $e->die_event;
+ $e->commit;
+ return 1;
+}
+
+
+__PACKAGE__->register_method(
+ method => 'update_user_note',
+ api_name => 'open-ils.actor.note.update',
+ signature => q/
+ @param authtoken The login session key
+ @param note The note
+ /
+);
+
+sub update_user_note {
+ my( $self, $conn, $auth, $note ) = @_;
+ my $e = new_editor(authtoken=>$auth, xact=>1);
+ return $e->die_event unless $e->checkauth;
+ my $patron = $e->retrieve_actor_user($note->usr)
+ or return $e->die_event;
+ return $e->die_event unless
+ $e->allowed('UPDATE_USER', $patron->home_ou);
+ $e->update_actor_user_note($note)
+ or return $e->die_event;
+ $e->commit;
+ return 1;
+}
+
+__PACKAGE__->register_method(
+ method => 'usrname_exists',
+ api_name => 'open-ils.actor.username.exists',
+ signature => {
+ desc => 'Check if a username is already taken (by an undeleted patron)',
+ param => [
+ {desc => 'Authentication token', type => 'string'},
+ {desc => 'Username', type => 'string'}
+ ],
+ return => {
+ desc => 'id of existing user if username exists, undef otherwise. Event on error'
+ },
+ }
+);
+
+sub usrname_exists {
+ my( $self, $conn, $auth, $usrname ) = @_;
+ my $e = new_editor(authtoken=>$auth);
+ return $e->event unless $e->checkauth;
+ my $a = $e->search_actor_user({usrname => $usrname}, {idlist=>1});
+ return $$a[0] if $a and @$a;
+ return undef;
+}
+
+# Retain the old typo API name just in case
+__PACKAGE__->register_method(
+ method => 'fetch_org_by_shortname',
+ api_name => 'open-ils.actor.org_unit.retrieve_by_shorname',
+);
+__PACKAGE__->register_method(
+ method => 'fetch_org_by_shortname',
+ api_name => 'open-ils.actor.org_unit.retrieve_by_shortname',
+);
+sub fetch_org_by_shortname {
+ my( $self, $conn, $sname ) = @_;
+ my $e = new_editor();
+ my $org = $e->search_actor_org_unit({ shortname => uc($sname)})->[0];
+ return $e->event unless $org;
+ return $org;
+}
+
+
+__PACKAGE__->register_method(
+ method => 'session_home_lib',
+ api_name => 'open-ils.actor.session.home_lib',
+);
+
+sub session_home_lib {
+ my( $self, $conn, $auth ) = @_;
+ my $e = new_editor(authtoken=>$auth);
+ return undef unless $e->checkauth;
+ my $org = $e->retrieve_actor_org_unit($e->requestor->home_ou);
+ return $org->shortname;
+}
+
+__PACKAGE__->register_method(
+ method => 'session_safe_token',
+ api_name => 'open-ils.actor.session.safe_token',
+ signature => q/
+ Returns a hashed session ID that is safe for export to the world.
+ This safe token will expire after 1 hour of non-use.
+ @param auth Active authentication token
+ /
+);
+
+sub session_safe_token {
+ my( $self, $conn, $auth ) = @_;
+ my $e = new_editor(authtoken=>$auth);
+ return undef unless $e->checkauth;
+
+ my $safe_token = md5_hex($auth);
+
+ $cache ||= OpenSRF::Utils::Cache->new("global", 0);
+
+ # Add more like the following if needed...
+ $cache->put_cache(
+ "safe-token-home_lib-shortname-$safe_token",
+ $e->retrieve_actor_org_unit(
+ $e->requestor->home_ou
+ )->shortname,
+ 60 * 60
+ );
+
+ return $safe_token;
+}
+
+
+__PACKAGE__->register_method(
+ method => 'safe_token_home_lib',
+ api_name => 'open-ils.actor.safe_token.home_lib.shortname',
+ signature => q/
+ Returns the home library shortname from the session
+ asscociated with a safe token from generated by
+ open-ils.actor.session.safe_token.
+ @param safe_token Active safe token
+ /
+);
+
+sub safe_token_home_lib {
+ my( $self, $conn, $safe_token ) = @_;
+
+ $cache ||= OpenSRF::Utils::Cache->new("global", 0);
+ return $cache->get_cache( 'safe-token-home_lib-shortname-'. $safe_token );
+}
+
+
+__PACKAGE__->register_method(
+ method => "user_retrieve_parts",
+ api_name => "open-ils.actor.user.retrieve.parts",
+);
+
+sub user_retrieve_parts {
+ my( $self, $client, $auth, $user_id, $fields ) = @_;
+ my $e = new_editor(authtoken => $auth);
+ return $e->event unless $e->checkauth;
+ $user_id ||= $e->requestor->id;
+ if( $e->requestor->id != $user_id ) {
+ return $e->event unless $e->allowed('VIEW_USER');
+ }
+ my @resp;
+ my $user = $e->retrieve_actor_user($user_id) or return $e->event;
+ push(@resp, $user->$_()) for(@$fields);
+ return \@resp;
+}
+
+
+__PACKAGE__->register_method (
+ method => 'verify_user_password',
+ api_name => 'open-ils.actor.verify_user_password',
+ signature => q/
+ Given a barcode or username and the MD5 encoded password,
+ returns 1 if the password is correct. Returns 0 otherwise.
+ /
+);
+
+sub verify_user_password {
+ my($self, $conn, $auth, $username, $password) = @_;
+ my $e = new_editor(authtoken => $auth);
+ return $e->die_event unless $e->checkauth;
+
+ my $user = $e->search_actor_user({usrname => $username})->[0] or return 0;
+ return 0 if (!$user);
+ return $e->event unless $e->allowed('VIEW_USER', $user->home_ou);
+ return 1 if $user->passwd eq $password;
+ return 0;
+}
+
+sub check_password_strength_default {
+ my $password = shift;
+ # Use the default set of checks
+ if ( (length($password) < 7) or
+ ($password !~ m/.*\d+.*/) or
+ ($password !~ m/.*[A-Za-z]+.*/)
+ ) {
+ return 0;
+ }
+ return 1;
+}
+
+sub check_password_strength_custom {
+ my ($password, $pw_regex) = @_;
+
+ $pw_regex = qr/$pw_regex/;
+ if ($password !~ /$pw_regex/) {
+ return 0;
+ }
+ return 1;
+}
+
+
+1;
--- /dev/null
+package ShareStuff::AppUtils;
+# vim:noet:ts=4
+use strict; use warnings;
+use OpenSRF::Application;
+use base qw/OpenSRF::Application/;
+use OpenSRF::Utils::Cache;
+use OpenSRF::Utils::Logger qw/$logger/;
+use OpenSRF::EX qw(:try);
+use ShareStuff::Event;
+use ShareStuff::Const qw/:const/;
+use Data::Dumper;
+use ShareStuff::CStoreEditor;
+use Unicode::Normalize;
+use OpenSRF::Utils::SettingsClient;
+use UUID::Tiny;
+use Encode;
+use DateTime;
+use DateTime::Format::ISO8601;
+
+# ---------------------------------------------------------------------------
+# Pile of utilty methods used accross applications.
+# ---------------------------------------------------------------------------
+my $cache_client = "OpenSRF::Utils::Cache";
+
+
+# ---------------------------------------------------------------------------
+# on sucess, returns the created session, on failure throws ERROR exception
+# ---------------------------------------------------------------------------
+sub start_db_session {
+
+ my $self = shift;
+ my $session = OpenSRF::AppSession->connect( "open-ils.storage" );
+ my $trans_req = $session->request( "open-ils.storage.transaction.begin" );
+
+ my $trans_resp = $trans_req->recv();
+ if(ref($trans_resp) and UNIVERSAL::isa($trans_resp,"Error")) { throw $trans_resp; }
+ if( ! $trans_resp->content() ) {
+ throw OpenSRF::ERROR
+ ("Unable to Begin Transaction with database" );
+ }
+ $trans_req->finish();
+
+ $logger->debug("Setting global storage session to ".
+ "session: " . $session->session_id . " : " . $session->app );
+
+ return $session;
+}
+
+sub set_audit_info {
+ my $self = shift;
+ my $session = shift;
+ my $authtoken = shift;
+ my $user_id = shift;
+ my $ws_id = shift;
+
+ my $audit_req = $session->request( "open-ils.storage.set_audit_info", $authtoken, $user_id, $ws_id );
+ my $audit_resp = $audit_req->recv();
+ $audit_req->finish();
+}
+
+my $PERM_QUERY = {
+ select => {
+ au => [ {
+ transform => 'permission.usr_has_perm',
+ alias => 'has_perm',
+ column => 'id',
+ params => []
+ } ]
+ },
+ from => 'au',
+ where => {},
+};
+
+
+# returns undef if user has all of the perms provided
+# returns the first failed perm on failure
+sub check_user_perms {
+ my($self, $user_id, $org_id, @perm_types ) = @_;
+ $logger->debug("Checking perms with user : $user_id , org: $org_id, @perm_types");
+
+ for my $type (@perm_types) {
+ $PERM_QUERY->{select}->{au}->[0]->{params} = [$type, $org_id];
+ $PERM_QUERY->{where}->{id} = $user_id;
+ return $type unless $self->is_true(OpenILS::Utils::CStoreEditor->new->json_query($PERM_QUERY)->[0]->{has_perm});
+ }
+ return undef;
+}
+
+# checks the list of user perms. The first one that fails returns a new
+sub check_perms {
+ my( $self, $user_id, $org_id, @perm_types ) = @_;
+ my $t = $self->check_user_perms( $user_id, $org_id, @perm_types );
+ return OpenILS::Event->new('PERM_FAILURE', ilsperm => $t, ilspermloc => $org_id ) if $t;
+ return undef;
+}
+
+
+
+# ---------------------------------------------------------------------------
+# commits and destroys the session
+# ---------------------------------------------------------------------------
+sub commit_db_session {
+ my( $self, $session ) = @_;
+
+ my $req = $session->request( "open-ils.storage.transaction.commit" );
+ my $resp = $req->recv();
+
+ if(!$resp) {
+ throw OpenSRF::EX::ERROR ("Unable to commit db session");
+ }
+
+ if(UNIVERSAL::isa($resp,"Error")) {
+ throw $resp ($resp->stringify);
+ }
+
+ if(!$resp->content) {
+ throw OpenSRF::EX::ERROR ("Unable to commit db session");
+ }
+
+ $session->finish();
+ $session->disconnect();
+ $session->kill_me();
+}
+
+sub rollback_db_session {
+ my( $self, $session ) = @_;
+
+ my $req = $session->request("open-ils.storage.transaction.rollback");
+ my $resp = $req->recv();
+ if(UNIVERSAL::isa($resp,"Error")) { throw $resp; }
+
+ $session->finish();
+ $session->disconnect();
+ $session->kill_me();
+}
+
+
+# returns undef it the event is not an ILS event
+# returns the event code otherwise
+sub event_code {
+ my( $self, $evt ) = @_;
+ return $evt->{ilsevent} if $self->is_event($evt);
+ return undef;
+}
+
+# some events, in particular auto-generated events, don't have an
+# ilsevent key. treat hashes with a 'textcode' key as events.
+sub is_event {
+ my ($self, $evt) = @_;
+ return (
+ ref($evt) eq 'HASH' and (
+ defined $evt->{ilsevent} or
+ defined $evt->{textcode}
+ )
+ );
+}
+
+# ---------------------------------------------------------------------------
+# Checks to see if a user is logged in. Returns the user record on success,
+# throws an exception on error.
+# ---------------------------------------------------------------------------
+sub check_user_session {
+ my( $self, $user_session ) = @_;
+
+ my $content = $self->simplereq(
+ 'open-ils.auth',
+ 'open-ils.auth.session.retrieve', $user_session);
+
+ return undef if (!$content) or $self->event_code($content);
+ return $content;
+}
+
+# generic simple request returning a scalar value
+sub simplereq {
+ my($self, $service, $method, @params) = @_;
+ return $self->simple_scalar_request($service, $method, @params);
+}
+
+
+sub simple_scalar_request {
+ my($self, $service, $method, @params) = @_;
+
+ my $session = OpenSRF::AppSession->create( $service );
+
+ my $request = $session->request( $method, @params );
+
+ my $val;
+ my $err;
+ try {
+
+ $val = $request->gather(1);
+
+ } catch Error with {
+ $err = shift;
+ };
+
+ if( $err ) {
+ warn "received error : service=$service : method=$method : params=".Dumper(\@params) . "\n $err";
+ throw $err ("Call to $service for method $method \n failed with exception: $err : " );
+ }
+
+ return $val;
+}
+
+sub build_org_tree {
+ my( $self, $orglist ) = @_;
+
+ return $orglist unless ref $orglist;
+ return $$orglist[0] if @$orglist == 1;
+
+ my @list = sort {
+ $a->ou_type <=> $b->ou_type ||
+ $a->name cmp $b->name } @$orglist;
+
+ for my $org (@list) {
+
+ next unless ($org);
+ next if (!defined($org->parent_ou) || $org->parent_ou eq "");
+
+ my ($parent) = grep { $_->id == $org->parent_ou } @list;
+ next unless $parent;
+ $parent->children([]) unless defined($parent->children);
+ push( @{$parent->children}, $org );
+ }
+
+ return $list[0];
+}
+
+sub fetch_closed_date {
+ my( $self, $cd ) = @_;
+ my $evt;
+
+ $logger->debug("Fetching closed_date $cd from cstore");
+
+ my $cd_obj = $self->simplereq(
+ 'open-ils.cstore',
+ 'open-ils.cstore.direct.actor.org_unit.closed_date.retrieve', $cd );
+
+ if(!$cd_obj) {
+ $logger->info("closed_date $cd not found in the db");
+ $evt = OpenILS::Event->new('ACTOR_USER_NOT_FOUND');
+ }
+
+ return ($cd_obj, $evt);
+}
+
+sub fetch_user {
+ my( $self, $userid ) = @_;
+ my( $user, $evt );
+
+ $logger->debug("Fetching user $userid from cstore");
+
+ $user = $self->simplereq(
+ 'open-ils.cstore',
+ 'open-ils.cstore.direct.actor.user.retrieve', $userid );
+
+ if(!$user) {
+ $logger->info("User $userid not found in the db");
+ $evt = OpenILS::Event->new('ACTOR_USER_NOT_FOUND');
+ }
+
+ return ($user, $evt);
+}
+
+sub checkses {
+ my( $self, $session ) = @_;
+ my $user = $self->check_user_session($session) or
+ return (undef, OpenILS::Event->new('NO_SESSION'));
+ return ($user);
+}
+
+
+# verifiese the session and checks the permissions agains the
+# session user and the user's home_ou as the org id
+sub checksesperm {
+ my( $self, $session, @perms ) = @_;
+ my $user; my $evt; my $e;
+ $logger->debug("Checking user session $session and perms @perms");
+ ($user, $evt) = $self->checkses($session);
+ return (undef, $evt) if $evt;
+ $evt = $self->check_perms($user->id, $user->home_ou, @perms);
+ return ($user, $evt);
+}
+
+
+sub checkrequestor {
+ my( $self, $staffobj, $userid, @perms ) = @_;
+ my $user; my $evt;
+ $userid = $staffobj->id unless defined $userid;
+
+ $logger->debug("checkrequestor(): requestor => " . $staffobj->id . ", target => $userid");
+
+ if( $userid ne $staffobj->id ) {
+ ($user, $evt) = $self->fetch_user($userid);
+ return (undef, $evt) if $evt;
+ $evt = $self->check_perms( $staffobj->id, $user->home_ou, @perms );
+
+ } else {
+ $user = $staffobj;
+ }
+
+ return ($user, $evt);
+}
+
+sub checkses_requestor {
+ my( $self, $authtoken, $targetid, @perms ) = @_;
+ my( $requestor, $target, $evt );
+
+ ($requestor, $evt) = $self->checkses($authtoken);
+ return (undef, undef, $evt) if $evt;
+
+ ($target, $evt) = $self->checkrequestor( $requestor, $targetid, @perms );
+ return( $requestor, $target, $evt);
+}
+
+sub fetch_copy {
+ my( $self, $copyid ) = @_;
+ my( $copy, $evt );
+
+ $logger->debug("Fetching copy $copyid from cstore");
+
+ $copy = $self->simplereq(
+ 'open-ils.cstore',
+ 'open-ils.cstore.direct.asset.copy.retrieve', $copyid );
+
+ if(!$copy) { $evt = OpenILS::Event->new('ASSET_COPY_NOT_FOUND'); }
+
+ return( $copy, $evt );
+}
+
+
+# retrieves a circ object by id
+sub fetch_circulation {
+ my( $self, $circid ) = @_;
+ my $circ; my $evt;
+
+ $logger->debug("Fetching circ $circid from cstore");
+
+ $circ = $self->simplereq(
+ 'open-ils.cstore',
+ "open-ils.cstore.direct.action.circulation.retrieve", $circid );
+
+ if(!$circ) {
+ $evt = OpenILS::Event->new('ACTION_CIRCULATION_NOT_FOUND', circid => $circid );
+ }
+
+ return ( $circ, $evt );
+}
+
+sub fetch_record_by_copy {
+ my( $self, $copyid ) = @_;
+ my( $record, $evt );
+
+ $logger->debug("Fetching record by copy $copyid from cstore");
+
+ $record = $self->simplereq(
+ 'open-ils.cstore',
+ 'open-ils.cstore.direct.asset.copy.retrieve', $copyid,
+ { flesh => 3,
+ flesh_fields => { bre => [ 'fixed_fields' ],
+ acn => [ 'record' ],
+ acp => [ 'call_number' ],
+ }
+ }
+ );
+
+ if(!$record) {
+ $evt = OpenILS::Event->new('BIBLIO_RECORD_ENTRY_NOT_FOUND');
+ } else {
+ $record = $record->call_number->record;
+ }
+
+ return ($record, $evt);
+}
+
+sub fetch_hold {
+ my( $self, $holdid ) = @_;
+ my( $hold, $evt );
+
+ $logger->debug("Fetching hold $holdid from cstore");
+
+ $hold = $self->simplereq(
+ 'open-ils.cstore',
+ 'open-ils.cstore.direct.action.hold_request.retrieve', $holdid);
+
+ $evt = OpenILS::Event->new('ACTION_HOLD_REQUEST_NOT_FOUND', holdid => $holdid) unless $hold;
+
+ return ($hold, $evt);
+}
+
+
+sub fetch_hold_transit_by_hold {
+ my( $self, $holdid ) = @_;
+ my( $transit, $evt );
+
+ $logger->debug("Fetching transit by hold $holdid from cstore");
+
+ $transit = $self->simplereq(
+ 'open-ils.cstore',
+ 'open-ils.cstore.direct.action.hold_transit_copy.search', { hold => $holdid } );
+
+ $evt = OpenILS::Event->new('ACTION_HOLD_TRANSIT_COPY_NOT_FOUND', holdid => $holdid) unless $transit;
+
+ return ($transit, $evt );
+}
+
+# fetches the captured, but not fulfilled hold attached to a given copy
+sub fetch_open_hold_by_copy {
+ my( $self, $copyid ) = @_;
+ $logger->debug("Searching for active hold for copy $copyid");
+ my( $hold, $evt );
+
+ $hold = $self->cstorereq(
+ 'open-ils.cstore.direct.action.hold_request.search',
+ {
+ current_copy => $copyid ,
+ capture_time => { "!=" => undef },
+ fulfillment_time => undef,
+ cancel_time => undef,
+ } );
+
+ $evt = OpenILS::Event->new('ACTION_HOLD_REQUEST_NOT_FOUND', copyid => $copyid) unless $hold;
+ return ($hold, $evt);
+}
+
+sub fetch_hold_transit {
+ my( $self, $transid ) = @_;
+ my( $htransit, $evt );
+ $logger->debug("Fetching hold transit with hold id $transid");
+ $htransit = $self->cstorereq(
+ 'open-ils.cstore.direct.action.hold_transit_copy.retrieve', $transid );
+ $evt = OpenILS::Event->new('ACTION_HOLD_TRANSIT_COPY_NOT_FOUND', id => $transid) unless $htransit;
+ return ($htransit, $evt);
+}
+
+sub fetch_copy_by_barcode {
+ my( $self, $barcode ) = @_;
+ my( $copy, $evt );
+
+ $logger->debug("Fetching copy by barcode $barcode from cstore");
+
+ $copy = $self->simplereq( 'open-ils.cstore',
+ 'open-ils.cstore.direct.asset.copy.search', { barcode => $barcode, deleted => 'f'} );
+ #'open-ils.storage.direct.asset.copy.search.barcode', $barcode );
+
+ $evt = OpenILS::Event->new('ASSET_COPY_NOT_FOUND', barcode => $barcode) unless $copy;
+
+ return ($copy, $evt);
+}
+
+sub fetch_open_billable_transaction {
+ my( $self, $transid ) = @_;
+ my( $transaction, $evt );
+
+ $logger->debug("Fetching open billable transaction $transid from cstore");
+
+ $transaction = $self->simplereq(
+ 'open-ils.cstore',
+ 'open-ils.cstore.direct.money.open_billable_transaction_summary.retrieve', $transid);
+
+ $evt = OpenILS::Event->new(
+ 'MONEY_OPEN_BILLABLE_TRANSACTION_SUMMARY_NOT_FOUND', transid => $transid ) unless $transaction;
+
+ return ($transaction, $evt);
+}
+
+
+
+my %buckets;
+$buckets{'biblio'} = 'biblio_record_entry_bucket';
+$buckets{'callnumber'} = 'call_number_bucket';
+$buckets{'copy'} = 'copy_bucket';
+$buckets{'user'} = 'user_bucket';
+
+sub fetch_container {
+ my( $self, $id, $type ) = @_;
+ my( $bucket, $evt );
+
+ $logger->debug("Fetching container $id with type $type");
+
+ my $e = 'CONTAINER_CALL_NUMBER_BUCKET_NOT_FOUND';
+ $e = 'CONTAINER_BIBLIO_RECORD_ENTRY_BUCKET_NOT_FOUND' if $type eq 'biblio';
+ $e = 'CONTAINER_USER_BUCKET_NOT_FOUND' if $type eq 'user';
+ $e = 'CONTAINER_COPY_BUCKET_NOT_FOUND' if $type eq 'copy';
+
+ my $meth = $buckets{$type};
+ $bucket = $self->simplereq(
+ 'open-ils.cstore',
+ "open-ils.cstore.direct.container.$meth.retrieve", $id );
+
+ $evt = OpenILS::Event->new(
+ $e, container => $id, container_type => $type ) unless $bucket;
+
+ return ($bucket, $evt);
+}
+
+
+sub fetch_container_e {
+ my( $self, $editor, $id, $type ) = @_;
+
+ my( $bucket, $evt );
+ $bucket = $editor->retrieve_container_copy_bucket($id) if $type eq 'copy';
+ $bucket = $editor->retrieve_container_call_number_bucket($id) if $type eq 'callnumber';
+ $bucket = $editor->retrieve_container_biblio_record_entry_bucket($id) if $type eq 'biblio';
+ $bucket = $editor->retrieve_container_user_bucket($id) if $type eq 'user';
+
+ $evt = $editor->event unless $bucket;
+ return ($bucket, $evt);
+}
+
+sub fetch_container_item_e {
+ my( $self, $editor, $id, $type ) = @_;
+
+ my( $bucket, $evt );
+ $bucket = $editor->retrieve_container_copy_bucket_item($id) if $type eq 'copy';
+ $bucket = $editor->retrieve_container_call_number_bucket_item($id) if $type eq 'callnumber';
+ $bucket = $editor->retrieve_container_biblio_record_entry_bucket_item($id) if $type eq 'biblio';
+ $bucket = $editor->retrieve_container_user_bucket_item($id) if $type eq 'user';
+
+ $evt = $editor->event unless $bucket;
+ return ($bucket, $evt);
+}
+
+
+
+
+
+sub fetch_container_item {
+ my( $self, $id, $type ) = @_;
+ my( $bucket, $evt );
+
+ $logger->debug("Fetching container item $id with type $type");
+
+ my $meth = $buckets{$type} . "_item";
+
+ $bucket = $self->simplereq(
+ 'open-ils.cstore',
+ "open-ils.cstore.direct.container.$meth.retrieve", $id );
+
+
+ my $e = 'CONTAINER_CALL_NUMBER_BUCKET_ITEM_NOT_FOUND';
+ $e = 'CONTAINER_BIBLIO_RECORD_ENTRY_BUCKET_ITEM_NOT_FOUND' if $type eq 'biblio';
+ $e = 'CONTAINER_USER_BUCKET_ITEM_NOT_FOUND' if $type eq 'user';
+ $e = 'CONTAINER_COPY_BUCKET_ITEM_NOT_FOUND' if $type eq 'copy';
+
+ $evt = OpenILS::Event->new(
+ $e, itemid => $id, container_type => $type ) unless $bucket;
+
+ return ($bucket, $evt);
+}
+
+
+sub fetch_patron_standings {
+ my $self = shift;
+ $logger->debug("Fetching patron standings");
+ return $self->simplereq(
+ 'open-ils.cstore',
+ 'open-ils.cstore.direct.config.standing.search.atomic', { id => { '!=' => undef } });
+}
+
+
+sub fetch_permission_group_tree {
+ my $self = shift;
+ $logger->debug("Fetching patron profiles");
+ return $self->simplereq(
+ 'open-ils.actor',
+ 'open-ils.actor.groups.tree.retrieve' );
+}
+
+sub fetch_permission_group_descendants {
+ my( $self, $profile ) = @_;
+ my $group_tree = $self->fetch_permission_group_tree();
+ my $start_here;
+ my @groups;
+
+ # FIXME: okay, so it's not an org tree, but it is compatible
+ $self->walk_org_tree($group_tree, sub {
+ my $g = shift;
+ if ($g->id == $profile) {
+ $start_here = $g;
+ }
+ });
+
+ $self->walk_org_tree($start_here, sub {
+ my $g = shift;
+ push(@groups,$g->id);
+ });
+
+ return \@groups;
+}
+
+sub fetch_patron_circ_summary {
+ my( $self, $userid ) = @_;
+ $logger->debug("Fetching patron summary for $userid");
+ my $summary = $self->simplereq(
+ 'open-ils.storage',
+ "open-ils.storage.action.circulation.patron_summary", $userid );
+
+ if( $summary ) {
+ $summary->[0] ||= 0;
+ $summary->[1] ||= 0.0;
+ return $summary;
+ }
+ return undef;
+}
+
+
+sub fetch_copy_statuses {
+ my( $self ) = @_;
+ $logger->debug("Fetching copy statuses");
+ return $self->simplereq(
+ 'open-ils.cstore',
+ 'open-ils.cstore.direct.config.copy_status.search.atomic', { id => { '!=' => undef } });
+}
+
+sub fetch_copy_location {
+ my( $self, $id ) = @_;
+ my $evt;
+ my $cl = $self->cstorereq(
+ 'open-ils.cstore.direct.asset.copy_location.retrieve', $id );
+ $evt = OpenILS::Event->new('ASSET_COPY_LOCATION_NOT_FOUND') unless $cl;
+ return ($cl, $evt);
+}
+
+sub fetch_copy_locations {
+ my $self = shift;
+ return $self->simplereq(
+ 'open-ils.cstore',
+ 'open-ils.cstore.direct.asset.copy_location.search.atomic', { id => { '!=' => undef } });
+}
+
+sub fetch_copy_location_by_name {
+ my( $self, $name, $org ) = @_;
+ my $evt;
+ my $cl = $self->cstorereq(
+ 'open-ils.cstore.direct.asset.copy_location.search',
+ { name => $name, owning_lib => $org } );
+ $evt = OpenILS::Event->new('ASSET_COPY_LOCATION_NOT_FOUND') unless $cl;
+ return ($cl, $evt);
+}
+
+sub fetch_callnumber {
+ my( $self, $id, $flesh, $e ) = @_;
+
+ $e ||= OpenILS::Utils::CStoreEditor->new;
+
+ my $evt = OpenILS::Event->new( 'ASSET_CALL_NUMBER_NOT_FOUND', id => $id );
+ return( undef, $evt ) unless $id;
+
+ $logger->debug("Fetching callnumber $id");
+
+ my $cn = $e->retrieve_asset_call_number([
+ $id,
+ { flesh => $flesh, flesh_fields => { acn => [ 'prefix', 'suffix', 'label_class' ] } },
+ ]);
+
+ return ( $cn, $e->event );
+}
+
+my %ORG_CACHE; # - these rarely change, so cache them..
+sub fetch_org_unit {
+ my( $self, $id ) = @_;
+ return undef unless $id;
+ return $id if( ref($id) eq 'Fieldmapper::actor::org_unit' );
+ return $ORG_CACHE{$id} if $ORG_CACHE{$id};
+ $logger->debug("Fetching org unit $id");
+ my $evt = undef;
+
+ my $org = $self->simplereq(
+ 'open-ils.cstore',
+ 'open-ils.cstore.direct.actor.org_unit.retrieve', $id );
+ $evt = OpenILS::Event->new( 'ACTOR_ORG_UNIT_NOT_FOUND', id => $id ) unless $org;
+ $ORG_CACHE{$id} = $org;
+
+ return ($org, $evt);
+}
+
+sub fetch_stat_cat {
+ my( $self, $type, $id ) = @_;
+ my( $cat, $evt );
+ $logger->debug("Fetching $type stat cat: $id");
+ $cat = $self->simplereq(
+ 'open-ils.cstore',
+ "open-ils.cstore.direct.$type.stat_cat.retrieve", $id );
+
+ my $e = 'ASSET_STAT_CAT_NOT_FOUND';
+ $e = 'ACTOR_STAT_CAT_NOT_FOUND' if $type eq 'actor';
+
+ $evt = OpenILS::Event->new( $e, id => $id ) unless $cat;
+ return ( $cat, $evt );
+}
+
+sub fetch_stat_cat_entry {
+ my( $self, $type, $id ) = @_;
+ my( $entry, $evt );
+ $logger->debug("Fetching $type stat cat entry: $id");
+ $entry = $self->simplereq(
+ 'open-ils.cstore',
+ "open-ils.cstore.direct.$type.stat_cat_entry.retrieve", $id );
+
+ my $e = 'ASSET_STAT_CAT_ENTRY_NOT_FOUND';
+ $e = 'ACTOR_STAT_CAT_ENTRY_NOT_FOUND' if $type eq 'actor';
+
+ $evt = OpenILS::Event->new( $e, id => $id ) unless $entry;
+ return ( $entry, $evt );
+}
+
+sub fetch_stat_cat_entry_default {
+ my( $self, $type, $id ) = @_;
+ my( $entry_default, $evt );
+ $logger->debug("Fetching $type stat cat entry default: $id");
+ $entry_default = $self->simplereq(
+ 'open-ils.cstore',
+ "open-ils.cstore.direct.$type.stat_cat_entry_default.retrieve", $id );
+
+ my $e = 'ASSET_STAT_CAT_ENTRY_DEFAULT_NOT_FOUND';
+ $e = 'ACTOR_STAT_CAT_ENTRY_DEFAULT_NOT_FOUND' if $type eq 'actor';
+
+ $evt = OpenILS::Event->new( $e, id => $id ) unless $entry_default;
+ return ( $entry_default, $evt );
+}
+
+sub fetch_stat_cat_entry_default_by_stat_cat_and_org {
+ my( $self, $type, $stat_cat, $orgId ) = @_;
+ my $entry_default;
+ $logger->info("### Fetching $type stat cat entry default with stat_cat $stat_cat owned by org_unit $orgId");
+ $entry_default = $self->simplereq(
+ 'open-ils.cstore',
+ "open-ils.cstore.direct.$type.stat_cat_entry_default.search.atomic",
+ { stat_cat => $stat_cat, owner => $orgId } );
+
+ $entry_default = $entry_default->[0];
+ return ($entry_default, undef) if $entry_default;
+
+ my $e = 'ASSET_STAT_CAT_ENTRY_DEFAULT_NOT_FOUND';
+ $e = 'ACTOR_STAT_CAT_ENTRY_DEFAULT_NOT_FOUND' if $type eq 'actor';
+ return (undef, OpenILS::Event->new($e) );
+}
+
+sub find_org {
+ my( $self, $org_tree, $orgid ) = @_;
+ return undef unless $org_tree and defined $orgid;
+ return $org_tree if ( $org_tree->id eq $orgid );
+ return undef unless ref($org_tree->children);
+ for my $c (@{$org_tree->children}) {
+ my $o = $self->find_org($c, $orgid);
+ return $o if $o;
+ }
+ return undef;
+}
+
+sub fetch_non_cat_type_by_name_and_org {
+ my( $self, $name, $orgId ) = @_;
+ $logger->debug("Fetching non cat type $name at org $orgId");
+ my $types = $self->simplereq(
+ 'open-ils.cstore',
+ 'open-ils.cstore.direct.config.non_cataloged_type.search.atomic',
+ { name => $name, owning_lib => $orgId } );
+ return ($types->[0], undef) if($types and @$types);
+ return (undef, OpenILS::Event->new('CONFIG_NON_CATALOGED_TYPE_NOT_FOUND') );
+}
+
+sub fetch_non_cat_type {
+ my( $self, $id ) = @_;
+ $logger->debug("Fetching non cat type $id");
+ my( $type, $evt );
+ $type = $self->simplereq(
+ 'open-ils.cstore',
+ 'open-ils.cstore.direct.config.non_cataloged_type.retrieve', $id );
+ $evt = OpenILS::Event->new('CONFIG_NON_CATALOGED_TYPE_NOT_FOUND') unless $type;
+ return ($type, $evt);
+}
+
+sub DB_UPDATE_FAILED {
+ my( $self, $payload ) = @_;
+ return OpenILS::Event->new('DATABASE_UPDATE_FAILED',
+ payload => ($payload) ? $payload : undef );
+}
+
+sub fetch_booking_reservation {
+ my( $self, $id ) = @_;
+ my( $res, $evt );
+
+ $res = $self->simplereq(
+ 'open-ils.cstore',
+ 'open-ils.cstore.direct.booking.reservation.retrieve', $id
+ );
+
+ # simplereq doesn't know how to flesh so ...
+ if ($res) {
+ $res->usr(
+ $self->simplereq(
+ 'open-ils.cstore',
+ 'open-ils.cstore.direct.actor.user.retrieve', $res->usr
+ )
+ );
+
+ $res->target_resource_type(
+ $self->simplereq(
+ 'open-ils.cstore',
+ 'open-ils.cstore.direct.booking.resource_type.retrieve', $res->target_resource_type
+ )
+ );
+
+ if ($res->current_resource) {
+ $res->current_resource(
+ $self->simplereq(
+ 'open-ils.cstore',
+ 'open-ils.cstore.direct.booking.resource.retrieve', $res->current_resource
+ )
+ );
+
+ if ($self->is_true( $res->target_resource_type->catalog_item )) {
+ $res->current_resource->catalog_item( $self->fetch_copy_by_barcode( $res->current_resource->barcode ) );
+ }
+ }
+
+ if ($res->target_resource) {
+ $res->target_resource(
+ $self->simplereq(
+ 'open-ils.cstore',
+ 'open-ils.cstore.direct.booking.resource.retrieve', $res->target_resource
+ )
+ );
+
+ if ($self->is_true( $res->target_resource_type->catalog_item )) {
+ $res->target_resource->catalog_item( $self->fetch_copy_by_barcode( $res->target_resource->barcode ) );
+ }
+ }
+
+ } else {
+ $evt = OpenILS::Event->new('RESERVATION_NOT_FOUND');
+ }
+
+ return ($res, $evt);
+}
+
+sub fetch_circ_duration_by_name {
+ my( $self, $name ) = @_;
+ my( $dur, $evt );
+ $dur = $self->simplereq(
+ 'open-ils.cstore',
+ 'open-ils.cstore.direct.config.rules.circ_duration.search.atomic', { name => $name } );
+ $dur = $dur->[0];
+ $evt = OpenILS::Event->new('CONFIG_RULES_CIRC_DURATION_NOT_FOUND') unless $dur;
+ return ($dur, $evt);
+}
+
+sub fetch_recurring_fine_by_name {
+ my( $self, $name ) = @_;
+ my( $obj, $evt );
+ $obj = $self->simplereq(
+ 'open-ils.cstore',
+ 'open-ils.cstore.direct.config.rules.recurring_fine.search.atomic', { name => $name } );
+ $obj = $obj->[0];
+ $evt = OpenILS::Event->new('CONFIG_RULES_RECURRING_FINE_NOT_FOUND') unless $obj;
+ return ($obj, $evt);
+}
+
+sub fetch_max_fine_by_name {
+ my( $self, $name ) = @_;
+ my( $obj, $evt );
+ $obj = $self->simplereq(
+ 'open-ils.cstore',
+ 'open-ils.cstore.direct.config.rules.max_fine.search.atomic', { name => $name } );
+ $obj = $obj->[0];
+ $evt = OpenILS::Event->new('CONFIG_RULES_MAX_FINE_NOT_FOUND') unless $obj;
+ return ($obj, $evt);
+}
+
+sub fetch_hard_due_date_by_name {
+ my( $self, $name ) = @_;
+ my( $obj, $evt );
+ $obj = $self->simplereq(
+ 'open-ils.cstore',
+ 'open-ils.cstore.direct.config.hard_due_date.search.atomic', { name => $name } );
+ $obj = $obj->[0];
+ $evt = OpenILS::Event->new('CONFIG_RULES_HARD_DUE_DATE_NOT_FOUND') unless $obj;
+ return ($obj, $evt);
+}
+
+sub storagereq {
+ my( $self, $method, @params ) = @_;
+ return $self->simplereq(
+ 'open-ils.storage', $method, @params );
+}
+
+sub storagereq_xact {
+ my($self, $method, @params) = @_;
+ my $ses = $self->start_db_session();
+ my $val = $ses->request($method, @params)->gather(1);
+ $self->rollback_db_session($ses);
+ return $val;
+}
+
+sub cstorereq {
+ my( $self, $method, @params ) = @_;
+ return $self->simplereq(
+ 'open-ils.cstore', $method, @params );
+}
+
+sub event_equals {
+ my( $self, $e, $name ) = @_;
+ if( $e and ref($e) eq 'HASH' and
+ defined($e->{textcode}) and $e->{textcode} eq $name ) {
+ return 1 ;
+ }
+ return 0;
+}
+
+sub logmark {
+ my( undef, $f, $l ) = caller(0);
+ my( undef, undef, undef, $s ) = caller(1);
+ $s =~ s/.*:://g;
+ $f =~ s/.*\///g;
+ $logger->debug("LOGMARK: $f:$l:$s");
+}
+
+# takes a copy id
+sub fetch_open_circulation {
+ my( $self, $cid ) = @_;
+ $self->logmark;
+
+ my $e = OpenILS::Utils::CStoreEditor->new;
+ my $circ = $e->search_action_circulation({
+ target_copy => $cid,
+ stop_fines_time => undef,
+ checkin_time => undef
+ })->[0];
+
+ return ($circ, $e->event);
+}
+
+my $copy_statuses;
+sub copy_status_from_name {
+ my( $self, $name ) = @_;
+ $copy_statuses = $self->fetch_copy_statuses unless $copy_statuses;
+ for my $status (@$copy_statuses) {
+ return $status if( $status->name =~ /$name/i );
+ }
+ return undef;
+}
+
+sub copy_status_to_name {
+ my( $self, $sid ) = @_;
+ $copy_statuses = $self->fetch_copy_statuses unless $copy_statuses;
+ for my $status (@$copy_statuses) {
+ return $status->name if( $status->id == $sid );
+ }
+ return undef;
+}
+
+
+sub copy_status {
+ my( $self, $arg ) = @_;
+ return $arg if ref $arg;
+ $copy_statuses = $self->fetch_copy_statuses unless $copy_statuses;
+ my ($stat) = grep { $_->id == $arg } @$copy_statuses;
+ return $stat;
+}
+
+sub fetch_open_transit_by_copy {
+ my( $self, $copyid ) = @_;
+ my($transit, $evt);
+ $transit = $self->cstorereq(
+ 'open-ils.cstore.direct.action.transit_copy.search',
+ { target_copy => $copyid, dest_recv_time => undef });
+ $evt = OpenILS::Event->new('ACTION_TRANSIT_COPY_NOT_FOUND') unless $transit;
+ return ($transit, $evt);
+}
+
+sub unflesh_copy {
+ my( $self, $copy ) = @_;
+ return undef unless $copy;
+ $copy->status( $copy->status->id ) if ref($copy->status);
+ $copy->location( $copy->location->id ) if ref($copy->location);
+ $copy->circ_lib( $copy->circ_lib->id ) if ref($copy->circ_lib);
+ return $copy;
+}
+
+sub unflesh_reservation {
+ my( $self, $reservation ) = @_;
+ return undef unless $reservation;
+ $reservation->usr( $reservation->usr->id ) if ref($reservation->usr);
+ $reservation->target_resource_type( $reservation->target_resource_type->id ) if ref($reservation->target_resource_type);
+ $reservation->target_resource( $reservation->target_resource->id ) if ref($reservation->target_resource);
+ $reservation->current_resource( $reservation->current_resource->id ) if ref($reservation->current_resource);
+ return $reservation;
+}
+
+# un-fleshes a copy and updates it in the DB
+# returns a DB_UPDATE_FAILED event on error
+# returns undef on success
+sub update_copy {
+ my( $self, %params ) = @_;
+
+ my $copy = $params{copy} || die "update_copy(): copy required";
+ my $editor = $params{editor} || die "update_copy(): copy editor required";
+ my $session = $params{session};
+
+ $logger->debug("Updating copy in the database: " . $copy->id);
+
+ $self->unflesh_copy($copy);
+ $copy->editor( $editor );
+ $copy->edit_date( 'now' );
+
+ my $s;
+ my $meth = 'open-ils.storage.direct.asset.copy.update';
+
+ $s = $session->request( $meth, $copy )->gather(1) if $session;
+ $s = $self->storagereq( $meth, $copy ) unless $session;
+
+ $logger->debug("Update of copy ".$copy->id." returned: $s");
+
+ return $self->DB_UPDATE_FAILED($copy) unless $s;
+ return undef;
+}
+
+sub update_reservation {
+ my( $self, %params ) = @_;
+
+ my $reservation = $params{reservation} || die "update_reservation(): reservation required";
+ my $editor = $params{editor} || die "update_reservation(): copy editor required";
+ my $session = $params{session};
+
+ $logger->debug("Updating copy in the database: " . $reservation->id);
+
+ $self->unflesh_reservation($reservation);
+
+ my $s;
+ my $meth = 'open-ils.cstore.direct.booking.reservation.update';
+
+ $s = $session->request( $meth, $reservation )->gather(1) if $session;
+ $s = $self->cstorereq( $meth, $reservation ) unless $session;
+
+ $logger->debug("Update of copy ".$reservation->id." returned: $s");
+
+ return $self->DB_UPDATE_FAILED($reservation) unless $s;
+ return undef;
+}
+
+sub fetch_billable_xact {
+ my( $self, $id ) = @_;
+ my($xact, $evt);
+ $logger->debug("Fetching billable transaction %id");
+ $xact = $self->cstorereq(
+ 'open-ils.cstore.direct.money.billable_transaction.retrieve', $id );
+ $evt = OpenILS::Event->new('MONEY_BILLABLE_TRANSACTION_NOT_FOUND') unless $xact;
+ return ($xact, $evt);
+}
+
+sub fetch_billable_xact_summary {
+ my( $self, $id ) = @_;
+ my($xact, $evt);
+ $logger->debug("Fetching billable transaction summary %id");
+ $xact = $self->cstorereq(
+ 'open-ils.cstore.direct.money.billable_transaction_summary.retrieve', $id );
+ $evt = OpenILS::Event->new('MONEY_BILLABLE_TRANSACTION_NOT_FOUND') unless $xact;
+ return ($xact, $evt);
+}
+
+sub fetch_fleshed_copy {
+ my( $self, $id ) = @_;
+ my( $copy, $evt );
+ $logger->info("Fetching fleshed copy $id");
+ $copy = $self->cstorereq(
+ "open-ils.cstore.direct.asset.copy.retrieve", $id,
+ { flesh => 1,
+ flesh_fields => { acp => [ qw/ circ_lib location status stat_cat_entries / ] }
+ }
+ );
+ $evt = OpenILS::Event->new('ASSET_COPY_NOT_FOUND', id => $id) unless $copy;
+ return ($copy, $evt);
+}
+
+
+# returns the org that owns the callnumber that the copy
+# is attached to
+sub fetch_copy_owner {
+ my( $self, $copyid ) = @_;
+ my( $copy, $cn, $evt );
+ $logger->debug("Fetching copy owner $copyid");
+ ($copy, $evt) = $self->fetch_copy($copyid);
+ return (undef,$evt) if $evt;
+ ($cn, $evt) = $self->fetch_callnumber($copy->call_number);
+ return (undef,$evt) if $evt;
+ return ($cn->owning_lib);
+}
+
+sub fetch_copy_note {
+ my( $self, $id ) = @_;
+ my( $note, $evt );
+ $logger->debug("Fetching copy note $id");
+ $note = $self->cstorereq(
+ 'open-ils.cstore.direct.asset.copy_note.retrieve', $id );
+ $evt = OpenILS::Event->new('ASSET_COPY_NOTE_NOT_FOUND', id => $id ) unless $note;
+ return ($note, $evt);
+}
+
+sub fetch_call_numbers_by_title {
+ my( $self, $titleid ) = @_;
+ $logger->info("Fetching call numbers by title $titleid");
+ return $self->cstorereq(
+ 'open-ils.cstore.direct.asset.call_number.search.atomic',
+ { record => $titleid, deleted => 'f' });
+ #'open-ils.storage.direct.asset.call_number.search.record.atomic', $titleid);
+}
+
+sub fetch_copies_by_call_number {
+ my( $self, $cnid ) = @_;
+ $logger->info("Fetching copies by call number $cnid");
+ return $self->cstorereq(
+ 'open-ils.cstore.direct.asset.copy.search.atomic', { call_number => $cnid, deleted => 'f' } );
+ #'open-ils.storage.direct.asset.copy.search.call_number.atomic', $cnid );
+}
+
+sub fetch_user_by_barcode {
+ my( $self, $bc ) = @_;
+ my $cardid = $self->cstorereq(
+ 'open-ils.cstore.direct.actor.card.id_list', { barcode => $bc } );
+ return (undef, OpenILS::Event->new('ACTOR_CARD_NOT_FOUND', barcode => $bc)) unless $cardid;
+ my $user = $self->cstorereq(
+ 'open-ils.cstore.direct.actor.user.search', { card => $cardid } );
+ return (undef, OpenILS::Event->new('ACTOR_USER_NOT_FOUND', card => $cardid)) unless $user;
+ return ($user);
+
+}
+
+sub fetch_bill {
+ my( $self, $billid ) = @_;
+ $logger->debug("Fetching billing $billid");
+ my $bill = $self->cstorereq(
+ 'open-ils.cstore.direct.money.billing.retrieve', $billid );
+ my $evt = OpenILS::Event->new('MONEY_BILLING_NOT_FOUND') unless $bill;
+ return($bill, $evt);
+}
+
+sub walk_org_tree {
+ my( $self, $node, $callback ) = @_;
+ return unless $node;
+ $callback->($node);
+ if( $node->children ) {
+ $self->walk_org_tree($_, $callback) for @{$node->children};
+ }
+}
+
+sub is_true {
+ my( $self, $item ) = @_;
+ return 1 if $item and $item !~ /^f$/i;
+ return 0;
+}
+
+
+sub patientreq {
+ my ($self, $client, $service, $method, @params) = @_;
+ my ($response, $err);
+
+ my $session = create OpenSRF::AppSession($service);
+ my $request = $session->request($method, @params);
+
+ my $spurt = 10;
+ my $give_up = time + 1000;
+
+ try {
+ while (time < $give_up) {
+ $response = $request->recv("timeout" => $spurt);
+ last if $request->complete;
+
+ $client->status(new OpenSRF::DomainObject::oilsContinueStatus);
+ }
+ } catch Error with {
+ $err = shift;
+ };
+
+ if ($err) {
+ warn "received error : service=$service : method=$method : params=".Dumper(\@params) . "\n $err";
+ throw $err ("Call to $service for method $method \n failed with exception: $err : " );
+ }
+
+ return $response->content;
+}
+
+# This logic now lives in storage
+sub __patron_money_owed {
+ my( $self, $patronid ) = @_;
+ my $ses = OpenSRF::AppSession->create('open-ils.storage');
+ my $req = $ses->request(
+ 'open-ils.storage.money.billable_transaction.summary.search',
+ { usr => $patronid, xact_finish => undef } );
+
+ my $total = 0;
+ my $data;
+ while( $data = $req->recv ) {
+ $data = $data->content;
+ $total += $data->balance_owed;
+ }
+ return $total;
+}
+
+sub patron_money_owed {
+ my( $self, $userid ) = @_;
+ my $ses = $self->start_db_session();
+ my $val = $ses->request(
+ 'open-ils.storage.actor.user.total_owed', $userid)->gather(1);
+ $self->rollback_db_session($ses);
+ return $val;
+}
+
+sub patron_total_items_out {
+ my( $self, $userid ) = @_;
+ my $ses = $self->start_db_session();
+ my $val = $ses->request(
+ 'open-ils.storage.actor.user.total_out', $userid)->gather(1);
+ $self->rollback_db_session($ses);
+ return $val;
+}
+
+
+
+
+#---------------------------------------------------------------------
+# Returns ($summary, $event)
+#---------------------------------------------------------------------
+sub fetch_mbts {
+ my $self = shift;
+ my $id = shift;
+ my $e = shift || OpenILS::Utils::CStoreEditor->new;
+ $id = $id->id if ref($id);
+
+ my $xact = $e->retrieve_money_billable_transaction_summary($id)
+ or return (undef, $e->event);
+
+ return ($xact);
+}
+
+
+#---------------------------------------------------------------------
+# Given a list of money.billable_transaction objects, this creates
+# transaction summary objects for each
+#--------------------------------------------------------------------
+sub make_mbts {
+ my $self = shift;
+ my $e = shift;
+ my @xacts = @_;
+ return () if (!@xacts);
+ return @{$e->search_money_billable_transaction_summary({id => [ map { $_->id } @xacts ]})};
+}
+
+
+sub ou_ancestor_setting_value {
+ my($self, $org_id, $name, $e) = @_;
+ $e = $e || OpenILS::Utils::CStoreEditor->new;
+ my $set = $self->ou_ancestor_setting($org_id, $name, $e);
+ return $set->{value} if $set;
+ return undef;
+}
+
+
+# If an authentication token is provided AND this org unit setting has a
+# view_perm, then make sure the user referenced by the auth token has
+# that permission. This means that if you call this method without an
+# authtoken param, you can get whatever org unit setting values you want.
+# API users beware.
+#
+# NOTE: If you supply an editor ($e) arg AND an auth token arg, the editor's
+# authtoken is checked, but the $auth arg is NOT checked. To say that another
+# way, be sure NOT to pass an editor argument if you want your token checked.
+# Otherwise the auth arg is just a flag saying "check the editor".
+
+sub ou_ancestor_setting {
+ my( $self, $orgid, $name, $e, $auth ) = @_;
+ $e = $e || OpenILS::Utils::CStoreEditor->new(
+ (defined $auth) ? (authtoken => $auth) : ()
+ );
+ my $coust = $e->retrieve_config_org_unit_setting_type([
+ $name, {flesh => 1, flesh_fields => {coust => ['view_perm']}}
+ ]);
+
+ if ($auth && $coust && $coust->view_perm) {
+ # And you can't have permission if you don't have a valid session.
+ return undef if not $e->checkauth;
+ # And now that we know you MIGHT have permission, we check it.
+ return undef if not $e->allowed($coust->view_perm->code, $orgid);
+ }
+
+ my $query = {from => ['actor.org_unit_ancestor_setting', $name, $orgid]};
+ my $setting = $e->json_query($query)->[0];
+ return undef unless $setting;
+ return {org => $setting->{org_unit}, value => OpenSRF::Utils::JSON->JSON2perl($setting->{value})};
+}
+
+
+# returns the ISO8601 string representation of the requested epoch in GMT
+sub epoch2ISO8601 {
+ my( $self, $epoch ) = @_;
+ my ($sec,$min,$hour,$mday,$mon,$year) = gmtime($epoch);
+ $year += 1900; $mon += 1;
+ my $date = sprintf(
+ '%s-%0.2d-%0.2dT%0.2d:%0.2d:%0.2d-00',
+ $year, $mon, $mday, $hour, $min, $sec);
+ return $date;
+}
+
+sub find_highest_perm_org {
+ my ( $self, $perm, $userid, $start_org, $org_tree ) = @_;
+ my $org = $self->find_org($org_tree, $start_org );
+
+ my $lastid = -1;
+ while( $org ) {
+ last if ($self->check_perms( $userid, $org->id, $perm )); # perm failed
+ $lastid = $org->id;
+ $org = $self->find_org( $org_tree, $org->parent_ou() );
+ }
+
+ return $lastid;
+}
+
+
+# returns the org_unit ID's
+sub user_has_work_perm_at {
+ my($self, $e, $perm, $options, $user_id) = @_;
+ $options ||= {};
+ $user_id = (defined $user_id) ? $user_id : $e->requestor->id;
+
+ my $func = 'permission.usr_has_perm_at';
+ $func = $func.'_all' if $$options{descendants};
+
+ my $orgs = $e->json_query({from => [$func, $user_id, $perm]});
+ $orgs = [map { $_->{ (keys %$_)[0] } } @$orgs];
+
+ return $orgs unless $$options{objects};
+
+ return $e->search_actor_org_unit({id => $orgs});
+}
+
+sub get_user_work_ou_ids {
+ my($self, $e, $userid) = @_;
+ my $work_orgs = $e->json_query({
+ select => {puwoum => ['work_ou']},
+ from => 'puwoum',
+ where => {usr => $e->requestor->id}});
+
+ return [] unless @$work_orgs;
+ my @work_orgs;
+ push(@work_orgs, $_->{work_ou}) for @$work_orgs;
+
+ return \@work_orgs;
+}
+
+
+my $org_types;
+sub get_org_types {
+ my($self, $client) = @_;
+ return $org_types if $org_types;
+ return $org_types = OpenILS::Utils::CStoreEditor->new->retrieve_all_actor_org_unit_type();
+}
+
+my %ORG_TREE;
+sub get_org_tree {
+ my $self = shift;
+ my $locale = shift || '';
+ my $cache = OpenSRF::Utils::Cache->new("global", 0);
+ my $tree = $ORG_TREE{$locale} || $cache->get_cache("orgtree.$locale");
+ return $tree if $tree;
+
+ my $ses = OpenILS::Utils::CStoreEditor->new;
+ $ses->session->session_locale($locale);
+ $tree = $ses->search_actor_org_unit(
+ [
+ {"parent_ou" => undef },
+ {
+ flesh => -1,
+ flesh_fields => { aou => ['children'] },
+ order_by => { aou => 'name'}
+ }
+ ]
+ )->[0];
+
+ $ORG_TREE{$locale} = $tree;
+ $cache->put_cache("orgtree.$locale", $tree);
+ return $tree;
+}
+
+sub get_org_descendants {
+ my($self, $org_id, $depth) = @_;
+
+ my $select = {
+ transform => 'actor.org_unit_descendants',
+ column => 'id',
+ result_field => 'id',
+ };
+ $select->{params} = [$depth] if defined $depth;
+
+ my $org_list = OpenILS::Utils::CStoreEditor->new->json_query({
+ select => {aou => [$select]},
+ from => 'aou',
+ where => {id => $org_id}
+ });
+ my @orgs;
+ push(@orgs, $_->{id}) for @$org_list;
+ return \@orgs;
+}
+
+sub get_org_ancestors {
+ my($self, $org_id, $use_cache) = @_;
+
+ my ($cache, $orgs);
+
+ if ($use_cache) {
+ $cache = OpenSRF::Utils::Cache->new("global", 0);
+ $orgs = $cache->get_cache("org.ancestors.$org_id");
+ return $orgs if $orgs;
+ }
+
+ my $org_list = OpenILS::Utils::CStoreEditor->new->json_query({
+ select => {
+ aou => [{
+ transform => 'actor.org_unit_ancestors',
+ column => 'id',
+ result_field => 'id',
+ params => []
+ }],
+ },
+ from => 'aou',
+ where => {id => $org_id}
+ });
+
+ $orgs = [ map { $_->{id} } @$org_list ];
+
+ $cache->put_cache("org.ancestors.$org_id", $orgs) if $use_cache;
+ return $orgs;
+}
+
+sub get_org_full_path {
+ my($self, $org_id, $depth) = @_;
+
+ my $query = {
+ select => {
+ aou => [{
+ transform => 'actor.org_unit_full_path',
+ column => 'id',
+ result_field => 'id',
+ }],
+ },
+ from => 'aou',
+ where => {id => $org_id}
+ };
+
+ $query->{select}->{aou}->[0]->{params} = [$depth] if defined $depth;
+ my $org_list = OpenILS::Utils::CStoreEditor->new->json_query($query);
+ return [ map {$_->{id}} @$org_list ];
+}
+
+# returns the ID of the org unit ancestor at the specified depth
+sub org_unit_ancestor_at_depth {
+ my($class, $org_id, $depth) = @_;
+ my $resp = OpenILS::Utils::CStoreEditor->new->json_query(
+ {from => ['actor.org_unit_ancestor_at_depth', $org_id, $depth]})->[0];
+ return ($resp) ? $resp->{id} : undef;
+}
+
+# returns the user's configured locale as a string. Defaults to en-US if none is configured.
+sub get_user_locale {
+ my($self, $user_id, $e) = @_;
+ $e ||= OpenILS::Utils::CStoreEditor->new;
+
+ # first, see if the user has an explicit locale set
+ my $setting = $e->search_actor_user_setting(
+ {usr => $user_id, name => 'global.locale'})->[0];
+ return OpenSRF::Utils::JSON->JSON2perl($setting->value) if $setting;
+
+ my $user = $e->retrieve_actor_user($user_id) or return $e->event;
+ return $self->get_org_locale($user->home_ou, $e);
+}
+
+# returns org locale setting
+sub get_org_locale {
+ my($self, $org_id, $e) = @_;
+ $e ||= OpenILS::Utils::CStoreEditor->new;
+
+ my $locale;
+ if(defined $org_id) {
+ $locale = $self->ou_ancestor_setting_value($org_id, 'global.default_locale', $e);
+ return $locale if $locale;
+ }
+
+ # system-wide default
+ my $sclient = OpenSRF::Utils::SettingsClient->new;
+ $locale = $sclient->config_value('default_locale');
+ return $locale if $locale;
+
+ # if nothing else, fallback to locale=cowboy
+ return 'en-US';
+}
+
+
+# xml-escape non-ascii characters
+sub entityize {
+ my($self, $string, $form) = @_;
+ $form ||= "";
+
+ # If we're going to convert non-ASCII characters to XML entities,
+ # we had better be dealing with a UTF8 string to begin with
+ $string = decode_utf8($string);
+
+ if ($form eq 'D') {
+ $string = NFD($string);
+ } else {
+ $string = NFC($string);
+ }
+
+ # Convert raw ampersands to entities
+ $string =~ s/&(?!\S+;)/&/gso;
+
+ # Convert Unicode characters to entities
+ $string =~ s/([\x{0080}-\x{fffd}])/sprintf('&#x%X;',ord($1))/sgoe;
+
+ return $string;
+}
+
+# x0000-x0008 isn't legal in XML documents
+# XXX Perhaps this should just go into our standard entityize method
+sub strip_ctrl_chars {
+ my ($self, $string) = @_;
+
+ $string =~ s/([\x{0000}-\x{0008}])//sgoe;
+ return $string;
+}
+
+sub get_copy_price {
+ my($self, $e, $copy, $volume) = @_;
+
+ $copy->price(0) if $copy->price and $copy->price < 0;
+
+ return $copy->price if $copy->price and $copy->price > 0;
+
+
+ my $owner;
+ if(ref $volume) {
+ if($volume->id == OILS_PRECAT_CALL_NUMBER) {
+ $owner = $copy->circ_lib;
+ } else {
+ $owner = $volume->owning_lib;
+ }
+ } else {
+ if($copy->call_number == OILS_PRECAT_CALL_NUMBER) {
+ $owner = $copy->circ_lib;
+ } else {
+ $owner = $e->retrieve_asset_call_number($copy->call_number)->owning_lib;
+ }
+ }
+
+ my $default_price = $self->ou_ancestor_setting_value(
+ $owner, OILS_SETTING_DEF_ITEM_PRICE, $e) || 0;
+
+ return $default_price unless defined $copy->price;
+
+ # price is 0. Use the default?
+ my $charge_on_0 = $self->ou_ancestor_setting_value(
+ $owner, OILS_SETTING_CHARGE_LOST_ON_ZERO, $e) || 0;
+
+ return $default_price if $charge_on_0;
+ return 0;
+}
+
+# given a transaction ID, this returns the context org_unit for the transaction
+sub xact_org {
+ my($self, $xact_id, $e) = @_;
+ $e ||= OpenILS::Utils::CStoreEditor->new;
+
+ my $loc = $e->json_query({
+ "select" => {circ => ["circ_lib"]},
+ from => "circ",
+ "where" => {id => $xact_id},
+ });
+
+ return $loc->[0]->{circ_lib} if @$loc;
+
+ $loc = $e->json_query({
+ "select" => {bresv => ["request_lib"]},
+ from => "bresv",
+ "where" => {id => $xact_id},
+ });
+
+ return $loc->[0]->{request_lib} if @$loc;
+
+ $loc = $e->json_query({
+ "select" => {mg => ["billing_location"]},
+ from => "mg",
+ "where" => {id => $xact_id},
+ });
+
+ return $loc->[0]->{billing_location};
+}
+
+
+sub find_event_def_by_hook {
+ my($self, $hook, $context_org, $e) = @_;
+
+ $e ||= OpenILS::Utils::CStoreEditor->new;
+
+ my $orgs = $self->get_org_ancestors($context_org);
+
+ # search from the context org up
+ for my $org_id (reverse @$orgs) {
+
+ my $def = $e->search_action_trigger_event_definition(
+ {hook => $hook, owner => $org_id})->[0];
+
+ return $def if $def;
+ }
+
+ return undef;
+}
+
+
+
+# If an event_def ID is not provided, use the hook and context org to find the
+# most appropriate event. create the event, fire it, then return the resulting
+# event with fleshed template_output and error_output
+sub fire_object_event {
+ my($self, $event_def, $hook, $object, $context_org, $granularity, $user_data, $client) = @_;
+
+ my $e = OpenILS::Utils::CStoreEditor->new;
+ my $def;
+
+ my $auto_method = "open-ils.trigger.event.autocreate.by_definition";
+
+ if($event_def) {
+ $def = $e->retrieve_action_trigger_event_definition($event_def)
+ or return $e->event;
+
+ $auto_method .= '.include_inactive';
+
+ } else {
+
+ # find the most appropriate event def depending on context org
+ $def = $self->find_event_def_by_hook($hook, $context_org, $e)
+ or return $e->event;
+ }
+
+ my $final_resp;
+
+ if($def->group_field) {
+ # we have a list of objects
+ $object = [$object] unless ref $object eq 'ARRAY';
+
+ my @event_ids;
+ $user_data ||= [];
+ for my $i (0..$#$object) {
+ my $obj = $$object[$i];
+ my $udata = $$user_data[$i];
+ my $event_id = $self->simplereq(
+ 'open-ils.trigger', $auto_method, $def->id, $obj, $context_org, $udata);
+ push(@event_ids, $event_id);
+ }
+
+ $logger->info("EVENTS = " . OpenSRF::Utils::JSON->perl2JSON(\@event_ids));
+
+ my $resp;
+ if (not defined $client) {
+ $resp = $self->simplereq(
+ 'open-ils.trigger',
+ 'open-ils.trigger.event_group.fire',
+ \@event_ids);
+ } else {
+ $resp = $self->patientreq(
+ $client,
+ "open-ils.trigger", "open-ils.trigger.event_group.fire",
+ \@event_ids
+ );
+ }
+
+ if($resp and $resp->{events} and @{$resp->{events}}) {
+
+ $e->xact_begin;
+ $final_resp = $e->retrieve_action_trigger_event([
+ $resp->{events}->[0]->id,
+ {flesh => 1, flesh_fields => {atev => ['template_output', 'error_output']}}
+ ]);
+ $e->rollback;
+ }
+
+ } else {
+
+ $object = $$object[0] if ref $object eq 'ARRAY';
+
+ my $event_id;
+ my $resp;
+
+ if (not defined $client) {
+ $event_id = $self->simplereq(
+ 'open-ils.trigger',
+ $auto_method, $def->id, $object, $context_org, $user_data
+ );
+
+ $resp = $self->simplereq(
+ 'open-ils.trigger',
+ 'open-ils.trigger.event.fire',
+ $event_id
+ );
+ } else {
+ $event_id = $self->patientreq(
+ $client,
+ 'open-ils.trigger',
+ $auto_method, $def->id, $object, $context_org, $user_data
+ );
+
+ $resp = $self->patientreq(
+ $client,
+ 'open-ils.trigger',
+ 'open-ils.trigger.event.fire',
+ $event_id
+ );
+ }
+
+ if($resp and $resp->{event}) {
+ $e->xact_begin;
+ $final_resp = $e->retrieve_action_trigger_event([
+ $resp->{event}->id,
+ {flesh => 1, flesh_fields => {atev => ['template_output', 'error_output']}}
+ ]);
+ $e->rollback;
+ }
+ }
+
+ return $final_resp;
+}
+
+
+sub create_events_for_hook {
+ my($self, $hook, $obj, $org_id, $granularity, $user_data, $wait) = @_;
+ my $ses = OpenSRF::AppSession->create('open-ils.trigger');
+ my $req = $ses->request('open-ils.trigger.event.autocreate',
+ $hook, $obj, $org_id, $granularity, $user_data);
+ return undef unless $wait;
+ my $resp = $req->recv;
+ return $resp->content if $resp;
+}
+
+sub create_uuid_string {
+ return create_UUID_as_string();
+}
+
+sub create_circ_chain_summary {
+ my($class, $e, $circ_id) = @_;
+ my $sum = $e->json_query({from => ['action.summarize_circ_chain', $circ_id]})->[0];
+ return undef unless $sum;
+ my $obj = Fieldmapper::action::circ_chain_summary->new;
+ $obj->$_($sum->{$_}) for keys %$sum;
+ return $obj;
+}
+
+
+# Returns "mra" attribute key/value pairs for a set of bre's
+# Takes a list of bre IDs, returns a hash of hashes,
+# {bre_id1 => {key1 => {code => value1, label => label1}, ...}...}
+my $ccvm_cache;
+sub get_bre_attrs {
+ my ($class, $bre_ids, $e) = @_;
+ $e = $e || OpenILS::Utils::CStoreEditor->new;
+
+ my $attrs = {};
+ return $attrs unless defined $bre_ids;
+ $bre_ids = [$bre_ids] unless ref $bre_ids;
+
+ my $mra = $e->json_query({
+ select => {
+ mra => [
+ {
+ column => 'id',
+ alias => 'bre'
+ }, {
+ column => 'attrs',
+ transform => 'each',
+ result_field => 'key',
+ alias => 'key'
+ },{
+ column => 'attrs',
+ transform => 'each',
+ result_field => 'value',
+ alias => 'value'
+ }
+ ]
+ },
+ from => 'mra',
+ where => {id => $bre_ids}
+ });
+
+ return $attrs unless $mra;
+
+ $ccvm_cache = $ccvm_cache || $e->search_config_coded_value_map({id => {'!=' => undef}});
+
+ for my $id (@$bre_ids) {
+ $attrs->{$id} = {};
+ for my $mra (grep { $_->{bre} eq $id } @$mra) {
+ my $ctype = $mra->{key};
+ my $code = $mra->{value};
+ $attrs->{$id}->{$ctype} = {code => $code};
+ if($code) {
+ my ($ccvm) = grep { $_->ctype eq $ctype and $_->code eq $code } @$ccvm_cache;
+ $attrs->{$id}->{$ctype}->{label} = $ccvm->value if $ccvm;
+ }
+ }
+ }
+
+ return $attrs;
+}
+
+# Shorter version of bib_container_items_via_search() below, only using
+# the queryparser record_list filter instead of the container filter.
+sub bib_record_list_via_search {
+ my ($class, $search_query, $search_args) = @_;
+
+ # First, Use search API to get container items sorted in any way that crad
+ # sorters support.
+ my $search_result = $class->simplereq(
+ "open-ils.search", "open-ils.search.biblio.multiclass.query",
+ $search_args, $search_query
+ );
+
+ unless ($search_result) {
+ # empty result sets won't cause this, but actual errors should.
+ $logger->warn("bib_record_list_via_search() got nothing from search");
+ return;
+ }
+
+ # Throw away other junk from search, keeping only bib IDs.
+ return [ map { pop @$_ } @{$search_result->{ids}} ];
+}
+
+# 'no_flesh' avoids fleshing the target_biblio_record_entry
+sub bib_container_items_via_search {
+ my ($class, $container_id, $search_query, $search_args, $no_flesh) = @_;
+
+ # First, Use search API to get container items sorted in any way that crad
+ # sorters support.
+ my $search_result = $class->simplereq(
+ "open-ils.search", "open-ils.search.biblio.multiclass.query",
+ $search_args, $search_query
+ );
+ unless ($search_result) {
+ # empty result sets won't cause this, but actual errors should.
+ $logger->warn("bib_container_items_via_search() got nothing from search");
+ return;
+ }
+
+ # Throw away other junk from search, keeping only bib IDs.
+ my $id_list = [ map { pop @$_ } @{$search_result->{ids}} ];
+
+ return [] unless @$id_list;
+
+ # Now get the bib container items themselves...
+ my $e = new OpenILS::Utils::CStoreEditor;
+ unless ($e) {
+ $logger->warn("bib_container_items_via_search() couldn't get cstoreeditor");
+ return;
+ }
+
+ my @flesh_fields = qw/notes/;
+ push(@flesh_fields, 'target_biblio_record_entry') unless $no_flesh;
+
+ my $items = $e->search_container_biblio_record_entry_bucket_item([
+ {
+ "target_biblio_record_entry" => $id_list,
+ "bucket" => $container_id
+ }, {
+ flesh => 1,
+ flesh_fields => {"cbrebi" => \@flesh_fields}
+ }
+ ]);
+ unless ($items) {
+ $logger->warn(
+ "bib_container_items_via_search() couldn't get bucket items: " .
+ $e->die_event->{textcode}
+ );
+ return;
+ }
+
+ # ... and put them in the same order that the search API said they
+ # should be in.
+ my %ordering_hash = map {
+ ($no_flesh) ? $_->target_biblio_record_entry : $_->target_biblio_record_entry->id,
+ $_
+ } @$items;
+
+ return [map { $ordering_hash{$_} } @$id_list];
+}
+
+# returns undef on success, Event on error
+sub log_user_activity {
+ my ($class, $user_id, $who, $what, $e, $async) = @_;
+
+ my $commit = 0;
+ if (!$e) {
+ $e = OpenILS::Utils::CStoreEditor->new(xact => 1);
+ $commit = 1;
+ }
+
+ my $res = $e->json_query({
+ from => [
+ 'actor.insert_usr_activity',
+ $user_id, $who, $what, OpenSRF::AppSession->ingress
+ ]
+ });
+
+ if ($res) { # call returned OK
+
+ $e->commit if $commit and @$res;
+ $e->rollback if $commit and !@$res;
+
+ } else {
+ return $e->die_event;
+ }
+
+ return undef;
+}
+
+# I hate to put this here exactly, but this code needs to be shared between
+# the TPAC's mod_perl module and open-ils.serial.
+#
+# There is a reason every part of the query *except* those parts dealing
+# with scope are moved here from the code's origin in TPAC. The serials
+# use case does *not* want the same scoping logic.
+#
+# Also, note that for the serials uses case, we may filter in OPAC visible
+# status and copy/call_number deletedness, but we don't filter on any
+# particular values for serial.item.status or serial.item.date_received.
+# Since we're only using this *after* winnowing down the set of issuances
+# that copies should be related to, I'm not sure we need any such serial.item
+# filters.
+
+sub basic_opac_copy_query {
+ ######################################################################
+ # Pass a defined value for either $rec_id OR ($iss_id AND $dist_id), #
+ # not both. #
+ ######################################################################
+ my ($self,$rec_id,$iss_id,$dist_id,$copy_limit,$copy_offset,$staff) = @_;
+
+ return {
+ select => {
+ acp => ['id', 'barcode', 'circ_lib', 'create_date',
+ 'age_protect', 'holdable'],
+ acpl => [
+ {column => 'name', alias => 'copy_location'},
+ {column => 'holdable', alias => 'location_holdable'}
+ ],
+ ccs => [
+ {column => 'name', alias => 'copy_status'},
+ {column => 'holdable', alias => 'status_holdable'}
+ ],
+ acn => [
+ {column => 'label', alias => 'call_number_label'},
+ {column => 'id', alias => 'call_number'}
+ ],
+ circ => ['due_date'],
+ acnp => [
+ {column => 'label', alias => 'call_number_prefix_label'},
+ {column => 'id', alias => 'call_number_prefix'}
+ ],
+ acns => [
+ {column => 'label', alias => 'call_number_suffix_label'},
+ {column => 'id', alias => 'call_number_suffix'}
+ ],
+ bmp => [
+ {column => 'label', alias => 'part_label'},
+ ],
+ ($iss_id ? (sitem => ["issuance"]) : ())
+ },
+
+ from => {
+ acp => {
+ ($iss_id ? (
+ sitem => {
+ fkey => 'id',
+ field => 'unit',
+ filter => {issuance => $iss_id},
+ join => {
+ sstr => { }
+ }
+ }
+ ) : ()),
+ acn => {
+ join => {
+ acnp => { fkey => 'prefix' },
+ acns => { fkey => 'suffix' }
+ },
+ filter => [
+ {deleted => 'f'},
+ ($rec_id ? {record => $rec_id} : ())
+ ],
+ },
+ circ => { # If the copy is circulating, retrieve the open circ
+ type => 'left',
+ filter => {checkin_time => undef}
+ },
+ acpl => {
+ ($staff ? () : (filter => { opac_visible => 't' }))
+ },
+ ccs => {
+ ($staff ? () : (filter => { opac_visible => 't' }))
+ },
+ aou => {},
+ acpm => {
+ type => 'left',
+ join => {
+ bmp => { type => 'left' }
+ }
+ }
+ }
+ },
+
+ where => {
+ '+acp' => {
+ deleted => 'f',
+ ($staff ? () : (opac_visible => 't'))
+ },
+ ($dist_id ? ( '+sstr' => { distribution => $dist_id } ) : ()),
+ ($staff ? () : ( '+aou' => { opac_visible => 't' } ))
+ },
+
+ order_by => [
+ {class => 'aou', field => 'name'},
+ {class => 'acn', field => 'label'}
+ ],
+
+ limit => $copy_limit,
+ offset => $copy_offset
+ };
+}
+
+# Compare two dates, date1 and date2. If date2 is not defined, then
+# DateTime->now will be used. Assumes dates are in ISO8601 format as
+# supported by DateTime::Format::ISO8601. (A future enhancement might
+# be to support other formats.)
+#
+# Returns -1 if $date1 < $date2
+# Returns 0 if $date1 == $date2
+# Returns 1 if $date1 > $date2
+sub datecmp {
+ my $self = shift;
+ my $date1 = shift;
+ my $date2 = shift;
+
+ # Check for timezone offsets and limit them to 2 digits:
+ if ($date1 && $date1 =~ /(?:-|\+)\d\d\d\d$/) {
+ $date1 = substr($date1, 0, length($date1) - 2);
+ }
+ if ($date2 && $date2 =~ /(?:-|\+)\d\d\d\d$/) {
+ $date2 = substr($date2, 0, length($date2) - 2);
+ }
+
+ # check date1:
+ unless (UNIVERSAL::isa($date1, "DateTime")) {
+ $date1 = DateTime::Format::ISO8601->parse_datetime($date1);
+ }
+
+ # Check for date2:
+ unless ($date2) {
+ $date2 = DateTime->now;
+ } else {
+ unless (UNIVERSAL::isa($date2, "DateTime")) {
+ $date2 = DateTime::Format::ISO8601->parse_datetime($date2);
+ }
+ }
+
+ return DateTime->compare($date1, $date2);
+}
+
+
+# marcdoc is an XML::LibXML document
+# updates the doc and returns the entityized MARC string
+sub strip_marc_fields {
+ my ($class, $e, $marcdoc, $grps) = @_;
+
+ my $orgs = $class->get_org_ancestors($e->requestor->ws_ou);
+
+ my $query = {
+ select => {vibtf => ['field']},
+ from => {vibtf => 'vibtg'},
+ where => {'+vibtg' => {owner => $orgs}},
+ distinct => 1
+ };
+
+ # give me always-apply groups plus any selected groups
+ if ($grps and @$grps) {
+ $query->{where}->{'+vibtg'}->{'-or'} = [
+ {id => $grps},
+ {always_apply => 't'}
+ ];
+
+ } else {
+ $query->{where}->{'+vibtg'}->{always_apply} = 't';
+ }
+
+ my $fields = $e->json_query($query);
+
+ for my $field (@$fields) {
+ my $tag = $field->{field};
+ for my $node ($marcdoc->findnodes('//*[@tag="'.$tag.'"]')) {
+ $node->parentNode->removeChild($node);
+ }
+ }
+
+ return $class->entityize($marcdoc->documentElement->toString);
+}
+
+
+1;
+
--- /dev/null
+use strict; use warnings;
+package ShareStuff::CStoreEditor;
+use ShareStuff::AppUtils;
+use OpenSRF::Application;
+use OpenSRF::AppSession;
+use OpenSRF::EX qw(:try);
+use Fieldmapper;
+use ShareStuff::Event;
+use Data::Dumper;
+use OpenSRF::Utils::JSON;
+use OpenSRF::Utils::Logger qw($logger);
+my $U = "ShareStuff::AppUtils";
+my %PERMS;
+my $cache;
+my %xact_ed_cache;
+
+# if set, we will use this locale for all new sessions
+# if unset, we rely on the existing opensrf locale propagation
+our $default_locale;
+
+our $always_xact = 0;
+our $_loaded = 1;
+
+#my %PERMS = (
+# 'biblio.record_entry' => { update => 'UPDATE_MARC' },
+# 'asset.copy' => { update => 'UPDATE_COPY'},
+# 'asset.call_number' => { update => 'UPDATE_VOLUME'},
+# 'action.circulation' => { retrieve => 'VIEW_CIRCULATIONS'},
+#);
+
+sub flush_forced_xacts {
+ for my $k ( keys %xact_ed_cache ) {
+ try {
+ $xact_ed_cache{$k}->rollback;
+ } catch Error with {
+ # rollback failed
+ };
+ delete $xact_ed_cache{$k};
+ }
+}
+
+# -----------------------------------------------------------------------------
+# Export some useful functions
+# -----------------------------------------------------------------------------
+use vars qw(@EXPORT_OK %EXPORT_TAGS);
+use Exporter;
+use base qw/Exporter/;
+push @EXPORT_OK, ( 'new_editor', 'new_rstore_editor' );
+%EXPORT_TAGS = ( funcs => [ qw/ new_editor new_rstore_editor / ] );
+
+sub new_editor { return ShareStuff::CStoreEditor->new(@_); }
+
+sub new_rstore_editor {
+ my $e = ShareStuff::CStoreEditor->new(@_);
+ $e->app('open-ils.reporter-store');
+ return $e;
+}
+
+
+# -----------------------------------------------------------------------------
+# Log levels
+# -----------------------------------------------------------------------------
+use constant E => 'error';
+use constant W => 'warn';
+use constant I => 'info';
+use constant D => 'debug';
+use constant A => 'activity';
+
+
+
+# -----------------------------------------------------------------------------
+# Params include:
+# xact=><true> : creates a storage transaction
+# authtoken=>$token : the login session key
+# -----------------------------------------------------------------------------
+sub new {
+ my( $class, %params ) = @_;
+ $class = ref($class) || $class;
+ my $self = bless( \%params, $class );
+ $self->{checked_perms} = {};
+ return $self;
+}
+
+sub DESTROY {
+ my $self = shift;
+ $self->reset;
+ return undef;
+}
+
+sub app {
+ my( $self, $app ) = @_;
+ $self->{app} = $app if $app;
+ $self->{app} = 'open-ils.cstore' unless $self->{app};
+ return $self->{app};
+}
+
+
+# -----------------------------------------------------------------------------
+# Log the editor metadata along with the log string
+# -----------------------------------------------------------------------------
+sub log {
+ my( $self, $lev, $str ) = @_;
+ my $s = "editor[";
+ if ($always_xact) {
+ $s .= "!|";
+ } elsif ($self->{xact}) {
+ $s .= "1|";
+ } else {
+ $s .= "0|";
+ }
+ $s .= "0" unless $self->requestor;
+ $s .= $self->requestor->id if $self->requestor;
+ $s .= "]";
+ $logger->$lev("$s $str");
+}
+
+# -----------------------------------------------------------------------------
+# Verifies the auth token and fetches the requestor object
+# -----------------------------------------------------------------------------
+sub checkauth {
+ my $self = shift;
+ $self->log(D, "checking auth token ".$self->authtoken);
+
+ my $content = $U->simplereq(
+ 'open-ils.auth',
+ 'open-ils.auth.session.retrieve', $self->authtoken, 1);
+
+ if(!$content or $U->event_code($content)) {
+ $self->event( ($content) ? $content : ShareStuff::Event->new('NO_SESSION'));
+ return undef;
+ }
+
+ $self->{authtime} = $content->{authtime};
+ return $self->{requestor} = $content->{userobj};
+}
+
+=head1 test
+
+sub checkauth {
+ my $self = shift;
+ $cache = OpenSRF::Utils::Cache->new('global') unless $cache;
+ $self->log(D, "checking cached auth token ".$self->authtoken);
+ my $user = $cache->get_cache("oils_auth_".$self->authtoken);
+ return $self->{requestor} = $user->{userobj} if $user;
+ $self->event(ShareStuff::Event->new('NO_SESSION'));
+ return undef;
+}
+
+=cut
+
+
+# -----------------------------------------------------------------------------
+# Returns the last generated event
+# -----------------------------------------------------------------------------
+sub event {
+ my( $self, $evt ) = @_;
+ $self->{event} = $evt if $evt;
+ return $self->{event};
+}
+
+# -----------------------------------------------------------------------------
+# Destroys the transaction and disconnects where necessary,
+# then returns the last event that occurred
+# -----------------------------------------------------------------------------
+sub die_event {
+ my $self = shift;
+ my $evt = shift;
+ $self->rollback;
+ $self->died(1);
+ $self->event($evt);
+ return $self->event;
+}
+
+
+# -----------------------------------------------------------------------------
+# Clears the last caught event
+# -----------------------------------------------------------------------------
+sub clear_event {
+ my $self = shift;
+ $self->{event} = undef;
+}
+
+sub died {
+ my($self, $died) = @_;
+ $self->{died} = $died if defined $died;
+ return $self->{died};
+}
+
+sub authtoken {
+ my( $self, $auth ) = @_;
+ $self->{authtoken} = $auth if $auth;
+ return $self->{authtoken};
+}
+
+sub authtime {
+ my( $self, $auth ) = @_;
+ $self->{authtime} = $auth if $auth;
+ return $self->{authtime};
+}
+
+sub timeout {
+ my($self, $to) = @_;
+ $self->{timeout} = $to if defined $to;
+ return defined($self->{timeout}) ? $self->{timeout} : 60;
+}
+
+# -----------------------------------------------------------------------------
+# fetches the session, creating if necessary. If 'xact' is true on this
+# object, a db session is created
+# -----------------------------------------------------------------------------
+sub session {
+ my( $self, $session ) = @_;
+ $self->{session} = $session if $session;
+
+ # sessions can stick around longer than a single request/transaction.
+ # kill it if our default locale was altered since the last request
+ # and it does not match the locale of the existing session.
+ delete $self->{session} if
+ $default_locale and
+ $self->{session} and
+ $self->{session}->session_locale ne $default_locale;
+
+ if(!$self->{session}) {
+ $self->{session} = OpenSRF::AppSession->create($self->app);
+ $self->{session}->session_locale($default_locale) if $default_locale;
+
+ if( ! $self->{session} ) {
+ my $str = "Error creating cstore session with OpenSRF::AppSession->create()!";
+ $self->log(E, $str);
+ throw OpenSRF::EX::ERROR ($str);
+ }
+
+ $self->{session}->connect if $self->{xact} or $self->{connect} or $always_xact;
+ $self->xact_begin if $self->{xact} or $always_xact;
+ }
+
+ $xact_ed_cache{$self->{xact_id}} = $self if $always_xact and $self->{xact_id};
+ return $self->{session};
+}
+
+
+# -----------------------------------------------------------------------------
+# Starts a storage transaction
+# -----------------------------------------------------------------------------
+sub xact_begin {
+ my $self = shift;
+ return $self->{xact_id} if $self->{xact_id};
+ $self->session->connect unless $self->session->state == OpenSRF::AppSession::CONNECTED();
+ $self->log(D, "starting new database transaction");
+ unless($self->{xact_id}) {
+ my $stat = $self->request($self->app . '.transaction.begin');
+ $self->log(E, "error starting database transaction") unless $stat;
+ $self->{xact_id} = $stat;
+ if($self->authtoken) {
+ if(!$self->requestor) {
+ $self->checkauth;
+ }
+ my $user_id = undef;
+ my $ws_id = undef;
+ if($self->requestor) {
+ $user_id = $self->requestor->id;
+ $ws_id = $self->requestor->wsid;
+ }
+ $self->request($self->app . '.set_audit_info', $self->authtoken, $user_id, $ws_id);
+ }
+ }
+ $self->{xact} = 1;
+ return $self->{xact_id};
+}
+
+# -----------------------------------------------------------------------------
+# Commits a storage transaction
+# -----------------------------------------------------------------------------
+sub xact_commit {
+ my $self = shift;
+ return unless $self->{xact_id};
+ $self->log(D, "comitting db session");
+ my $stat = $self->request($self->app.'.transaction.commit');
+ $self->log(E, "error comitting database transaction") unless $stat;
+ delete $self->{xact_id};
+ delete $self->{xact};
+ return $stat;
+}
+
+# -----------------------------------------------------------------------------
+# Rolls back a storage stransaction
+# -----------------------------------------------------------------------------
+sub xact_rollback {
+ my $self = shift;
+ return unless $self->{session} and $self->{xact_id};
+ $self->log(I, "rolling back db session");
+ my $stat = $self->request($self->app.".transaction.rollback");
+ $self->log(E, "error rolling back database transaction") unless $stat;
+ delete $self->{xact_id};
+ delete $self->{xact};
+ return $stat;
+}
+
+
+# -----------------------------------------------------------------------------
+# Savepoint functions. If no savepoint name is provided, the same name is used
+# for each successive savepoint, in which case only the last savepoint set can
+# be released or rolled back.
+# -----------------------------------------------------------------------------
+sub set_savepoint {
+ my $self = shift;
+ my $name = shift || 'savepoint';
+ return unless $self->{session} and $self->{xact_id};
+ $self->log(I, "setting savepoint '$name'");
+ my $stat = $self->request($self->app.".savepoint.set", $name)
+ or $self->log(E, "error setting savepoint '$name'");
+ return $stat;
+}
+
+sub release_savepoint {
+ my $self = shift;
+ my $name = shift || 'savepoint';
+ return unless $self->{session} and $self->{xact_id};
+ $self->log(I, "releasing savepoint '$name'");
+ my $stat = $self->request($self->app.".savepoint.release", $name)
+ or $self->log(E, "error releasing savepoint '$name'");
+ return $stat;
+}
+
+sub rollback_savepoint {
+ my $self = shift;
+ my $name = shift || 'savepoint';
+ return unless $self->{session} and $self->{xact_id};
+ $self->log(I, "rollback savepoint '$name'");
+ my $stat = $self->request($self->app.".savepoint.rollback", $name)
+ or $self->log(E, "error rolling back savepoint '$name'");
+ return $stat;
+}
+
+
+# -----------------------------------------------------------------------------
+# Rolls back the transaction and disconnects
+# -----------------------------------------------------------------------------
+sub rollback {
+ my $self = shift;
+ my $err;
+ my $ret;
+ try {
+ $self->xact_rollback;
+ } catch Error with {
+ $err = shift
+ } finally {
+ $ret = $self->disconnect
+ };
+ throw $err if ($err);
+ return $ret;
+}
+
+sub disconnect {
+ my $self = shift;
+ $self->session->disconnect if
+ $self->{session} and
+ $self->{session}->state == OpenSRF::AppSession::CONNECTED();
+ delete $self->{session};
+}
+
+
+# -----------------------------------------------------------------------------
+# commits the db session and destroys the session
+# returns the status of the commit call
+# -----------------------------------------------------------------------------
+sub commit {
+ my $self = shift;
+ return unless $self->{xact_id};
+ my $stat = $self->xact_commit;
+ $self->disconnect;
+ return $stat;
+}
+
+# -----------------------------------------------------------------------------
+# clears all object data. Does not commit the db transaction.
+# -----------------------------------------------------------------------------
+sub reset {
+ my $self = shift;
+ $self->disconnect;
+ $$self{$_} = undef for (keys %$self);
+}
+
+
+# -----------------------------------------------------------------------------
+# commits and resets
+# -----------------------------------------------------------------------------
+sub finish {
+ my $self = shift;
+ my $err;
+ my $ret;
+ try {
+ $self->commit;
+ } catch Error with {
+ $err = shift
+ } finally {
+ $ret = $self->reset
+ };
+ throw $err if ($err);
+ return $ret;
+}
+
+
+
+# -----------------------------------------------------------------------------
+# Does a simple storage request
+# -----------------------------------------------------------------------------
+sub request {
+ my( $self, $method, @params ) = @_;
+
+ my $val;
+ my $err;
+ my $argstr = __arg_to_string( (scalar(@params)) == 1 ? $params[0] : \@params);
+ my $locale = $self->session->session_locale;
+
+ $self->log(I, "request $locale $method $argstr");
+
+ if( ($self->{xact} or $always_xact) and
+ $self->session->state != OpenSRF::AppSession::CONNECTED() ) {
+ #$logger->error("CStoreEditor lost it's connection!!");
+ throw OpenSRF::EX::ERROR ("CStore connection timed out - transaction cannot continue");
+ }
+
+
+ try {
+
+ my $req = $self->session->request($method, @params);
+
+ if($self->substream) {
+ $self->log(D,"running in substream mode");
+ $val = [];
+ while( my $resp = $req->recv(timeout => $self->timeout) ) {
+ push(@$val, $resp->content) if $resp->content and not $self->discard;
+ }
+
+ } else {
+ my $resp = $req->recv(timeout => $self->timeout);
+ if($req->failed) {
+ $err = $resp;
+ $self->log(E, "request error $method : $argstr : $err");
+ } else {
+ $val = $resp->content if $resp;
+ }
+ }
+
+ $req->finish;
+
+ } catch Error with {
+ $err = shift;
+ $self->log(E, "request error $method : $argstr : $err");
+ };
+
+ throw $err if $err;
+ return $val;
+}
+
+sub substream {
+ my( $self, $bool ) = @_;
+ $self->{substream} = $bool if defined $bool;
+ return $self->{substream};
+}
+
+# -----------------------------------------------------------------------------
+# discard response data instead of returning it to the caller. currently only
+# works in conjunction with substream mode.
+# -----------------------------------------------------------------------------
+sub discard {
+ my( $self, $bool ) = @_;
+ $self->{discard} = $bool if defined $bool;
+ return $self->{discard};
+}
+
+
+# -----------------------------------------------------------------------------
+# Sets / Returns the requestor object. This is set when checkauth succeeds.
+# -----------------------------------------------------------------------------
+sub requestor {
+ my($self, $requestor) = @_;
+ $self->{requestor} = $requestor if $requestor;
+ return $self->{requestor};
+}
+
+
+
+# -----------------------------------------------------------------------------
+# Holds the last data received from a storage call
+# -----------------------------------------------------------------------------
+sub data {
+ my( $self, $data ) = @_;
+ $self->{data} = $data if defined $data;
+ return $self->{data};
+}
+
+
+# -----------------------------------------------------------------------------
+# True if this perm has already been checked at this org
+# -----------------------------------------------------------------------------
+sub perm_checked {
+ my( $self, $perm, $org ) = @_;
+ $self->{checked_perms}->{$org} = {}
+ unless $self->{checked_perms}->{$org};
+ my $checked = $self->{checked_perms}->{$org}->{$perm};
+ if(!$checked) {
+ $self->{checked_perms}->{$org}->{$perm} = 1;
+ return 0;
+ }
+ return 1;
+}
+
+
+
+# -----------------------------------------------------------------------------
+# Returns true if the requested perm is allowed. If the perm check fails,
+# $e->event is set and undef is returned
+# The perm user is $e->requestor->id and perm org defaults to the requestor's
+# ws_ou
+# if perm is an array of perms, method will return true at the first allowed
+# permission. If none of the perms are allowed, the perm_failure event
+# is created with the last perm to fail
+# -----------------------------------------------------------------------------
+my $PERM_QUERY = {
+ select => {
+ au => [ {
+ transform => 'permission.usr_has_perm',
+ alias => 'has_perm',
+ column => 'id',
+ params => []
+ } ]
+ },
+ from => 'au',
+ where => {},
+};
+
+my $OBJECT_PERM_QUERY = {
+ select => {
+ au => [ {
+ transform => 'permission.usr_has_object_perm',
+ alias => 'has_perm',
+ column => 'id',
+ params => []
+ } ]
+ },
+ from => 'au',
+ where => {},
+};
+
+sub allowed {
+ my( $self, $perm, $org, $object, $hint ) = @_;
+ my $uid = $self->requestor->id;
+ $org ||= $self->requestor->ws_ou;
+
+ my $perms = (ref($perm) eq 'ARRAY') ? $perm : [$perm];
+
+ for $perm (@$perms) {
+ $self->log(I, "checking perms user=$uid, org=$org, perm=$perm");
+
+ if($object) {
+ my $params;
+ if(ref $object) {
+ # determine the ID field and json_hint from the object
+ my $id_field = $object->Identity;
+ $params = [$perm, $object->json_hint, $object->$id_field];
+ } else {
+ # we were passed an object-id and json_hint
+ $params = [$perm, $hint, $object];
+ }
+ push(@$params, $org) if $org;
+ $OBJECT_PERM_QUERY->{select}->{au}->[0]->{params} = $params;
+ $OBJECT_PERM_QUERY->{where}->{id} = $uid;
+ return 1 if $U->is_true($self->json_query($OBJECT_PERM_QUERY)->[0]->{has_perm});
+
+ } else {
+ $PERM_QUERY->{select}->{au}->[0]->{params} = [$perm, $org];
+ $PERM_QUERY->{where}->{id} = $uid;
+ return 1 if $U->is_true($self->json_query($PERM_QUERY)->[0]->{has_perm});
+ }
+ }
+
+ # set the perm failure event if the permission check returned false
+ my $e = ShareStuff::Event->new('PERM_FAILURE', ilsperm => $perm, ilspermloc => $org);
+ $self->event($e);
+ return undef;
+}
+
+
+# -----------------------------------------------------------------------------
+# Returns the list of object IDs this user has object-specific permissions for
+# -----------------------------------------------------------------------------
+sub objects_allowed {
+ my($self, $perm, $obj_type) = @_;
+
+ my $perms = (ref($perm) eq 'ARRAY') ? $perm : [$perm];
+ my @ids;
+
+ for $perm (@$perms) {
+ my $query = {
+ select => {puopm => ['object_id']},
+ from => {
+ puopm => {
+ ppl => {field => 'id',fkey => 'perm'}
+ }
+ },
+ where => {
+ '+puopm' => {usr => $self->requestor->id, object_type => $obj_type},
+ '+ppl' => {code => $perm}
+ }
+ };
+
+ my $list = $self->json_query($query);
+ push(@ids, 0+$_->{object_id}) for @$list;
+ }
+
+ my %trim;
+ $trim{$_} = 1 for @ids;
+ return [ keys %trim ];
+}
+
+
+# -----------------------------------------------------------------------------
+# checks the appropriate perm for the operation
+# -----------------------------------------------------------------------------
+sub _checkperm {
+ my( $self, $ptype, $action, $org ) = @_;
+ $org ||= $self->requestor->ws_ou;
+ my $perm = $PERMS{$ptype}{$action};
+ if( $perm ) {
+ return undef if $self->perm_checked($perm, $org);
+ return $self->event unless $self->allowed($perm, $org);
+ } else {
+ $self->log(I, "no perm provided for $ptype.$action");
+ }
+ return undef;
+}
+
+
+
+# -----------------------------------------------------------------------------
+# Logs update actions to the activity log
+# -----------------------------------------------------------------------------
+sub log_activity {
+ my( $self, $method, $type, $action, $arg ) = @_;
+ my $str = "$type.$action";
+
+ if ($arg) {
+
+ my $redact;
+
+ if ($OpenSRF::Application::shared_conf and
+ $OpenSRF::Application::shared_conf->shared and
+ $redact = $OpenSRF::Application::shared_conf->shared->log_protect and
+ ref($redact) eq 'ARRAY' and
+ grep { $method =~ /^$_/ } @{$redact}) {
+
+ # when API calls are marked as log-protect, avoid
+ # dumping the param object to the activity log.
+ $str .= " **DETAILS REDACTED**";
+ } else {
+
+ $str .= _prop_string($arg);
+ }
+ }
+
+
+ $self->log(A, $str);
+}
+
+
+
+sub _prop_string {
+ my $obj = shift;
+ my @props = $obj->properties;
+ my $str = "";
+ for(@props) {
+ my $prop = $obj->$_() || "";
+ $prop = substr($prop, 0, 128) . "..." if length $prop > 131;
+ $str .= " $_=$prop";
+ }
+ return $str;
+}
+
+
+sub __arg_to_string {
+ my $arg = shift;
+ return "" unless defined $arg;
+ if( UNIVERSAL::isa($arg, "Fieldmapper") ) {
+ my $idf = $arg->Identity;
+ return (defined $arg->$idf) ? $arg->$idf : '<new object>';
+ }
+ return OpenSRF::Utils::JSON->perl2JSON($arg);
+ return "";
+}
+
+
+# -----------------------------------------------------------------------------
+# This does the actual storage query.
+#
+# 'search' calls become search_where calls and $arg can be a search hash or
+# an array-ref of storage search options.
+#
+# 'retrieve' expects an id
+# 'update' expects an object
+# 'create' expects an object
+# 'delete' expects an object
+#
+# All methods return true on success and undef on failure. On failure,
+# $e->event is set to the generated event.
+# Note: this method assumes that updating a non-changed object and
+# thereby receiving a 0 from storage, is a successful update.
+#
+# The method will therefore return true so the caller can just do
+# $e->update_blah($x) or return $e->event;
+# The true value returned from storage for all methods will be stored in
+# $e->data, until the next method is called.
+#
+# not-found events are generated on retrieve and serach methods.
+# action=search methods will return [] (==true) if no data is found. If the
+# caller is interested in the not found event, they can do:
+# return $e->event unless @$results;
+# -----------------------------------------------------------------------------
+sub runmethod {
+ my( $self, $action, $type, $arg, $options ) = @_;
+
+ $options ||= {};
+
+ if( $action eq 'retrieve' ) {
+ if(! defined($arg) ) {
+ $self->log(W,"$action $type called with no ID...");
+ $self->event(_mk_not_found($type, $arg));
+ return undef;
+ } elsif( ref($arg) =~ /Fieldmapper/ ) {
+ $self->log(D,"$action $type called with an object.. attempting Identity retrieval..");
+ my $idf = $arg->Identity;
+ $arg = $arg->$idf;
+ }
+ }
+
+ my @arg = ( ref($arg) eq 'ARRAY' ) ? @$arg : ($arg);
+ my $method = $self->app.".direct.$type.$action";
+
+ if( $action eq 'search' ) {
+ $method .= '.atomic';
+
+ } elsif( $action eq 'batch_retrieve' ) {
+ $action = 'search';
+ $method =~ s/batch_retrieve/search/o;
+ $method .= '.atomic';
+ my $tt = $type;
+ $tt =~ s/\./::/og;
+ my $fmobj = "Fieldmapper::$tt";
+ my $ident_field = $fmobj->Identity;
+
+ if (ref $arg[0] eq 'ARRAY') {
+ # $arg looks like: ([1, 2, 3], {search_args})
+ @arg = ( { $ident_field => $arg[0] }, @arg[1 .. $#arg] );
+ } else {
+ # $arg looks like: [1, 2, 3]
+ @arg = ( { $ident_field => $arg } );
+ }
+
+ } elsif( $action eq 'retrieve_all' ) {
+ $action = 'search';
+ $method =~ s/retrieve_all/search/o;
+ my $tt = $type;
+ $tt =~ s/\./::/og;
+ my $fmobj = "Fieldmapper::$tt";
+ @arg = ( { $fmobj->Identity => { '!=' => undef } } );
+ $method .= '.atomic';
+ }
+
+ $method =~ s/search/id_list/o if $options->{idlist};
+
+ $method =~ s/\.atomic$//o if $self->substream($$options{substream} || 0);
+ $self->timeout($$options{timeout});
+ $self->discard($$options{discard});
+
+ # remove any stale events
+ $self->clear_event;
+
+ if( $action eq 'update' or $action eq 'delete' or $action eq 'create' ) {
+ if(!($self->{xact} or $always_xact)) {
+ $logger->error("Attempt to update DB while not in a transaction : $method");
+ throw OpenSRF::EX::ERROR ("Attempt to update DB while not in a transaction : $method");
+ }
+ $self->log_activity($method, $type, $action, $arg);
+ }
+
+ if($$options{checkperm}) {
+ my $a = ($action eq 'search') ? 'retrieve' : $action;
+ my $e = $self->_checkperm($type, $a, $$options{permorg});
+ if($e) {
+ $self->event($e);
+ return undef;
+ }
+ }
+
+ my $obj;
+ my $err = '';
+
+ try {
+ $obj = $self->request($method, @arg);
+ } catch Error with { $err = shift; };
+
+
+ if(!defined $obj) {
+ $self->log(I, "request returned no data : $method");
+
+ if( $action eq 'retrieve' ) {
+ $self->event(_mk_not_found($type, $arg));
+
+ } elsif( $action eq 'update' or
+ $action eq 'delete' or $action eq 'create' ) {
+ my $evt = ShareStuff::Event->new(
+ 'DATABASE_UPDATE_FAILED', payload => $arg, debug => "$err" );
+ $self->event($evt);
+ }
+
+ if( $err ) {
+ $self->event(
+ ShareStuff::Event->new( 'DATABASE_QUERY_FAILED',
+ payload => $arg, debug => "$err" ));
+ return undef;
+ }
+
+ return undef;
+ }
+
+ if( $action eq 'create' and $obj == 0 ) {
+ my $evt = ShareStuff::Event->new(
+ 'DATABASE_UPDATE_FAILED', payload => $arg, debug => "$err" );
+ $self->event($evt);
+ return undef;
+ }
+
+ # If we havn't dealt with the error in a nice way, go ahead and throw it
+ if( $err ) {
+ $self->event(
+ ShareStuff::Event->new( 'DATABASE_QUERY_FAILED',
+ payload => $arg, debug => "$err" ));
+ return undef;
+ }
+
+ if( $action eq 'search' ) {
+ $self->log(I, "$type.$action : returned ".scalar(@$obj). " result(s)");
+ $self->event(_mk_not_found($type, $arg)) unless @$obj;
+ }
+
+ if( $action eq 'create' ) {
+ my $idf = $obj->Identity;
+ $self->log(I, "created a new $type object with Identity " . $obj->$idf);
+ $arg->$idf($obj->$idf);
+ }
+
+ $self->data($obj); # cache the data for convenience
+
+ return ($obj) ? $obj : 1;
+}
+
+
+sub _mk_not_found {
+ my( $type, $arg ) = @_;
+ (my $t = $type) =~ s/\./_/og;
+ $t = uc($t);
+ return ShareStuff::Event->new("${t}_NOT_FOUND", payload => $arg);
+}
+
+
+
+# utility method for loading
+sub __fm2meth {
+ my $str = shift;
+ my $sep = shift;
+ $str =~ s/Fieldmapper:://o;
+ $str =~ s/::/$sep/g;
+ return $str;
+}
+
+
+# -------------------------------------------------------------
+# Load up the methods from the FM classes
+# -------------------------------------------------------------
+
+sub init {
+ no warnings; # Here we potentially redefine subs via eval
+ my $map = $Fieldmapper::fieldmap;
+ for my $object (keys %$map) {
+ my $obj = __fm2meth($object, '_');
+ my $type = __fm2meth($object, '.');
+ foreach my $command (qw/ update retrieve search create delete batch_retrieve retrieve_all /) {
+ eval "sub ${command}_$obj {return shift()->runmethod('$command', '$type', \@_);}\n";
+ }
+ # TODO: performance test against concatenating a big string of all the subs and eval'ing only ONCE.
+ }
+}
+
+init(); # Add very many subs to this namespace
+
+sub json_query {
+ my( $self, $arg, $options ) = @_;
+ $options ||= {};
+ my @arg = ( ref($arg) eq 'ARRAY' ) ? @$arg : ($arg);
+ my $method = $self->app.'.json_query.atomic';
+ $method =~ s/\.atomic$//o if $self->substream($$options{substream} || 0);
+
+ $self->timeout($$options{timeout});
+ $self->discard($$options{discard});
+ $self->clear_event;
+ my $obj;
+ my $err;
+
+ try {
+ $obj = $self->request($method, @arg);
+ } catch Error with { $err = shift; };
+
+ if( $err ) {
+ $self->event(
+ ShareStuff::Event->new( 'DATABASE_QUERY_FAILED',
+ payload => $arg, debug => "$err" ));
+ return undef;
+ }
+
+ $self->log(I, "json_query : returned ".scalar(@$obj). " result(s)") if (ref($obj));
+ return $obj;
+}
+
+
+
+1;
+
+
--- /dev/null
+package ShareStuff::Const;
+use strict; use warnings;
+use vars qw(@EXPORT_OK %EXPORT_TAGS);
+use Exporter;
+use base qw/Exporter/;
+
+
+# ---------------------------------------------------------------------
+# Shoves defined constants into the export array
+# so they don't have to be listed twice in the code
+# ---------------------------------------------------------------------
+sub econst {
+ my($name, $value) = @_;
+ my $caller = caller;
+ no strict;
+ *{$name} = sub () { $value };
+ push @{$caller.'::EXPORT_OK'}, $name;
+}
+
+# ---------------------------------------------------------------------
+# CONSTANTS
+# ---------------------------------------------------------------------
+
+
+
+# ---------------------------------------------------------------------
+# Copy Statuses
+# ---------------------------------------------------------------------
+econst OILS_COPY_STATUS_AVAILABLE => 0;
+econst OILS_COPY_STATUS_CHECKED_OUT => 1;
+econst OILS_COPY_STATUS_BINDERY => 2;
+econst OILS_COPY_STATUS_LOST => 3;
+econst OILS_COPY_STATUS_MISSING => 4;
+econst OILS_COPY_STATUS_IN_PROCESS => 5;
+econst OILS_COPY_STATUS_IN_TRANSIT => 6;
+econst OILS_COPY_STATUS_RESHELVING => 7;
+econst OILS_COPY_STATUS_ON_HOLDS_SHELF=> 8;
+econst OILS_COPY_STATUS_ON_ORDER => 9;
+econst OILS_COPY_STATUS_ILL => 10;
+econst OILS_COPY_STATUS_CATALOGING => 11;
+econst OILS_COPY_STATUS_RESERVES => 12;
+econst OILS_COPY_STATUS_DISCARD => 13;
+econst OILS_COPY_STATUS_DAMAGED => 14;
+econst OILS_COPY_STATUS_ON_RESV_SHELF => 15;
+
+
+# ---------------------------------------------------------------------
+# Circ defaults for pre-cataloged copies
+# ---------------------------------------------------------------------
+econst OILS_PRECAT_COPY_FINE_LEVEL => 2;
+econst OILS_PRECAT_COPY_LOAN_DURATION => 2;
+econst OILS_PRECAT_CALL_NUMBER => -1;
+econst OILS_PRECAT_RECORD => -1;
+
+
+# ---------------------------------------------------------------------
+# Circ constants
+# ---------------------------------------------------------------------
+econst OILS_CIRC_DURATION_SHORT => 1;
+econst OILS_CIRC_DURATION_NORMAL => 2;
+econst OILS_CIRC_DURATION_EXTENDED => 3;
+econst OILS_REC_FINE_LEVEL_LOW => 1;
+econst OILS_REC_FINE_LEVEL_NORMAL => 2;
+econst OILS_REC_FINE_LEVEL_HIGH => 3;
+econst OILS_STOP_FINES_CHECKIN => 'CHECKIN';
+econst OILS_STOP_FINES_RENEW => 'RENEW';
+econst OILS_STOP_FINES_LOST => 'LOST';
+econst OILS_STOP_FINES_CLAIMSRETURNED => 'CLAIMSRETURNED';
+econst OILS_STOP_FINES_LONGOVERDUE => 'LONGOVERDUE';
+econst OILS_STOP_FINES_MAX_FINES => 'MAXFINES';
+econst OILS_STOP_FINES_CLAIMS_NEVERCHECKEDOUT => 'CLAIMSNEVERCHECKEDOUT';
+econst OILS_UNLIMITED_CIRC_DURATION => 'unlimited';
+
+# ---------------------------------------------------------------------
+# Settings
+# ---------------------------------------------------------------------
+econst OILS_SETTING_LOST_PROCESSING_FEE => 'circ.lost_materials_processing_fee';
+econst OILS_SETTING_DEF_ITEM_PRICE => 'cat.default_item_price';
+econst OILS_SETTING_ORG_BOUNCED_EMAIL => 'org.bounced_emails';
+econst OILS_SETTING_CHARGE_LOST_ON_ZERO => 'circ.charge_lost_on_zero';
+econst OILS_SETTING_VOID_OVERDUE_ON_LOST => 'circ.void_overdue_on_lost';
+econst OILS_SETTING_HOLD_SOFT_STALL => 'circ.hold_stalling.soft';
+econst OILS_SETTING_HOLD_HARD_STALL => 'circ.hold_stalling.hard';
+econst OILS_SETTING_HOLD_SOFT_BOUNDARY => 'circ.hold_boundary.soft';
+econst OILS_SETTING_HOLD_HARD_BOUNDARY => 'circ.hold_boundary.hard';
+econst OILS_SETTING_HOLD_EXPIRE => 'circ.hold_expire_interval';
+econst OILS_SETTING_HOLD_ESIMATE_WAIT_INTERVAL => 'circ.holds.default_estimated_wait_interval';
+econst OILS_SETTING_VOID_LOST_ON_CHECKIN => 'circ.void_lost_on_checkin';
+econst OILS_SETTING_MAX_ACCEPT_RETURN_OF_LOST => 'circ.max_accept_return_of_lost';
+econst OILS_SETTING_VOID_LOST_PROCESS_FEE_ON_CHECKIN => 'circ.void_lost_proc_fee_on_checkin';
+econst OILS_SETTING_RESTORE_OVERDUE_ON_LOST_RETURN => 'circ.restore_overdue_on_lost_return';
+econst OILS_SETTING_LOST_IMMEDIATELY_AVAILABLE => 'circ.lost_immediately_available';
+econst OILS_SETTING_BLOCK_HOLD_FOR_EXPIRED_PATRON => 'circ.holds.expired_patron_block';
+econst OILS_SETTING_GENERATE_OVERDUE_ON_LOST_RETURN => 'circ.lost.generate_overdue_on_checkin';
+
+
+
+
+econst OILS_HOLD_TYPE_COPY => 'C';
+econst OILS_HOLD_TYPE_FORCE => 'F';
+econst OILS_HOLD_TYPE_RECALL => 'R';
+econst OILS_HOLD_TYPE_ISSUANCE => 'I';
+econst OILS_HOLD_TYPE_VOLUME => 'V';
+econst OILS_HOLD_TYPE_TITLE => 'T';
+econst OILS_HOLD_TYPE_METARECORD => 'M';
+econst OILS_HOLD_TYPE_MONOPART => 'P';
+
+
+econst OILS_BILLING_TYPE_OVERDUE_MATERIALS => 'Overdue materials';
+econst OILS_BILLING_TYPE_COLLECTION_FEE => 'Long Overdue Collection Fee';
+econst OILS_BILLING_TYPE_DEPOSIT => 'System: Deposit';
+econst OILS_BILLING_TYPE_RENTAL => 'System: Rental';
+econst OILS_BILLING_NOTE_SYSTEM => 'SYSTEM GENERATED';
+
+econst OILS_ACQ_DEBIT_TYPE_PURCHASE => 'purchase';
+econst OILS_ACQ_DEBIT_TYPE_TRANSFER => 'xfer';
+
+# all penalties with ID < 100 are managed automatically
+econst OILS_PENALTY_AUTO_ID => 100;
+econst OILS_PENALTY_PATRON_EXCEEDS_FINES => 1;
+econst OILS_PENALTY_PATRON_EXCEEDS_OVERDUE_COUNT => 2;
+econst OILS_PENALTY_INVALID_PATRON_ADDRESS => 29;
+
+
+econst OILS_BILLING_TYPE_NOTIFICATION_FEE => 9;
+
+
+
+# ---------------------------------------------------------------------
+# finally, export all the constants
+# ---------------------------------------------------------------------
+%EXPORT_TAGS = ( const => [ @EXPORT_OK ] );
+
--- /dev/null
+package ShareStuff::Event;
+# vim:noet:ts=4
+use strict; use warnings;
+use XML::LibXML;
+use OpenSRF::Utils::SettingsClient;
+use OpenSRF::Utils::Logger;
+my $logger = "OpenSRF::Utils::Logger";
+
+
+# Returns a new Event data hash (not a blessed object)
+# The first param is the event name
+# Following the first param is an optional hash of params:
+# perm => the name of the permission error for permimssion errors
+# permloc => the location of the permission error for permission errors
+# payload => the payload to be returned on successfull events
+
+
+my $events = undef;
+my $descs = undef;
+
+sub new {
+ my( $class, $event, %params ) = @_;
+ _load_events() unless $events;
+
+ throw OpenSRF::EX ("Bad event name: $event") unless $event;
+ my $e = $events->{$event};
+ $e = '' unless defined $e;
+
+ my( $m, $f, $l ) = caller(0);
+ my( $mm, $ff, $ll ) = caller(1);
+ my( $mmm, $fff, $lll ) = caller(2);
+
+ $f ||= "";
+ $l ||= "";
+ $ff ||= "";
+ $ll ||= "";
+ $fff ||= "";
+ $lll ||= "";
+
+ my $lang = 'en-US'; # assume english for now
+
+ my $t = CORE::localtime();
+
+ return {
+ ilsevent => $e,
+ textcode => $event,
+ stacktrace => "$f:$l $ff:$ll $fff:$lll",
+ desc => $descs->{$lang}->{$e || ''} || '',
+ servertime => $t,
+ pid => $$, %params
+ };
+}
+
+sub _load_events {
+ my $settings_client = OpenSRF::Utils::SettingsClient->new();
+ my $eventsxml = $settings_client->config_value( "ils_events" );
+
+ if(!$eventsxml) {
+ throw OpenSRF::EX ("No ils_events file found in settings config");
+ }
+
+ $logger->info("Loading events xml file $eventsxml");
+
+ my $doc = XML::LibXML->new->parse_file($eventsxml);
+
+ my @nodes = $doc->documentElement->findnodes('//event');
+ for my $node (@nodes) {
+ $events->{$node->getAttribute('textcode')} =
+ $node->getAttribute('code');
+ }
+
+ $descs = {};
+ my @desc = $doc->documentElement->findnodes('//desc');
+ for my $d (@desc) {
+ my $lang = $d->getAttributeNS('http://www.w3.org/XML/1998/namespace', 'lang');
+ my $code = $d->parentNode->getAttribute('code');
+ unless ($descs && $lang && exists $descs->{$lang}) {
+ $descs->{$lang} = {};
+ if (!$descs) {
+ $logger->error("No error description nodes found in $eventsxml.");
+ }
+ if (!$lang) {
+ $logger->error("No xml:lang attribute found for node in $eventsxml.");
+ }
+ }
+ $descs->{$lang}->{$code} = $d->textContent;
+ }
+}
+
+
+1;
use CGI;
use OpenSRF::EX qw(:try);
use OpenSRF::System;
-use OpenILS::Utils::CStoreEditor;
+use ShareStuff::CStoreEditor qw/:funcs/;
# set the bootstrap config and template include directory when
$env{authtoken} = $cgi->cookie('ses') || $cgi->param('ses');
$env{user} = verify_login($env{authtoken});
- $env{cstore} = new OpenILS::Utils::CStoreEditor;
+ $env{cstore} = new_editor( authtoken => $env{authtoken} );
$env{file} = $env{r}->path_info;
projects / transitory.git / commitdiff