Open-ILS/src/support-scripts/offline-blocked-list.pl

   1 #!/usr/bin/perl
   2 #
   3
   4 use strict; use warnings;
   5
   6 use Getopt::Long;
   7
   8 use OpenSRF::Utils::JSON;     # for the oils_requestor approach
   9 use IPC::Open2 qw/open2/;     # for the oils_requestor approach
  10 use Net::Domain qw/hostfqdn/; # for the oils_requestor approach
  11
  12 # use OpenSRF::EX qw(:try);   # for traditional approach
  13 use OpenSRF::System;        # for traditional approach
  14 use OpenSRF::AppSession;    # for traditional approach
  15
  16 ### USAGE
  17
  18 sub usage {
  19     my $defhost = hostfqdn();
  20     return <<END_OF_USAGE
  21
  22 $0
  23
  24 Generate a file of blocked barcodes for offline use.  There are two styles of
  25 invocation, old and new (using oils_requestor).  See WARNING.
  26
  27 By default, all known blocked barcodes are output.  Override with --barcodes option.
  28
  29 OPTIONS:
  30
  31 --oldstyle  Use traditional OpenSRF calls       default: OFF.
  32 --verbose   give feedback on STDERR, including number of barcodes fetched
  33 --help      print this message
  34
  35 --config   =[file] core config file             default: /openils/conf/opensrf_core.xml
  36 --requestor=[/path/to/requstor]                 default: /openils/bin/oils_requestor
  37 --hostname =[my.fqdn.com]                       default: hostfqdn()
  38                                                 (Only used by new style.)
  39      May be necessary if hostfqdn does not match router configs.
  40      Currently your hostfqdn is '$defhost'.
  41
  42 --barcodes [key=eg_code]                        default: ALL
  43      Specify what kind of barcodes to fetch and how to tag them in the output.
  44      The key is the (one letter) tag used in the offline file,
  45      and the eg_code is the component of the SRF call that targets the barcodes
  46      (like "lost").  NOTE: This option can be specified multiple times.
  47
  48
  49 EXAMPLES:
  50
  51 # Use the old style with a custom config
  52 $0 --config /openils/conf/test_core.xml --oldstyle
  53
  54 # Append just lost and barred barcodes to file, showing feedback on STDERR
  55 $0 --verbose --barcodes L=lost --barcodes B=barred >>file
  56
  57 WARNING:
  58 The new style offers performance benefits but seems to lose one line of data per call.
  59
  60 END_OF_USAGE
  61 }
  62
  63 ### DEFAULTS
  64
  65 my $config    = '/openils/conf/opensrf_core.xml';
  66 my $oils_reqr = '/openils/bin/oils_requestor';
  67 my $context   = 'opensrf';
  68 my $hostname  = hostfqdn();
  69 my $help      = 0;
  70 my $verbose   = 0;
  71 my $approach  = 0;
  72 my %types     = ();
  73
  74 GetOptions(
  75     "barcodes=s" => \%types,
  76       "config:s"   => \$config,
  77       "oldstyle" => \$approach,
  78       "hostname:s" => \$hostname,
  79      "requestor:s" => \$oils_reqr,
  80       "verbose"  => \$verbose,
  81        "help"    => \$help,
  82 );
  83
  84 ### SANITY CHECK
  85
  86 print usage() and exit if $help;
  87
  88 (-r $config) or die "Cannot read config file\n";
  89
  90 %types or %types = (    # If you don't specify, you get'm all.
  91     L => 'lost',
  92     E => 'expired',     # Possibly too many, making the file too large for download
  93     B => 'barred',
  94     D => 'penalized',
  95 );
  96
  97 my %counts = ();
  98 foreach (keys %types) {
  99     $counts{$_} = 0;    # initialize count
 100 }
 101
 102 ### FEEDBACK
 103
 104 if ($verbose) {
 105     print STDERR "verbose feedback is ON\n";
 106     print STDERR "hostname: $hostname\n";
 107     print STDERR "barcodes types:\n";
 108     foreach (sort keys %types) {
 109         print STDERR " $_ ==> $types{$_}\n";
 110     }
 111     print STDERR "Using the ", ($approach ? 'traditional' : 'new oils'), " approach\n";
 112 }
 113
 114 ### Engine of the new style piped approach
 115 ### Note, this appears to LOSE DATA, specifically one barcode value from each call.
 116
 117 sub runmethod {
 118     my $method  = shift;
 119     my $key     = shift;
 120     my $command = "echo \"open-ils.storage $method\" | $oils_reqr -f $config -c $context -h $hostname";
 121     $verbose and print STDERR "\nCOMMAND:\n-> $command\n";
 122
 123     my ($child_stdout, $child_stdin);
 124     my $pid = open2($child_stdout, $child_stdin, $command);
 125     for my $barcode (<$child_stdout>) {
 126         next if $barcode =~ /^oils/o; # hack to chop out the oils_requestor prompt
 127         next if $barcode =~ /^Connected to OpenSRF/o;
 128         chomp $barcode;
 129         $barcode = OpenSRF::Utils::JSON->JSON2perl($barcode);
 130         print "$barcode $key\n" if $barcode;
 131         $counts{$key}++;
 132     }
 133     close($child_stdout);
 134     close($child_stdin);
 135     waitpid($pid, 0); # don't leave any zombies (see ipc::open2)
 136 }
 137
 138 ### MAIN
 139
 140 if (! $approach) {
 141     # ------------------------------------------------------------
 142     # This sends the method calls to storage via oils_requestor,
 143     # which is able to process the results much faster
 144     # Make this the default for now.
 145     # ------------------------------------------------------------
 146
 147     foreach my $key (keys %types) {
 148         runmethod('open-ils.storage.actor.user.' . $types{$key} . '_barcodes', $key);
 149     }
 150
 151 } else {
 152     # ------------------------------------------------------------
 153     # Uses the traditional opensrf Perl API approach
 154     # ------------------------------------------------------------
 155
 156     OpenSRF::System->bootstrap_client( config_file => $config );
 157
 158     my $ses = OpenSRF::AppSession->connect( 'open-ils.storage' );
 159
 160     foreach my $key (keys %types) {
 161         my $req = $ses->request( 'open-ils.storage.actor.user.' . $types{$key} . '_barcodes' );
 162         while (my $resp = $req->recv) {
 163             print $resp->content, " $key\n";
 164             $counts{$key}++;
 165         }
 166         $req->finish;
 167     }
 168
 169     $ses->disconnect;
 170     $ses->finish;
 171 }
 172
 173 if ($verbose) {
 174     print STDERR "\nBarcodes retrieved:\n";
 175     foreach (sort keys %types) {
 176         printf STDERR " %s ==> %9s ==> %d\n", $_, $types{$_}, $counts{$_};
 177     }
 178     print STDERR "\ndone\n";
 179 }
 180