Bug 20941: Add Illrequest->getType method
[koha.git] / Koha / Illrequest.pm
1 package Koha::Illrequest;
2
3 # Copyright PTFS Europe 2016
4 #
5 # This file is part of Koha.
6 #
7 # Koha is free software; you can redistribute it and/or modify it under the
8 # terms of the GNU General Public License as published by the Free Software
9 # Foundation; either version 3 of the License, or (at your option) any later
10 # version.
11 #
12 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
13 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
14 # FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
15 # details.
16 #
17 # You should have received a copy of the GNU General Public License along with
18 # Koha; if not, write to the Free Software Foundation, Inc., 51 Franklin
19 # Street, Fifth Floor, Boston, MA 02110-1301 USA.
20
21 use Modern::Perl;
22
23 use Clone 'clone';
24 use File::Basename qw( basename );
25 use Encode qw( encode );
26 use Mail::Sendmail;
27 use Try::Tiny;
28
29 use Koha::Database;
30 use Koha::Email;
31 use Koha::Exceptions::Ill;
32 use Koha::Illcomments;
33 use Koha::Illrequestattributes;
34 use Koha::Patron;
35
36 use base qw(Koha::Object);
37
38 =head1 NAME
39
40 Koha::Illrequest - Koha Illrequest Object class
41
42 =head1 (Re)Design
43
44 An ILLRequest consists of two parts; the Illrequest Koha::Object, and a series
45 of related Illrequestattributes.
46
47 The former encapsulates the basic necessary information that any ILL requires
48 to be usable in Koha.  The latter is a set of additional properties used by
49 one of the backends.
50
51 The former subsumes the legacy "Status" object.  The latter remains
52 encapsulated in the "Record" object.
53
54 TODO:
55
56 - Anything invoking the ->status method; annotated with:
57   + # Old use of ->status !
58
59 =head1 API
60
61 =head2 Backend API Response Principles
62
63 All methods should return a hashref in the following format:
64
65 =over
66
67 =item * error
68
69 This should be set to 1 if an error was encountered.
70
71 =item * status
72
73 The status should be a string from the list of statuses detailed below.
74
75 =item * message
76
77 The message is a free text field that can be passed on to the end user.
78
79 =item * value
80
81 The value returned by the method.
82
83 =back
84
85 =head2 Interface Status Messages
86
87 =over
88
89 =item * branch_address_incomplete
90
91 An interface request has determined branch address details are incomplete.
92
93 =item * cancel_success
94
95 The interface's cancel_request method was successful in cancelling the
96 Illrequest using the API.
97
98 =item * cancel_fail
99
100 The interface's cancel_request method failed to cancel the Illrequest using
101 the API.
102
103 =item * unavailable
104
105 The interface's request method returned saying that the desired item is not
106 available for request.
107
108 =back
109
110 =head2 Class methods
111
112 =head3 illrequestattributes
113
114 =cut
115
116 sub illrequestattributes {
117     my ( $self ) = @_;
118     return Koha::Illrequestattributes->_new_from_dbic(
119         scalar $self->_result->illrequestattributes
120     );
121 }
122
123 =head3 illcomments
124
125 =cut
126
127 sub illcomments {
128     my ( $self ) = @_;
129     return Koha::Illcomments->_new_from_dbic(
130         scalar $self->_result->illcomments
131     );
132 }
133
134 =head3 patron
135
136 =cut
137
138 sub patron {
139     my ( $self ) = @_;
140     return Koha::Patron->_new_from_dbic(
141         scalar $self->_result->borrowernumber
142     );
143 }
144
145 =head3 load_backend
146
147 Require "Base.pm" from the relevant ILL backend.
148
149 =cut
150
151 sub load_backend {
152     my ( $self, $backend_id ) = @_;
153
154     my @raw = qw/Koha Illbackends/; # Base Path
155
156     my $backend_name = $backend_id || $self->backend;
157
158     unless ( defined $backend_name && $backend_name ne '' ) {
159         Koha::Exceptions::Ill::InvalidBackendId->throw(
160             "An invalid backend ID was requested ('')");
161     }
162
163     my $location = join "/", @raw, $backend_name, "Base.pm";    # File to load
164     my $backend_class = join "::", @raw, $backend_name, "Base"; # Package name
165     require $location;
166     $self->{_my_backend} = $backend_class->new({ config => $self->_config });
167     return $self;
168 }
169
170
171 =head3 _backend
172
173     my $backend = $abstract->_backend($new_backend);
174     my $backend = $abstract->_backend;
175
176 Getter/Setter for our API object.
177
178 =cut
179
180 sub _backend {
181     my ( $self, $backend ) = @_;
182     $self->{_my_backend} = $backend if ( $backend );
183     # Dynamically load our backend object, as late as possible.
184     $self->load_backend unless ( $self->{_my_backend} );
185     return $self->{_my_backend};
186 }
187
188 =head3 _backend_capability
189
190     my $backend_capability_result = $self->_backend_capability($name, $args);
191
192 This is a helper method to invoke optional capabilities in the backend.  If
193 the capability named by $name is not supported, return 0, else invoke it,
194 passing $args along with the invocation, and return its return value.
195
196 NOTE: this module suffers from a confusion in termninology:
197
198 in _backend_capability, the notion of capability refers to an optional feature
199 that is implemented in core, but might not be supported by a given backend.
200
201 in capabilities & custom_capability, capability refers to entries in the
202 status_graph (after union between backend and core).
203
204 The easiest way to fix this would be to fix the terminology in
205 capabilities & custom_capability and their callers.
206
207 =cut
208
209 sub _backend_capability {
210     my ( $self, $name, $args ) = @_;
211     my $capability = 0;
212     try {
213         $capability = $self->_backend->capabilities($name);
214     } catch {
215         return 0;
216     };
217     if ( $capability ) {
218         return &{$capability}($args);
219     } else {
220         return 0;
221     }
222 }
223
224 =head3 _config
225
226     my $config = $abstract->_config($config);
227     my $config = $abstract->_config;
228
229 Getter/Setter for our config object.
230
231 =cut
232
233 sub _config {
234     my ( $self, $config ) = @_;
235     $self->{_my_config} = $config if ( $config );
236     # Load our config object, as late as possible.
237     unless ( $self->{_my_config} ) {
238         $self->{_my_config} = Koha::Illrequest::Config->new;
239     }
240     return $self->{_my_config};
241 }
242
243 =head3 metadata
244
245 =cut
246
247 sub metadata {
248     my ( $self ) = @_;
249     return $self->_backend->metadata($self);
250 }
251
252 =head3 _core_status_graph
253
254     my $core_status_graph = $illrequest->_core_status_graph;
255
256 Returns ILL module's default status graph.  A status graph defines the list of
257 available actions at any stage in the ILL workflow.  This is for instance used
258 by the perl script & template to generate the correct buttons to display to
259 the end user at any given point.
260
261 =cut
262
263 sub _core_status_graph {
264     my ( $self ) = @_;
265     return {
266         NEW => {
267             prev_actions => [ ],                           # Actions containing buttons
268                                                            # leading to this status
269             id             => 'NEW',                       # ID of this status
270             name           => 'New request',               # UI name of this status
271             ui_method_name => 'New request',               # UI name of method leading
272                                                            # to this status
273             method         => 'create',                    # method to this status
274             next_actions   => [ 'REQ', 'GENREQ', 'KILL' ], # buttons to add to all
275                                                            # requests with this status
276             ui_method_icon => 'fa-plus',                   # UI Style class
277         },
278         REQ => {
279             prev_actions   => [ 'NEW', 'REQREV', 'QUEUED', 'CANCREQ' ],
280             id             => 'REQ',
281             name           => 'Requested',
282             ui_method_name => 'Confirm request',
283             method         => 'confirm',
284             next_actions   => [ 'REQREV', 'COMP' ],
285             ui_method_icon => 'fa-check',
286         },
287         GENREQ => {
288             prev_actions   => [ 'NEW', 'REQREV' ],
289             id             => 'GENREQ',
290             name           => 'Requested from partners',
291             ui_method_name => 'Place request with partners',
292             method         => 'generic_confirm',
293             next_actions   => [ 'COMP' ],
294             ui_method_icon => 'fa-send-o',
295         },
296         REQREV => {
297             prev_actions   => [ 'REQ' ],
298             id             => 'REQREV',
299             name           => 'Request reverted',
300             ui_method_name => 'Revert Request',
301             method         => 'cancel',
302             next_actions   => [ 'REQ', 'GENREQ', 'KILL' ],
303             ui_method_icon => 'fa-times',
304         },
305         QUEUED => {
306             prev_actions   => [ ],
307             id             => 'QUEUED',
308             name           => 'Queued request',
309             ui_method_name => 0,
310             method         => 0,
311             next_actions   => [ 'REQ', 'KILL' ],
312             ui_method_icon => 0,
313         },
314         CANCREQ => {
315             prev_actions   => [ 'NEW' ],
316             id             => 'CANCREQ',
317             name           => 'Cancellation requested',
318             ui_method_name => 0,
319             method         => 0,
320             next_actions   => [ 'KILL', 'REQ' ],
321             ui_method_icon => 0,
322         },
323         COMP => {
324             prev_actions   => [ 'REQ' ],
325             id             => 'COMP',
326             name           => 'Completed',
327             ui_method_name => 'Mark completed',
328             method         => 'mark_completed',
329             next_actions   => [ ],
330             ui_method_icon => 'fa-check',
331         },
332         KILL => {
333             prev_actions   => [ 'QUEUED', 'REQREV', 'NEW', 'CANCREQ' ],
334             id             => 'KILL',
335             name           => 0,
336             ui_method_name => 'Delete request',
337             method         => 'delete',
338             next_actions   => [ ],
339             ui_method_icon => 'fa-trash',
340         },
341     };
342 }
343
344 =head3 _core_status_graph
345
346     my $status_graph = $illrequest->_core_status_graph($origin, $new_graph);
347
348 Return a new status_graph, the result of merging $origin & new_graph.  This is
349 operation is a union over the sets defied by the two graphs.
350
351 Each entry in $new_graph is added to $origin.  We do not provide a syntax for
352 'subtraction' of entries from $origin.
353
354 Whilst it is not intended that this works, you can override entries in $origin
355 with entries with the same key in $new_graph.  This can lead to problematic
356 behaviour when $new_graph adds an entry, which modifies a dependent entry in
357 $origin, only for the entry in $origin to be replaced later with a new entry
358 from $new_graph.
359
360 NOTE: this procedure does not "re-link" entries in $origin or $new_graph,
361 i.e. each of the graphs need to be correct at the outset of the operation.
362
363 =cut
364
365 sub _status_graph_union {
366     my ( $self, $core_status_graph, $backend_status_graph ) = @_;
367     # Create new status graph with:
368     # - all core_status_graph
369     # - for-each each backend_status_graph
370     #   + add to new status graph
371     #   + for each core prev_action:
372     #     * locate core_status
373     #     * update next_actions with additional next action.
374     #   + for each core next_action:
375     #     * locate core_status
376     #     * update prev_actions with additional prev action
377
378     my @core_status_ids = keys %{$core_status_graph};
379     my $status_graph = clone($core_status_graph);
380
381     foreach my $backend_status_key ( keys %{$backend_status_graph} ) {
382         my $backend_status = $backend_status_graph->{$backend_status_key};
383         # Add to new status graph
384         $status_graph->{$backend_status_key} = $backend_status;
385         # Update all core methods' next_actions.
386         foreach my $prev_action ( @{$backend_status->{prev_actions}} ) {
387             if ( grep $prev_action, @core_status_ids ) {
388                 my @next_actions =
389                      @{$status_graph->{$prev_action}->{next_actions}};
390                 push @next_actions, $backend_status_key;
391                 $status_graph->{$prev_action}->{next_actions}
392                     = \@next_actions;
393             }
394         }
395         # Update all core methods' prev_actions
396         foreach my $next_action ( @{$backend_status->{next_actions}} ) {
397             if ( grep $next_action, @core_status_ids ) {
398                 my @prev_actions =
399                      @{$status_graph->{$next_action}->{prev_actions}};
400                 push @prev_actions, $backend_status_key;
401                 $status_graph->{$next_action}->{prev_actions}
402                     = \@prev_actions;
403             }
404         }
405     }
406
407     return $status_graph;
408 }
409
410 ### Core API methods
411
412 =head3 capabilities
413
414     my $capabilities = $illrequest->capabilities;
415
416 Return a hashref mapping methods to operation names supported by the queried
417 backend.
418
419 Example return value:
420
421     { create => "Create Request", confirm => "Progress Request" }
422
423 NOTE: this module suffers from a confusion in termninology:
424
425 in _backend_capability, the notion of capability refers to an optional feature
426 that is implemented in core, but might not be supported by a given backend.
427
428 in capabilities & custom_capability, capability refers to entries in the
429 status_graph (after union between backend and core).
430
431 The easiest way to fix this would be to fix the terminology in
432 capabilities & custom_capability and their callers.
433
434 =cut
435
436 sub capabilities {
437     my ( $self, $status ) = @_;
438     # Generate up to date status_graph
439     my $status_graph = $self->_status_graph_union(
440         $self->_core_status_graph,
441         $self->_backend->status_graph({
442             request => $self,
443             other   => {}
444         })
445     );
446     # Extract available actions from graph.
447     return $status_graph->{$status} if $status;
448     # Or return entire graph.
449     return $status_graph;
450 }
451
452 =head3 custom_capability
453
454 Return the result of invoking $CANDIDATE on this request's backend with
455 $PARAMS, or 0 if $CANDIDATE is an unknown method on backend.
456
457 NOTE: this module suffers from a confusion in termninology:
458
459 in _backend_capability, the notion of capability refers to an optional feature
460 that is implemented in core, but might not be supported by a given backend.
461
462 in capabilities & custom_capability, capability refers to entries in the
463 status_graph (after union between backend and core).
464
465 The easiest way to fix this would be to fix the terminology in
466 capabilities & custom_capability and their callers.
467
468 =cut
469
470 sub custom_capability {
471     my ( $self, $candidate, $params ) = @_;
472     foreach my $capability ( values %{$self->capabilities} ) {
473         if ( $candidate eq $capability->{method} ) {
474             my $response =
475                 $self->_backend->$candidate({
476                     request    => $self,
477                     other      => $params,
478                 });
479             return $self->expandTemplate($response);
480         }
481     }
482     return 0;
483 }
484
485 =head3 available_backends
486
487 Return a list of available backends.
488
489 =cut
490
491 sub available_backends {
492     my ( $self ) = @_;
493     my $backends = $self->_config->available_backends;
494     return $backends;
495 }
496
497 =head3 available_actions
498
499 Return a list of available actions.
500
501 =cut
502
503 sub available_actions {
504     my ( $self ) = @_;
505     my $current_action = $self->capabilities($self->status);
506     my @available_actions = map { $self->capabilities($_) }
507         @{$current_action->{next_actions}};
508     return \@available_actions;
509 }
510
511 =head3 mark_completed
512
513 Mark a request as completed (status = COMP).
514
515 =cut
516
517 sub mark_completed {
518     my ( $self ) = @_;
519     $self->status('COMP')->store;
520     return {
521         error   => 0,
522         status  => '',
523         message => '',
524         method  => 'mark_completed',
525         stage   => 'commit',
526         next    => 'illview',
527     };
528 }
529
530 =head2 backend_confirm
531
532 Confirm a request. The backend handles setting of mandatory fields in the commit stage:
533
534 =over
535
536 =item * orderid
537
538 =item * accessurl, cost (if available).
539
540 =back
541
542 =cut
543
544 sub backend_confirm {
545     my ( $self, $params ) = @_;
546
547     my $response = $self->_backend->confirm({
548             request    => $self,
549             other      => $params,
550         });
551     return $self->expandTemplate($response);
552 }
553
554 =head3 backend_update_status
555
556 =cut
557
558 sub backend_update_status {
559     my ( $self, $params ) = @_;
560     return $self->expandTemplate($self->_backend->update_status($params));
561 }
562
563 =head3 backend_cancel
564
565     my $ILLResponse = $illRequest->backend_cancel;
566
567 The standard interface method allowing for request cancellation.
568
569 =cut
570
571 sub backend_cancel {
572     my ( $self, $params ) = @_;
573
574     my $result = $self->_backend->cancel({
575         request => $self,
576         other => $params
577     });
578
579     return $self->expandTemplate($result);
580 }
581
582 =head3 backend_renew
583
584     my $renew_response = $illRequest->backend_renew;
585
586 The standard interface method allowing for request renewal queries.
587
588 =cut
589
590 sub backend_renew {
591     my ( $self ) = @_;
592     return $self->expandTemplate(
593         $self->_backend->renew({
594             request    => $self,
595         })
596     );
597 }
598
599 =head3 backend_create
600
601     my $create_response = $abstractILL->backend_create($params);
602
603 Return an array of Record objects created by querying our backend with
604 a Search query.
605
606 In the context of the other ILL methods, this is a special method: we only
607 pass it $params, as it does not yet have any other data associated with it.
608
609 =cut
610
611 sub backend_create {
612     my ( $self, $params ) = @_;
613
614     # Establish whether we need to do a generic copyright clearance.
615     if ($params->{opac}) {
616         if ( ( !$params->{stage} || $params->{stage} eq 'init' )
617                 && C4::Context->preference("ILLModuleCopyrightClearance") ) {
618             return {
619                 error   => 0,
620                 status  => '',
621                 message => '',
622                 method  => 'create',
623                 stage   => 'copyrightclearance',
624                 value   => {
625                     backend => $self->_backend->name
626                 }
627             };
628         } elsif (     defined $params->{stage}
629                 && $params->{stage} eq 'copyrightclearance' ) {
630             $params->{stage} = 'init';
631         }
632     }
633     # First perform API action, then...
634     my $args = {
635         request => $self,
636         other   => $params,
637     };
638     my $result = $self->_backend->create($args);
639
640     # ... simple case: we're not at 'commit' stage.
641     my $stage = $result->{stage};
642     return $self->expandTemplate($result)
643         unless ( 'commit' eq $stage );
644
645     # ... complex case: commit!
646
647     # Do we still have space for an ILL or should we queue?
648     my $permitted = $self->check_limits(
649         { patron => $self->patron }, { librarycode => $self->branchcode }
650     );
651
652     # Now augment our committed request.
653
654     $result->{permitted} = $permitted;             # Queue request?
655
656     # This involves...
657
658     # ...Updating status!
659     $self->status('QUEUED')->store unless ( $permitted );
660
661     return $self->expandTemplate($result);
662 }
663
664 =head3 expandTemplate
665
666     my $params = $abstract->expandTemplate($params);
667
668 Return a version of $PARAMS augmented with our required template path.
669
670 =cut
671
672 sub expandTemplate {
673     my ( $self, $params ) = @_;
674     my $backend = $self->_backend->name;
675     # Generate path to file to load
676     my $backend_dir = $self->_config->backend_dir;
677     my $backend_tmpl = join "/", $backend_dir, $backend;
678     my $intra_tmpl =  join "/", $backend_tmpl, "intra-includes",
679         $params->{method} . ".inc";
680     my $opac_tmpl =  join "/", $backend_tmpl, "opac-includes",
681         $params->{method} . ".inc";
682     # Set files to load
683     $params->{template} = $intra_tmpl;
684     $params->{opac_template} = $opac_tmpl;
685     return $params;
686 }
687
688 #### Abstract Imports
689
690 =head3 getLimits
691
692     my $limit_rules = $abstract->getLimits( {
693         type  => 'brw_cat' | 'branch',
694         value => $value
695     } );
696
697 Return the ILL limit rules for the supplied combination of type / value.
698
699 As the config may have no rules for this particular type / value combination,
700 or for the default, we must define fall-back values here.
701
702 =cut
703
704 sub getLimits {
705     my ( $self, $params ) = @_;
706     my $limits = $self->_config->getLimitRules($params->{type});
707
708     if (     defined $params->{value}
709           && defined $limits->{$params->{value}} ) {
710             return $limits->{$params->{value}};
711     }
712     else {
713         return $limits->{default} || { count => -1, method => 'active' };
714     }
715 }
716
717 =head3 getPrefix
718
719     my $prefix = $abstract->getPrefix( {
720         brw_cat => $brw_cat,
721         branch  => $branch_code,
722     } );
723
724 Return the ILL prefix as defined by our $params: either per borrower category,
725 per branch or the default.
726
727 =cut
728
729 sub getPrefix {
730     my ( $self, $params ) = @_;
731     my $brn_prefixes = $self->_config->getPrefixes('branch');
732     my $brw_prefixes = $self->_config->getPrefixes('brw_cat');
733
734     return $brw_prefixes->{$params->{brw_cat}}
735         || $brn_prefixes->{$params->{branch}}
736         || $brw_prefixes->{default}
737         || "";                  # "the empty prefix"
738 }
739
740 =head3 getType
741
742     my $type = $abstract->getType();
743
744 Return a string representing the material type of this request
745
746 =cut
747
748 sub getType {
749     my ($self) = @_;
750     my $attr = $self->illrequestattributes->find({ type => 'type'});
751     return $attr ? $attr->value : '<span>N/A</span>';
752 };
753
754 #### Illrequests Imports
755
756 =head3 check_limits
757
758     my $ok = $illRequests->check_limits( {
759         borrower   => $borrower,
760         branchcode => 'branchcode' | undef,
761     } );
762
763 Given $PARAMS, a hashref containing a $borrower object and a $branchcode,
764 see whether we are still able to place ILLs.
765
766 LimitRules are derived from koha-conf.xml:
767  + default limit counts, and counting method
768  + branch specific limit counts & counting method
769  + borrower category specific limit counts & counting method
770  + err on the side of caution: a counting fail will cause fail, even if
771    the other counts passes.
772
773 =cut
774
775 sub check_limits {
776     my ( $self, $params ) = @_;
777     my $patron     = $params->{patron};
778     my $branchcode = $params->{librarycode} || $patron->branchcode;
779
780     # Establish maximum number of allowed requests
781     my ( $branch_rules, $brw_rules ) = (
782         $self->getLimits( {
783             type => 'branch',
784             value => $branchcode
785         } ),
786         $self->getLimits( {
787             type => 'brw_cat',
788             value => $patron->categorycode,
789         } ),
790     );
791     my ( $branch_limit, $brw_limit )
792         = ( $branch_rules->{count}, $brw_rules->{count} );
793     # Establish currently existing requests
794     my ( $branch_count, $brw_count ) = (
795         $self->_limit_counter(
796             $branch_rules->{method}, { branchcode => $branchcode }
797         ),
798         $self->_limit_counter(
799             $brw_rules->{method}, { borrowernumber => $patron->borrowernumber }
800         ),
801     );
802
803     # Compare and return
804     # A limit of -1 means no limit exists.
805     # We return blocked if either branch limit or brw limit is reached.
806     if ( ( $branch_limit != -1 && $branch_limit <= $branch_count )
807              || ( $brw_limit != -1 && $brw_limit <= $brw_count ) ) {
808         return 0;
809     } else {
810         return 1;
811     }
812 }
813
814 sub _limit_counter {
815     my ( $self, $method, $target ) = @_;
816
817     # Establish parameters of counts
818     my $resultset;
819     if ($method && $method eq 'annual') {
820         $resultset = Koha::Illrequests->search({
821             -and => [
822                 %{$target},
823                 \"YEAR(placed) = YEAR(NOW())"
824             ]
825         });
826     } else {                    # assume 'active'
827         # XXX: This status list is ugly. There should be a method in config
828         # to return these.
829         my $where = { status => { -not_in => [ 'QUEUED', 'COMP' ] } };
830         $resultset = Koha::Illrequests->search({ %{$target}, %{$where} });
831     }
832
833     # Fetch counts
834     return $resultset->count;
835 }
836
837 =head3 requires_moderation
838
839     my $status = $illRequest->requires_moderation;
840
841 Return the name of the status if moderation by staff is required; or 0
842 otherwise.
843
844 =cut
845
846 sub requires_moderation {
847     my ( $self ) = @_;
848     my $require_moderation = {
849         'CANCREQ' => 'CANCREQ',
850     };
851     return $require_moderation->{$self->status};
852 }
853
854 =head3 generic_confirm
855
856     my $stage_summary = $illRequest->generic_confirm;
857
858 Handle the generic_confirm extended method.  The first stage involves creating
859 a template email for the end user to edit in the browser.  The second stage
860 attempts to submit the email.
861
862 =cut
863
864 sub generic_confirm {
865     my ( $self, $params ) = @_;
866     my $branch = Koha::Libraries->find($params->{current_branchcode})
867         || die "Invalid current branchcode. Are you logged in as the database user?";
868     if ( !$params->{stage}|| $params->{stage} eq 'init' ) {
869         my $draft->{subject} = "ILL Request";
870         $draft->{body} = <<EOF;
871 Dear Sir/Madam,
872
873     We would like to request an interlibrary loan for a title matching the
874 following description:
875
876 EOF
877
878         my $details = $self->metadata;
879         while (my ($title, $value) = each %{$details}) {
880             $draft->{body} .= "  - " . $title . ": " . $value . "\n"
881                 if $value;
882         }
883         $draft->{body} .= <<EOF;
884
885 Please let us know if you are able to supply this to us.
886
887 Kind Regards
888
889 EOF
890
891         my @address = map { $branch->$_ }
892             qw/ branchname branchaddress1 branchaddress2 branchaddress3
893                 branchzip branchcity branchstate branchcountry branchphone
894                 branchemail /;
895         my $address = "";
896         foreach my $line ( @address ) {
897             $address .= $line . "\n" if $line;
898         }
899
900         $draft->{body} .= $address;
901
902         my $partners = Koha::Patrons->search({
903             categorycode => $self->_config->partner_code
904         });
905         return {
906             error   => 0,
907             status  => '',
908             message => '',
909             method  => 'generic_confirm',
910             stage   => 'draft',
911             value   => {
912                 draft    => $draft,
913                 partners => $partners,
914             }
915         };
916
917     } elsif ( 'draft' eq $params->{stage} ) {
918         # Create the to header
919         my $to = $params->{partners};
920         if ( defined $to ) {
921             $to =~ s/^\x00//;       # Strip leading NULLs
922             $to =~ s/\x00/; /;      # Replace others with '; '
923         }
924         Koha::Exceptions::Ill::NoTargetEmail->throw(
925             "No target email addresses found. Either select at least one partner or check your ILL partner library records.")
926           if ( !$to );
927         # Create the from, replyto and sender headers
928         my $from = $branch->branchemail;
929         my $replyto = $branch->branchreplyto || $from;
930         Koha::Exceptions::Ill::NoLibraryEmail->throw(
931             "Your library has no usable email address. Please set it.")
932           if ( !$from );
933
934         # Create the email
935         my $message = Koha::Email->new;
936         my %mail = $message->create_message_headers(
937             {
938                 to          => $to,
939                 from        => $from,
940                 replyto     => $replyto,
941                 subject     => Encode::encode( "utf8", $params->{subject} ),
942                 message     => Encode::encode( "utf8", $params->{body} ),
943                 contenttype => 'text/plain',
944             }
945         );
946         # Send it
947         my $result = sendmail(%mail);
948         if ( $result ) {
949             $self->status("GENREQ")->store;
950             return {
951                 error   => 0,
952                 status  => '',
953                 message => '',
954                 method  => 'generic_confirm',
955                 stage   => 'commit',
956                 next    => 'illview',
957             };
958         } else {
959             return {
960                 error   => 1,
961                 status  => 'email_failed',
962                 message => $Mail::Sendmail::error,
963                 method  => 'generic_confirm',
964                 stage   => 'draft',
965             };
966         }
967     } else {
968         die "Unknown stage, should not have happened."
969     }
970 }
971
972 =head3 id_prefix
973
974     my $prefix = $record->id_prefix;
975
976 Return the prefix appropriate for the current Illrequest as derived from the
977 borrower and branch associated with this request's Status, and the config
978 file.
979
980 =cut
981
982 sub id_prefix {
983     my ( $self ) = @_;
984     my $brw = $self->patron;
985     my $brw_cat = "dummy";
986     $brw_cat = $brw->categorycode
987         unless ( 'HASH' eq ref($brw) && $brw->{deleted} );
988     my $prefix = $self->getPrefix( {
989         brw_cat => $brw_cat,
990         branch  => $self->branchcode,
991     } );
992     $prefix .= "-" if ( $prefix );
993     return $prefix;
994 }
995
996 =head3 _censor
997
998     my $params = $illRequest->_censor($params);
999
1000 Return $params, modified to reflect our censorship requirements.
1001
1002 =cut
1003
1004 sub _censor {
1005     my ( $self, $params ) = @_;
1006     my $censorship = $self->_config->censorship;
1007     $params->{censor_notes_staff} = $censorship->{censor_notes_staff}
1008         if ( $params->{opac} );
1009     $params->{display_reply_date} = ( $censorship->{censor_reply_date} ) ? 0 : 1;
1010
1011     return $params;
1012 }
1013
1014 =head3 TO_JSON
1015
1016     $json = $illrequest->TO_JSON
1017
1018 Overloaded I<TO_JSON> method that takes care of inserting calculated values
1019 into the unblessed representation of the object.
1020
1021 =cut
1022
1023 sub TO_JSON {
1024     my ( $self, $embed ) = @_;
1025
1026     my $object = $self->SUPER::TO_JSON();
1027     $object->{id_prefix} = $self->id_prefix;
1028
1029     if ( scalar (keys %$embed) ) {
1030         # Augment the request response with patron details if appropriate
1031         if ( $embed->{patron} ) {
1032             my $patron = $self->patron;
1033             $object->{patron} = {
1034                 firstname  => $patron->firstname,
1035                 surname    => $patron->surname,
1036                 cardnumber => $patron->cardnumber
1037             };
1038         }
1039         # Augment the request response with metadata details if appropriate
1040         if ( $embed->{metadata} ) {
1041             $object->{metadata} = $self->metadata;
1042         }
1043         # Augment the request response with status details if appropriate
1044         if ( $embed->{capabilities} ) {
1045             $object->{capabilities} = $self->capabilities;
1046         }
1047         # Augment the request response with library details if appropriate
1048         if ( $embed->{library} ) {
1049             $object->{library} = Koha::Libraries->find(
1050                 $self->branchcode
1051             )->TO_JSON;
1052         }
1053         # Augment the request response with the number of comments if appropriate
1054         if ( $embed->{comments} ) {
1055             $object->{comments} = $self->illcomments->count;
1056         }
1057     }
1058
1059     return $object;
1060 }
1061
1062 =head2 Internal methods
1063
1064 =head3 _type
1065
1066 =cut
1067
1068 sub _type {
1069     return 'Illrequest';
1070 }
1071
1072 =head1 AUTHOR
1073
1074 Alex Sassmannshausen <alex.sassmannshausen@ptfs-europe.com>
1075
1076 =cut
1077
1078 1;