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 OpenSRF::Utils::JSON;
  10 use Data::Dumper;
  11 use OpenSRF::System;
  12 use OpenSRF::AppSession;
  13 use OpenSRF::EX qw(:try);
  14 use Time::HiRes qw/time/;
  15 use Digest::MD5 qw(md5_hex);
  16 use OpenILS::Utils::Fieldmapper;
  17 use OpenILS::Application::AppUtils;
  18 use OpenSRF::Utils::SettingsClient;
  19 use OpenSRF::Utils::Logger qw/:logger/;
  20
  21
  22 # Some useful objects
  23 our $apputils = "OpenILS::Application::AppUtils";
  24 our $memcache;
  25 our $user;
  26 our $authtoken;
  27 our $authtime;
  28
  29 # Some constants for our services
  30 our $AUTH               = 'open-ils.auth';
  31 our $STORAGE    = 'open-ils.storage';
  32 our $SEARCH             = 'open-ils.search';
  33 our $CIRC               = 'open-ils.circ';
  34 our $CAT                        = 'open-ils.cat';
  35 our $MATH               = 'opensrf.math';
  36 our $SETTINGS   = 'opensrf.settings';
  37 our $ACTOR              = 'open-ils.actor';
  38
  39 sub AUTH                { return $AUTH; }
  40 sub STORAGE { return $STORAGE; }
  41 sub SEARCH      { return $SEARCH; }
  42 sub CIRC                { return $CIRC; }
  43 sub CAT         { return $CAT; }
  44 sub MATH                { return $MATH; }
  45 sub SETTINGS { return $SETTINGS; }
  46 sub ACTOR       { return $ACTOR; }
  47
  48
  49 #----------------------------------------------------------------
  50 # Exit a script
  51 #----------------------------------------------------------------
  52 sub err {
  53         my ($pkg, $file, $line, $sub)  = _caller();
  54         no warnings;
  55         die "Script halted with error ".
  56                 "($pkg : $file : $line : $sub):\n" . shift() . "\n";
  57 }
  58
  59 #----------------------------------------------------------------
  60 # Print with newline
  61 #----------------------------------------------------------------
  62 sub printl { print "@_\n"; }
  63
  64 #----------------------------------------------------------------
  65 # Print with Data::Dumper
  66 #----------------------------------------------------------------
  67 sub debug { printl(Dumper(@_)); }
  68
  69
  70 #----------------------------------------------------------------
  71 # This is not the function you're looking for
  72 #----------------------------------------------------------------
  73 sub _caller {
  74         my ($pkg, $file, $line, $sub)  = caller(2);
  75         if(!$line) {
  76                 ($pkg, $file, $line)  = caller(1);
  77                 $sub = "";
  78         }
  79         return ($pkg, $file, $line, $sub);
  80 }
  81
  82
  83 #----------------------------------------------------------------
  84 # Connect to the servers
  85 #----------------------------------------------------------------
  86 sub osrf_connect {
  87         my $config = shift;
  88         err("Bootstrap config required") unless $config;
  89         OpenSRF::System->bootstrap_client( config_file => $config );
  90         Fieldmapper->import(IDL =>
  91                 OpenSRF::Utils::SettingsClient->new->config_value("IDL"));
  92         reset_cstore();
  93 }
  94
  95 sub reset_cstore {
  96         my ($key) = grep { $_ =~ /OpenILS.*CStoreEditor/o } keys %INC;
  97         return unless $key;
  98         delete $INC{$key};
  99         my $h = $SIG{__WARN__};
 100         $SIG{__WARN__} = sub {};
 101         require OpenILS::Utils::CStoreEditor;
 102         $SIG{__WARN__} = $h;
 103 }
 104
 105
 106 #----------------------------------------------------------------
 107 # Get a handle for the memcache object
 108 #----------------------------------------------------------------
 109 sub osrf_cache {
 110         eval 'use OpenSRF::Utils::Cache;';
 111         $memcache = OpenSRF::Utils::Cache->new('global') unless $memcache;
 112         return $memcache;
 113 }
 114
 115 #----------------------------------------------------------------
 116 # Is the given object an OILS event?
 117 #----------------------------------------------------------------
 118 sub oils_is_event {
 119         my $e = shift;
 120         if( $e and ref($e) eq 'HASH' ) {
 121                 return 1 if defined($e->{ilsevent});
 122         }
 123         return 0;
 124 }
 125
 126 sub oils_event_equals {
 127         my( $e, $name ) = @_;
 128         return 1 if (oils_is_event($e) and ($e->{textcode} eq $name));
 129         return 0;
 130 }
 131
 132 #----------------------------------------------------------------
 133 # If the given object is an event, this prints the event info
 134 # and exits the script
 135 #----------------------------------------------------------------
 136 sub oils_event_die {
 137         my $evt = shift;
 138         my ($pkg, $file, $line, $sub)  = _caller();
 139         if(oils_is_event($evt)) {
 140                 if($evt->{ilsevent}) {
 141                         printl("\nReceived Event($pkg : $file : $line : $sub): \n" . Dumper($evt));
 142                         exit 1;
 143                 }
 144         }
 145 }
 146
 147
 148 #----------------------------------------------------------------
 149 # Login to the auth server and set the global $authtoken var
 150 #----------------------------------------------------------------
 151 sub oils_login {
 152         my( $username, $password, $type ) = @_;
 153
 154         $type |= "staff";
 155
 156         my $seed = $apputils->simplereq( $AUTH,
 157                 'open-ils.auth.authenticate.init', $username );
 158         err("No auth seed") unless $seed;
 159
 160         my $response = $apputils->simplereq( $AUTH,
 161                 'open-ils.auth.authenticate.complete',
 162                 {       username => $username,
 163                         password => md5_hex($seed . md5_hex($password)),
 164                         type => $type });
 165
 166         err("No auth response returned on login") unless $response;
 167
 168         oils_event_die($response);
 169
 170         $authtime = $response->{payload}->{authtime};
 171         $authtoken = $response->{payload}->{authtoken};
 172         return $authtoken;
 173 }
 174
 175
 176 #----------------------------------------------------------------
 177 # Destroys the login session on the server
 178 #----------------------------------------------------------------
 179 sub oils_logout {
 180         $apputils->simplereq(
 181                 'open-ils.auth',
 182                 'open-ils.auth.session.delete', $authtoken );
 183 }
 184
 185 #----------------------------------------------------------------
 186 # Fetches the user object and sets the global $user var
 187 #----------------------------------------------------------------
 188 sub oils_fetch_session {
 189         my $ses = shift;
 190         my $resp = $apputils->simplereq( $AUTH,
 191                 'open-ils.auth.session.retrieve', $ses, 'staff' );
 192         oils_event_die($resp);
 193         return $user = $resp;
 194 }
 195
 196 #----------------------------------------------------------------
 197 # var $response = simplereq( $service, $method, @params );
 198 #----------------------------------------------------------------
 199 sub simplereq { return $apputils->simplereq(@_); }
 200 sub osrf_request { return $apputils->simplereq(@_); }
 201
 202 1;