Bug 4472 Fix how   are injected into XSL files
[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
26 use Mail::Sendmail;
27 use MIME::QuotedPrint;
28 use MIME::Base64;
29 use C4::Auth;
30 use C4::Biblio;
31 use C4::Items;
32 use C4::Output;
33 use C4::VirtualShelves;
34
35 my $query = new CGI;
36
37 my ( $template, $borrowernumber, $cookie ) = get_template_and_user (
38     {
39         template_name   => "virtualshelves/sendshelfform.tmpl",
40         query           => $query,
41         type            => "intranet",
42         authnotrequired => 0,
43         flagsrequired   => { catalogue => 1 },
44     }
45 );
46
47 my $shelfid = $query->param('shelfid');
48 my $email   = $query->param('email');
49
50 my $dbh          = C4::Context->dbh;
51
52 if ( $email ) {
53     my $email_from = C4::Context->preference('KohaAdminEmailAddress');
54     my $comment    = $query->param('comment');
55
56     my %mail = (
57         To   => $email,
58         From => $email_from
59     );
60
61     my ( $template2, $borrowernumber, $cookie ) = get_template_and_user(
62         {
63             template_name   => "virtualshelves/sendshelf.tmpl",
64             query           => $query,
65             type            => "intranet",
66             authnotrequired => 0,
67             flagsrequired   => { catalogue => 1 },
68         }
69     );
70
71     my @shelf               = GetShelf($shelfid);
72     my ($items, $totitems)  = GetShelfContents($shelfid);
73     my $marcflavour         = C4::Context->preference('marcflavour');
74     my $iso2709;
75     my @results;
76
77     # retrieve biblios from shelf
78     foreach my $biblio (@$items) {
79         my $biblionumber = $biblio->{biblionumber};
80
81         my $dat              = GetBiblioData($biblionumber);
82         my $record           = GetMarcBiblio($biblionumber);
83         my $marcnotesarray   = GetMarcNotes( $record, $marcflavour );
84         my $marcauthorsarray = GetMarcAuthors( $record, $marcflavour );
85         my $marcsubjctsarray = GetMarcSubjects( $record, $marcflavour );
86
87         my @items = &GetItemsInfo( $biblionumber, 'opac' );
88
89         $dat->{MARCNOTES}      = $marcnotesarray;
90         $dat->{MARCSUBJCTS}    = $marcsubjctsarray;
91         $dat->{MARCAUTHORS}    = $marcauthorsarray;
92         $dat->{'biblionumber'} = $biblionumber;
93         $dat->{ITEM_RESULTS}   = \@items;
94
95         $iso2709 .= $record->as_usmarc();
96
97         push( @results, $dat );
98     }
99
100     $template2->param(
101         BIBLIO_RESULTS => \@results,
102         email_sender   => $email_from,
103         comment        => $comment,
104         shelfname      => $shelf[1],
105     );
106
107     # Getting template result
108     my $template_res = $template2->output();
109     my $body;
110
111     # Analysing information and getting mail properties
112     if ( $template_res =~ /<SUBJECT>\n(.*)\n<END_SUBJECT>/s ) {
113         $mail{'subject'} = $1;
114     }
115     else { $mail{'subject'} = "no subject"; }
116
117     my $email_header = "";
118     if ( $template_res =~ /<HEADER>\n(.*)\n<END_HEADER>/s ) {
119         $email_header = $1;
120     }
121
122     my $email_file = "basket.txt";
123     if ( $template_res =~ /<FILENAME>\n(.*)\n<END_FILENAME>/s ) {
124         $email_file = $1;
125     }
126
127     if ( $template_res =~ /<MESSAGE>\n(.*)\n<END_MESSAGE>/s ) { $body = encode_qp($1); }
128
129     my $boundary = "====" . time() . "====";
130
131     # We set and put the multipart content
132     $mail{'content-type'} = "multipart/mixed; boundary=\"$boundary\"";
133
134     my $isofile = encode_base64(encode("UTF-8", $iso2709));
135     $boundary = '--' . $boundary;
136
137     $mail{body} = <<END_OF_BODY;
138 $boundary
139 Content-Type: text/plain; charset="utf-8"
140 Content-Transfer-Encoding: quoted-printable
141
142 $email_header
143 $body
144 $boundary
145 Content-Type: application/octet-stream; name="shelf.iso2709"
146 Content-Transfer-Encoding: base64
147 Content-Disposition: attachment; filename="shelf.iso2709"
148
149 $isofile
150 $boundary--
151 END_OF_BODY
152
153     # Sending mail
154     if ( sendmail %mail ) {
155         # do something if it works....
156         $template->param( SENT      => "1" );
157     }
158     else {
159         # do something if it doesnt work....
160         warn "Error sending mail: $Mail::Sendmail::error \n";
161         $template->param( error => 1 );
162     }
163
164     $template->param( email => $email );
165     output_html_with_http_headers $query, $cookie, $template->output;
166
167
168 }else{
169     $template->param( shelfid => $shelfid,
170                       url     => "/cgi-bin/koha/virtualshelves/sendshelf.pl",
171                     );
172     output_html_with_http_headers $query, $cookie, $template->output;
173 }