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 1;
 397 __END__
 398
 399 =pod
 400
 401 =head1 NAME
 402
 403 OpenILS::Utils::Cronscript - Consolidated options handling and utility
 404 methods for any script (not just cron, really)
 405
 406 =head1 SYNOPSIS
 407
 408     use OpenILS::Utils::Cronscript;
 409
 410     my %defaults = (
 411         'min=i'      => 0,          # keys are Getopt::Long style options
 412         'max=i'      => 999,        # values are default values
 413         'user=s'     => 'admin',
 414         'password=s' => '',
 415         'nolockfile' => 1,
 416     );
 417
 418     my $core = OpenILS::Utils::Cronscript->new(\%defaults);
 419     my $opts = $core->MyGetOptions();   # options now in, e.g.: $opts->{max}
 420     $core->bootstrap;
 421
 422 You can skip alot of the above if you're happy with the defaults:
 423
 424     my $script = OpenILS::Utils::Cronscript->new();
 425
 426 If you just don't want a lock file:
 427
 428     my $core = OpenILS::Utils::Cronscript->new({nolockfile=>1});
 429
 430 Or if you don't need any additional options and just want to get a
 431 session going:
 432
 433     use OpenILS::Utils::Cronscript;
 434     my $session = OpenILS::Utils::Cronscript->new()->session('open-ils.acq');
 435
 436 Cronscript gives you access to many useful methods:
 437
 438 You can login if necessary:
 439
 440     my $account = {
 441         username => 'admin',
 442         password => 'password',
 443         workstation => 'workstation_name', # optional
 444         type => 'staff' # optional, but staff is the default
 445     };
 446     my $authtoken = $core->authenticate($account);
 447
 448 You can logout a session given its authtoken:
 449
 450     $core->logout($authtoken);
 451
 452 Or, if you've authenticated with the authenticate method, you can
 453 logout the most recently authenticated session:
 454
 455     $core->logout();
 456
 457 If you have logged in with the authenticate method, you can retrieve
 458 your current authtoken or authtime values:
 459
 460     my $token = $core->authtoken;
 461     my $authtime = $core->authtime;
 462
 463 You can create a CStoreEdtor object:
 464
 465     my $editor = $core->editor(); # With defaults.
 466     my $editor = $core->editor(authtoken=>$authtoken); # with a given
 467                                                        # session
 468     my $editor = $core->editor(xact=>1); # With transactions or any
 469                                          # other CStoreEditor options.
 470
 471 You can create OpenSRF AppSesions to run commands:
 472
 473     my $pcrud = $core->session('open-ils.pcrud');
 474     #...Do some pcrud stuff here.
 475
 476 You can print warnings or die on events:
 477
 478     my $evt ...;
 479     $core->warn_event($evt);
 480     $core->die_event($evt);
 481
 482 Or only on certain events:
 483
 484      $core->warn_event($evt, 'PERM_FAILURE');
 485      $core->die_event($evt, 'PERM_FAILURE');
 486
 487 Includes a shared debug flag so you can turn debug mode on and off:
 488
 489     $OpenILS::Utils::Cronscript::debug = 1; # Debugging on
 490     $OpenILS::Utils::Cronscript::debug = 0; # Debugging off
 491
 492 Includes OpenILS::Application::Apputils so using AppUtils methods is
 493 as simple as:
 494
 495     my $apputils = 'OpenILS::Application::AppUtils';
 496     $apputils->event_code($evt);
 497
 498 Uses and imports the OpenILS::Utils::Fieldmapper so you don't have to.
 499
 500 =head1 DESCRIPTION
 501
 502 There are a few main problems when writing a new script for Evergreen.
 503
 504 =head2 Initialization
 505
 506 The runtime environment for the application requires a lot of
 507 initialization, but during normal operation it has already occured
 508 (when Evergreen was started).  So most of the EG code never has to
 509 deal with this problem, but standalone scripts do.  The timing and
 510 sequence of requisite events is important and not obvious.
 511
 512 =head2 Common Options, Consistent Options
 513
 514 We need several common options for each script that accesses the
 515 database or uses EG data objects and methods.  Logically, these
 516 options often deal with initialization.  They should take the B<exact>
 517 same form(s) for each script and should not be dependent on the local
 518 author to copy and paste them from some reference source.  We really
 519 don't want to encourage (let alone force) admins to use C<--config>,
 520 C<--osrf-confg>, C<-c>, and C<@ARGV[2]> for the same purpose in
 521 different scripts, with different default handling, help descriptions
 522 and error messages (or lack thereof).
 523
 524 This suggests broader problem of UI consistency and uniformity, also
 525 partially addressed by this module.
 526
 527 =head2 Lockfiles
 528
 529 A lockfile is necessary for a script that wants to prevent possible
 530 simultaneous execution.  For example, consider a script that is
 531 scheduled to run frequently, but that experiences occasional high
 532 load: you wouldn't want crontab to start running it again if the first
 533 instance had not yet finished.
 534
 535 But the code for creating, writing to, checking for, reading and
 536 cleaning up a lockfile for the script bloats what might otherwise be a
 537 terse method call.  Conscript handles lockfile generation and removal
 538 automatically.
 539
 540 =head1 OPTIONS
 541
 542 The common options (and default values) are:
 543
 544     'lock-file=s'   => OpenILS::Utils::Lockfile::default_filename,
 545     'osrf-config=s' => '/openils/conf/opensrf_core.xml',
 546     'debug'         => 0,
 547     'verbose+'      => 0,
 548     'help'          => 0,
 549
 550 =head1 SEE ALSO
 551
 552     Getopt::Long
 553     OpenILS::Application::AppUtils
 554     OpenILS::Utils::Fieldmapper
 555     OpenILS::Utils::Lockfile
 556
 557 =head1 AUTHORS
 558
 559     Joe Atzberger <jatzberger@esilibrary.com>
 560     Jason Stephenson <jstephenson@mvlc.org>
 561
 562 =cut
 563