Bug 20996: (follow-up) Fix merge problems
[srvgit] / Koha / Illrequest.pm
index 2b34b88..0b4d71c 100644 (file)
@@ -18,17 +18,20 @@ package Koha::Illrequest;
 # Koha; if not, write to the Free Software Foundation, Inc., 51 Franklin
 # Street, Fifth Floor, Boston, MA 02110-1301 USA.
 
 # Koha; if not, write to the Free Software Foundation, Inc., 51 Franklin
 # Street, Fifth Floor, Boston, MA 02110-1301 USA.
 
-use Modern::Perl;
+use Modern::Perl;
 
 use Clone 'clone';
 
 use Clone 'clone';
-use File::Basename qw/basename/;
+use File::Basename qw( basename );
+use Encode qw( encode );
+use Mail::Sendmail;
+use Try::Tiny;
+
 use Koha::Database;
 use Koha::Email;
 use Koha::Database;
 use Koha::Email;
-use Koha::Illrequest;
+use Koha::Exceptions::Ill;
+use Koha::Illcomments;
 use Koha::Illrequestattributes;
 use Koha::Patron;
 use Koha::Illrequestattributes;
 use Koha::Patron;
-use Mail::Sendmail;
-use Try::Tiny;
 
 use base qw(Koha::Object);
 
 
 use base qw(Koha::Object);
 
@@ -59,6 +62,8 @@ TODO:
 
 All methods should return a hashref in the following format:
 
 
 All methods should return a hashref in the following format:
 
+=over
+
 =item * error
 
 This should be set to 1 if an error was encountered.
 =item * error
 
 This should be set to 1 if an error was encountered.
@@ -75,7 +80,7 @@ The message is a free text field that can be passed on to the end user.
 
 The value returned by the method.
 
 
 The value returned by the method.
 
-=over
+=back
 
 =head2 Interface Status Messages
 
 
 =head2 Interface Status Messages
 
@@ -100,8 +105,12 @@ the API.
 The interface's request method returned saying that the desired item is not
 available for request.
 
 The interface's request method returned saying that the desired item is not
 available for request.
 
+=back
+
 =head2 Class methods
 
 =head2 Class methods
 
+=head3 illrequestattributes
+
 =cut
 
 sub illrequestattributes {
 =cut
 
 sub illrequestattributes {
@@ -111,6 +120,21 @@ sub illrequestattributes {
     );
 }
 
     );
 }
 
