Open-ILS/src/support-scripts/oils_header.pl

   1 #!/usr/bin/perl
   2
   3 #----------------------------------------------------------------
   4 # Generic header for tesing OpenSRF methods
   5 #----------------------------------------------------------------
   6
   7 use strict;
   8 use warnings;
   9 use Data::Dumper;
  10 use OpenSRF::System;
  11 use OpenSRF::AppSession;
  12 use OpenSRF::EX qw(:try);
  13 use Time::HiRes qw/time/;
  14 use Digest::MD5 qw(md5_hex);
  15 use OpenILS::Utils::Fieldmapper;
  16 use OpenILS::Application::AppUtils;
  17 use OpenSRF::Utils::Logger qw/:logger/;
  18
  19
  20 # Some useful objects
  21 our $apputils = "OpenILS::Application::AppUtils";
  22 our $memcache;
  23 our $user;
  24 our $authtoken;
  25 our $authtime;
  26
  27 # Some constants for our services
  28 our $AUTH               = 'open-ils.auth';
  29 our $STORAGE    = 'open-ils.storage';
  30 our $SEARCH             = 'open-ils.search';
  31 our $CIRC               = 'open-ils.circ';
  32 our $CAT                        = 'open-ils.cat';
  33 our $MATH               = 'opensrf.math';
  34 our $SETTINGS   = 'opensrf.settings';
  35 our $ACTOR              = 'open-ils.actor';
  36
  37
  38 #----------------------------------------------------------------
  39 # Exit a script
  40 #----------------------------------------------------------------
  41 sub err {
  42         my ($pkg, $file, $line, $sub)  = _caller();
  43         die "Script halted with error ".
  44                 "($pkg : $file : $line : $sub):\n" . shift() . "\n";
  45 }
  46
  47 #----------------------------------------------------------------
  48 # Print with newline
  49 #----------------------------------------------------------------
  50 sub printl { print "@_\n"; }
  51
  52 #----------------------------------------------------------------
  53 # Print with Data::Dumper
  54 #----------------------------------------------------------------
  55 sub debug { printl(Dumper(@_)); }
  56
  57
  58 #----------------------------------------------------------------
  59 # This is not the function you're looking for
  60 #----------------------------------------------------------------
  61 sub _caller {
  62         my ($pkg, $file, $line, $sub)  = caller(2);
  63         if(!$line) {
  64                 ($pkg, $file, $line)  = caller(1);
  65                 $sub = "";
  66         }
  67         return ($pkg, $file, $line, $sub);
  68 }
  69
  70
  71 #----------------------------------------------------------------
  72 # Connect to the servers
  73 #----------------------------------------------------------------
  74 sub osrf_connect {
  75         my $config = shift;
  76         err("Bootstrap config required") unless $config;
  77         OpenSRF::System->bootstrap_client( config_file => $config );
  78 }
  79
  80 #----------------------------------------------------------------
  81 # Get a handle for the memcache object
  82 #----------------------------------------------------------------
  83 sub osrf_cache {
  84         eval 'use OpenSRF::Utils::Cache;';
  85         $memcache = OpenSRF::Utils::Cache->new('global') unless $memcache;
  86         return $memcache;
  87 }
  88
  89 #----------------------------------------------------------------
  90 # Is the given object an OILS event?
  91 #----------------------------------------------------------------
  92 sub oils_is_event {
  93         my $e = shift;
  94         if( $e and ref($e) eq 'HASH' ) {
  95                 return 1 if defined($e->{ilsevent});
  96         }
  97         return 0;
  98 }
  99
 100 #----------------------------------------------------------------
 101 # If the given object is an event, this prints the event info
 102 # and exits the script
 103 #----------------------------------------------------------------
 104 sub oils_event_die {
 105         my $evt = shift;
 106         my ($pkg, $file, $line, $sub)  = _caller();
 107         if(oils_is_event($evt)) {
 108                 if($evt->{ilsevent}) {
 109                         printl("\nReceived Event($pkg : $file : $line : $sub): \n" . Dumper($evt));
 110                         exit 1;
 111                 }
 112         }
 113 }
 114
 115
 116 #----------------------------------------------------------------
 117 # Login to the auth server and set the global $authtoken var
 118 #----------------------------------------------------------------
 119 sub oils_login {
 120         my( $username, $password ) = @_;
 121
 122         my $seed = $apputils->simplereq( $AUTH,
 123                 'open-ils.auth.authenticate.init', $username );
 124         err("No auth seed") unless $seed;
 125
 126         my $response = $apputils->simplereq( $AUTH,
 127                 'open-ils.auth.authenticate.complete', $username,
 128                 md5_hex($seed . md5_hex($password)));
 129         err("No auth response returned on login") unless $response;
 130
 131         oils_event_die($response);
 132
 133         $authtime = $response->{payload}->{authtime};
 134         $authtoken = $response->{payload}->{authtoken};
 135         return $authtoken;
 136 }
 137
 138 #----------------------------------------------------------------
 139 # Fetches the user object and sets the global $user var
 140 #----------------------------------------------------------------
 141 sub oils_fetch_session {
 142         my $ses = shift;
 143         my $resp = $apputils->simplereq( $AUTH,
 144                 'open-ils.auth.session.retrieve', $ses, 'staff' );
 145         oils_event_die($resp);
 146         return $user = $resp;
 147 }
 148
 149 #----------------------------------------------------------------
 150 # var $response = simplereq( $service, $method, @params );
 151 #----------------------------------------------------------------
 152 sub simplereq { return $apputils->simplereq(@_); }
 153
 154
 155 1;