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

   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
  35 use File::Basename qw/fileparse/;
  36
  37 use Data::Dumper;
  38 use Carp;
  39
  40 our @extra_opts = (     # additional keys are stored here
  41     # 'addlopt'
  42 );
  43
  44 our $debug = 0;
  45
  46 sub _default_self {
  47     return {
  48     #   opts       => {},
  49     #   opts_clean => {},
  50     #   default_opts_clean => {},
  51         default_opts       => {
  52             'lock-file=s'   => OpenILS::Utils::Lockfile::default_filename,
  53             'osrf-config=s' => '/openils/conf/opensrf_core.xml',   # TODO: packaging needs a make variable like @@EG_CONF_DIR@@
  54             'debug'         => 0,
  55             'verbose+'      => 0,
  56             'help'          => 0,
  57             'internal_var'  => 'XYZ',
  58         },
  59     #   lockfile => undef,
  60     #   session => undef,
  61     #   bootstrapped => 0,
  62     #   got_options => 0,
  63         auto_get_options_4_bootstrap => 1,
  64     };
  65 }
  66
  67 sub is_clean {
  68     my $key = shift   or  return 1;
  69     $key =~ /[=:].*$/ and return 0;
  70     $key =~ /[+!]$/   and return 0;
  71     return 1;
  72 }
  73
  74 sub clean {
  75     my $key = shift or return;
  76     $key =~ s/[=:].*$//;
  77     $key =~ s/[+!]$//;
  78     return $key;
  79 }
  80
  81 sub fuzzykey {                      # when you know the hash you want from, but not the exact key
  82     my $self = shift or return;
  83     my $key  = shift or return;
  84     my $target = @_ ? shift : 'opts_clean';
  85     foreach (map {clean($_)} keys %{$self->{default_opts}}) {  # TODO: cache
  86         $key eq $_ and return $self->{$target}->{$_};
  87     }
  88 }
  89
  90 # MyGetOptions
  91 # A wrapper around GetOptions
  92 # {opts} does two things for GetOptions (see Getopt::Long)
  93 #  (1) maps command-line options to the *other* variables where values are stored (in opts_clean)
  94 #  (2) provides hashspace for the rest of the arbitrary options from the command-line
  95 #
  96 # TODO: allow more options to be passed here, maybe mimic Getopt::Long::GetOptions style
  97 #
  98 # If an arrayref argument is passed, then @ARGV will NOT be touched.
  99 # Instead, the array will be passed to GetOptionsFromArray.
 100 #
 101
 102 sub MyGetOptions {
 103     my $self = shift;
 104     my $arrayref = @_ ? shift : undef;
 105     if ($arrayref and ref($arrayref) ne 'ARRAY') {
 106         carp "MyGetOptions argument is not an array ref.  Expect GetOptionsFromArray to explode";
 107     }
 108     $self->{got_options} and carp "MyGetOptions called after options were already retrieved previously";
 109     my @keys = sort {is_clean($b) <=> is_clean($a)} keys %{$self->{default_opts}};
 110     $debug and print "KEYS: ", join(", ", @keys), "\n";
 111     foreach (@keys) {
 112         my $clean = clean($_);
 113         my $place = $self->{default_opts_clean}->{$clean};
 114         $self->{opts_clean}->{$clean} = $place;  # prepopulate default
 115         # $self->{opts}->{$_} = $self->{opts_clean}->{$clean};                 # pointer for GetOptions
 116         $self->{opts}->{$_} = sub {
 117             my $opt = shift;
 118             my $val = shift;
 119             ref ( $self->{opts_clean}->{$opt} ) and ref($self->{opts_clean}->{$opt}) eq 'SCALAR'
 120             and ${$self->{opts_clean}->{$opt}} = $val;  # set the referent's value
 121             $self->{opts_clean}->{$opt} = $val;     # burn the map, stick the value there
 122         };                 # pointer for GetOptions
 123     }
 124     $arrayref  ? GetOptionsFromArray($arrayref, $self->{opts}, @keys)
 125                : GetOptions(                    $self->{opts}, @keys) ;
 126
 127     foreach (@keys) {
 128         delete $self->{opts}->{$_};     # now remove the mappings from (1) so we just have (2)
 129     }
 130     $self->clean_mirror('opts');        # populate clean_opts w/ cleaned versions of (2), plus everything else
 131
 132     print $self->help() and exit if $self->{opts_clean}->{help};
 133     $self->new_lockfile();
 134     $self->{got_options}++;
 135     return wantarray ? %{$self->{opts_clean}} : $self->{opts_clean};
 136 }
 137
 138 sub new_lockfile {
 139     my $self = shift;
 140     $debug and $OpenILS::Utils::Lockfile::debug = $debug;
 141     unless ($self->{opts_clean}->{nolockfile} || $self->{default_opts_clean}->{nolockfile}) {
 142         $self->{lockfile_obj} = OpenILS::Utils::Lockfile->new($self->first_defined('lock-file'));
 143         $self->{lockfile}     = $self->{lockfile_obj}->filename;
 144     }
 145 }
 146
 147 sub first_defined {
 148     my $self = shift;
 149     my $key  = shift or return;
 150     foreach (qw(opts_clean opts default_opts_clean default_opts)) {
 151         defined $self->{$_}->{$key} and return $self->{$_}->{$key};
 152     }
 153     return;
 154 }
 155
 156 sub clean_mirror {
 157     my $self  = shift;
 158     my $dirty = @_ ? shift : 'default_opts';
 159     foreach (keys %{$self->{$dirty}}) {
 160         defined $self->{$dirty}->{$_} or next;
 161         $self->{$dirty . '_clean'}->{clean($_)} = $self->{$dirty}->{$_};
 162     }
 163 }
 164
 165 sub new {
 166     my $class = shift;
 167     my $self  = _default_self;
 168     bless ($self, $class);
 169     $self->init(@_);
 170     $debug and print "new ",  __PACKAGE__, " obj: ", Dumper($self);
 171     return $self;
 172 }
 173
 174 sub add_and_purge {
 175     my $self = shift;
 176     my $key  = shift;
 177     my $val  = shift;
 178     my $clean = clean($key);
 179     my @others = grep {/$clean/ and $_ ne $key} keys %{$self->{default_opts}};
 180     unless (@others) {
 181         $debug and print "unique key $key => $val\n";
 182         $self->{default_opts}->{$key} = $val;   # no purge, just add
 183         return;
 184     }
 185     foreach (@others) {
 186         $debug and print "variant of $key => $_\n";
 187         if ($key ne $clean) {    # if it is a dirtier key, delete the clean one
 188             delete $self->{default_opts}->{$_};
 189             $self->{default_opts}->{$key} = $val;
 190         } else {                 # else update the dirty one
 191             $self->{default_opts}->{$_} = $val;
 192         }
 193     }
 194 }
 195
 196 sub init {      # not INIT
 197     my $self = shift;
 198     my $opts  = @_ ? shift : {};    # user can specify more default options to constructor
 199 # TODO: check $opts is hashref; then check verbose/debug first.  maybe check negations e.g. "no-verbose" ?
 200     @extra_opts = keys %$opts;
 201     foreach (@extra_opts) {        # add any other keys w/ default values
 202         $debug and print "init() adding option $_, default value: $opts->{$_}\n";
 203         $self->add_and_purge($_, $opts->{$_});
 204     }
 205     $self->clean_mirror;
 206     return $self;
 207 }
 208
 209 sub usage {
 210     # my $self = shift;
 211     return "\nUSAGE: $0 [OPTIONS]";
 212 }
 213
 214 sub options_help {
 215     my $self = shift;
 216     my $chunk = @_ ? shift : '';
 217     return <<HELP
 218
 219 COMMON OPTIONS:
 220     --osrf-config </path/to/config_file>  Default: $self->{default_opts_clean}->{'osrf-config'}
 221                  Specify OpenSRF core config file.
 222
 223     --lock-file </path/to/file_name>      Default: $self->{default_opts_clean}->{'lock-file'}
 224                  Specify lock file.
 225
 226 HELP
 227     . $chunk . <<HELP;
 228     --debug      Print server responses to STDOUT for debugging
 229     --verbose    Set verbosity
 230     --help       Show this help message
 231 HELP
 232 }
 233
 234 sub help {
 235     my $self = shift;
 236     return $self->usage() . "\n" . $self->options_help(@_) . $self->example();
 237 }
 238
 239 sub example {
 240     return "\n\nEXAMPLES:\n\n    $0 --osrf-config /my/other/opensrf_core.xml\n";
 241 }
 242
 243 # the proper order is: MyGetOptions, bootstrap, session.
 244 # But the latter subs will check to see if they need to call the preceeding one(s).
 245
 246 sub session {
 247     my $self = shift or return;
 248     $self->{bootstrapped} or $self->bootstrap();
 249     @_ or croak "session() called without required argument (app_name, e.g. 'open-ils.acq')";
 250     return ($self->{session} ||= OpenSRF::AppSession->create(@_));
 251 }
 252
 253 sub bootstrap {
 254     my $self = shift or return;
 255     if ($self->{auto_get_options_4_bootstrap} and not $self->{got_options}) {
 256         $debug and print "Automatically calling MyGetOptions before bootstrap\n";
 257         $self->MyGetOptions();
 258     }
 259     try {
 260         $debug and print "bootstrap lock-file  : ", $self->first_defined('lock-file'), "\n";
 261         $debug and print "bootstrap osrf-config: ", $self->first_defined('osrf-config'), "\n";
 262         OpenSRF::System->bootstrap_client(config_file => $self->first_defined('osrf-config'));
 263         Fieldmapper->import(IDL => OpenSRF::Utils::SettingsClient->new->config_value("IDL"));
 264         $self->{bootstrapped} = 1;
 265     } otherwise {
 266         $self->{bootstrapped} = 0;
 267         warn shift;
 268     };
 269 }
 270
 271 1;