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 #
   7 # This program is free software; you can redistribute it and/or
   8 # modify it under the terms of the GNU General Public License
   9 # as published by the Free Software Foundation; either version 2
  10 # of the License, or (at your option) any later version.
  11
  12 # This program is distributed in the hope that it will be useful,
  13 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 # GNU General Public License for more details.
  16 # ---------------------------------------------------------------
  17
  18 # The purpose of this module is to consolidate the common aspects
  19 # of various cron tasks that all need the same things:
  20 #    ~ non-duplicative processing, i.e. lockfiles and lockfile checking
  21 #    ~ opensrf_core.xml file location
  22 #    ~ common options like help and debug
  23
  24 use strict;
  25 use warnings;
  26
  27 use Getopt::Long qw(:DEFAULT GetOptionsFromArray);
  28 use OpenSRF::System;
  29 use OpenSRF::AppSession;
  30 use OpenSRF::Utils::JSON;
  31 use OpenSRF::EX qw(:try);
  32 use OpenILS::Utils::Fieldmapper;
  33 use OpenILS::Utils::Lockfile;
  34 use OpenILS::Utils::CStoreEditor q/:funcs/;
  35
  36 use File::Basename qw/fileparse/;
  37
  38 use Data::Dumper;
  39 use Carp;
  40
  41 # Added for authentication
  42 use Digest::MD5 qw/md5_hex/;
  43
  44 our @extra_opts = (     # additional keys are stored here
  45     # 'addlopt'
  46 );
  47
  48 our $debug = 0;
  49
  50 sub _default_self {
  51     return {
  52     #   opts       => {},
  53     #   opts_clean => {},
  54     #   default_opts_clean => {},
  55         default_opts       => {
  56             'lock-file=s'   => OpenILS::Utils::Lockfile::default_filename,
  57             'osrf-config=s' => '@sysconfdir@/opensrf_core.xml',
  58             'debug'         => 0,
  59             'verbose+'      => 0,
  60             'help'          => 0,
  61           # 'internal_var'  => 'XYZ',
  62         },
  63     #   lockfile => undef,
  64     #   session => undef,
  65     #   bootstrapped => 0,
  66     #   got_options => 0,
  67         auto_get_options_4_bootstrap => 1,
  68     };
  69 }
  70
  71 sub is_clean {
  72     my $key = shift   or  return 1;
  73     $key =~ /[=:].*$/ and return 0;
  74     $key =~ /[+!]$/   and return 0;
  75     return 1;
  76 }
  77
  78 sub clean {
  79     my $key = shift or return;
  80     $key =~ s/[=:].*$//;
  81     $key =~ s/[+!]$//;
  82     return $key;
  83 }
  84
  85 sub fuzzykey {                      # when you know the hash you want from, but not the exact key
  86     my $self = shift or return;
  87     my $key  = shift or return;
  88     my $target = @_ ? shift : 'opts_clean';
  89     foreach (map {clean($_)} keys %{$self->{default_opts}}) {  # TODO: cache
  90         $key eq $_ and return $self->{$target}->{$_};
  91     }
  92 }
  93
  94 # MyGetOptions
  95 # A wrapper around GetOptions
  96 # {opts} does two things for GetOptions (see Getopt::Long)
  97 #  (1) maps command-line options to the *other* variables where values are stored (in opts_clean)
  98 #  (2) provides hashspace for the rest of the arbitrary options from the command-line
  99 #
 100 # TODO: allow more options to be passed here, maybe mimic Getopt::Long::GetOptions style
 101 #
 102 # If an arrayref argument is passed, then @ARGV will NOT be touched.
 103 # Instead, the array will be passed to GetOptionsFromArray.
 104 #
 105
 106 sub MyGetOptions {
 107     my $self = shift;
 108     my $arrayref = @_ ? shift : undef;
 109     if ($arrayref and ref($arrayref) ne 'ARRAY') {
 110         carp "MyGetOptions argument is not an array ref.  Expect GetOptionsFromArray to explode";
 111     }
 112     $self->{got_options} and carp "MyGetOptions called after options were already retrieved previously";
 113     my @keys = sort {is_clean($b) <=> is_clean($a)} keys %{$self->{default_opts}};
 114     $debug and print "KEYS: ", join(", ", @keys), "\n";
 115     foreach (@keys) {
 116         my $clean = clean($_);
 117         my $place = $self->{default_opts_clean}->{$clean};
 118         $self->{opts_clean}->{$clean} = $place;  # prepopulate default
 119         # $self->{opts}->{$_} = $self->{opts_clean}->{$clean};                 # pointer for GetOptions
 120         $self->{opts}->{$_} = sub {
 121             my $opt = shift;
 122             my $val = shift;
 123             ref ( $self->{opts_clean}->{$opt} ) and ref($self->{opts_clean}->{$opt}) eq 'SCALAR'
 124             and ${$self->{opts_clean}->{$opt}} = $val;  # set the referent's value
 125             $self->{opts_clean}->{$opt} = $val;     # burn the map, stick the value there
 126         };                 # pointer for GetOptions
 127     }
 128     $arrayref  ? GetOptionsFromArray($arrayref, $self->{opts}, @keys)
 129                : GetOptions(                    $self->{opts}, @keys) ;
 130
 131     foreach (@keys) {
 132         delete $self->{opts}->{$_};     # now remove the mappings from (1) so we just have (2)
 133     }
 134     $self->clean_mirror('opts');        # populate clean_opts w/ cleaned versions of (2), plus everything else
 135
 136     print $self->help() and exit if $self->{opts_clean}->{help};
 137     $self->new_lockfile();
 138     $self->{got_options}++;
 139     return wantarray ? %{$self->{opts_clean}} : $self->{opts_clean};
 140 }
 141
 142 sub new_lockfile {
 143     my $self = shift;
 144     $debug and $OpenILS::Utils::Lockfile::debug = $debug;
 145     unless ($self->{opts_clean}->{nolockfile} || $self->{default_opts_clean}->{nolockfile}) {
 146         $self->{lockfile_obj} = OpenILS::Utils::Lockfile->new($self->first_defined('lock-file'));
 147         $self->{lockfile}     = $self->{lockfile_obj}->filename;
 148     }
 149 }
 150
 151 sub first_defined {
 152     my $self = shift;
 153     my $key  = shift or return;
 154     foreach (qw(opts_clean opts default_opts_clean default_opts)) {
 155         defined $self->{$_}->{$key} and return $self->{$_}->{$key};
 156     }
 157     return;
 158 }
 159
 160 sub clean_mirror {
 161     my $self  = shift;
 162     my $dirty = @_ ? shift : 'default_opts';
 163     foreach (keys %{$self->{$dirty}}) {
 164         defined $self->{$dirty}->{$_} or next;
 165         $self->{$dirty . '_clean'}->{clean($_)} = $self->{$dirty}->{$_};
 166     }
 167 }
 168
 169 sub new {
 170     my $class = shift;
 171     my $self  = _default_self;
 172     bless ($self, $class);
 173     $self->init(@_);
 174     $debug and print "new ",  __PACKAGE__, " obj: ", Dumper($self);
 175     return $self;
 176 }
 177
 178 sub add_and_purge {
 179     my $self = shift;
 180     my $key  = shift;
 181     my $val  = shift;
 182     my $clean = clean($key);
 183     my @others = grep {/$clean/ and $_ ne $key} keys %{$self->{default_opts}};
 184     unless (@others) {
 185         $debug and print "unique key $key => $val\n";
 186         $self->{default_opts}->{$key} = $val;   # no purge, just add
 187         return;
 188     }
 189     foreach (@others) {
 190         $debug and print "variant of $key => $_\n";
 191         if ($key ne $clean) {    # if it is a dirtier key, delete the clean one
 192             delete $self->{default_opts}->{$_};
 193             $self->{default_opts}->{$key} = $val;
 194         } else {                 # else update the dirty one
 195             $self->{default_opts}->{$_} = $val;
 196         }
 197     }
 198 }
 199
 200 sub init {      # not INIT
 201     my $self = shift;
 202     my $opts  = @_ ? shift : {};    # user can specify more default options to constructor
 203 # TODO: check $opts is hashref; then check verbose/debug first.  maybe check negations e.g. "no-verbose" ?
 204     @extra_opts = keys %$opts;
 205     foreach (@extra_opts) {        # add any other keys w/ default values
 206         $debug and print "init() adding option $_, default value: $opts->{$_}\n";
 207         $self->add_and_purge($_, $opts->{$_});
 208     }
 209     $self->clean_mirror;
 210     return $self;
 211 }
 212
 213 sub usage {
 214     # my $self = shift;
 215     return "\nUSAGE: $0 [OPTIONS]";
 216 }
 217
 218 sub options_help {
 219     my $self = shift;
 220     my $chunk = @_ ? shift : '';
 221     return <<HELP
 222
 223 COMMON OPTIONS:
 224     --osrf-config </path/to/config_file>  Default: $self->{default_opts_clean}->{'osrf-config'}
 225                  Specify OpenSRF core config file.
 226
 227     --lock-file </path/to/file_name>      Default: $self->{default_opts_clean}->{'lock-file'}
 228                  Specify lock file.
 229
 230 HELP
 231     . $chunk . <<HELP;
 232     --debug      Print server responses to STDOUT for debugging
 233     --verbose    Set verbosity
 234     --help       Show this help message
 235 HELP
 236 }
 237
 238 sub help {
 239     my $self = shift;
 240     return $self->usage() . "\n" . $self->options_help(@_) . $self->example();
 241 }
 242
 243 sub example {
 244     return "\n\nEXAMPLES:\n\n    $0 --osrf-config /my/other/opensrf_core.xml\n";
 245 }
 246
 247 # the proper order is: MyGetOptions, bootstrap, session.
 248 # But the latter subs will check to see if they need to call the preceeding one(s).
 249
 250 sub session {
 251     my $self = shift or return;
 252     $self->{bootstrapped} or $self->bootstrap();
 253     @_ or croak "session() called without required argument (app_name, e.g. 'open-ils.acq')";
 254     return ($self->{session} ||= OpenSRF::AppSession->create(@_));
 255 }
 256
 257 sub bootstrap {
 258     my $self = shift or return;
 259     if ($self->{auto_get_options_4_bootstrap} and not $self->{got_options}) {
 260         $debug and print "Automatically calling MyGetOptions before bootstrap\n";
 261         $self->MyGetOptions();
 262     }
 263     try {
 264         $debug and print "bootstrap lock-file  : ", $self->first_defined('lock-file'), "\n";
 265         $debug and print "bootstrap osrf-config: ", $self->first_defined('osrf-config'), "\n";
 266         OpenSRF::System->bootstrap_client(config_file => $self->first_defined('osrf-config'));
 267         Fieldmapper->import(IDL => OpenSRF::Utils::SettingsClient->new->config_value("IDL"));
 268         $self->{bootstrapped} = 1;
 269     } otherwise {
 270         $self->{bootstrapped} = 0;
 271         warn shift;
 272     };
 273 }
 274
 275 sub editor_init {
 276     my $self = shift or return;
 277     OpenILS::Utils::CStoreEditor::init();   # no return value to check
 278     $self->{editor_inited} = 1;
 279 }
 280
 281 sub editor {
 282     my $self = shift or return;
 283     $self->{bootstrapped}  or $self->bootstrap();
 284     $self->{editor_inited} or $self->editor_init();
 285     return new_editor(@_);
 286 }
 287
 288 # Authenticate with the open-ils.auth module.
 289 # Takes a hash ref of arguments:
 290 # {
 291 #   username => username to authenticate as,
 292 #   password => the user's password,
 293 #   workstation => the workstation to use (optional),
 294 #   type => the type of login (optional, but defaults to staff)
 295 # }
 296 #
 297 # returns the authtoken or undef on failure.
 298 # Also stores the authtoken and authtime as fields on the object.
 299 sub authenticate {
 300     my $self = shift or return;
 301     my $args = shift or return;
 302     if ($args && ref($args) eq 'HASH') {
 303         $self->{bootstrapped} or $self->bootstrap();
 304
 305         my $session = Opensrf::AppSession->create('open-ils.auth');
 306         my $seed = $session->request(
 307             'open-ils.auth.authenticate.init', $args->{'username'}
 308         )->gather(1);
 309
 310         $args->{password} = md5_hex($seed . md5_hex($args->{password}));
 311         my $req = $session->request(
 312             'open-ils.auth.authenticate.complete', $args
 313         );
 314
 315         my $response = $req->gather(1);
 316         if ($response && ref($response) eq 'HASH' && $response->{payload}) {
 317             $self->{authtoken} = $response->{payload}->{authtoken};
 318             $self->{authtime} = $response->{payload}->{authtime};
 319         } else {
 320             $self->{authtoken} = undef;
 321             $self->{authtime} = undef;
 322         }
 323         $session->disconnect();
 324         return $self->authtoken;
 325     } else {
 326         return undef;
 327     }
 328 }
 329
 330 sub authtoken {
 331     my $self = shift;
 332     return $self->{authtoken};
 333 }
 334
 335 sub authtime {
 336     my $self = shift;
 337     return $self->{authtime};
 338 }
 339
 340 1;
 341 __END__
 342
 343 =pod
 344
 345 =head1 NAME
 346
 347 OpenILS::Utils::Cronscript - Consolidated options handling for any script (not just cron, really)
 348
 349 =head1 SYNOPSIS
 350
 351     use OpenILS::Utils::Cronscript;
 352
 353     my %defaults = (
 354         'min=i'      => 0,          # keys are Getopt::Long style options
 355         'max=i'      => 999,        # values are default values
 356         'user=s'     => 'admin',
 357         'password=s' => '',
 358         'nolockfile' => 1,
 359     };
 360
 361     my $core = OpenILS::Utils::Cronscript->new(\%defaults);
 362     my $opts = $core->MyGetOptions();   # options now in, e.g.: $opts->{max}
 363     $core->bootstrap;
 364
 365 Or if you don't need any additional options and just want to get a session going:
 366
 367     use OpenILS::Utils::Cronscript;
 368     my $session = OpenILS::Utils::Cronscript->new()->session('open-ils.acq');
 369
 370 =head1 DESCRIPTION
 371
 372 There are a few main problems when writing a new script for Evergreen.
 373
 374 =head2 Initialization
 375
 376 The runtime
 377 environment for the application requires a lot of initialization, but during normal operation it
 378 has already occured (when Evergreen was started).  So most of the EG code never has to deal with
 379 this problem, but standalone scripts do.  The timing and sequence of requisite events is important and not obvious.
 380
 381 =head2 Common Options, Consistent Options
 382
 383 We need several common options for each script that accesses the database or
 384 uses EG data objects and methods.  Logically, these options often deal with initialization.  They
 385 should take the B<exact> same form(s) for each script and should not be
 386 dependent on the local author to copy and paste them from some reference source.  We really don't want to encourage (let alone force)
 387 admins to use C<--config>, C<--osrf-confg>, C<-c>, and C<@ARGV[2]> for the same purpose in different scripts, with different
 388 default handling, help descriptions and error messages (or lack thereof).
 389
 390 This suggests broader problem of UI consistency and uniformity, also partially addressed by this module.
 391
 392 =head2 Lockfiles
 393
 394 A lockfile is necessary for a script that wants to prevent possible simultaneous execution.  For example, consider a script
 395 that is scheduled to run frequently, but that experiences occasional high load: you wouldn't want crontab to start running
 396 it again if the first instance had not yet finished.
 397
 398 But the code for creating, writing to, checking for, reading and cleaning up a lockfile for the script bloats what might otherwise be a terse
 399 method call.  Conscript handles lockfile generation and removal automatically.
 400
 401 =head1 OPTIONS
 402
 403 The common options (and default values) are:
 404
 405     'lock-file=s'   => OpenILS::Utils::Lockfile::default_filename,
 406     'osrf-config=s' => '/openils/conf/opensrf_core.xml',
 407     'debug'         => 0,
 408     'verbose+'      => 0,
 409     'help'          => 0,
 410
 411 =head1 TODO
 412
 413 More docs here.
 414
 415 =head1 SEE ALSO
 416
 417     Getopt::Long
 418     OpenILS::Utils::Lockfile
 419     oils_header.pl
 420
 421 =head1 AUTHOR
 422
 423 Joe Atzberger <jatzberger@esilibrary.com>
 424
 425 =cut
 426