first round of a circ script tester, fixed some typos
[working/Evergreen.git] / Open-ILS / src / support-scripts / test-scripts / circ_rules.pl
1 #/usr/bin/perl
2 use strict; use warnings;
3 use lib q|../../../perlmods/|;
4 use OpenILS::Utils::ScriptRunner;
5 require '../oils_header.pl';
6 use vars qw/ $user $authtoken $apputils /;
7
8
9 # ---------------------------------------------------------------------
10 # SCRIPT VARS
11 # ----------------------------------------------------------------------
12 my $patronid                                    = 4;
13 my $copyid                                              = 8000107;
14 my $patron_items_out                    = 11;
15 my $patron_overdue_count        = 11;
16 my $patron_fines                                = 20;
17
18 # these are not currently tested in the scripts
19 my $is_renewal                                  = 0;
20 my $is_non_cat                                  = 0;
21 my $is_hold                                             = 0;
22 my $non_cat_type                                = 1;
23 # ---------------------------------------------------------------------
24
25
26
27
28 my $bsconfig = shift;
29 my $script = shift;
30 my $path;
31
32 ($path, $script) = ($script =~ m#(/.*/)(.*)#);
33
34 osrf_connect($bsconfig);
35
36 my $evt                         = 'environment';
37 my $fatal_events        = 'result.fatalEvents';
38 my $info_events = 'result.infoEvents';
39 my $events                      = 'result.events';
40
41 my $runner = load_runner();
42 $runner->add_path($path);
43
44
45
46 # ---------------------------------------------------------------------
47 # Run the script
48 # ---------------------------------------------------------------------
49 print "\nLoading script: $script\n";
50 print "\n" . '-'x70 . "\n";
51
52 $runner->load($script);
53 $runner->run or die "Script died: $@";
54
55
56
57 # ---------------------------------------------------------------------
58 # Print out any events that occurred
59 # ---------------------------------------------------------------------
60 print "\n" . '-'x70 . "\n";
61
62 show_events( 'events', $runner->retrieve($events));
63 show_events( 'fatal_events', $runner->retrieve($fatal_events));
64 show_events( 'info_events', $runner->retrieve($info_events));
65
66
67 sub show_events {
68         my $t = shift;
69         my $e = shift;
70         my @e;
71
72         if($e and @e = split(/,/, $e)) {
73                 print "$t : $_\n" for @e;
74
75         } else {
76                 print "No $t occurred\n";
77         } 
78 }
79
80 print "\n";
81
82
83
84 # ---------------------------------------------------------------------
85 # Fetch data and build the script runner
86 # ---------------------------------------------------------------------
87
88 sub load_runner {
89
90         my( $patron, $copy, $org, $e );
91
92
93         ($patron, $e) = $apputils->fetch_user($patronid);
94         oils_event_die($e);
95
96         ($org, $e) = $apputils->fetch_org_unit($patron->home_ou);       
97         oils_event_die($e);
98
99         $patron->home_ou($org);
100
101         ($copy, $e) = $apputils->fetch_copy($copyid);
102         oils_event_die($e);
103
104         my $groups = $apputils->fetch_permission_group_tree();
105         $patron->profile( _get_patron_profile($patron, $groups));
106
107         my $cp_stats = $apputils->fetch_copy_statuses();
108         $copy->status( _get_copy_status($copy, $cp_stats) );
109
110         my $runner = OpenILS::Utils::ScriptRunner->new;
111         
112         $runner->insert( "$evt.patronOverdueCount", $patron_overdue_count );
113         $runner->insert( "$evt.patronItemsOut", $patron_items_out );
114         $runner->insert( "$evt.patronFines", $patron_fines );
115         $runner->insert( "$evt.isRenewal", $is_renewal );
116         $runner->insert( "$evt.isNonCat", $is_non_cat );
117         $runner->insert( "$evt.isHold", $is_hold );
118         $runner->insert( "$evt.nonCatType", $non_cat_type );
119         $runner->insert( "$evt.patron", $patron );
120         $runner->insert( "$evt.copy", $copy );
121         $runner->insert( $fatal_events, [] );
122         $runner->insert( $info_events, [] );
123         $runner->insert( $events, [] );
124
125         # ---------------------------------------------------------------------
126         # Override the default log functions for convenience
127         # ---------------------------------------------------------------------
128         $runner->insert(log_activity    => sub { print "@_\n"; return 1;} );
129         $runner->insert(log_error               => sub { print "@_\n"; return 1;} );
130         $runner->insert(log_warn                => sub { print "@_\n"; return 1;} );
131         $runner->insert(log_info                => sub { print "@_\n"; return 1;} );
132         $runner->insert(log_debug               => sub { print "@_\n"; return 1;} );
133         $runner->insert(log_internal    => sub { print "@_\n"; return 1;} );
134         
135         return $runner;
136 }
137
138
139 # ---------------------------------------------------------------------
140 # Utility code for fleshing objects
141 # ---------------------------------------------------------------------
142 sub _get_patron_profile { 
143         my( $patron, $group_tree ) = @_;
144         return $group_tree if ($group_tree->id eq $patron->profile);
145         return undef unless ($group_tree->children);
146         for my $child (@{$group_tree->children}) {
147                 my $ret = _get_patron_profile( $patron, $child );
148                 return $ret if $ret;
149         }
150         return undef;
151 }
152
153
154 sub _get_copy_status {
155         my( $copy, $cstatus ) = @_;
156         my $s = undef;
157         for my $status (@$cstatus) {
158                 $s = $status if( $status->id eq $copy->status )
159         }
160         return $s;
161 }
162
163
164