Open-ILS/src/offline/offline-lib.pl

   1 #!/usr/bin/perl
   2 use strict; use warnings;
   3 use CGI;
   4 use OpenSRF::System;
   5 use OpenSRF::Utils::Logger qw/$logger/;
   6 use OpenILS::Application::AppUtils;
   7 use OpenILS::Event;
   8 use OpenSRF::EX qw/:try/;
   9 use JSON;
  10 use Data::Dumper;
  11 use OpenILS::Utils::Fieldmapper;
  12 use Digest::MD5 qw/md5_hex/;
  13 use OpenSRF::Utils qw/:daemon/;
  14 our $U = "OpenILS::Application::AppUtils";
  15 our %config;
  16
  17
  18 # --------------------------------------------------------------------
  19 # Load the config options
  20 # --------------------------------------------------------------------
  21 my $time_delta;
  22 my $cgi;
  23 my $base_dir;
  24 my $requestor;
  25 my $workstation;
  26 my $org;
  27 my $org_unit;
  28 my $authtoken;
  29 my $seskey;
  30
  31 # --------------------------------------------------------------------
  32 # Define accessors for all of the shared vars
  33 # --------------------------------------------------------------------
  34 sub offline_requestor { return $requestor; }
  35 sub offline_authtoken { return $authtoken; }
  36 sub offline_workstation { return $workstation; }
  37 sub offline_org { return $org; }
  38 sub offline_org_unit { return $org_unit;}
  39 sub offline_meta_file { return &offline_pending_dir . '/meta'; }
  40 sub offline_lock_file { return &offline_pending_dir . '/lock'; }
  41 sub offline_result_file { return &offline_pending_dir . '/results'; }
  42 sub offline_base_dir { return $base_dir; }
  43 sub offline_time_delta { return $time_delta; }
  44 sub offline_config { return %config; }
  45 sub offline_cgi { return $cgi; }
  46 sub offline_seskey { return $seskey; }
  47
  48
  49
  50 # --------------------------------------------------------------------
  51 # Load the config
  52 # --------------------------------------------------------------------
  53 #do '##CONFIG##/upload-server.pl';
  54 do 'offline-config.pl';
  55
  56
  57 # --------------------------------------------------------------------
  58 # Set everything up
  59 # --------------------------------------------------------------------
  60 &initialize();
  61
  62
  63
  64
  65
  66
  67 # --------------------------------------------------------------------
  68 # Loads the necessary CGI params, connects to OpenSRF, and verifies
  69 # the login session
  70 # --------------------------------------------------------------------
  71 sub initialize {
  72
  73         $base_dir       = $config{base_dir};
  74         my $bsconfig    = $config{bootstrap};
  75         my $evt;
  76
  77         # --------------------------------------------------------------------
  78         # Connect to OpenSRF
  79         # --------------------------------------------------------------------
  80         OpenSRF::System->bootstrap_client(config_file => $bsconfig);
  81
  82
  83         # --------------------------------------------------------------------
  84         # Load the required CGI params
  85         # --------------------------------------------------------------------
  86         $cgi = new CGI;
  87
  88         $authtoken      = $cgi->param('ses')
  89                 or handle_event(OpenILS::Event->new('NO_SESSION'));
  90
  91         $org = $cgi->param('org') || "";
  92         if(!$org) {
  93                 if(my $ws = $cgi->param('ws')) {
  94                         $workstation = fetch_workstation($ws);
  95                         $org = $workstation->owning_lib if $workstation;
  96                 }
  97         }
  98
  99         if($org) {
 100                 ($org_unit, $evt) = $U->fetch_org_unit($org);
 101                 handle_event($evt) if $evt;
 102         }
 103
 104         ($requestor, $evt) = $U->checkses($authtoken);
 105         handle_event($evt) if $evt;
 106
 107         $time_delta      = $cgi->param('delta') || "0";
 108
 109         $seskey = $cgi->param('seskey') || time . "_$$";
 110 }
 111
 112
 113 # --------------------------------------------------------------------
 114 # Print out a full HTML page and exits
 115 # --------------------------------------------------------------------
 116 sub print_html {
 117
 118         my %args        = @_;
 119         my $body        = $args{body} || "";
 120         my $res  = $args{result} || "";
 121         my $on  = ($org_unit) ? $org_unit->name : "";
 122
 123         $authtoken      ||= "";
 124         $org                    ||= "";
 125         $seskey         ||= "";
 126
 127         my $html = <<"  HTML";
 128                 <html>
 129                         <head>
 130                                 <script src='/opac/common/js/JSON.js'> </script>
 131                                 <script>
 132                                         function offline_complete(obj) { if(obj) alert(js2JSON(obj)); }
 133                                 </script>
 134                                 <style>
 135                                         a { margin: 6px; }
 136                                         div { margin: 10px; text-align: center; }
 137                                 </style>
 138                         </head>
 139                         <body onload='offline_complete($res);'>
 140                                 <div>
 141                                         <div style='margin: 5px;'><b>$on</b></div>
 142                                         <a href='offline-upload.pl?ses=$authtoken&org=$org&seskey=$seskey'>Upload More Files</a>
 143                                         <a href='offline-status.pl?ses=$authtoken&org=$org&seskey=$seskey'>Status Page</a>
 144                                         <a href='offline-execute.pl?ses=$authtoken&org=$org&seskey=$seskey'>Execute Batch</a>
 145                                 </div>
 146                                 <hr/>
 147                                 <div>$body</div>
 148                         </body>
 149                 </html>
 150         HTML
 151
 152         print "content-type: text/html\n\n";
 153         print $html;
 154
 155         exit(0);
 156 }
 157
 158
 159 # --------------------------------------------------------------------
 160 # Prints the JSON form of the event out to the client
 161 # --------------------------------------------------------------------
 162 sub handle_event { &offline_handle_json(@_); }
 163
 164 sub offline_handle_json {
 165         my $obj = shift;
 166         my $ischild = shift;
 167         return unless $obj;
 168         print_html(result => JSON->perl2JSON($obj)) unless $ischild;
 169         append_result($obj) and exit;
 170 }
 171
 172
 173 # --------------------------------------------------------------------
 174 # Appends a result event to the result file
 175 # --------------------------------------------------------------------
 176 sub append_result {
 177         my $evt = JSON->perl2JSON(shift());
 178         my $fname = &offline_result_file;
 179         open(R, ">>$fname") or die
 180                 "Unable to open result file [$fname] for appending: $@\n";
 181         print R "$evt\n";
 182         close(R);
 183 }
 184
 185
 186 sub handle_error { warn shift() . "\n"; }
 187
 188
 189 # --------------------------------------------------------------------
 190 # Fetches (and creates if necessary) the pending directory
 191 # --------------------------------------------------------------------
 192 sub offline_pending_dir {
 193         my $dir = "$base_dir/pending/$org/$seskey/";
 194
 195         if( ! -e $dir ) {
 196                 qx/mkdir -p $dir/ and handle_error("Unable to create directory $dir");
 197         }
 198
 199         return $dir;
 200 }
 201
 202 # --------------------------------------------------------------------
 203 # Fetches and creates if necessary the archive directory
 204 # --------------------------------------------------------------------
 205 sub create_archive_dir {
 206         #my (undef,$min,$hour,$mday,$mon,$year) = localtime(time);
 207         my (undef,undef, undef, $mday,$mon,$year) = localtime(time);
 208
 209         $mon++;
 210         $year           += 1900;
 211 #       $min            = "0$min"       unless $min             =~ /\d{2}/o;
 212 #       $hour           = "0$hour"      unless $hour    =~ /\d{2}/o;
 213         $mday           = "0$mday"      unless $mday    =~ /\d{2}/o;
 214         $mon            = "0$mon"       unless $mon             =~ /\d{2}/o;
 215
 216         my $dir = "$base_dir/archive/$org/${year}_${mon}_${mday}/$seskey/";
 217         qx/mkdir -p $dir/ and handle_error("Unable to create archive directory $dir");
 218         return $dir;
 219 }
 220
 221
 222
 223 # --------------------------------------------------------------------
 224 # Fetches the workstation object by name
 225 # --------------------------------------------------------------------
 226 sub fetch_workstation {
 227         my $name = shift;
 228         $logger->debug("offline: Fetching workstation $name");
 229         my $ws = $U->storagereq(
 230                 'open-ils.storage.direct.actor.workstation.search.name', $name);
 231         handle_event(OpenILS::Event->new('WORKSTATION_NOT_FOUND')) unless $ws;
 232         return $ws;
 233 }
 234
 235 sub append_meta {
 236         my $data = shift;
 237         $data = JSON->perl2JSON($data);
 238         my $mf = &offline_meta_file;
 239         $logger->debug("offline: Append metadata to file $mf: $data");
 240         open(F, ">>$mf") or handle_event(OpenILS::Event->new('OFFLINE_FILE_ERROR', payload => $@));
 241         print F "$data\n";
 242         close(F);
 243 }
 244
 245 sub offline_read_meta {
 246         my $mf = &offline_meta_file;
 247         open(F, "$mf") or return [];
 248         my @data = <F>;
 249         close(F);
 250         my @resp;
 251         push(@resp, JSON->JSON2perl($_)) for @data;
 252         @resp = grep { $_ and $_->{'workstation'} } @resp;
 253         return \@resp;
 254 }
 255
 256 sub offline_read_results {
 257         my $file = &offline_result_file;
 258         open(F,$file) or return [];
 259         my @data = <F>;
 260         close(F);
 261         my @resp;
 262         push(@resp, JSON->JSON2perl($_)) for @data;
 263         @resp = grep { $_ and $_->{command} } @resp;
 264         return \@resp;
 265 }
 266
 267
 268 sub log_to_wsname {
 269         my $log = shift;
 270         $log =~ s/\.log//og;
 271         $log =~ s#/.*/(\w+)#$1#og;
 272         return $log
 273 }
 274
 275 1;