Merge remote-tracking branch 'origin/new/bug_7178'
[koha.git] / virtualshelves / sendshelf.pl
1 #!/usr/bin/perl
2
3 # Copyright 2009 BibLibre
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 2 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 FOR
14 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
15 #
16 # You should have received a copy of the GNU General Public License along
17 # with Koha; if not, write to the Free Software Foundation, Inc.,
18 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19
20 use strict;
21 use warnings;
22
23 use CGI;
24 use Encode qw(encode);
25 use Carp;
26
27 use Mail::Sendmail;
28 use MIME::QuotedPrint;
29 use MIME::Base64;
30 use C4::Auth;
31 use C4::Biblio;
32 use C4::Items;
33 use C4::Output;
34 use C4::VirtualShelves;
35
36 my $query = new CGI;
37
38 my ( $template, $borrowernumber, $cookie ) = get_template_and_user (
39     {
40         template_name   => "virtualshelves/sendshelfform.tmpl",
41         query           => $query,
42         type            => "intranet",
43         authnotrequired => 0,
44         flagsrequired   => { catalogue => 1 },
45     }
46 );
47
48 my $shelfid = $query->param('shelfid');
49 my $email   = $query->param('email');
50
51 my $dbh          = C4::Context->dbh;
52
53 if ( $email ) {
54     my $email_from = C4::Context->preference('KohaAdminEmailAddress');
55     my $comment    = $query->param('comment');
56
57     my %mail = (
58         To   => $email,
59         From => $email_from
60     );
61
62     my ( $template2, $borrowernumber, $cookie ) = get_template_and_user(
63         {
64             template_name   => "virtualshelves/sendshelf.tmpl",
65             query           => $query,
66             type            => "intranet",
67             authnotrequired => 0,
68             flagsrequired   => { catalogue => 1 },
69         }
70     );
71
72     my @shelf               = GetShelf($shelfid);
73     my ($items, $totitems)  = GetShelfContents($shelfid);
74     my $marcflavour         = C4::Context->preference('marcflavour');
75     my $iso2709;
76     my @results;
77
78     # retrieve biblios from shelf
79     foreach my $biblio (@$items) {
80         my $biblionumber     = $biblio->{biblionumber};
81         my $fw               = GetFrameworkCode($biblionumber);
82         my $dat              = GetBiblioData($biblionumber);
83         my $record           = GetMarcBiblio($biblionumber);
84         my $marcnotesarray   = GetMarcNotes( $record, $marcflavour );
85         my $marcauthorsarray = GetMarcAuthors( $record, $marcflavour );
86         my $marcsubjctsarray = GetMarcSubjects( $record, $marcflavour );
87         my $subtitle         = GetRecordValue('subtitle', $record, $fw);
88
89         my @items = GetItemsInfo( $biblionumber );
90
91         $dat->{MARCNOTES}      = $marcnotesarray;
92         $dat->{MARCSUBJCTS}    = $marcsubjctsarray;
93         $dat->{MARCAUTHORS}    = $marcauthorsarray;
94         $dat->{'biblionumber'} = $biblionumber;
95         $dat->{ITEM_RESULTS}   = \@items;
96         $dat->{subtitle}       = $subtitle;
97
98         $iso2709 .= $record->as_usmarc();
99
100         push( @results, $dat );
101     }
102
103   if (C4::Context->preference('OPACBaseURL')){
104         $template2->param( OPACBaseURL => C4::Context->preference('OPACBaseURL') );
105   }
106
107     $template2->param(
108         BIBLIO_RESULTS => \@results,
109         email_sender   => $email_from,
110         comment        => $comment,
111         shelfname      => $shelf[1],
112     );
113
114     # Getting template result
115     my $template_res = $template2->output();
116     my $body;
117
118     # Analysing information and getting mail properties
119     if ( $template_res =~ /<SUBJECT>\n(.*)\n<END_SUBJECT>/s ) {
120         $mail{'subject'} = $1;
121     }
122     else { $mail{'subject'} = "no subject"; }
123
124     my $email_header = "";
125     if ( $template_res =~ /<HEADER>\n(.*)\n<END_HEADER>/s ) {
126         $email_header = $1;
127     }
128
129     my $email_file = "basket.txt";
130     if ( $template_res =~ /<FILENAME>\n(.*)\n<END_FILENAME>/s ) {
131         $email_file = $1;
132     }
133
134     if ( $template_res =~ /<MESSAGE>\n(.*)\n<END_MESSAGE>/s ) { $body = encode_qp($1); }
135
136     my $boundary = "====" . time() . "====";
137
138     # We set and put the multipart content
139     $mail{'content-type'} = "multipart/mixed; boundary=\"$boundary\"";
140
141     my $isofile = encode_base64(encode("UTF-8", $iso2709));
142     $boundary = '--' . $boundary;
143
144     $mail{body} = <<END_OF_BODY;
145 $boundary
146 Content-Type: text/plain; charset="utf-8"
147 Content-Transfer-Encoding: quoted-printable
148
149 $email_header
150 $body
151 $boundary
152 Content-Type: application/octet-stream; name="shelf.iso2709"
153 Content-Transfer-Encoding: base64
154 Content-Disposition: attachment; filename="shelf.iso2709"
155
156 $isofile
157 $boundary--
158 END_OF_BODY
159
160     # Sending mail
161     if ( sendmail %mail ) {
162         # do something if it works....
163         $template->param( SENT      => "1" );
164     }
165     else {
166         # do something if it doesnt work....
167         carp "Error sending mail: $Mail::Sendmail::error \n";
168         $template->param( error => 1 );
169     }
170
171     $template->param( email => $email );
172     output_html_with_http_headers $query, $cookie, $template->output;
173
174
175 }else{
176     $template->param( shelfid => $shelfid,
177                       url     => "/cgi-bin/koha/virtualshelves/sendshelf.pl",
178                     );
179     output_html_with_http_headers $query, $cookie, $template->output;
180 }