Commit a9ded4fa authored by Srdjan Jankovic's avatar Srdjan Jankovic Committed by Paul Poulain

bug_7001: Issue and Reserve slips are notices.

Branches can have their own version of notices - added branchcode to
letter table.
Support html notices - added is_html to letter table.
Support for borrower attributes in templates.
GetPreparedletter() is the interface for compiling letters (notices).
Sysprefs for notice and slips stylesheets
Added TRANSFERSLIP to the letters
Signed-off-by: default avatarPaul Poulain <paul.poulain@biblibre.com>
parent e32e3ba6
......@@ -99,6 +99,7 @@ BEGIN {
&IsBranchTransferAllowed
&CreateBranchTransferLimit
&DeleteBranchTransferLimits
&TransferSlip
);
# subs to deal with offline circulation
......@@ -2676,11 +2677,18 @@ sub SendCirculationAlert {
borrowernumber => $borrower->{borrowernumber},
message_name => $message_name{$type},
});
my $letter = C4::Letters::getletter('circulation', $type);
C4::Letters::parseletter($letter, 'biblio', $item->{biblionumber});
C4::Letters::parseletter($letter, 'biblioitems', $item->{biblionumber});
C4::Letters::parseletter($letter, 'borrowers', $borrower->{borrowernumber});
C4::Letters::parseletter($letter, 'branches', $branch);
my $letter = C4::Letters::GetPreparedLetter (
module => 'circulation',
letter_code => $type,
branchcode => $branch,
tables => {
'biblio' => $item->{biblionumber},
'biblioitems' => $item->{biblionumber},
'borrowers' => $borrower,
'branches' => $branch,
}
) or return;
my @transports = @{ $borrower_preferences->{transports} };
# warn "no transports" unless @transports;
for (@transports) {
......@@ -2695,7 +2703,8 @@ sub SendCirculationAlert {
$message->update;
}
}
$letter;
return $letter;
}
=head2 updateWrongTransfer
......@@ -3147,6 +3156,35 @@ sub ProcessOfflineIssue {
=head2 TransferSlip
TransferSlip($user_branch, $itemnumber, $to_branch)
Returns letter hash ( see C4::Letters::GetPreparedLetter ) or undef
=cut
sub TransferSlip {
my ($branch, $itemnumber, $to_branch) = @_;
my $item = GetItem( $itemnumber )
or return;
my $pulldate = C4::Dates->new();
return C4::Letters::GetPreparedLetter (
module => 'circulation',
letter_code => 'TRANSFERSLIP',
branchcode => $branch,
tables => {
'branches' => $to_branch,
'biblio' => $item->{biblionumber},
'items' => $item,
},
);
}
1;
__END__
......
This diff is collapsed.
......@@ -23,7 +23,7 @@ package C4::Members;
use strict;
#use warnings; FIXME - Bug 2505
use C4::Context;
use C4::Dates qw(format_date_in_iso);
use C4::Dates qw(format_date_in_iso format_date);
use Digest::MD5 qw(md5_base64);
use Date::Calc qw/Today Add_Delta_YM check_date Date_to_Days/;
use C4::Log; # logaction
......@@ -31,8 +31,10 @@ use C4::Overdues;
use C4::Reserves;
use C4::Accounts;
use C4::Biblio;
use C4::Letters;
use C4::SQLHelper qw(InsertInTable UpdateInTable SearchInTable);
use C4::Members::Attributes qw(SearchIdMatchingAttribute);
use C4::NewsChannels; #get slip news
our ($VERSION,@ISA,@EXPORT,@EXPORT_OK,$debug);
......@@ -91,6 +93,8 @@ BEGIN {
&DeleteMessage
&GetMessages
&GetMessagesCount
&IssueSlip
);
#Modify data
......@@ -2229,7 +2233,80 @@ sub DeleteMessage {
logaction("MEMBERS", "DELCIRCMESSAGE", $message->{'borrowernumber'}, $message->{'message'}) if C4::Context->preference("BorrowersLog");
}
END { } # module clean-up code here (global destructor)
=head2 IssueSlip
IssueSlip($branchcode, $borrowernumber, $quickslip)
Returns letter hash ( see C4::Letters::GetPreparedLetter )
$quickslip is boolean, to indicate whether we want a quick slip
=cut
sub IssueSlip {
my ($branch, $borrowernumber, $quickslip) = @_;
# return unless ( C4::Context->boolean_preference('printcirculationslips') );
my $today = POSIX::strftime("%Y-%m-%d", localtime);
my $issueslist = GetPendingIssues($borrowernumber);
foreach my $it (@$issueslist){
if ($it->{'issuedate'} eq $today) {
$it->{'today'} = 1;
}
elsif ($it->{'date_due'} le $today) {
$it->{'overdue'} = 1;
}
$it->{'date_due'}=format_date($it->{'date_due'});
}
my @issues = sort { $b->{'timestamp'} <=> $a->{'timestamp'} } @$issueslist;
my ($letter_code, %repeat);
if ( $quickslip ) {
$letter_code = 'ISSUEQSLIP';
%repeat = (
'checkedout' => [ map {
'biblio' => $_,
'items' => $_,
'issues' => $_,
}, grep { $_->{'today'} } @issues ],
);
}
else {
$letter_code = 'ISSUESLIP';
%repeat = (
'checkedout' => [ map {
'biblio' => $_,
'items' => $_,
'issues' => $_,
}, grep { !$_->{'overdue'} } @issues ],
'overdue' => [ map {
'biblio' => $_,
'items' => $_,
'issues' => $_,
}, grep { $_->{'overdue'} } @issues ],
'news' => [ map {
$_->{'timestamp'} = $_->{'newdate'};
{ opac_news => $_ }
} @{ GetNewsToDisplay("slip") } ],
);
}
return C4::Letters::GetPreparedLetter (
module => 'circulation',
letter_code => $letter_code,
branchcode => $branch,
tables => {
'branches' => $branch,
'borrowers' => $borrowernumber,
},
repeat => \%repeat,
);
}
1;
......
......@@ -95,6 +95,24 @@ sub GetBorrowerAttributes {
return \@results;
}
=head2 GetAttributes
my $attributes = C4::Members::Attributes::GetAttributes([$opac_only]);
Retrieve an arrayref of extended attribute codes
=cut
sub GetAttributes {
my ($opac_only) = @_;
my $dbh = C4::Context->dbh();
my $query = "SELECT code FROM borrower_attribute_types";
$query .= "\nWHERE opac_display = 1" if $opac_only;
$query .= "\nORDER BY code";
return $dbh->selectcol_arrayref($query);
}
=head2 GetBorrowerAttributeValue
my $value = C4::Members::Attributes::GetBorrowerAttributeValue($borrowernumber, $attribute_code);
......
......@@ -18,9 +18,15 @@ How to add a new message to the queue:
use C4::Items;
my $borrower = { borrowernumber => 1 };
my $item = C4::Items::GetItem(1);
my $letter = C4::Letters::getletter('circulation', 'CHECKOUT');
C4::Letters::parseletter($letter, 'biblio', $item->{biblionumber});
C4::Letters::parseletter($letter, 'biblioitems', $item->{biblionumber});
my $letter = C4::Letters::GetPreparedLetter (
module => 'circulation',
letter_code => 'CHECKOUT',
branchcode => $branch,
tables => {
'biblio', $item->{biblionumber},
'biblioitems', $item->{biblionumber},
},
);
C4::Message->enqueue($letter, $borrower->{borrowernumber}, 'email');
How to update a borrower's last checkout message:
......
......@@ -20,8 +20,6 @@ package C4::Print;
use strict;
#use warnings; FIXME - Bug 2505
use C4::Context;
use C4::Members;
use C4::Dates qw(format_date);
use vars qw($VERSION @ISA @EXPORT);
......@@ -30,7 +28,7 @@ BEGIN {
$VERSION = 3.01;
require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(&remoteprint &printreserve &printslip);
@EXPORT = qw(&printslip);
}
=head1 NAME
......@@ -47,28 +45,48 @@ The functions in this module handle sending text to a printer.
=head1 FUNCTIONS
=head2 remoteprint
=cut
=comment
my $slip = <<"EOF";
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Date: $todaysdate;
ITEM RESERVED:
$itemdata->{'title'} ($itemdata->{'author'})
barcode: $itemdata->{'barcode'}
COLLECT AT: $branchname
BORROWER:
$bordata->{'surname'}, $bordata->{'firstname'}
card number: $bordata->{'cardnumber'}
Phone: $bordata->{'phone'}
$bordata->{'streetaddress'}
$bordata->{'suburb'}
$bordata->{'town'}
$bordata->{'emailaddress'}
&remoteprint($items, $borrower);
Prints the list of items in C<$items> to a printer.
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
EOF
=cut
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.
=head2 printslip
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>.
&printslip($slip)
print a slip for the given $borrowernumber and $branchcode
=cut
sub printslip ($) {
my ($slip) = @_;
return unless ( C4::Context->boolean_preference('printcirculationslips') );
# FIXME - It'd be nifty if this could generate pretty PostScript.
sub remoteprint ($$) {
my ($items, $borrower) = @_;
(return)
unless ( C4::Context->boolean_preference('printcirculationslips') );
my $queue = '';
# FIXME - If 'queue' is undefined or empty, then presumably it should
......@@ -94,107 +112,13 @@ sub remoteprint ($$) {
# print $queue;
#open (FILE,">/tmp/$file");
my $i = 0;
# FIXME - This is HLT-specific. Put this stuff in a customizable
# site-specific file somewhere.
print PRINTER "Horowhenua Library Trust\r\n";
print PRINTER "Phone: 368-1953\r\n";
print PRINTER "Fax: 367-9218\r\n";
print PRINTER "Email: renewals\@library.org.nz\r\n\r\n\r\n";
print PRINTER "$borrower->{'cardnumber'}\r\n";
print PRINTER
"$borrower->{'title'} $borrower->{'initials'} $borrower->{'surname'}\r\n";
# FIXME - Use for ($i = 0; $items->[$i]; $i++)
# Or better yet, foreach $item (@{$items})
while ( $items->[$i] ) {
# print $i;
my $itemdata = $items->[$i];
# FIXME - This is just begging for a Perl format.
print PRINTER "$i $itemdata->{'title'}\r\n";
print PRINTER "$itemdata->{'barcode'}";
print PRINTER " " x 15;
print PRINTER "$itemdata->{'date_due'}\r\n";
$i++;
}
print PRINTER $slip;
print PRINTER "\r\n" x 7 ;
close PRINTER;
#system("lpr /tmp/$file");
}
sub printreserve {
# FIXME - make useful
return;
my ( $branchname, $bordata, $itemdata ) = @_;
my $printer = '';
(return) unless ( C4::Context->boolean_preference('printreserveslips') );
if ( $printer eq "" || $printer eq 'nulllp' ) {
open( PRINTER, ">>/tmp/kohares" )
or die "Could not write to /tmp/kohares";
}
else {
open( PRINTER, "| lpr -P $printer >/dev/null" )
or die "Couldn't write to queue:$!\n";
}
my @da = localtime();
my $todaysdate = "$da[2]:$da[1] " . C4::Dates->today();
my $slip = <<"EOF";
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Date: $todaysdate;
ITEM RESERVED:
$itemdata->{'title'} ($itemdata->{'author'})
barcode: $itemdata->{'barcode'}
COLLECT AT: $branchname
BORROWER:
$bordata->{'surname'}, $bordata->{'firstname'}
card number: $bordata->{'cardnumber'}
Phone: $bordata->{'phone'}
$bordata->{'streetaddress'}
$bordata->{'suburb'}
$bordata->{'town'}
$bordata->{'emailaddress'}
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
EOF
print PRINTER $slip;
close PRINTER;
return $slip;
}
=head2 printslip
&printslip($borrowernumber)
print a slip for the given $borrowernumber
=cut
#'
sub printslip ($) {
#FIXME - make useful
my $borrowernumber = shift;
my $borrower = GetMemberDetails($borrowernumber);
my $issueslist = GetPendingIssues($borrowernumber);
foreach my $it (@$issueslist){
$it->{'date_due'}=format_date($it->{'date_due'});
}
my @issues = sort { $b->{'timestamp'} <=> $a->{'timestamp'} } @$issueslist;
remoteprint(\@issues, $borrower );
}
END { } # module clean-up code here (global destructor)
1;
__END__
......
......@@ -121,6 +121,8 @@ BEGIN {
&AlterPriority
&ToggleLowestPriority
&ReserveSlip
);
@EXPORT_OK = qw( MergeHolds );
}
......@@ -194,32 +196,31 @@ sub AddReserve {
# Send e-mail to librarian if syspref is active
if(C4::Context->preference("emailLibrarianWhenHoldIsPlaced")){
my $borrower = C4::Members::GetMember(borrowernumber => $borrowernumber);
my $biblio = GetBiblioData($biblionumber);
my $letter = C4::Letters::getletter( 'reserves', 'HOLDPLACED');
my $branchcode = $borrower->{branchcode};
my $branch_details = C4::Branch::GetBranchDetail($branchcode);
my $admin_email_address =$branch_details->{'branchemail'} || C4::Context->preference('KohaAdminEmailAddress');
my %keys = (%$borrower, %$biblio);
foreach my $key (keys %keys) {
my $replacefield = "<<$key>>";
$letter->{content} =~ s/$replacefield/$keys{$key}/g;
$letter->{title} =~ s/$replacefield/$keys{$key}/g;
my $branch_details = C4::Branch::GetBranchDetail($borrower->{branchcode});
if ( my $letter = C4::Letters::GetPreparedLetter (
module => 'reserves',
letter_code => 'HOLDPLACED',
branchcode => $branch,
tables => {
'branches' => $branch_details,
'borrowers' => $borrower,
'biblio' => $biblionumber,
},
) ) {
my $admin_email_address =$branch_details->{'branchemail'} || C4::Context->preference('KohaAdminEmailAddress');
C4::Letters::EnqueueLetter(
{ letter => $letter,
borrowernumber => $borrowernumber,
message_transport_type => 'email',
from_address => $admin_email_address,
to_address => $admin_email_address,
}
);
}
C4::Letters::EnqueueLetter(
{ letter => $letter,
borrowernumber => $borrowernumber,
message_transport_type => 'email',
from_address => $admin_email_address,
to_address => $admin_email_address,
}
);
}
#}
($const eq "o" || $const eq "e") or return; # FIXME: why not have a useful return value?
$query = qq/
......@@ -1720,21 +1721,21 @@ sub _koha_notify_reserve {
my $admin_email_address = $branch_details->{'branchemail'} || C4::Context->preference('KohaAdminEmailAddress');
my $letter = getletter( 'reserves', $letter_code );
die "Could not find a letter called '$letter_code' in the 'reserves' module" unless( $letter );
my $letter = C4::Letters::GetPreparedLetter (
module => 'reserves',
letter_code => $letter_code,
branchcode => $reserve->{branchcode},
tables => {
'branches' => $branch_details,
'borrowers' => $borrower,
'biblio' => $biblionumber,
'reserves' => $reserve,
'items', $reserve->{'itemnumber'},
},
substitute => { today => C4::Dates->new()->output() },
) or die "Could not find a letter called '$letter_code' in the 'reserves' module";
C4::Letters::parseletter( $letter, 'branches', $reserve->{'branchcode'} );
C4::Letters::parseletter( $letter, 'borrowers', $borrowernumber );
C4::Letters::parseletter( $letter, 'biblio', $biblionumber );
C4::Letters::parseletter( $letter, 'reserves', $borrowernumber, $biblionumber );
if ( $reserve->{'itemnumber'} ) {
C4::Letters::parseletter( $letter, 'items', $reserve->{'itemnumber'} );
}
my $today = C4::Dates->new()->output();
$letter->{'title'} =~ s/<<today>>/$today/g;
$letter->{'content'} =~ s/<<today>>/$today/g;
$letter->{'content'} =~ s/<<[a-z0-9_]+\.[a-z0-9]+>>//g; #remove any stragglers
if ( $print_mode ) {
C4::Letters::EnqueueLetter( {
......@@ -1908,6 +1909,36 @@ sub MergeHolds {
}
=head2 ReserveSlip
ReserveSlip($branchcode, $borrowernumber, $biblionumber)
Returns letter hash ( see C4::Letters::GetPreparedLetter ) or undef
=cut
sub ReserveSlip {
my ($branch, $borrowernumber, $biblionumber) = @_;
# return unless ( C4::Context->boolean_preference('printreserveslips') );
my $reserve = GetReserveInfo($borrowernumber,$biblionumber )
or return;
return C4::Letters::GetPreparedLetter (
module => 'circulation',
letter_code => 'RESERVESLIP',
branchcode => $branch,
tables => {
'reserves' => $reserve,
'branches' => $reserve->{branchcode},
'borrowers' => $reserve,
'biblio' => $reserve,
'items' => $reserve,
},
);
}
=head1 AUTHOR
Koha Development Team <http://koha-community.org/>
......
......@@ -425,20 +425,24 @@ sub ModSuggestion {
if ($suggestion->{STATUS}) {
# fetch the entire updated suggestion so that we can populate the letter
my $full_suggestion = GetSuggestion($suggestion->{suggestionid});
my $letter = C4::Letters::getletter('suggestions', $full_suggestion->{STATUS});
if ($letter) {
C4::Letters::parseletter($letter, 'branches', $full_suggestion->{branchcode});
C4::Letters::parseletter($letter, 'borrowers', $full_suggestion->{suggestedby});
C4::Letters::parseletter($letter, 'suggestions', $full_suggestion->{suggestionid});
C4::Letters::parseletter($letter, 'biblio', $full_suggestion->{biblionumber});
my $enqueued = C4::Letters::EnqueueLetter({
if ( my $letter = C4::Letters::GetPreparedLetter (
module => 'suggestions',
letter_code => $full_suggestion->{STATUS},
branchcode => $full_suggestion->{branchcode},
tables => {
'branches' => $full_suggestion->{branchcode},
'borrowers' => $full_suggestion->{suggestedby},
'suggestions' => $full_suggestion,
'biblio' => $full_suggestion->{biblionumber},
},
) ) {
C4::Letters::EnqueueLetter({
letter => $letter,
borrowernumber => $full_suggestion->{suggestedby},
suggestionid => $full_suggestion->{suggestionid},
LibraryName => C4::Context->preference("LibraryName"),
message_transport_type => 'email',
});
if (!$enqueued){warn "can't enqueue letter $letter";}
}) or warn "can't enqueue letter $letter";
}
}
return $status_update_table;
......
......@@ -111,16 +111,11 @@ for my $vendor (@suppliers) {
for my $basket ( @{$baskets} ) {
my $authorisedby = $basket->{authorisedby};
my $basketbranch = ''; # set a blank branch to start with
if ( GetMember( borrowernumber => $authorisedby ) ) {
# authorisedby may not be a valid borrowernumber; it's not foreign-key constrained!
$basketbranch = GetMember( borrowernumber => $authorisedby )->{branchcode};
}
if ($userenv->{'flags'} & 1 || #user is superlibrarian
(haspermission( $uid, { acquisition => q{*} } ) && #user has acq permissions and
($viewbaskets eq 'all' || #user is allowed to see all baskets
($viewbaskets eq 'branch' && $authorisedby && $userbranch eq $basketbranch) || #basket belongs to user's branch
($viewbaskets eq 'branch' && $authorisedby && $userbranch eq GetMember( borrowernumber => $authorisedby )->{branchcode}) || #basket belongs to user's branch
($basket->{authorisedby} && $viewbaskets == 'user' && $authorisedby == $loggedinuser) #user created this basket
)
)
......
......@@ -24,7 +24,6 @@ use strict;
#use warnings; FIXME - Bug 2505
use CGI;
use C4::Output;
use C4::Print;
use C4::Auth qw/:DEFAULT get_session/;
use C4::Dates qw/format_date/;
use C4::Branch; # GetBranches
......@@ -176,7 +175,7 @@ if ( $barcode eq '' && $query->param('charges') eq 'yes' ) {
}
if ( $print eq 'yes' && $borrowernumber ne '' ) {
printslip( $borrowernumber );
PrintIssueSlip($session->param('branch') || $branch, $borrowernumber);
$query->param( 'borrowernumber', '' );
$borrowernumber = '';
}
......
......@@ -23,10 +23,8 @@ use strict;
use C4::Context;
use C4::Output;
use CGI;
use C4::Auth;
use C4::Auth qw/:DEFAULT get_session/;
use C4::Reserves;
use C4::Branch;
use C4::Dates qw/format_date format_date_in_iso/;
use vars qw($debug);
......@@ -35,13 +33,16 @@ BEGIN {
}
my $input = new CGI;
my $sessionID = $input->cookie("CGISESSID");
my $session = get_session($sessionID);
my $biblionumber = $input->param('biblionumber');
my $borrowernumber = $input->param('borrowernumber');
my $transfer = $input->param('transfer');
my ( $template, $loggedinuser, $cookie ) = get_template_and_user(
{
template_name => "circ/hold-transfer-slip.tmpl",
template_name => "circ/printslip.tmpl",
query => $input,
type => "intranet",
authnotrequired => 0,
......@@ -50,14 +51,21 @@ my ( $template, $loggedinuser, $cookie ) = get_template_and_user(
}
);
my $reserveinfo = GetReserveInfo($borrowernumber,$biblionumber );
my $pulldate = C4::Dates->new();
$reserveinfo->{'pulldate'} = $pulldate->output();
$reserveinfo->{'branchname'} = GetBranchName($reserveinfo->{'branchcode'});
$reserveinfo->{'transferrequired'} = $transfer;
$template->param( reservedata => [ $reserveinfo ] ,
);
my $userenv = C4::Context->userenv;
my ($slip, $is_html);
if ( my $letter = ReserveSlip ($session->param('branch') || $userenv->{branch}, $borrowernumber, $biblionumber) ) {
$slip = $letter->{content};
$is_html = $letter->{is_html};
}
else {
$slip = "Reserve not found";
}
$template->param(
slip => $slip,
plain => !$is_html,
title => "Koha -- Circulation: Transfers",
stylesheet => C4::Context->preference("SlipCSS"),
);
output_html_with_http_headers $input, $cookie, $template->output;
......
......@@ -24,11 +24,8 @@ use warnings;
use C4::Context;
use C4::Output;
use CGI;
use C4::Auth;
use C4::Biblio;
use C4::Items;
use C4::Branch;
use C4::Dates qw/format_date format_date_in_iso/;
use C4::Auth qw/:DEFAULT get_session/;
use C4::Circulation;
use vars qw($debug);
......@@ -37,12 +34,15 @@ BEGIN {
}
my $input = new CGI;
my $sessionID = $input->cookie("CGISESSID");
my $session = get_session($sessionID);
my $itemnumber = $input->param('transferitem');
my $branchcode = $input->param('branchcode');
my ( $template, $loggedinuser, $cookie ) = get_template_and_user(
{
template_name => "circ/transfer-slip.tmpl",
template_name => "circ/printslip.tmpl",
query => $input,
type => "intranet",
authnotrequired => 0,
......@@ -51,15 +51,21 @@ my ( $template, $loggedinuser, $cookie ) = get_template_and_user(
}
);
my $pulldate = C4::Dates->new();
my $item = GetItem( $itemnumber );
my ( undef, $biblio ) = GetBiblio($item->{biblionumber});
my $userenv = C4::Context->userenv;