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;
  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 sub MyGetOptions {
  99     my $self = shift;
 100     $self->{got_options} and carp "MyGetOptions called after options were already retrieved previously";
 101     my @keys = sort {is_clean($b) <=> is_clean($a)} keys %{$self->{default_opts}};
 102     $debug and print "KEYS: ", join(", ", @keys), "\n";
 103     foreach (@keys) {
 104         my $clean = clean($_);
 105         $self->{opts_clean}->{$clean} = $self->{default_opts_clean}->{$clean};  # prepopulate default
 106         $self->{opts}->{$_} = \$self->{opts_clean}->{$clean};                   # pointer for GetOptions
 107     }
 108     GetOptions($self->{opts}, @keys);
 109     foreach (@keys) {
 110         delete $self->{opts}->{$_};     # now remove the mappings from (1) so we just have (2)
 111     }
 112     $self->clean_mirror('opts');        # populate clean_opts w/ cleaned versions of (2), plus everything else
 113
 114     print $self->help() and exit if $self->{opts_clean}->{help};
 115     $debug and $OpenILS::Utils::Lockfile::debug = $debug;
 116
 117     unless ($self->{opts_clean}->{nolockfile} || $self->{default_opts_clean}->{nolockfile}) {
 118         $self->{lockfile_obj} = OpenILS::Utils::Lockfile->new($self->first_defined('lock-file'));
 119         $self->{lockfile}     = $self->{lockfile_obj}->filename;
 120     }
 121     $self->{got_options}++;
 122     return $self;
 123 }
 124
 125 sub first_defined {
 126     my $self = shift;
 127     my $key  = shift or return;
 128     foreach (qw(opts_clean opts default_opts_clean default_opts)) {
 129         defined $self->{$_}->{$key} and return $self->{$_}->{$key};
 130     }
 131     return;
 132 }
 133
 134 sub clean_mirror {
 135     my $self  = shift;
 136     my $dirty = @_ ? shift : 'default_opts';
 137     foreach (keys %{$self->{$dirty}}) {
 138         defined $self->{$dirty}->{$_} or next;
 139         $self->{$dirty . '_clean'}->{clean($_)} = $self->{$dirty}->{$_};
 140     }
 141 }
 142
 143 sub new {
 144     my $class = shift;
 145     my $self  = _default_self;
 146     bless ($self, $class);
 147     $self->init(@_);
 148     $debug and print "new ",  __PACKAGE__, " obj: ", Dumper($self);
 149     return $self;
 150 }
 151
 152 sub add_and_purge {
 153     my $self = shift;
 154     my $key  = shift;
 155     my $val  = shift;
 156     my $clean = clean($key);
 157     my @others = grep {/$clean/ and $_ ne $key} keys %{$self->{default_opts}};
 158     foreach (@others) {
 159         $debug and print "variant of $key => $_\n";
 160         if ($key ne $clean) {    # if it is a dirtier key, delete the clean one
 161             delete $self->{default_opts}->{$_};
 162             $self->{default_opts}->{$key} = $val;
 163         } else {                 # else update the dirty one
 164             $self->{default_opts}->{$_} = $val;
 165         }
 166     }
 167 }
 168
 169 sub init {      # not INIT
 170     my $self = shift;
 171     my $opts  = @_ ? shift : {};    # user can specify more default options to constructor
 172 # TODO: check $opts is hashref; then check verbose/debug first.  maybe check negations e.g. "no-verbose" ?
 173     @extra_opts = keys %$opts;
 174     foreach (@extra_opts) {        # add any other keys w/ default values
 175         $self->add_and_purge($_, $opts->{$_});
 176     }
 177     $self->clean_mirror;
 178     return $self;
 179 }
 180
 181 sub usage {
 182     my $self = shift;
 183     return "\nUSAGE: $0 [OPTIONS]";
 184 }
 185
 186 sub options_help {
 187     my $self = shift;
 188     my $chunk = @_ ? shift : '';
 189     return <<HELP
 190
 191 OPTIONS:
 192     --osrf-config </path/to/config_file>  Default: $self->{default_opts_clean}->{'osrf-config'}
 193                  Specify OpenSRF core config file.
 194
 195     --lock-file </path/to/file_name>      Default: $self->{default_opts_clean}->{'lock-file'}
 196                  Specify lock file.
 197
 198 HELP
 199     . $chunk . <<HELP;
 200     --debug      Print server responses to STDOUT for debugging
 201     --verbose    Set verbosity
 202     --help       Show this help message
 203 HELP
 204 }
 205
 206 sub help {
 207     my $self = shift;
 208     return $self->usage() . "\n" . $self->options_help(@_) . $self->example();
 209 }
 210
 211 sub example {
 212     return "\n\nEXAMPLES:\n\n    $0 --osrf-config /my/other/opensrf_core.xml\n";
 213 }
 214
 215 # the proper order is: MyGetOptions, bootstrap, session.
 216 # But the latter subs will check to see if they need to call the preceeding one(s).
 217
 218 sub session {
 219     my $self = shift or return;
 220     $self->{bootstrapped} or $self->bootstrap();
 221     @_ or croak "session() called without required argument (app_name, e.g. 'open-ils.acq')";
 222     return ($self->{session} ||= OpenSRF::AppSession->create(@_));
 223 }
 224
 225 sub bootstrap {
 226     my $self = shift or return;
 227     if ($self->{auto_get_options_4_bootstrap} and not $self->{got_options}) {
 228         $debug and print "Automatically calling MyGetOptions before bootstrap\n";
 229         $self->MyGetOptions();
 230     }
 231     try {
 232         $debug and print "bootstrap lock-file  : ", $self->first_defined('lock-file'), "\n";
 233         $debug and print "bootstrap osrf-config: ", $self->first_defined('osrf-config'), "\n";
 234         OpenSRF::System->bootstrap_client(config_file => $self->first_defined('osrf-config'));
 235         Fieldmapper->import(IDL => OpenSRF::Utils::SettingsClient->new->config_value("IDL"));
 236         $self->{bootstrapped} = 1;
 237     } otherwise {
 238         $self->{bootstrapped} = 0;
 239         warn shift;
 240     };
 241 }
 242
 243 1;