| File: | C4/Print.pm |
| Coverage: | 29.0% |
| line | stmt | bran | cond | sub | time | code |
|---|---|---|---|---|---|---|
| 1 | package C4::Print; | |||||
| 2 | ||||||
| 3 | # Copyright 2000-2002 Katipo Communications | |||||
| 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 | 3 3 3 | 27707 49 98 | use strict; | |||
| 21 | #use warnings; FIXME - Bug 2505 | |||||
| 22 | 3 3 3 | 239 35 67 | use C4::Context; | |||
| 23 | 3 3 3 | 178 4 1255 | use C4::Members; | |||
| 24 | 3 3 3 | 15 4 162 | use C4::Dates qw(format_date); | |||
| 25 | ||||||
| 26 | 3 3 3 | 13 5 304 | use vars qw($VERSION @ISA @EXPORT); | |||
| 27 | ||||||
| 28 | BEGIN { | |||||
| 29 | # set the version for version checking | |||||
| 30 | 3 | 6 | $VERSION = 3.01; | |||
| 31 | 3 | 12 | require Exporter; | |||
| 32 | 3 | 63 | @ISA = qw(Exporter); | |||
| 33 | 3 | 2715 | @EXPORT = qw(&remoteprint &printreserve &printslip); | |||
| 34 | } | |||||
| 35 | ||||||
| 36 - 64 | =head1 NAME C4::Print - Koha module dealing with printing =head1 SYNOPSIS use C4::Print; =head1 DESCRIPTION The functions in this module handle sending text to a printer. =head1 FUNCTIONS =head2 remoteprint &remoteprint($items, $borrower); Prints the list of items in C<$items> to a printer. C<$borrower> is a reference-to-hash giving information about a patron. This may be gotten from C<&GetMemberDetails>. The patron's name will be printed in the output. C<$items> is a reference-to-list, where each element is a reference-to-hash describing a borrowed item. C<$items> may be gotten from C<&GetBorrowerIssues>. =cut | |||||
| 65 | ||||||
| 66 | # FIXME - It'd be nifty if this could generate pretty PostScript. | |||||
| 67 | sub remoteprint ($$) { | |||||
| 68 | 0 | my ($items, $borrower) = @_; | ||||
| 69 | ||||||
| 70 | (return) | |||||
| 71 | 0 | unless ( C4::Context->boolean_preference('printcirculationslips') ); | ||||
| 72 | 0 | my $queue = ''; | ||||
| 73 | ||||||
| 74 | # FIXME - If 'queue' is undefined or empty, then presumably it should | |||||
| 75 | # mean "use the default queue", whatever the default is. Presumably | |||||
| 76 | # the default depends on the physical location of the machine. | |||||
| 77 | # FIXME - Perhaps "print to file" should be a supported option. Just | |||||
| 78 | # set the queue to "file" (or " file", if real queues aren't allowed | |||||
| 79 | # to have spaces in them). Or perhaps if $queue eq "" and | |||||
| 80 | # $env->{file} ne "", then that should mean "print to $env->{file}". | |||||
| 81 | 0 | if ( $queue eq "" || $queue eq 'nulllp' ) { | ||||
| 82 | 0 | return; | ||||
| 83 | #open( PRINTER, ">/tmp/kohaiss" ); | |||||
| 84 | } | |||||
| 85 | else { | |||||
| 86 | ||||||
| 87 | # FIXME - This assumes that 'lpr' exists, and works as expected. | |||||
| 88 | # This is a reasonable assumption, but only because every other | |||||
| 89 | # printing package has a wrapper script called 'lpr'. It'd still | |||||
| 90 | # be better to be able to customize this. | |||||
| 91 | 0 | open( PRINTER, "| lpr -P $queue > /dev/null" ) | ||||
| 92 | or die "Couldn't write to queue:$queue!\n"; | |||||
| 93 | } | |||||
| 94 | ||||||
| 95 | # print $queue; | |||||
| 96 | #open (FILE,">/tmp/$file"); | |||||
| 97 | 0 | my $i = 0; | ||||
| 98 | # FIXME - This is HLT-specific. Put this stuff in a customizable | |||||
| 99 | # site-specific file somewhere. | |||||
| 100 | 0 | print PRINTER "Horowhenua Library Trust\r\n"; | ||||
| 101 | 0 | print PRINTER "Phone: 368-1953\r\n"; | ||||
| 102 | 0 | print PRINTER "Fax: 367-9218\r\n"; | ||||
| 103 | 0 | print PRINTER "Email: renewals\@library.org.nz\r\n\r\n\r\n"; | ||||
| 104 | 0 | print PRINTER "$borrower->{'cardnumber'}\r\n"; | ||||
| 105 | 0 | print PRINTER | ||||
| 106 | "$borrower->{'title'} $borrower->{'initials'} $borrower->{'surname'}\r\n"; | |||||
| 107 | ||||||
| 108 | # FIXME - Use for ($i = 0; $items->[$i]; $i++) | |||||
| 109 | # Or better yet, foreach $item (@{$items}) | |||||
| 110 | 0 | while ( $items->[$i] ) { | ||||
| 111 | ||||||
| 112 | # print $i; | |||||
| 113 | 0 | my $itemdata = $items->[$i]; | ||||
| 114 | ||||||
| 115 | # FIXME - This is just begging for a Perl format. | |||||
| 116 | 0 | print PRINTER "$i $itemdata->{'title'}\r\n"; | ||||
| 117 | 0 | print PRINTER "$itemdata->{'barcode'}"; | ||||
| 118 | 0 | print PRINTER " " x 15; | ||||
| 119 | 0 | print PRINTER "$itemdata->{'date_due'}\r\n"; | ||||
| 120 | 0 | $i++; | ||||
| 121 | } | |||||
| 122 | 0 | print PRINTER "\r\n" x 7 ; | ||||
| 123 | 0 | close PRINTER; | ||||
| 124 | ||||||
| 125 | #system("lpr /tmp/$file"); | |||||
| 126 | } | |||||
| 127 | ||||||
| 128 | sub printreserve { | |||||
| 129 | ||||||
| 130 | # FIXME - make useful | |||||
| 131 | 0 | return; | ||||
| 132 | ||||||
| 133 | 0 | my ( $branchname, $bordata, $itemdata ) = @_; | ||||
| 134 | 0 | my $printer = ''; | ||||
| 135 | 0 | (return) unless ( C4::Context->boolean_preference('printreserveslips') ); | ||||
| 136 | 0 | if ( $printer eq "" || $printer eq 'nulllp' ) { | ||||
| 137 | 0 | open( PRINTER, ">>/tmp/kohares" ) | ||||
| 138 | or die "Could not write to /tmp/kohares"; | |||||
| 139 | } | |||||
| 140 | else { | |||||
| 141 | 0 | open( PRINTER, "| lpr -P $printer >/dev/null" ) | ||||
| 142 | or die "Couldn't write to queue:$!\n"; | |||||
| 143 | } | |||||
| 144 | 0 | my @da = localtime(); | ||||
| 145 | 0 | my $todaysdate = "$da[2]:$da[1] " . C4::Dates->today(); | ||||
| 146 | 0 | my $slip = <<"EOF"; | ||||
| 147 | ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ | |||||
| 148 | Date: $todaysdate; | |||||
| 149 | ||||||
| 150 | ITEM RESERVED: | |||||
| 151 | $itemdata->{'title'} ($itemdata->{'author'}) | |||||
| 152 | barcode: $itemdata->{'barcode'} | |||||
| 153 | ||||||
| 154 | COLLECT AT: $branchname | |||||
| 155 | ||||||
| 156 | BORROWER: | |||||
| 157 | $bordata->{'surname'}, $bordata->{'firstname'} | |||||
| 158 | card number: $bordata->{'cardnumber'} | |||||
| 159 | Phone: $bordata->{'phone'} | |||||
| 160 | $bordata->{'streetaddress'} | |||||
| 161 | $bordata->{'suburb'} | |||||
| 162 | $bordata->{'town'} | |||||
| 163 | $bordata->{'emailaddress'} | |||||
| 164 | ||||||
| 165 | ||||||
| 166 | ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ | |||||
| 167 | EOF | |||||
| 168 | 0 | print PRINTER $slip; | ||||
| 169 | 0 | close PRINTER; | ||||
| 170 | 0 | return $slip; | ||||
| 171 | } | |||||
| 172 | ||||||
| 173 - 179 | =head2 printslip &printslip($borrowernumber) print a slip for the given $borrowernumber =cut | |||||
| 180 | ||||||
| 181 | #' | |||||
| 182 | sub printslip ($) { | |||||
| 183 | ||||||
| 184 | #FIXME - make useful | |||||
| 185 | ||||||
| 186 | 0 | my $borrowernumber = shift; | ||||
| 187 | 0 | my $borrower = GetMemberDetails($borrowernumber); | ||||
| 188 | 0 | my $issueslist = GetPendingIssues($borrowernumber); | ||||
| 189 | 0 | foreach my $it (@$issueslist){ | ||||
| 190 | 0 | $it->{'date_due'}=format_date($it->{'date_due'}); | ||||
| 191 | } | |||||
| 192 | 0 0 | my @issues = sort { $b->{'timestamp'} <=> $a->{'timestamp'} } @$issueslist; | ||||
| 193 | 0 | remoteprint(\@issues, $borrower ); | ||||
| 194 | } | |||||
| 195 | ||||||
| 196 | 3 | 812066 | END { } # module clean-up code here (global destructor) | |||
| 197 | ||||||
| 198 | 1; | |||||