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