2 use strict; use warnings;
4 use OpenSRF::Utils::JSON;
6 use OpenSRF::Utils::Logger qw/$logger/;
7 use OpenILS::Application::AppUtils;
9 use OpenSRF::EX qw/:try/;
11 use OpenILS::Utils::Fieldmapper;
12 use Digest::MD5 qw/md5_hex/;
13 use OpenSRF::Utils qw/:daemon/;
14 use OpenILS::Utils::OfflineStore;
15 use OpenSRF::Utils::SettingsClient;
22 my $U = "OpenILS::Application::AppUtils";
23 my $DB = "OpenILS::Utils::OfflineStore";
24 my $SES = "${DB}::Session";
25 my $SCRIPT = "OpenILS::Utils::OfflineStore::Script";
28 # --------------------------------------------------------------------
30 # --------------------------------------------------------------------
32 do '##CONFIG##/offline-config.pl';
36 my $basedir = $config{base_dir} || die "Offline config error: no base_dir defined\n";
37 my $bootstrap = $config{bootstrap} || die "Offline config error: no bootstrap defined\n";
38 my $wsname = $cgi->param('ws');
39 my $org = $cgi->param('org');
40 my $authtoken = $cgi->param('ses') || "";
41 my $seskey = $cgi->param('seskey');
42 my $action = $cgi->param('action'); # - create, load, execute, status
54 # --------------------------------------------------------------------
56 # This function should behave as a child_init might behave in case
57 # this is moved to mod_perl
58 # --------------------------------------------------------------------
60 $DB->DBFile($config{dsn}, $config{usr}, $config{pw});
65 OpenSRF::System->bootstrap_client(config_file => $bootstrap );
66 Fieldmapper->import(IDL =>
67 OpenSRF::Utils::SettingsClient->new->config_value("IDL"));
72 sub _ol_debug_params {
74 my @params = $cgi->param;
75 @params = sort { $a cmp $b } @params;
76 $s .= "$_=" . $cgi->param($_) . "\n" for @params;
78 warn '-'x60 ."\n$s\n";
82 # --------------------------------------------------------------------
83 # Finds the requestor and other info specific to this request
84 # --------------------------------------------------------------------
87 # fetch the requestor object
88 ($requestor, $evt) = $U->checkses($authtoken);
89 ol_handle_result($evt) if $evt;
91 # try the param, the workstation, and finally the user's ws org
93 $wsobj = ol_fetch_workstation($wsname);
94 $org = $wsobj->owning_lib if $wsobj;
95 $org = $requestor->ws_ou unless $org;
96 ol_handle_result(OpenILS::Event->new('OFFLINE_NO_ORG')) unless $org;
99 $user_groups = $U->simplereq(
100 'open-ils.actor', 'open-ils.actor.groups.retrieve');
104 # --------------------------------------------------------------------
105 # Runs the requested action
106 # --------------------------------------------------------------------
111 if( $action eq 'create' ) {
113 $evt = $U->check_perms($requestor->id, $org, 'OFFLINE_UPLOAD');
114 ol_handle_result($evt) if $evt;
115 $payload = ol_create_session();
117 } elsif( $action eq 'load' ) {
119 $evt = $U->check_perms($requestor->id, $org, 'OFFLINE_UPLOAD');
120 ol_handle_result($evt) if $evt;
121 $payload = ol_load();
123 } elsif( $action eq 'execute' ) {
125 $evt = $U->check_perms($requestor->id, $org, 'OFFLINE_EXECUTE');
126 ol_handle_result($evt) if $evt;
127 $payload = ol_execute();
129 } elsif( $action eq 'status' ) {
131 $evt = $U->check_perms($requestor->id, $org, 'OFFLINE_VIEW');
132 ol_handle_result($evt) if $evt;
133 $payload = ol_status();
136 ol_handle_event('SUCCESS', payload => $payload );
140 # --------------------------------------------------------------------
141 # Creates a new session
142 # --------------------------------------------------------------------
143 sub ol_create_session {
145 my $desc = $cgi->param('desc') || "";
146 $seskey = time . "_${$}_" . int(rand() * 1000);
148 $logger->debug("offline: user ".$requestor->id.
149 " creating new session with key $seskey and description $desc");
155 description => $desc,
156 creator => $requestor->id,
157 create_time => CORE::time(),
166 # --------------------------------------------------------------------
167 # Holds the meta-info for a script file
168 # --------------------------------------------------------------------
169 sub ol_create_script {
172 my $session = ol_find_session($seskey);
173 my $delta = $cgi->param('delta') || 0;
175 my $script = $session->add_to_scripts(
177 requestor => $requestor->id,
178 create_time => CORE::time,
179 workstation => $wsname,
180 logfile => "$basedir/pending/$org/$seskey/$wsname.log",
181 time_delta => $delta,
187 # --------------------------------------------------------------------
188 # Finds the current session in the db
189 # --------------------------------------------------------------------
190 sub ol_find_session {
191 my $ses = $SES->retrieve($seskey);
192 ol_handle_event('OFFLINE_INVALID_SESSION', payload => $seskey) unless $ses;
196 # --------------------------------------------------------------------
197 # Finds a script object in the DB based on workstation and seskey
198 # --------------------------------------------------------------------
200 my $ws = shift || $wsname;
201 my $sk = shift || $seskey;
202 my ($script) = $SCRIPT->search( session => $seskey, workstation => $ws );
206 # --------------------------------------------------------------------
207 # Creates a new script in the database and loads the new script file
208 # --------------------------------------------------------------------
211 my $session = ol_find_session;
212 my $handle = $cgi->upload('file');
213 my $outdir = "$basedir/pending/$org/$seskey";
214 my $outfile = "$outdir/$wsname.log";
216 ol_handle_event('OFFLINE_SESSION_FILE_EXISTS') if ol_find_script();
217 ol_handle_event('OFFLINE_SESSION_ACTIVE') if $session->in_process;
218 ol_handle_event('OFFLINE_SESSION_COMPLETE') if $session->end_time;
220 qx/mkdir -p $outdir/;
222 open(FILE, ">>$outfile") or ol_handle_event('OFFLINE_FILE_ERROR');
223 while( <$handle> ) { print FILE; $x++;}
226 ol_create_script($x);
232 # --------------------------------------------------------------------
233 sub ol_handle_result {
235 my $json = OpenSRF::Utils::JSON->perl2JSON($obj);
237 # Clear this so it's not remembered
240 if( $cgi->param('html')) {
241 my $html = "<html><body onload='xulG.handle_event($json)'></body></html>";
242 print "content-type: text/html\n\n";
247 print "content-type: text/plain\n\n";
254 # --------------------------------------------------------------------
255 sub ol_handle_event {
256 my( $evt, @args ) = @_;
257 ol_handle_result(OpenILS::Event->new($evt, @args));
261 # --------------------------------------------------------------------
262 sub ol_flesh_session {
266 map { $data{$_} = $session->$_ } $session->columns;
269 for my $script ($session->scripts) {
271 map { $sdata{$_} = $script->$_ } $script->columns;
273 # the client doesn't need this info
274 delete $sdata{session};
276 delete $sdata{logfile};
278 push( @{$data{scripts}}, \%sdata );
285 # --------------------------------------------------------------------
286 # Returns various information on the sessions and scripts
287 # --------------------------------------------------------------------
290 my $type = $cgi->param('status_type') || "scripts";
292 # --------------------------------------------------------------------
293 # Returns info on every script upload attached to the current session
294 # --------------------------------------------------------------------
295 if( $type eq 'scripts' ) {
296 my $session = ol_find_session();
297 ol_handle_result(ol_flesh_session($session));
300 # --------------------------------------------------------------------
301 # Returns all scripts and sessions for the given org
302 # --------------------------------------------------------------------
303 } elsif( $type eq 'sessions' ) {
304 my @sessions = $SES->search( org => $org );
306 # can I do this in the DB without raw SQL?
307 @sessions = sort { $a->create_time <=> $b->create_time } @sessions;
309 push( @data, ol_flesh_session($_) ) for @sessions;
310 ol_handle_result(\@data);
313 # --------------------------------------------------------------------
314 # Returns total commands and completed commands counts
315 # --------------------------------------------------------------------
316 } elsif( $type eq 'summary' ) {
317 my $session = ol_find_session();
319 $logger->debug("offline: retrieving summary info ".
320 "for session ".$session->key." with completed=".$session->num_complete);
323 $count += $_->count for ($session->scripts);
325 { total => $count, num_complete => $session->num_complete });
329 # --------------------------------------------------------------------
330 # Returns the list of non-SUCCESS events that have occurred so far for
331 # this set of commands
332 # --------------------------------------------------------------------
333 } elsif( $type eq 'exceptions' ) {
335 my $session = ol_find_session();
336 my $resfile = "$basedir/pending/$org/$seskey/results";
337 if( $session->end_time ) {
338 $resfile = "$basedir/archive/$org/$seskey/results";
340 my $data = ol_file_to_perl($resfile);
341 $data = [ grep { $_->{event}->{ilsevent} ne '0' } @$data ];
342 ol_handle_result($data);
347 sub ol_fetch_workstation {
349 $logger->debug("offline: Fetching workstation $name");
350 my $ws = $U->storagereq(
351 'open-ils.storage.direct.actor.workstation.search.name', $name);
352 ol_handle_result(OpenILS::Event->new('ACTOR_WORKSTATION_NOT_FOUND')) unless $ws;
359 # --------------------------------------------------------------------
360 # Sorts the script commands then forks a child to executes them.
361 # --------------------------------------------------------------------
364 my $session = ol_find_session();
365 ol_handle_event('OFFLINE_SESSION_ACTIVE') if $session->in_process;
366 ol_handle_event('OFFLINE_SESSION_COMPLETE') if $session->end_time;
368 my $commands = ol_collect_commands();
370 # --------------------------------------------------------------------
371 # Note that we must disconnect from opensrf before forking or the
372 # connection will be borked...
373 # --------------------------------------------------------------------
374 OpenSRF::Transport::PeerHandle->retrieve->disconnect;
380 # --------------------------------------------------------------------
381 # Tell the client all is well
382 # --------------------------------------------------------------------
383 ol_handle_event('SUCCESS'); # - this exits
388 # --------------------------------------------------------------------
389 # close stdout/stderr or apache will wait on the child to finish
390 # --------------------------------------------------------------------
394 $logger->debug("offline: child $$ processing data...");
396 # --------------------------------------------------------------------
397 # The child re-connects to the opensrf network and processes
398 # the script requests
399 # --------------------------------------------------------------------
400 OpenSRF::System->bootstrap_client(config_file => $bootstrap);
405 #Class::DBI->autoupdate(1);
409 my $sesion = ol_find_session();
410 $session->in_process(1);
411 ol_process_commands($session, $commands);
412 ol_archive_files($session);
416 $logger->error("offline: child process error $e");
421 sub ol_file_to_perl {
423 open(F, "$fname") or ol_handle_event('OFFLINE_FILE_ERROR');
426 push(@p, OpenSRF::Utils::JSON->JSON2perl($_)) for @d;
431 # collects the commands and sorts them on timestamp+delta
432 sub ol_collect_commands {
433 my $ses = ol_find_session();
436 # cycle through every script loaded to this session
437 for my $script ($ses->scripts) {
438 my $coms = ol_file_to_perl($script->logfile);
440 # cycle through all of the commands for this script
441 for my $com (@$coms) {
442 $$com{_workstation} = $script->workstation;
443 $$com{_realtime} = $script->time_delta + $com->{timestamp};
444 push( @commands, $com );
448 # make sure thera are no blank commands
449 @commands = grep { ($_ and $_->{type}) } @commands;
452 @commands = sort { $a->{_realtime} <=> $b->{_realtime} } @commands;
454 # push user registrations to the front
455 my @regs = grep { $_->{type} eq 'register' } @commands;
456 my @others = grep { $_->{type} ne 'register' } @commands;
458 return [ @regs, @others ];
462 my $time = shift || CORE::time;
463 my (undef,undef, undef, $mday,$mon,$year) = localtime($time);
464 $mon++; $year += 1900;
465 $mday = "0$mday" unless $mday =~ /\d{2}/o;
466 $mon = "0$mon" unless $mon =~ /\d{2}/o;
467 return ($year, $mon, $mday);
471 # --------------------------------------------------------------------
472 # Moves all files from the pending directory to the archive directory
473 # and removes the pending directory
474 # --------------------------------------------------------------------
475 sub ol_archive_files {
477 my ($y, $m, $d) = ol_date();
479 my $dir = "$basedir/pending/$org/$seskey";
480 my $archdir = "$basedir/archive/$org/$seskey";
481 $logger->debug("offline: archiving files to $archdir");
483 # Tell the db the files are moving
484 $_->logfile($archdir.'/'.$_->workstation.'.log') for ($session->scripts);
486 qx/mkdir -p $archdir/;
487 qx/mv $_ $archdir/ for <$dir/*>;
492 # --------------------------------------------------------------------
493 # Appends results to the results file.
494 # --------------------------------------------------------------------
496 sub ol_append_result {
501 $obj = OpenSRF::Utils::JSON->perl2JSON($obj);
504 open($rhandle, ">>$basedir/pending/$org/$seskey/results")
505 or ol_handle_event('OFFLINE_FILE_ERROR');
508 print $rhandle "$obj\n";
509 close($rhandle) if $last;
514 # --------------------------------------------------------------------
515 # Runs the commands and returns the list of errors
516 # --------------------------------------------------------------------
517 sub ol_process_commands {
520 my $commands = shift;
523 $session->start_time(CORE::time);
525 for my $d ( @$commands ) {
528 my $last = ($x++ == scalar(@$commands) - 1) ? 1 : 0;
529 my $res = { command => $d };
535 $logger->debug("offline: top of execute loop : $t");
538 $res->{event} = ol_handle_checkin($d) if $t eq 'checkin';
539 $res->{event} = ol_handle_inhouse($d) if $t eq 'in_house_use';
540 $res->{event} = ol_handle_checkout($d) if $t eq 'checkout';
541 $res->{event} = ol_handle_renew($d) if $t eq 'renew';
542 $res->{event} = ol_handle_register($d) if $t eq 'register';
544 } catch Error with { $err = shift; };
548 if( ref($err) eq 'OpenSRF::EX::JabberDisconnected' ) {
549 $logger->error("offline: we lost jabber .. trying to reconnect");
553 $res->{event} = OpenILS::Event->new('INTERNAL_SERVER_ERROR', debug => "$err");
562 ol_append_result($res, $last);
563 $session->num_complete( $session->num_complete + 1 );
565 $logger->debug("offline: set session [".$session->key."] num_complete to ".$session->num_complete);
568 $session->end_time(CORE::time);
569 $session->in_process(0);
573 # --------------------------------------------------------------------
574 # Runs an in_house_use action
575 # --------------------------------------------------------------------
576 sub ol_handle_inhouse {
579 my $realtime = $command->{_realtime};
580 my $ws = $command->{_workstation};
581 my $barcode = $command->{barcode};
582 my $count = $command->{count} || 1;
583 my $use_time = $command->{use_time} || "";
585 $logger->activity("offline: in_house_use : requestor=". $requestor->id.", realtime=$realtime, ".
586 "workstation=$ws, barcode=$barcode, count=$count, use_time=$use_time");
589 return OpenILS::Event->new(
590 'INTERNAL_SERVER_ERROR', payload => 'TOO MANY IN HOUSE USE');
593 my $ids = $U->simplereq(
595 'open-ils.circ.in_house_use.create', $authtoken,
596 { barcode => $barcode, count => $count, location => $org, use_time => $use_time } );
598 return OpenILS::Event->new('SUCCESS', payload => $ids) if( ref($ids) eq 'ARRAY' );
604 # --------------------------------------------------------------------
605 # Pulls the relevant circ args from the command, fetches data where
607 # --------------------------------------------------------------------
608 sub ol_circ_args_from_command {
611 my $type = $command->{type};
612 my $realtime = $command->{_realtime};
613 my $ws = $command->{_workstation};
614 my $barcode = $command->{barcode} || "";
615 my $cotime = $command->{checkout_time} || "";
616 my $pbc = $command->{patron_barcode};
617 my $due_date = $command->{due_date} || "";
618 my $noncat = ($command->{noncat}) ? "yes" : "no"; # for logging
620 $logger->activity("offline: $type : requestor=". $requestor->id.
621 ", realtime=$realtime, workstation=$ws, checkout_time=$cotime, ".
622 "patron=$pbc, due_date=$due_date, noncat=$noncat");
625 permit_override => 1,
627 checkout_time => $cotime,
628 patron_barcode => $pbc,
629 due_date => $due_date };
631 if( $command->{noncat} ) {
633 $args->{noncat_type} = $command->{noncat_type};
634 $args->{noncat_count} = $command->{noncat_count};
642 # --------------------------------------------------------------------
643 # Performs a checkout action
644 # --------------------------------------------------------------------
645 sub ol_handle_checkout {
647 my $args = ol_circ_args_from_command($command);
649 if( $args->{noncat} and $args->{noncat_count} > 99 ) {
650 return OpenILS::Event->new(
651 'INTERNAL_SERVER_ERROR', payload => 'TOO MANY NON CATS');
654 if( $args->{barcode} ) {
655 my( $c, $e ) = $U->fetch_copy_by_barcode($args->{barcode});
659 return $U->simplereq(
660 'open-ils.circ', 'open-ils.circ.checkout', $authtoken, $args );
664 # --------------------------------------------------------------------
665 # Performs the renewal action
666 # --------------------------------------------------------------------
667 sub ol_handle_renew {
669 my $args = ol_circ_args_from_command($command);
671 return $U->simplereq(
672 'open-ils.circ', 'open-ils.circ.renew', $authtoken, $args );
676 # --------------------------------------------------------------------
677 # Runs a checkin action
678 # --------------------------------------------------------------------
679 sub ol_handle_checkin {
682 my $realtime = $command->{_realtime};
683 my $ws = $command->{_workstation};
684 my $barcode = $command->{barcode};
685 my $backdate = $command->{backdate} || "";
687 $logger->activity("offline: checkin : requestor=". $requestor->id.
688 ", realtime=$realtime, ". "workstation=$ws, barcode=$barcode, backdate=$backdate");
690 return $U->simplereq(
692 'open-ils.circ.checkin', $authtoken,
693 { barcode => $barcode, backdate => $backdate } );
698 # --------------------------------------------------------------------
699 # Registers a new patron
700 # --------------------------------------------------------------------
701 sub ol_handle_register {
704 my $barcode = $command->{user}->{card}->{barcode};
705 delete $command->{user}->{card};
707 $logger->info("offline: creating new user with barcode $barcode");
709 # now, create the user
710 my $actor = Fieldmapper::actor::user->new;
711 my $card = Fieldmapper::actor::card->new;
714 # username defaults to the barcode
715 $actor->usrname( ($actor->usrname) ? $actor->usrname : $barcode );
717 # Set up all of the virtual IDs, isnew, etc.
721 $actor->cards([$card]);
726 $card->barcode($barcode);
732 for my $resp (@{$command->{user}->{survey_responses}}) {
733 my $sr = Fieldmapper::action::survey_response->new;
734 $sr->$_( $resp->{$_} ) for keys %$resp;
738 $logger->debug("offline: created new survey response for survey ".$sr->survey);
740 delete $command->{user}->{survey_responses};
741 $actor->survey_responses(\@sresp) if @sresp;
743 # extract the billing address
744 if( my $addr = $command->{user}->{billing_address} ) {
745 $billing_address = Fieldmapper::actor::user_address->new;
746 $billing_address->$_($addr->{$_}) for keys %$addr;
747 $billing_address->isnew(1);
748 $billing_address->id(-1);
749 $billing_address->usr(-1);
750 delete $command->{user}->{billing_address};
751 $logger->debug("offline: read billing address ".$billing_address->street1);
754 # extract the mailing address
755 if( my $addr = $command->{user}->{mailing_address} ) {
756 $mailing_address = Fieldmapper::actor::user_address->new;
757 $mailing_address->$_($addr->{$_}) for keys %$addr;
758 $mailing_address->isnew(1);
759 $mailing_address->id(-2);
760 $mailing_address->usr(-1);
761 delete $command->{user}->{mailing_address};
762 $logger->debug("offline: read mailing address ".$mailing_address->street1);
765 # make sure we have values for both
766 $billing_address ||= $mailing_address;
767 $mailing_address ||= $billing_address;
769 $actor->billing_address($billing_address->id);
770 $actor->mailing_address($mailing_address->id);
771 $actor->addresses([$mailing_address]);
773 push( @{$actor->addresses}, $billing_address )
774 unless $billing_address->id eq $mailing_address->id;
776 # pull all of the rest of the data from the command blob
777 $actor->$_( $command->{user}->{$_} ) for keys %{$command->{user}};
779 # calculate the expire date for the patron based on the profile group
780 my ($grp) = grep {$_->id == $actor->profile} @$user_groups;
782 my $seconds = OpenSRF::Utils->interval_to_seconds($grp->perm_interval);
783 my $expire_date = DateTime->from_epoch(epoch => DateTime->now->epoch + $seconds);
784 $logger->debug("offline: setting expire date to $expire_date");
785 $actor->expire_date($U->epoch2ISO8601($expire_date));
788 $logger->debug("offline: creating user object...");
789 $actor = $U->simplereq(
791 'open-ils.actor.patron.update', $authtoken, $actor);
793 return $actor if(ref($actor) eq 'HASH'); # an event occurred
795 return OpenILS::Event->new('SUCCESS', payload => $actor);