Merge remote-tracking branch 'kc/new/awaiting_qa/bug_6316' into kcmaster
[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
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
88         my @items = GetItemsInfo( $biblionumber );
89
90         $dat->{MARCNOTES}      = $marcnotesarray;
91         $dat->{MARCSUBJCTS}    = $marcsubjctsarray;
92         $dat->{MARCAUTHORS}    = $marcauthorsarray;
93         $dat->{'biblionumber'} = $biblionumber;
94         $dat->{ITEM_RESULTS}   = \@items;
95
96         $iso2709 .= $record->as_usmarc();
97
98         push( @results, $dat );
99     }
100
101     $template2->param(
102         BIBLIO_RESULTS => \@results,
103         email_sender   => $email_from,
104         comment        => $comment,
105         shelfname      => $shelf[1],
106     );
107
108     # Getting template result
109     my $template_res = $template2->output();
110     my $body;
111
112     # Analysing information and getting mail properties
113     if ( $template_res =~ /<SUBJECT>\n(.*)\n<END_SUBJECT>/s ) {
114         $mail{'subject'} = $1;
115     }
116     else { $mail{'subject'} = "no subject"; }
117
118     my $email_header = "";
119     if ( $template_res =~ /<HEADER>\n(.*)\n<END_HEADER>/s ) {
120         $email_header = $1;
121     }
122
123     my $email_file = "basket.txt";
124     if ( $template_res =~ /<FILENAME>\n(.*)\n<END_FILENAME>/s ) {
125         $email_file = $1;
126     }
127
128     if ( $template_res =~ /<MESSAGE>\n(.*)\n<END_MESSAGE>/s ) { $body = encode_qp($1); }
129
130     my $boundary = "====" . time() . "====";
131
132     # We set and put the multipart content
133     $mail{'content-type'} = "multipart/mixed; boundary=\"$boundary\"";
134
135     my $isofile = encode_base64(encode("UTF-8", $iso2709));
136     $boundary = '--' . $boundary;
137
138     $mail{body} = <<END_OF_BODY;
139 $boundary
140 Content-Type: text/plain; charset="utf-8"
141 Content-Transfer-Encoding: quoted-printable
142
143 $email_header
144 $body
145 $boundary
146 Content-Type: application/octet-stream; name="shelf.iso2709"
147 Content-Transfer-Encoding: base64
148 Content-Disposition: attachment; filename="shelf.iso2709"
149
150 $isofile
151 $boundary--
152 END_OF_BODY
153
154     # Sending mail
155     if ( sendmail %mail ) {
156         # do something if it works....
157         $template->param( SENT      => "1" );
158     }
159     else {
160         # do something if it doesnt work....
161         carp "Error sending mail: $Mail::Sendmail::error \n";
162         $template->param( error => 1 );
163     }
164
165     $template->param( email => $email );
166     output_html_with_http_headers $query, $cookie, $template->output;
167
168
169 }else{
170     $template->param( shelfid => $shelfid,
171                       url     => "/cgi-bin/koha/virtualshelves/sendshelf.pl",
172                     );
173     output_html_with_http_headers $query, $cookie, $template->output;
174 }