Open-ILS/src/perlmods/lib/OpenILS/Utils/Cronscript.pm.in

   1 package OpenILS::Utils::Cronscript;
   2
   3 # ---------------------------------------------------------------
   4 # Copyright (C) 2010 Equinox Software, Inc
   5 # Author: Joe Atzberger <jatzberger@esilibrary.com>
   6 # Portions Copyright (C) 2011 Merrimack Valley Library Consortium
   7 # Author: Jason Stephenson <jstephenson@mvlc.org>
   8 #
   9 # This program is free software; you can redistribute it and/or
  10 # modify it under the terms of the GNU General Public License
  11 # as published by the Free Software Foundation; either version 2
  12 # of the License, or (at your option) any later version.
  13
  14 # This program is distributed in the hope that it will be useful,
  15 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 # GNU General Public License for more details.
  18 # ---------------------------------------------------------------
  19
  20 # The purpose of this module is to consolidate the common aspects
  21 # of various cron tasks that all need the same things:
  22 #    ~ non-duplicative processing, i.e. lockfiles and lockfile checking
  23 #    ~ opensrf_core.xml file location
  24 #    ~ common options like help and debug
  25
  26 use strict;
  27 use warnings;
  28
  29 use Getopt::Long qw(:DEFAULT GetOptionsFromArray);
  30 use OpenSRF::System;
  31 use OpenSRF::AppSession;
  32 use OpenSRF::Utils::JSON;
  33 use OpenSRF::EX qw(:try);
  34 use OpenILS::Utils::Fieldmapper;
  35 use OpenILS::Utils::Lockfile;
  36 use OpenILS::Utils::CStoreEditor q/:funcs/;
  37 use OpenILS::Application::AppUtils;
  38
  39 use File::Basename qw/fileparse/;
  40
  41 use Data::Dumper;
  42 use Carp;
  43
  44 # Added for authentication
  45 use Digest::MD5 qw/md5_hex/;
  46
  47 our @extra_opts = (     # additional keys are stored here
  48     # 'addlopt'
  49 );
  50
  51 our $debug = 0;
  52
  53 my $apputils = 'OpenILS::Application::AppUtils';
  54
  55 sub _default_self {
  56     return {
  57     #   opts       => {},
  58     #   opts_clean => {},
  59     #   default_opts_clean => {},
  60         default_opts       => {
  61             'lock-file=s'   => OpenILS::Utils::Lockfile::default_filename,
  62             'osrf-config=s' => '@sysconfdir@/opensrf_core.xml',
  63             'debug'         => 0,
  64             'verbose+'      => 0,
  65             'help'          => 0,
  66           # 'internal_var'  => 'XYZ',
  67         },
  68     #   lockfile => undef,
  69     #   session => undef,
  70     #   bootstrapped => 0,
  71     #   got_options => 0,
  72         auto_get_options_4_bootstrap => 1,
  73     };
  74 }
  75
  76 sub is_clean {
  77     my $key = shift   or  return 1;
  78     $key =~ /[=:].*$/ and return 0;
  79     $key =~ /[+!]$/   and return 0;
  80     return 1;
  81 }
  82
  83 sub clean {
  84     my $key = shift or return;
  85     $key =~ s/[=:].*$//;
  86     $key =~ s/[+!]$//;
  87     return $key;
  88 }
  89
  90 sub fuzzykey {                      # when you know the hash you want from, but not the exact key
  91     my $self = shift or return;
  92     my $key  = shift or return;
  93     my $target = @_ ? shift : 'opts_clean';
  94     foreach (map {clean($_)} keys %{$self->{default_opts}}) {  # TODO: cache
  95         $key eq $_ and return $self->{$target}->{$_};
  96     }
  97 }
  98
  99 # MyGetOptions
 100 # A wrapper around GetOptions
 101 # {opts} does two things for GetOptions (see Getopt::Long)
 102 #  (1) maps command-line options to the *other* variables where values are stored (in opts_clean)
 103 #  (2) provides hashspace for the rest of the arbitrary options from the command-line
 104 #
 105 # TODO: allow more options to be passed here, maybe mimic Getopt::Long::GetOptions style
 106 #
 107 # If an arrayref argument is passed, then @ARGV will NOT be touched.
 108 # Instead, the array will be passed to GetOptionsFromArray.
 109 #
 110
 111 sub MyGetOptions {
 112     my $self = shift;
 113     my $arrayref = @_ ? shift : undef;
 114     if ($arrayref and ref($arrayref) ne 'ARRAY') {
 115         carp "MyGetOptions argument is not an array ref.  Expect GetOptionsFromArray to explode";
 116     }
 117     $self->{got_options} and carp "MyGetOptions called after options were already retrieved previously";
 118     my @keys = sort {is_clean($b) <=> is_clean($a)} keys %{$self->{default_opts}};
 119     $debug and print "KEYS: ", join(", ", @keys), "\n";
 120     foreach (@keys) {
 121         my $clean = clean($_);
 122         my $place = $self->{default_opts_clean}->{$clean};
 123         $self->{opts_clean}->{$clean} = $place;  # prepopulate default
 124         # $self->{opts}->{$_} = $self->{opts_clean}->{$clean};                 # pointer for GetOptions
 125         $self->{opts}->{$_} = sub {
 126             my $opt = shift;
 127             my $val = shift;
 128             ref ( $self->{opts_clean}->{$opt} ) and ref($self->{opts_clean}->{$opt}) eq 'SCALAR'
 129             and ${$self->{opts_clean}->{$opt}} = $val;  # set the referent's value
 130             $self->{opts_clean}->{$opt} = $val;     # burn the map, stick the value there
 131         };                 # pointer for GetOptions
 132     }
 133     $arrayref  ? GetOptionsFromArray($arrayref, $self->{opts}, @keys)
 134                : GetOptions(                    $self->{opts}, @keys) ;
 135
 136     foreach (@keys) {
 137         delete $self->{opts}->{$_};     # now remove the mappings from (1) so we just have (2)
 138     }
 139     $self->clean_mirror('opts');        # populate clean_opts w/ cleaned versions of (2), plus everything else
 140
 141     print $self->help() and exit if $self->{opts_clean}->{help};
 142     $self->new_lockfile();
 143     $self->{got_options}++;
 144     return wantarray ? %{$self->{opts_clean}} : $self->{opts_clean};
 145 }
 146
 147 sub new_lockfile {
 148     my $self = shift;
 149     $debug and $OpenILS::Utils::Lockfile::debug = $debug;
 150     unless ($self->{opts_clean}->{nolockfile} || $self->{default_opts_clean}->{nolockfile}) {
 151         $self->{lockfile_obj} = OpenILS::Utils::Lockfile->new($self->first_defined('lock-file'));
 152         $self->{lockfile}     = $self->{lockfile_obj}->filename;
 153     }
 154 }
 155
 156 sub first_defined {
 157     my $self = shift;
 158     my $key  = shift or return;
 159     foreach (qw(opts_clean opts default_opts_clean default_opts)) {
 160         defined $self->{$_}->{$key} and return $self->{$_}->{$key};
 161     }
 162     return;
 163 }
 164
 165 sub clean_mirror {
 166     my $self  = shift;
 167     my $dirty = @_ ? shift : 'default_opts';
 168     foreach (keys %{$self->{$dirty}}) {
 169         defined $self->{$dirty}->{$_} or next;
 170         $self->{$dirty . '_clean'}->{clean($_)} = $self->{$dirty}->{$_};
 171     }
 172 }
 173
 174 sub new {
 175     my $class = shift;
 176     my $self  = _default_self;
 177     bless ($self, $class);
 178     $self->init(@_);
 179     $debug and print "new ",  __PACKAGE__, " obj: ", Dumper($self);
 180     return $self;
 181 }
 182
 183 sub add_and_purge {
 184     my $self = shift;
 185     my $key  = shift;
 186     my $val  = shift;
 187     my $clean = clean($key);
 188     my @others = grep {/$clean/ and $_ ne $key} keys %{$self->{default_opts}};
 189     unless (@others) {
 190         $debug and print "unique key $key => $val\n";
 191         $self->{default_opts}->{$key} = $val;   # no purge, just add
 192         return;
 193     }
 194     foreach (@others) {
 195         $debug and print "variant of $key => $_\n";
 196         if ($key ne $clean) {    # if it is a dirtier key, delete the clean one
 197             delete $self->{default_opts}->{$_};
 198             $self->{default_opts}->{$key} = $val;
 199         } else {                 # else update the dirty one
 200             $self->{default_opts}->{$_} = $val;
 201         }
 202     }
 203 }
 204
 205 sub init {      # not INIT
 206     my $self = shift;
 207     my $opts  = @_ ? shift : {};    # user can specify more default options to constructor
 208 # TODO: check $opts is hashref; then check verbose/debug first.  maybe check negations e.g. "no-verbose" ?
 209     @extra_opts = keys %$opts;
 210     foreach (@extra_opts) {        # add any other keys w/ default values
 211         $debug and print "init() adding option $_, default value: $opts->{$_}\n";
 212         $self->add_and_purge($_, $opts->{$_});
 213     }
 214     $self->clean_mirror;
 215     return $self;
 216 }
 217
 218 sub usage {
 219     # my $self = shift;
 220     return "\nUSAGE: $0 [OPTIONS]";
 221 }
 222
 223 sub options_help {
 224     my $self = shift;
 225     my $chunk = @_ ? shift : '';
 226     return <<HELP
 227
 228 COMMON OPTIONS:
 229     --osrf-config </path/to/config_file>  Default: $self->{default_opts_clean}->{'osrf-config'}
 230                  Specify OpenSRF core config file.
 231
 232     --lock-file </path/to/file_name>      Default: $self->{default_opts_clean}->{'lock-file'}
 233                  Specify lock file.
 234
 235 HELP
 236     . $chunk . <<HELP;
 237     --debug      Print server responses to STDOUT for debugging
 238     --verbose    Set verbosity
 239     --help       Show this help message
 240 HELP
 241 }
 242
 243 sub help {
 244     my $self = shift;
 245     return $self->usage() . "\n" . $self->options_help(@_) . $self->example();
 246 }
 247
 248 sub example {
 249     return "\n\nEXAMPLES:\n\n    $0 --osrf-config /my/other/opensrf_core.xml\n";
 250 }
 251
 252 # the proper order is: MyGetOptions, bootstrap, session.
 253 # But the latter subs will check to see if they need to call the preceeding one(s).
 254
 255 sub session {
 256     my $self = shift or return;
 257     $self->{bootstrapped} or $self->bootstrap();
 258     @_ or croak "session() called without required argument (app_name, e.g. 'open-ils.acq')";
 259     return OpenSRF::AppSession->create(@_);
 260 }
 261
 262 sub bootstrap {
 263     my $self = shift or return;
 264     if ($self->{auto_get_options_4_bootstrap} and not $self->{got_options}) {
 265         $debug and print "Automatically calling MyGetOptions before bootstrap\n";
 266         $self->MyGetOptions();
 267     }
 268     try {
 269         $debug and print "bootstrap lock-file  : ", $self->first_defined('lock-file'), "\n";
 270         $debug and print "bootstrap osrf-config: ", $self->first_defined('osrf-config'), "\n";
 271         OpenSRF::System->bootstrap_client(config_file => $self->first_defined('osrf-config'));
 272         Fieldmapper->import(IDL => OpenSRF::Utils::SettingsClient->new->config_value("IDL"));
 273         $self->{bootstrapped} = 1;
 274     } otherwise {
 275         $self->{bootstrapped} = 0;
 276         warn shift;
 277     };
 278 }
 279
 280 sub editor_init {
 281     my $self = shift or return;
 282     OpenILS::Utils::CStoreEditor::init();   # no return value to check
 283     $self->{editor_inited} = 1;
 284 }
 285
 286 sub editor {
 287     my $self = shift or return;
 288     $self->{bootstrapped}  or $self->bootstrap();
 289     $self->{editor_inited} or $self->editor_init();
 290     return new_editor(@_);
 291 }
 292
 293 # Die on an event. Takes an optional third parameter for the textcode
 294 # of an event to die on. If the event textcode does not match the
 295 # third parameter, will warn on the event instead of dying.
 296 sub die_event {
 297     my $self = shift;
 298     my $e = shift;
 299     my $name = shift;
 300     if ($apputils->event_code($e)) {
 301         if (!defined($name) || $apputils->event_equals($e,$name)) {
 302             croak(Dumper $e);
 303         } else {
 304             carp(Dumper $e);
 305         }
 306     }
 307 }
 308
 309 # Prints warning on an even. Takes an optional third parameter for the
 310 # textcode of an event to warn on.
 311 sub warn_event {
 312     my $self = shift;
 313     my $e = shift;
 314     my $name = shift;
 315     if ($apputils->event_code($e)
 316             && (!defined($name) || $apputils->event_equals($e, $name))) {
 317         carp(Dumper $e);
 318     }
 319 }
 320
 321 # Authenticate with the open-ils.auth module.
 322 # Takes a hash ref of arguments:
 323 # {
 324 #   username => username to authenticate as,
 325 #   password => the user's password,
 326 #   workstation => the workstation to use (optional),
 327 #   type => the type of login (optional, but defaults to staff)
 328 # }
 329 #
 330 # returns the authtoken or undef on failure.
 331 # Also stores the authtoken and authtime as fields on the object.
 332 sub authenticate {
 333     my $self = shift or return;
 334     my $args = shift or return;
 335     if ($args && ref($args) eq 'HASH') {
 336         # Default to staff in case the back end ever stops doing so.
 337         $args->{type} = 'staff' unless (defined($args->{type}));
 338
 339         my $session = $self->session('open-ils.auth');
 340         my $seed = $session->request(
 341             'open-ils.auth.authenticate.init', $args->{'username'}
 342         )->gather(1);
 343
 344         $args->{password} = md5_hex($seed . md5_hex($args->{password}));
 345         my $req = $session->request(
 346             'open-ils.auth.authenticate.complete', $args
 347         );
 348
 349         my $response = $req->gather(1);
 350         if ($response && ref($response) eq 'HASH' && $response->{payload}) {
 351             $self->{authtoken} = $response->{payload}->{authtoken};
 352             $self->{authtime} = $response->{payload}->{authtime};
 353         } else {
 354             $self->{authtoken} = undef;
 355             $self->{authtime} = undef;
 356             carp("Authentication failed");
 357         }
 358         $session->disconnect();
 359         return $self->authtoken;
 360     } else {
 361         return undef;
 362     }
 363 }
 364
 365 # Deletes the session for our authtoken if we have logged in with the
 366 # authenticate method.
 367 sub logout {
 368     my $self = shift or return;
 369     my $token = shift || $self->{authtoken};
 370     if ($token) {
 371         my $session = $self->session('open-ils.auth');
 372         if ($session->request('open-ils.auth.session.delete', $token)->gather(1)) {
 373             if ($token eq $self->{authtoken}) {
 374                 $self->{authtoken} = undef;
 375                 $self->{authtime} = undef;
 376             }
 377         } else {
 378             carp("Not authenticated");
 379         }
 380         $session->disconnect();
 381     } else {
 382         carp("No authtoken");
 383     }
 384 }
 385
 386 sub authtoken {
 387     my $self = shift;
 388     return $self->{authtoken};
 389 }
 390
 391 sub authtime {
 392     my $self = shift;
 393     return $self->{authtime};
 394 }
 395
 396 sub cache {
 397     my $self = shift;
 398     my $cache = "OpenSRF::Utils::Cache";
 399     $cache->use;
 400     $self->{memcache} = $cache->new('global') unless $self->{memcache};
 401     return $self->{memcache};
 402 }
 403
 404 1;
 405 __END__
 406
 407 =pod
 408
 409 =head1 NAME
 410
 411 OpenILS::Utils::Cronscript - Consolidated options handling and utility
 412 methods for any script (not just cron, really)
 413
 414 =head1 SYNOPSIS
 415
 416     use OpenILS::Utils::Cronscript;
 417
 418     my %defaults = (
 419         'min=i'      => 0,          # keys are Getopt::Long style options
 420         'max=i'      => 999,        # values are default values
 421         'user=s'     => 'admin',
 422         'password=s' => '',
 423         'nolockfile' => 1,
 424     );
 425
 426     my $core = OpenILS::Utils::Cronscript->new(\%defaults);
 427     my $opts = $core->MyGetOptions();   # options now in, e.g.: $opts->{max}
 428     $core->bootstrap;
 429
 430 You can skip alot of the above if you're happy with the defaults:
 431
 432     my $script = OpenILS::Utils::Cronscript->new();
 433
 434 If you just don't want a lock file:
 435
 436     my $core = OpenILS::Utils::Cronscript->new({nolockfile=>1});
 437
 438 Or if you don't need any additional options and just want to get a
 439 session going:
 440
 441     use OpenILS::Utils::Cronscript;
 442     my $session = OpenILS::Utils::Cronscript->new()->session('open-ils.acq');
 443
 444 Cronscript gives you access to many useful methods:
 445
 446 You can login if necessary:
 447
 448     my $account = {
 449         username => 'admin',
 450         password => 'password',
 451         workstation => 'workstation_name', # optional
 452         type => 'staff' # optional, but staff is the default
 453     };
 454     my $authtoken = $core->authenticate($account);
 455
 456 You can logout a session given its authtoken:
 457
 458     $core->logout($authtoken);
 459
 460 Or, if you've authenticated with the authenticate method, you can
 461 logout the most recently authenticated session:
 462
 463     $core->logout();
 464
 465 If you have logged in with the authenticate method, you can retrieve
 466 your current authtoken or authtime values:
 467
 468     my $token = $core->authtoken;
 469     my $authtime = $core->authtime;
 470
 471 You can create a CStoreEdtor object:
 472
 473     my $editor = $core->editor(); # With defaults.
 474     my $editor = $core->editor(authtoken=>$authtoken); # with a given
 475                                                        # session
 476     my $editor = $core->editor(xact=>1); # With transactions or any
 477                                          # other CStoreEditor options.
 478
 479 You can create OpenSRF AppSesions to run commands:
 480
 481     my $pcrud = $core->session('open-ils.pcrud');
 482     #...Do some pcrud stuff here.
 483
 484 You can print warnings or die on events:
 485
 486     my $evt ...;
 487     $core->warn_event($evt);
 488     $core->die_event($evt);
 489
 490 Or only on certain events:
 491
 492      $core->warn_event($evt, 'PERM_FAILURE');
 493      $core->die_event($evt, 'PERM_FAILURE');
 494
 495 Includes a shared debug flag so you can turn debug mode on and off:
 496
 497     $OpenILS::Utils::Cronscript::debug = 1; # Debugging on
 498     $OpenILS::Utils::Cronscript::debug = 0; # Debugging off
 499
 500 Includes OpenILS::Application::Apputils so using AppUtils methods is
 501 as simple as:
 502
 503     my $apputils = 'OpenILS::Application::AppUtils';
 504     $apputils->event_code($evt);
 505
 506 Uses and imports the OpenILS::Utils::Fieldmapper so you don't have to.
 507
 508 =head1 DESCRIPTION
 509
 510 There are a few main problems when writing a new script for Evergreen.
 511
 512 =head2 Initialization
 513
 514 The runtime environment for the application requires a lot of
 515 initialization, but during normal operation it has already occured
 516 (when Evergreen was started).  So most of the EG code never has to
 517 deal with this problem, but standalone scripts do.  The timing and
 518 sequence of requisite events is important and not obvious.
 519
 520 =head2 Common Options, Consistent Options
 521
 522 We need several common options for each script that accesses the
 523 database or uses EG data objects and methods.  Logically, these
 524 options often deal with initialization.  They should take the B<exact>
 525 same form(s) for each script and should not be dependent on the local
 526 author to copy and paste them from some reference source.  We really
 527 don't want to encourage (let alone force) admins to use C<--config>,
 528 C<--osrf-confg>, C<-c>, and C<@ARGV[2]> for the same purpose in
 529 different scripts, with different default handling, help descriptions
 530 and error messages (or lack thereof).
 531
 532 This suggests broader problem of UI consistency and uniformity, also
 533 partially addressed by this module.
 534
 535 =head2 Lockfiles
 536
 537 A lockfile is necessary for a script that wants to prevent possible
 538 simultaneous execution.  For example, consider a script that is
 539 scheduled to run frequently, but that experiences occasional high
 540 load: you wouldn't want crontab to start running it again if the first
 541 instance had not yet finished.
 542
 543 But the code for creating, writing to, checking for, reading and
 544 cleaning up a lockfile for the script bloats what might otherwise be a
 545 terse method call.  Conscript handles lockfile generation and removal
 546 automatically.
 547
 548 =head1 OPTIONS
 549
 550 The common options (and default values) are:
 551
 552     'lock-file=s'   => OpenILS::Utils::Lockfile::default_filename,
 553     'osrf-config=s' => '/openils/conf/opensrf_core.xml',
 554     'debug'         => 0,
 555     'verbose+'      => 0,
 556     'help'          => 0,
 557
 558 =head1 SEE ALSO
 559
 560     Getopt::Long
 561     OpenILS::Application::AppUtils
 562     OpenILS::Utils::Fieldmapper
 563     OpenILS::Utils::Lockfile
 564
 565 =head1 AUTHORS
 566
 567     Joe Atzberger <jatzberger@esilibrary.com>
 568     Jason Stephenson <jstephenson@mvlc.org>
 569
 570 =cut
 571