Bug 20920: Add missing dependency on CGI::Compile
[koha.git] / misc / cronjobs / gather_print_notices.pl
blobcb1aecf94dc5550e4ab5b4e9f2bd67824ec0c17a
1 #!/usr/bin/perl -w
3 use Modern::Perl;
5 BEGIN {
6 # find Koha's Perl modules
7 # test carefully before changing this
8 use FindBin;
9 eval { require "$FindBin::Bin/../kohalib.pl" };
12 use CGI qw( utf8 ); # NOT a CGI script, this is just to keep C4::Templates::gettemplate happy
13 use C4::Context;
14 use C4::Debug;
15 use C4::Letters;
16 use C4::Templates;
17 use File::Spec;
18 use Pod::Usage;
19 use Getopt::Long;
20 use C4::Log;
22 use File::Basename qw( dirname );
23 use Koha::DateUtils;
24 use MIME::Lite;
26 my (
27 $stylesheet,
28 $help,
29 $split,
30 $html,
31 $csv,
32 $ods,
33 $delimiter,
34 @letter_codes,
35 $send,
36 @emails,
39 $send = 1;
40 GetOptions(
41 'h|help' => \$help,
42 's|split' => \$split,
43 'html' => \$html,
44 'csv' => \$csv,
45 'ods' => \$ods,
46 'd|delimiter:s' => \$delimiter,
47 'letter_code:s' => \@letter_codes,
48 'send!' => \$send,
49 'e|email:s' => \@emails,
50 ) || pod2usage(1);
52 pod2usage(0) if $help;
54 my $output_directory = $ARGV[0];
56 if ( !$output_directory || !-d $output_directory || !-w $output_directory ) {
57 pod2usage({
58 -exitval => 1,
59 -msg => qq{\nError: You must specify a valid and writeable directory to dump the print notices in.\n},
60 });
63 # Default value is html
64 $html = 1 if not $html and not $csv and not $ods;
66 if ( $csv and @letter_codes != 1 ) {
67 pod2usage({
68 -exitval => 1,
69 -msg => qq{\nIt is not consistent to use --csv without one (and only one) letter_code\n},
70 });
73 if ( $ods and @letter_codes != 1 ) {
74 pod2usage({
75 -exitval => 1,
76 -msg => qq{\nIt is not consistent to use --ods without one (and only one) letter_code\n},
77 });
80 $delimiter ||= q|,|;
82 cronlogaction();
84 my $today_iso = output_pref( { dt => dt_from_string, dateonly => 1, dateformat => 'iso' } ) ;
85 my $today_syspref = output_pref( { dt => dt_from_string, dateonly => 1 } );
87 my @all_messages = @{ GetPrintMessages() };
89 # Filter by letter_code
90 @all_messages = map {
91 my $letter_code = $_->{letter_code};
93 grep { /^$letter_code$/ } @letter_codes
94 ) ? $_ : ()
95 } @all_messages if @letter_codes;
96 exit unless @all_messages;
98 my ( $html_filenames, $csv_filenames, $ods_filenames );
99 $csv_filenames = print_notices({
100 messages => \@all_messages,
101 split => $split,
102 output_directory => $output_directory,
103 format => 'csv',
104 }) if $csv;
106 $ods_filenames = print_notices({
107 messages => \@all_messages,
108 split => $split,
109 output_directory => $output_directory,
110 format => 'ods',
111 }) if $ods;
113 if ( $html ) {
114 ## carriage return replaced by <br/> as output is html
115 foreach my $message (@all_messages) {
116 local $_ = $message->{'content'};
117 s/\n/<br \/>/g;
118 s/\r//g;
119 $message->{'content'} = $_;
122 $html_filenames = print_notices({
123 messages => \@all_messages,
124 split => $split,
125 output_directory => $output_directory,
126 format => 'html',
130 if ( @emails ) {
131 my $files = {
132 html => $html_filenames,
133 csv => $csv_filenames,
134 ods => $ods_filenames,
136 for my $email ( @emails ) {
137 send_files({
138 directory => $output_directory,
139 files => $files,
140 to => $email,
141 from => C4::Context->preference('KohaAdminEmailAddress'), # Should be replaced if bug 8000 is pushed
146 sub print_notices {
147 my ( $params ) = @_;
149 my $messages = $params->{messages};
150 my $split = $params->{split};
151 my $output_directory = $params->{output_directory};
152 my $format = $params->{format} // 'html';
154 die "Format $format is not known"
155 unless $format =~ m[^html$|^csv$|^ods$];
157 my ( @filenames, $messages_by_branch );
159 if ( $split ) {
160 foreach my $message (@$messages) {
161 push( @{ $messages_by_branch->{ $message->{'branchcode'} } }, $message );
163 } else {
164 $messages_by_branch->{all_branches} = $messages;
167 while ( my ( $branchcode, $branch_messages ) = each %$messages_by_branch ) {
168 my $letter_codes = @letter_codes == 0 ? 'all' : join '_', @letter_codes;
169 my $filename = $split
170 ? "notices_$letter_codes-" . $today_iso . "-$branchcode.$format"
171 : "notices_$letter_codes-" . $today_iso . ".$format";
172 my $filepath = File::Spec->catdir( $output_directory, $filename );
173 if ( $format eq 'html' ) {
174 generate_html({
175 messages => $branch_messages,
176 filepath => $filepath,
178 } elsif ( $format eq 'csv' ) {
179 generate_csv ({
180 messages => $branch_messages,
181 filepath => $filepath,
183 } elsif ( $format eq 'ods' ) {
184 generate_ods ({
185 messages => $branch_messages,
186 filepath => $filepath,
190 if ( $send ) {
191 foreach my $message ( @$branch_messages ) {
192 C4::Letters::_set_message_status(
194 message_id => $message->{'message_id'},
195 status => 'sent'
200 push @filenames, $filename;
202 return \@filenames;
205 sub generate_html {
206 my ( $params ) = @_;
207 my $messages = $params->{messages};
208 my $filepath = $params->{filepath};
210 my $template =
211 C4::Templates::gettemplate( 'batch/print-notices.tt', 'intranet',
212 new CGI );
214 $template->param(
215 stylesheet => C4::Context->preference("NoticeCSS"),
216 today => $today_syspref,
217 messages => $messages,
220 open my $OUTPUT, '>encoding(utf-8)', $filepath
221 or die "Could not open $filepath: $!";
222 print $OUTPUT $template->output;
223 close $OUTPUT;
226 sub generate_csv {
227 my ( $params ) = @_;
228 my $messages = $params->{messages};
229 my $filepath = $params->{filepath};
231 open my $OUTPUT, '>encoding(utf-8)', $filepath
232 or die "Could not open $filepath: $!";
233 my ( @csv_lines, $headers );
234 foreach my $message ( @$messages ) {
235 my @lines = split /\n/, $message->{content};
236 chomp for @lines;
238 # We don't have headers, get them
239 unless ( $headers ) {
240 $headers = $lines[0];
241 say $OUTPUT $headers;
244 shift @lines;
245 for my $line ( @lines ) {
246 next if $line =~ /^\s$/;
247 say $OUTPUT $line;
252 sub generate_ods {
253 my ( $params ) = @_;
254 my $messages = $params->{messages};
255 my $filepath = $params->{filepath};
257 use OpenOffice::OODoc;
258 my $tmpdir = dirname $filepath;
259 odfWorkingDirectory( $tmpdir );
260 my $container = odfContainer( $filepath, create => 'spreadsheet' );
261 my $doc = odfDocument (
262 container => $container,
263 part => 'content'
265 my $table = $doc->getTable(0);
267 my @headers;
268 my ( $nb_rows, $nb_cols, $i ) = ( scalar(@$messages), 0, 0 );
269 foreach my $message ( @$messages ) {
270 my @lines = split /\n/, $message->{content};
271 chomp for @lines;
273 # We don't have headers, get them
274 unless ( @headers ) {
275 @headers = split $delimiter, $lines[0];
277 $nb_cols = @headers;
278 $doc->expandTable( $table, $nb_rows + 1, $nb_cols );
279 my $row = $doc->getRow( $table, 0 );
280 my $j = 0;
281 for my $header ( @headers ) {
282 $doc->cellValue( $row, $j, Encode::encode( 'UTF8', $header ) );
283 $j++;
285 $i = 1;
288 shift @lines; # remove headers
289 for my $line ( @lines ) {
290 my @row_data = split $delimiter, $line;
291 my $row = $doc->getRow( $table, $i );
292 # Note scalar(@$row_data) should be equal to $nb_cols
293 for ( my $j = 0 ; $j < scalar(@row_data) ; $j++ ) {
294 my $value = Encode::encode( 'UTF8', $row_data[$j] );
295 $doc->cellValue( $row, $j, $value );
297 $i++;
300 $doc->save();
303 sub send_files {
304 my ( $params ) = @_;
305 my $directory = $params->{directory};
306 my $files = $params->{files};
307 my $to = $params->{to};
308 my $from = $params->{from};
309 return unless $to and $from;
311 my $mail = MIME::Lite->new(
312 From => $from,
313 To => $to,
314 Subject => 'Print notices for ' . $today_syspref,
315 Type => 'multipart/mixed',
318 while ( my ( $type, $filenames ) = each %$files ) {
319 for my $filename ( @$filenames ) {
320 my $mimetype = $type eq 'html'
321 ? 'text/html'
322 : $type eq 'csv'
323 ? 'text/csv'
324 : $type eq 'ods'
325 ? 'application/vnd.oasis.opendocument.spreadsheet'
326 : undef;
328 next unless $mimetype;
330 my $filepath = File::Spec->catdir( $directory, $filename );
332 next unless $filepath or -f $filepath;
334 $mail->attach(
335 Type => $mimetype,
336 Path => $filepath,
337 Filename => $filename,
338 Encoding => 'base64',
343 $mail->send;
346 =head1 NAME
348 gather_print_notices - Print waiting print notices
350 =head1 SYNOPSIS
352 gather_print_notices output_directory [-s|--split] [--html] [--csv] [--ods] [--letter_code=LETTER_CODE] [-e|--email=your_email@example.org] [-h|--help]
354 Will print all waiting print notices to the output_directory.
356 The generated filename will be notices-TODAY.[csv|html|ods] or notices-TODAY-BRANCHCODE.[csv|html|ods] if the --split parameter is given.
358 =head1 OPTIONS
360 =over
362 =item B<output_directory>
364 Define the output directory where the files will be generated.
366 =item B<--send|--nosend>
368 After files have been generated, messages status is changed from 'pending' to
369 'sent'. This is the default action, without this parameter or with --send.
370 Using --nosend, the message status is not changed.
372 =item B<-s|--split>
374 Split messages into separate files by borrower home library to OUTPUT_DIRECTORY/notices-CURRENT_DATE-BRANCHCODE.[csv|html|ods]
376 =item B<--html>
378 Generate the print notices in a html file (default is --html, if --csv and --ods are not given).
380 =item B<--csv>
382 Generate the print notices in a csv file.
383 If you use this parameter, the template should contain 2 lines.
384 The first one the csv headers and the second one the value list.
386 For example:
387 cardnumber:patron:email:item
388 <<borrowers.cardnumber>>:<<borrowers.firstname>> <<borrowers.surname>>:<<borrowers.email>>:<<items.barcode>>
390 You have to combine this option with one (and only one) letter_code.
392 =item B<--ods>
394 Generate the print notices in a ods file.
396 This is the same as the csv parameter but using csv2odf to generate an ods file instead of a csv file.
398 =item B<--letter_code>
400 Filter print messages by letter_code.
401 Several letter_code parameters can be given.
403 =item B<-e|--email>
405 Repeatable.
406 E-mail address to send generated files to.
408 =item B<-h|--help>
410 Print a brief help message
412 =back
414 =head1 AUTHOR
416 Jesse Weaver <pianohacker@gmail.com>
418 Jonathan Druart <jonathan.druart@biblibre.com>
420 =head1 COPYRIGHT
422 Copyright 2009 Jesse Weaver
424 Copyright 2014 BibLibre
426 =head1 LICENSE
427 This file is part of Koha.
429 Koha is free software; you can redistribute it and/or modify it
430 under the terms of the GNU General Public License as published by
431 the Free Software Foundation; either version 3 of the License, or
432 (at your option) any later version.
434 Koha is distributed in the hope that it will be useful, but
435 WITHOUT ANY WARRANTY; without even the implied warranty of
436 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
437 GNU General Public License for more details.
439 You should have received a copy of the GNU General Public License
440 along with Koha; if not, see <http://www.gnu.org/licenses>.
442 =cut