User level exceptions. the exception messages are stored in a
[Evergreen.git] / Open-ILS / src / perlmods / OpenILS / EX.pm
1 package OpenILS::EX;
2 use strict; use warnings;
3 use Template qw(:template);
4 use OpenSRF::Utils::SettingsClient;
5 use OpenILS::Utils::Fieldmapper;
6
7 # ----------------------------------------------------------------------------------
8 # These exceptions are not thrown.  They are returned as request result objects
9 # ----------------------------------------------------------------------------------
10
11 my %ex_types = (
12         UNKNOWN                         => 1,
13         SEARCH_TOO_LARGE        => 2,
14 );
15
16 use overload ( '""' => sub { $_[0]->ex()->err_msg(); } );
17
18 sub new {
19
20         my($class, $type) = @_;
21         $class = ref($class) || $class;
22
23         my $self = {};
24         bless($self, $class);
25
26         $self->{ex} = new Fieldmapper::ex;
27         $self->{ex}->type($ex_types{$type});
28         $self->{ex}->err_msg($self->run());
29         warn "type is $type\n";
30
31         return $self;
32 }
33
34
35 sub ex { return shift()->{ex}; }
36
37 sub run {
38
39         my $self = shift;
40
41         my $result;
42         my $conf = OpenSRF::Utils::SettingsClient->new;
43
44         my $script = $conf->config_value("ex_script");
45
46         my $template = Template->new(
47                 { 
48                         ABSOLUTE                => 1, 
49                         OUTPUT          => \$result,
50                         PRE_CHOMP       => 1,
51                         POST_CHOMP      => 1,
52                 }
53         );
54
55         my $status = $template->process($script, 
56                         { ex_types => \%ex_types, type => $self->{ex}->type });
57
58         if(!$status) {
59                 return "Unable to process exception script.  No meaningful data to return..." .
60                         " Error is:\n" . $template->error() . "\n";
61         }
62
63         $result =~ s/^\s*//og;
64         warn " -|-|-|- Exception result [$result]\n";
65
66         return $result;
67 }
68
69
70
71
72
73