+=head3 illcomments
+
+=cut
+
+sub illcomments {
+    my ( $self ) = @_;
+    return Koha::Illcomments->_new_from_dbic(
+        scalar $self->_result->illcomments
+    );
+}
+
+=head3 patron
+
+=cut
+
 sub patron {
     my ( $self ) = @_;
     return Koha::Patron->_new_from_dbic(
 sub patron {
     my ( $self ) = @_;
     return Koha::Patron->_new_from_dbic(
@@ -118,19 +142,32 @@ sub patron {
     );
 }
 
     );
 }
 
+=head3 load_backend
+
+Require "Base.pm" from the relevant ILL backend.
+
+=cut
+
 sub load_backend {
     my ( $self, $backend_id ) = @_;
 
     my @raw = qw/Koha Illbackends/; # Base Path
 
     my $backend_name = $backend_id || $self->backend;
 sub load_backend {
     my ( $self, $backend_id ) = @_;
 
     my @raw = qw/Koha Illbackends/; # Base Path
 
     my $backend_name = $backend_id || $self->backend;
-    $location = join "/", @raw, $backend_name, "Base.pm"; # File to load
-    $backend_class = join "::", @raw, $backend_name, "Base"; # Package name
+
+    unless ( defined $backend_name && $backend_name ne '' ) {
+        Koha::Exceptions::Ill::InvalidBackendId->throw(
+            "An invalid backend ID was requested ('')");
+    }
+
+    my $location = join "/", @raw, $backend_name, "Base.pm";    # File to load
+    my $backend_class = join "::", @raw, $backend_name, "Base"; # Package name
     require $location;
     $self->{_my_backend} = $backend_class->new({ config => $self->_config });
     return $self;
 }
 
     require $location;
     $self->{_my_backend} = $backend_class->new({ config => $self->_config });
     return $self;
 }
 
+
 =head3 _backend
 
     my $backend = $abstract->_backend($new_backend);
 =head3 _backend
 
     my $backend = $abstract->_backend($new_backend);
@@ -342,7 +379,7 @@ sub _status_graph_union {
     my $status_graph = clone($core_status_graph);
 
     foreach my $backend_status_key ( keys %{$backend_status_graph} ) {
     my $status_graph = clone($core_status_graph);
 
     foreach my $backend_status_key ( keys %{$backend_status_graph} ) {
-        $backend_status = $backend_status_graph->{$backend_status_key};
+        my $backend_status = $backend_status_graph->{$backend_status_key};
         # Add to new status graph
         $status_graph->{$backend_status_key} = $backend_status;
         # Update all core methods' next_actions.
         # Add to new status graph
         $status_graph->{$backend_status_key} = $backend_status;
         # Update all core methods' next_actions.
@@ -445,15 +482,24 @@ sub custom_capability {
     return 0;
 }
 
     return 0;
 }
 
+=head3 available_backends
+
+Return a list of available backends.
+
+=cut
+
 sub available_backends {
     my ( $self ) = @_;
 sub available_backends {
     my ( $self ) = @_;
-    my $backend_dir = $self->_config->backend_dir;
-    my @backends = ();
-    @backends = <$backend_dir/*> if ( $backend_dir );
-    @backends = map { basename($_) } @backends;
-    return \@backends;
+    my $backends = $self->_config->available_backends;
+    return $backends;
 }
 
 }
 
+=head3 available_actions
+
+Return a list of available actions.
+
+=cut
+
 sub available_actions {
     my ( $self ) = @_;
     my $current_action = $self->capabilities($self->status);
 sub available_actions {
     my ( $self ) = @_;
     my $current_action = $self->capabilities($self->status);
@@ -462,6 +508,12 @@ sub available_actions {
     return \@available_actions;
 }
 
     return \@available_actions;
 }
 
+=head3 mark_completed
+
+Mark a request as completed (status = COMP).
+
+=cut
+
 sub mark_completed {
     my ( $self ) = @_;
     $self->status('COMP')->store;
 sub mark_completed {
     my ( $self ) = @_;
     $self->status('COMP')->store;
@@ -475,12 +527,23 @@ sub mark_completed {
     };
 }
 
     };
 }
 
+=head2 backend_confirm
+
+Confirm a request. The backend handles setting of mandatory fields in the commit stage:
+
+=over
+
+=item * orderid
+
+=item * accessurl, cost (if available).
+
+=back
+
+=cut
+
 sub backend_confirm {
     my ( $self, $params ) = @_;
 
 sub backend_confirm {
     my ( $self, $params ) = @_;
 
-    # The backend handles setting of mandatory fields in the commit stage:
-    # - orderid
-    # - accessurl, cost (if available).
     my $response = $self->_backend->confirm({
             request    => $self,
             other      => $params,
     my $response = $self->_backend->confirm({
             request    => $self,
             other      => $params,
@@ -488,6 +551,10 @@ sub backend_confirm {
     return $self->expandTemplate($response);
 }
 
     return $self->expandTemplate($response);
 }
 
+=head3 backend_update_status
+
+=cut
+
 sub backend_update_status {
     my ( $self, $params ) = @_;
     return $self->expandTemplate($self->_backend->update_status($params));
 sub backend_update_status {
     my ( $self, $params ) = @_;
     return $self->expandTemplate($self->_backend->update_status($params));
@@ -545,22 +612,24 @@ sub backend_create {
     my ( $self, $params ) = @_;
 
     # Establish whether we need to do a generic copyright clearance.
     my ( $self, $params ) = @_;
 
     # Establish whether we need to do a generic copyright clearance.
-    if ( ( !$params->{stage} || $params->{stage} eq 'init' )
-             && C4::Context->preference("ILLModuleCopyrightClearance") ) {
-        return {
-            error   => 0,
-            status  => '',
-            message => '',
-            method  => 'create',
-            stage   => 'copyrightclearance',
-            value   => {
-                backend => $self->_backend->name
-            }
-        };
-    } elsif ( $params->{stage} eq 'copyrightclearance' ) {
-        $params->{stage} = 'init';
+    if ($params->{opac}) {
+        if ( ( !$params->{stage} || $params->{stage} eq 'init' )
+                && C4::Context->preference("ILLModuleCopyrightClearance") ) {
+            return {
+                error   => 0,
+                status  => '',
+                message => '',
+                method  => 'create',
+                stage   => 'copyrightclearance',
+                value   => {
+                    backend => $self->_backend->name
+                }
+            };
+        } elsif (     defined $params->{stage}
+                && $params->{stage} eq 'copyrightclearance' ) {
+            $params->{stage} = 'init';
+        }
     }
     }
-
     # First perform API action, then...
     my $args = {
         request => $self,
     # First perform API action, then...
     my $args = {
         request => $self,
@@ -636,16 +705,19 @@ sub getLimits {
     my ( $self, $params ) = @_;
     my $limits = $self->_config->getLimitRules($params->{type});
 
     my ( $self, $params ) = @_;
     my $limits = $self->_config->getLimitRules($params->{type});
 
-    return $limits->{$params->{value}}
-        || $limits->{default}
-        || { count => -1, method => 'active' };
+    if (     defined $params->{value}
+          && defined $limits->{$params->{value}} ) {
+            return $limits->{$params->{value}};
+    }
+    else {
+        return $limits->{default} || { count => -1, method => 'active' };
+    }
 }
 
 =head3 getPrefix
 
     my $prefix = $abstract->getPrefix( {
 }
 
 =head3 getPrefix
 
     my $prefix = $abstract->getPrefix( {
-        brw_cat => $brw_cat,
-        branch  => $branch_code,
+        branch  => $branch_code
     } );
 
 Return the ILL prefix as defined by our $params: either per borrower category,
     } );
 
 Return the ILL prefix as defined by our $params: either per borrower category,
@@ -655,15 +727,25 @@ per branch or the default.
 
 sub getPrefix {
     my ( $self, $params ) = @_;
 
 sub getPrefix {
     my ( $self, $params ) = @_;
-    my $brn_prefixes = $self->_config->getPrefixes('branch');
-    my $brw_prefixes = $self->_config->getPrefixes('brw_cat');
-
-    return $brw_prefixes->{$params->{brw_cat}}
-        || $brn_prefixes->{$params->{branch}}
-        || $brw_prefixes->{default}
-        || "";                  # "the empty prefix"
+    my $brn_prefixes = $self->_config->getPrefixes();
+    return $brn_prefixes->{$params->{branch}} || ""; # "the empty prefix"
 }
 
 }
 
+=head3 get_type
+
+    my $type = $abstract->get_type();
+
+Return a string representing the material type of this request or undef
+
+=cut
+
+sub get_type {
+    my ($self) = @_;
+    my $attr = $self->illrequestattributes->find({ type => 'type'});
+    return if !$attr;
+    return $attr->value;
+};
+
 #### Illrequests Imports
 
 =head3 check_limits
 #### Illrequests Imports
 
 =head3 check_limits
@@ -739,7 +821,7 @@ sub _limit_counter {
     } else {                    # assume 'active'
         # XXX: This status list is ugly. There should be a method in config
         # to return these.
     } else {                    # assume 'active'
         # XXX: This status list is ugly. There should be a method in config
         # to return these.
-        $where = { status => { -not_in => [ 'QUEUED', 'COMP' ] } };
+        my $where = { status => { -not_in => [ 'QUEUED', 'COMP' ] } };
         $resultset = Koha::Illrequests->search({ %{$target}, %{$where} });
     }
 
         $resultset = Koha::Illrequests->search({ %{$target}, %{$where} });
     }
 
@@ -830,14 +912,20 @@ EOF
     } elsif ( 'draft' eq $params->{stage} ) {
         # Create the to header
         my $to = $params->{partners};
     } elsif ( 'draft' eq $params->{stage} ) {
         # Create the to header
         my $to = $params->{partners};
-        $to =~ s/^\x00//;       # Strip leading NULLs
-        $to =~ s/\x00/; /;      # Replace others with '; '
-        die "No target email addresses found. Either select at least one partner or check your ILL partner library records." if ( !$to );
+        if ( defined $to ) {
+            $to =~ s/^\x00//;       # Strip leading NULLs
+            $to =~ s/\x00/; /;      # Replace others with '; '
+        }
+        Koha::Exceptions::Ill::NoTargetEmail->throw(
+            "No target email addresses found. Either select at least one partner or check your ILL partner library records.")
+          if ( !$to );
         # Create the from, replyto and sender headers
         my $from = $branch->branchemail;
         my $replyto = $branch->branchreplyto || $from;
         # Create the from, replyto and sender headers
         my $from = $branch->branchemail;
         my $replyto = $branch->branchreplyto || $from;
-        die "Your branch has no email address. Please set it."
-            if ( !$from );
+        Koha::Exceptions::Ill::NoLibraryEmail->throw(
+            "Your library has no usable email address. Please set it.")
+          if ( !$from );
+
         # Create the email
         my $message = Koha::Email->new;
         my %mail = $message->create_message_headers(
         # Create the email
         my $message = Koha::Email->new;
         my %mail = $message->create_message_headers(
@@ -888,12 +976,7 @@ file.
 
 sub id_prefix {
     my ( $self ) = @_;
 
 sub id_prefix {
     my ( $self ) = @_;
-    my $brw = $self->patron;
-    my $brw_cat = "dummy";
-    $brw_cat = $brw->categorycode
-        unless ( 'HASH' eq ref($brw) && $brw->{deleted} );
     my $prefix = $self->getPrefix( {
     my $prefix = $self->getPrefix( {
-        brw_cat => $brw_cat,
         branch  => $self->branchcode,
     } );
     $prefix .= "-" if ( $prefix );
         branch  => $self->branchcode,
     } );
     $prefix .= "-" if ( $prefix );
@@ -925,6 +1008,10 @@ sub _censor {
 Overloaded I<TO_JSON> method that takes care of inserting calculated values
 into the unblessed representation of the object.
 
 Overloaded I<TO_JSON> method that takes care of inserting calculated values
 into the unblessed representation of the object.
 
+TODO: This method does nothing and is not called anywhere. However, bug 74325
+touches it, so keeping this for now until both this and bug 74325 are merged,
+at which point we can sort it out and remove it completely
+
 =cut
 
 sub TO_JSON {
 =cut
 
 sub TO_JSON {
@@ -933,32 +1020,6 @@ sub TO_JSON {
     my $object = $self->SUPER::TO_JSON();
     $object->{id_prefix} = $self->id_prefix;
 
     my $object = $self->SUPER::TO_JSON();
     $object->{id_prefix} = $self->id_prefix;
 
-    if ( scalar (keys %$embed) ) {
-        # Augment the request response with patron details if appropriate
-        if ( $embed->{patron} ) {
-            my $patron = $self->patron;
-            $object->{patron} = {
-                firstname  => $patron->firstname,
-                surname    => $patron->surname,
-                cardnumber => $patron->cardnumber
-            };
-        }
-        # Augment the request response with metadata details if appropriate
-        if ( $embed->{metadata} ) {
-            $object->{metadata} = $self->metadata;
-        }
-        # Augment the request response with status details if appropriate
-        if ( $embed->{capabilities} ) {
-            $object->{capabilities} = $self->capabilities;
-        }
-        # Augment the request response with library details if appropriate
-        if ( $embed->{branch} ) {
-            $object->{branch} = Koha::Libraries->find(
-                $self->branchcode
-            )->TO_JSON;
-        }
-    }
-
     return $object;
 }
 
     return $object;
 }