Browse Source

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: Paul Poulain <paul.poulain@biblibre.com>
3.8.x
Srdjan Jankovic 11 years ago
committed by Paul Poulain
parent
commit
a9ded4fa00
  1. 50
      C4/Circulation.pm
  2. 549
      C4/Letters.pm
  3. 81
      C4/Members.pm
  4. 18
      C4/Members/Attributes.pm
  5. 12
      C4/Message.pm
  6. 146
      C4/Print.pm
  7. 103
      C4/Reserves.pm
  8. 22
      C4/Suggestions.pm
  9. 7
      acqui/booksellers.pl
  10. 3
      circ/circulation.pl
  11. 32
      circ/hold-transfer-slip.pl
  12. 32
      circ/transfer-slip.pl
  13. 2
      installer/data/mysql/de-DE/mandatory/sample_notices.sql
  14. 91
      installer/data/mysql/en/mandatory/sample_notices.sql
  15. 2
      installer/data/mysql/es-ES/mandatory/sample_notices.sql
  16. 2
      installer/data/mysql/fr-FR/1-Obligatoire/sample_notices.sql
  17. 2
      installer/data/mysql/it-IT/necessari/notices.sql
  18. 7
      installer/data/mysql/kohastructure.sql
  19. 2
      installer/data/mysql/nb-NO/1-Obligatorisk/sample_notices.sql
  20. 2
      installer/data/mysql/pl-PL/mandatory/sample_notices.sql
  21. 2
      installer/data/mysql/ru-RU/mandatory/sample_notices.sql
  22. 3
      installer/data/mysql/sysprefs.sql
  23. 2
      installer/data/mysql/uk-UA/mandatory/sample_notices.sql
  24. 111
      installer/data/mysql/updatedatabase.pl
  25. 4
      koha-tmpl/intranet-tmpl/prog/en/includes/circ-toolbar.inc
  26. 5
      koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/circulation.pref
  27. 5
      koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/staff_client.pref
  28. 6
      koha-tmpl/intranet-tmpl/prog/en/modules/batch/print-notices.tt
  29. 54
      koha-tmpl/intranet-tmpl/prog/en/modules/circ/hold-transfer-slip.tt
  30. 28
      koha-tmpl/intranet-tmpl/prog/en/modules/circ/printslip.tt
  31. 162
      koha-tmpl/intranet-tmpl/prog/en/modules/tools/letter.tt
  32. 2
      koha-tmpl/intranet-tmpl/prog/en/modules/tools/tools-home.tt
  33. 5
      members/memberentry.pl
  34. 10
      members/moremember.pl
  35. 92
      members/printslip.pl
  36. 78
      misc/cronjobs/advance_notices.pl
  37. 14
      misc/cronjobs/gather_print_notices.pl
  38. 86
      misc/cronjobs/overdue_notices.pl
  39. 5
      t/db_dependent/lib/KohaTest/Letters.pm
  40. 3
      t/db_dependent/lib/KohaTest/Letters/GetLetter.pm
  41. 1
      t/db_dependent/lib/KohaTest/Members.pm
  42. 5
      t/db_dependent/lib/KohaTest/Print.pm
  43. 1
      t/db_dependent/lib/KohaTest/Reserves.pm
  44. 230
      tools/letter.pl

50
C4/Circulation.pm

@ -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__

549
C4/Letters.pm

@ -24,6 +24,7 @@ use MIME::Lite;
use Mail::Sendmail;
use C4::Members;
use C4::Members::Attributes qw(GetBorrowerAttributes);
use C4::Branch;
use C4::Log;
use C4::SMS;
@ -40,7 +41,7 @@ BEGIN {
$VERSION = 3.01;
@ISA = qw(Exporter);
@EXPORT = qw(
&GetLetters &getletter &addalert &getalert &delalert &findrelatedto &SendAlerts GetPrintMessages
&GetLetters &GetPreparedLetter &GetWrappedLetter &addalert &getalert &delalert &findrelatedto &SendAlerts &GetPrintMessages
);
}
@ -115,13 +116,26 @@ sub GetLetters (;$) {
return \%letters;
}
sub getletter ($$) {
my ( $module, $code ) = @_;
my %letter;
sub getletter ($$$) {
my ( $module, $code, $branchcode ) = @_;
if (C4::Context->preference('IndependantBranches') && $branchcode){
$branchcode = C4::Context->userenv->{'branch'};
}
if ( my $l = $letter{$module}{$code}{$branchcode} ) {
return { %$l }; # deep copy
}
my $dbh = C4::Context->dbh;
my $sth = $dbh->prepare("select * from letter where module=? and code=?");
$sth->execute( $module, $code );
my $line = $sth->fetchrow_hashref;
return $line;
my $sth = $dbh->prepare("select * from letter where module=? and code=? and (branchcode = ? or branchcode = '') order by branchcode desc limit 1");
$sth->execute( $module, $code, $branchcode );
my $line = $sth->fetchrow_hashref
or return;
$line->{'content-type'} = 'text/html; charset="UTF-8"' if $line->{is_html};
$letter{$module}{$code}{$branchcode} = $line;
return { %$line };
}
=head2 addalert ($borrowernumber, $type, $externalid)
@ -176,7 +190,7 @@ sub delalert ($) {
sub getalert (;$$$) {
my ( $borrowernumber, $type, $externalid ) = @_;
my $dbh = C4::Context->dbh;
my $query = "SELECT * FROM alert WHERE";
my $query = "SELECT a.*, b.branchcode FROM alert a JOIN borrowers b USING(borrowernumber) WHERE";
my @bind;
if ($borrowernumber and $borrowernumber =~ /^\d+$/) {
$query .= " borrowernumber=? AND ";
@ -232,73 +246,68 @@ sub findrelatedto ($$) {
parameters :
- $type : the type of alert
- $externalid : the id of the "object" to query
- $letter : the letter to send.
- $letter_code : the letter to send.
send an alert to all borrowers having put an alert on a given subject.
=cut
sub SendAlerts {
my ( $type, $externalid, $letter ) = @_;
my ( $type, $externalid, $letter_code ) = @_;
my $dbh = C4::Context->dbh;
my $strsth;
if ( $type eq 'issue' ) {
# warn "sending issues...";
my $letter = getletter( 'serial', $letter );
# prepare the letter...
# search the biblionumber
my $sth =
$dbh->prepare(
"SELECT biblionumber FROM subscription WHERE subscriptionid=?");
$sth->execute($externalid);
my ($biblionumber) = $sth->fetchrow;
# parsing branch info
my $userenv = C4::Context->userenv;
parseletter( $letter, 'branches', $userenv->{branch} );
# parsing librarian name
$letter->{content} =~ s/<<LibrarianFirstname>>/$userenv->{firstname}/g;
$letter->{content} =~ s/<<LibrarianSurname>>/$userenv->{surname}/g;
$letter->{content} =~
s/<<LibrarianEmailaddress>>/$userenv->{emailaddress}/g;
# parsing biblio information
parseletter( $letter, 'biblio', $biblionumber );
parseletter( $letter, 'biblioitems', $biblionumber );
my ($biblionumber) = $sth->fetchrow
or warn( "No subscription for '$externalid'" ),
return;
my %letter;
# find the list of borrowers to alert
my $alerts = getalert( '', 'issue', $externalid );
foreach (@$alerts) {
# and parse borrower ...
my $innerletter = $letter;
my $borinfo = C4::Members::GetMember('borrowernumber' => $_->{'borrowernumber'});
parseletter( $innerletter, 'borrowers', $_->{'borrowernumber'} );
my $email = $borinfo->{email} or next;
# warn "sending issues...";
my $userenv = C4::Context->userenv;
my $letter = GetPreparedLetter (
module => 'serial',
letter_code => $letter_code,
branchcode => $userenv->{branch},
tables => {
'branches' => $_->{branchcode},
'biblio' => $biblionumber,
'biblioitems' => $biblionumber,
'borrowers' => $borinfo,
},
want_librarian => 1,
) or return;
# ... then send mail
if ( $borinfo->{email} ) {
my %mail = (
To => $borinfo->{email},
From => $borinfo->{email},
Subject => "" . $innerletter->{title},
Message => "" . $innerletter->{content},
'Content-Type' => 'text/plain; charset="utf8"',
);
sendmail(%mail) or carp $Mail::Sendmail::error;
}
my %mail = (
To => $email,
From => $email,
Subject => "" . $letter->{title},
Message => "" . $letter->{content},
'Content-Type' => 'text/plain; charset="utf8"',
);
sendmail(%mail) or carp $Mail::Sendmail::error;
}
}
elsif ( $type eq 'claimacquisition' ) {
$letter = getletter( 'claimacquisition', $letter );
elsif ( $type eq 'claimacquisition' or $type eq 'claimissues' ) {
# prepare the letter...
# search the biblionumber
$strsth = qq{
$strsth = $type eq 'claimacquisition'
? qq{
SELECT aqorders.*,aqbasket.*,biblio.*,biblioitems.*,aqbooksellers.*
FROM aqorders
LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
@ -306,114 +315,83 @@ sub SendAlerts {
LEFT JOIN biblioitems ON aqorders.biblioitemnumber=biblioitems.biblioitemnumber
LEFT JOIN aqbooksellers ON aqbasket.booksellerid=aqbooksellers.id
WHERE aqorders.ordernumber IN (
}
. join( ",", @$externalid ) . ")";
}
elsif ( $type eq 'claimissues' ) {
$letter = getletter( 'claimissues', $letter );
# prepare the letter...
# search the biblionumber
$strsth = qq{
}
: qq{
SELECT serial.*,subscription.*, biblio.*, aqbooksellers.*
FROM serial
LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
LEFT JOIN biblio ON serial.biblionumber=biblio.biblionumber
LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
WHERE serial.serialid IN (
}
}
. join( ",", @$externalid ) . ")";
}
if ( $type eq 'claimacquisition' or $type eq 'claimissues' ) {
my $sthorders = $dbh->prepare($strsth);
$sthorders->execute;
my @fields = map {
$sthorders->{mysql_table}[$_] . "." . $sthorders->{NAME}[$_] }
(0 .. $#{$sthorders->{NAME}} ) ;
my @orders_infos;
while ( my $row = $sthorders->fetchrow_arrayref() ) {
my %rec = ();
@rec{@fields} = @$row;
push @orders_infos, \%rec;
my $dataorders = $sthorders->fetchall_arrayref( {} );
my $sthbookseller =
$dbh->prepare("select * from aqbooksellers where id=?");
$sthbookseller->execute( $dataorders->[0]->{booksellerid} );
my $databookseller = $sthbookseller->fetchrow_hashref;
my @email;
push @email, $databookseller->{bookselleremail} if $databookseller->{bookselleremail};
push @email, $databookseller->{contemail} if $databookseller->{contemail};
unless (@email) {
warn "Bookseller $dataorders->[0]->{booksellerid} without emails";
return;
}
# parsing branch info
my $userenv = C4::Context->userenv;
parseletter( $letter, 'branches', $userenv->{branch} );
# parsing librarian name
$letter->{content} =~ s/<<LibrarianFirstname>>/$userenv->{firstname}/g;
$letter->{content} =~ s/<<LibrarianSurname>>/$userenv->{surname}/g;
$letter->{content} =~ s/<<LibrarianEmailaddress>>/$userenv->{emailaddress}/g;
# Get Fields remplacement
my $order_format = $1 if ( $letter->{content} =~ m/(<order>.*<\/order>)/xms );
# Foreach field to remplace
while ( $letter->{content} =~ m/<<([^>]*)>>/g ) {
my $field = $1;
my $value = $orders_infos[0]->{$field} || "";
$value = sprintf("%.2f", $value) if $field =~ /price/;
$letter->{content} =~ s/<<$field>>/$value/g;
}
if ( $order_format ) {
# For each order
foreach my $infos ( @orders_infos ) {
my $order_content = $order_format;
# We replace by value
while ( $order_content =~ m/<<([^>]*)>>/g ) {
my $field = $1;
my $value = $infos->{$field} || "";
$value = sprintf("%.2f", $value) if $field =~ /price/;
$order_content =~ s/(<<$field>>)/$value/g;
}
$order_content =~ s/<\/{0,1}?order>//g;
$letter->{content} =~ s/<order>.*<\/order>/$order_content\n$order_format/xms;
}
$letter->{content} =~ s/<order>.*<\/order>//xms;
}
my $innerletter = $letter;
my $letter = GetPreparedLetter (
module => $type,
letter_code => $letter_code,
branchcode => $userenv->{branch},
tables => {
'branches' => $userenv->{branch},
'aqbooksellers' => $databookseller,
},
repeat => $dataorders,
want_librarian => 1,
) or return;
# ... then send mail
if ( $orders_infos[0]->{'aqbooksellers.bookselleremail'}
|| $orders_infos[0]->{'aqbooksellers.contemail'} ) {
my $to = $orders_infos[0]->{'aqbooksellers.bookselleremail'};
$to .= ", " if $to;
$to .= $orders_infos[0]->{'aqbooksellers.contemail'} || "";
my %mail = (
To => $to,
From => $userenv->{emailaddress},
Subject => Encode::encode( "utf8", "" . $innerletter->{title} ),
Message => Encode::encode( "utf8", "" . $innerletter->{content} ),
'Content-Type' => 'text/plain; charset="utf8"',
);
sendmail(%mail) or carp $Mail::Sendmail::error;
warn "sending to $mail{To} From $mail{From} subj $mail{Subject} Mess $mail{Message}" if $debug;
if ( C4::Context->preference("LetterLog") ) {
logaction( "ACQUISITION", "Send Acquisition claim letter", "", "order list : " . join( ",", @$externalid ) . "\n$innerletter->{title}\n$innerletter->{content}" ) if $type eq 'claimacquisition';
logaction( "ACQUISITION", "CLAIM ISSUE", undef, "To=" . $mail{To} . " Title=" . $innerletter->{title} . " Content=" . $innerletter->{content} ) if $type eq 'claimissues';
}
} else {
return {error => "no_email" };
}
warn "sending to From $userenv->{emailaddress} subj $innerletter->{title} Mess $innerletter->{content}" if $debug;
}
my %mail = (
To => join( ','. @email),
From => $userenv->{emailaddress},
Subject => "" . $letter->{title},
Message => "" . $letter->{content},
'Content-Type' => 'text/plain; charset="utf8"',
);
sendmail(%mail) or carp $Mail::Sendmail::error;
# send an "account details" notice to a newly created user
logaction(
"ACQUISITION",
$type eq 'claimissues' ? "CLAIM ISSUE" : "ACQUISITION CLAIM",
undef,
"To="
. $databookseller->{contemail}
. " Title="
. $letter->{title}
. " Content="
. $letter->{content}
) if C4::Context->preference("LetterLog");
}
# send an "account details" notice to a newly created user
elsif ( $type eq 'members' ) {
# must parse the password special, before it's hashed.
$letter->{content} =~ s/<<borrowers.password>>/$externalid->{'password'}/g;
parseletter( $letter, 'borrowers', $externalid->{'borrowernumber'});
parseletter( $letter, 'branches', $externalid->{'branchcode'} );
my $branchdetails = GetBranchDetail($externalid->{'branchcode'});
my $letter = GetPreparedLetter (
module => 'members',
letter_code => $letter_code,
branchcode => $externalid->{'branchcode'},
tables => {
'branches' => $branchdetails,
'borrowers' => $externalid->{'borrowernumber'},
},
substitute => { 'borrowers.password' => $externalid->{'password'} },
want_librarian => 1,
) or return;
my %mail = (
To => $externalid->{'emailaddr'},
From => $branchdetails->{'branchemail'} || C4::Context->preference("KohaAdminEmailAddress"),
@ -425,24 +403,148 @@ sub SendAlerts {
}
}
=head2 parseletter($letter, $table, $pk)
parameters :
- $letter : a hash to letter fields (title & content useful)
- $table : the Koha table to parse.
- $pk : the primary key to query on the $table table
parse all fields from a table, and replace values in title & content with the appropriate value
(not exported sub, used only internally)
=head2 GetPreparedLetter( %params )
%params hash:
module => letter module, mandatory
letter_code => letter code, mandatory
branchcode => for letter selection, if missing default system letter taken
tables => a hashref with table names as keys. Values are either:
- a scalar - primary key value
- an arrayref - primary key values
- a hashref - full record
substitute => custom substitution key/value pairs
repeat => records to be substituted on consecutive lines:
- an arrayref - tries to guess what needs substituting by
taking remaining << >> tokensr; not recommended
- a hashref token => @tables - replaces <token> << >> << >> </token>
subtemplate for each @tables row; table is a hashref as above
want_librarian => boolean, if set to true triggers librarian details
substitution from the userenv
Return value:
letter fields hashref (title & content useful)
=cut
our %handles = ();
our %columns = ();
sub GetPreparedLetter {
my %params = @_;
my $module = $params{module} or croak "No module";
my $letter_code = $params{letter_code} or croak "No letter_code";
my $branchcode = $params{branchcode} || '';
my $letter = getletter( $module, $letter_code, $branchcode )
or warn( "No $module $letter_code letter"),
return;
my $tables = $params{tables};
my $substitute = $params{substitute};
my $repeat = $params{repeat};
$tables || $substitute || $repeat
or carp( "ERROR: nothing to substitute - both 'tables' and 'substitute' are empty" ),
return;
my $want_librarian = $params{want_librarian};
if ($substitute) {
while ( my ($token, $val) = each %$substitute ) {
$letter->{title} =~ s/<<$token>>/$val/g;
$letter->{content} =~ s/<<$token>>/$val/g;
}
}
if ($want_librarian) {
# parsing librarian name
my $userenv = C4::Context->userenv;
$letter->{content} =~ s/<<LibrarianFirstname>>/$userenv->{firstname}/go;
$letter->{content} =~ s/<<LibrarianSurname>>/$userenv->{surname}/go;
$letter->{content} =~ s/<<LibrarianEmailaddress>>/$userenv->{emailaddress}/go;
}
my ($repeat_no_enclosing_tags, $repeat_enclosing_tags);
if ($repeat) {
if (ref ($repeat) eq 'ARRAY' ) {
$repeat_no_enclosing_tags = $repeat;
} else {
$repeat_enclosing_tags = $repeat;
}
}
if ($repeat_enclosing_tags) {
while ( my ($tag, $tag_tables) = each %$repeat_enclosing_tags ) {
if ( $letter->{content} =~ m!<$tag>(.*)</$tag>!s ) {
my $subcontent = $1;
my @lines = map {
my %subletter = ( title => '', content => $subcontent );
_substitute_tables( \%subletter, $_ );
$subletter{content};
} @$tag_tables;
$letter->{content} =~ s!<$tag>.*</$tag>!join( "\n", @lines )!se;
}
}
}
sub parseletter_sth {
if ($tables) {
_substitute_tables( $letter, $tables );
}
if ($repeat_no_enclosing_tags) {
if ( $letter->{content} =~ m/[^\n]*<<.*>>[^\n]*/so ) {
my $line = $&;
my $i = 1;
my @lines = map {
my $c = $line;
$c =~ s/<<count>>/$i/go;
foreach my $field ( keys %{$_} ) {
$c =~ s/(<<[^\.]+.$field>>)/$_->{$field}/;
}
$i++;
$c;
} @$repeat_no_enclosing_tags;
my $replaceby = join( "\n", @lines );
$letter->{content} =~ s/\Q$line\E/$replaceby/s;
}
}
$letter->{content} =~ s/<<\S*>>//go; #remove any stragglers
# $letter->{content} =~ s/<<[^>]*>>//go;
return $letter;
}
sub _substitute_tables {
my ( $letter, $tables ) = @_;
while ( my ($table, $param) = each %$tables ) {
next unless $param;
my $ref = ref $param;
my $values;
if ($ref && $ref eq 'HASH') {
$values = $param;
}
else {
my @pk;
my $sth = _parseletter_sth($table);
unless ($sth) {
warn "_parseletter_sth('$table') failed to return a valid sth. No substitution will be done for that table.";
return;
}
$sth->execute( $ref ? @$param : $param );
$values = $sth->fetchrow_hashref;
}
_parseletter ( $letter, $table, $values );
}
}
my %handles = ();
sub _parseletter_sth {
my $table = shift;
unless ($table) {
carp "ERROR: parseletter_sth() called without argument (table)";
carp "ERROR: _parseletter_sth() called without argument (table)";
return;
}
# check cache first
@ -456,9 +558,12 @@ sub parseletter_sth {
($table eq 'borrowers' ) ? "SELECT * FROM $table WHERE borrowernumber = ?" :
($table eq 'branches' ) ? "SELECT * FROM $table WHERE branchcode = ?" :
($table eq 'suggestions' ) ? "SELECT * FROM $table WHERE suggestionid = ?" :
($table eq 'aqbooksellers') ? "SELECT * FROM $table WHERE id = ?" : undef ;
($table eq 'aqbooksellers') ? "SELECT * FROM $table WHERE id = ?" :
($table eq 'aqorders' ) ? "SELECT * FROM $table WHERE ordernumber = ?" :
($table eq 'opac_news' ) ? "SELECT * FROM $table WHERE idnew = ?" :
undef ;
unless ($query) {
warn "ERROR: No parseletter_sth query for table '$table'";
warn "ERROR: No _parseletter_sth query for table '$table'";
return; # nothing to get
}
unless ($handles{$table} = C4::Context->dbh->prepare($query)) {
@ -468,25 +573,21 @@ sub parseletter_sth {
return $handles{$table}; # now cache is populated for that $table
}
sub parseletter {
my ( $letter, $table, $pk, $pk2 ) = @_;
unless ($letter) {
carp "ERROR: parseletter() 1st argument 'letter' empty";
return;
}
my $sth = parseletter_sth($table);
unless ($sth) {
warn "parseletter_sth('$table') failed to return a valid sth. No substitution will be done for that table.";
return;
}
if ( $pk2 ) {
$sth->execute($pk, $pk2);
} else {
$sth->execute($pk);
}
=head2 _parseletter($letter, $table, $values)
parameters :
- $letter : a hash to letter fields (title & content useful)
- $table : the Koha table to parse.
- $values : table record hashref
parse all fields from a table, and replace values in title & content with the appropriate value
(not exported sub, used only internally)
=cut
my %columns = ();
sub _parseletter {
my ( $letter, $table, $values ) = @_;
my $values = $sth->fetchrow_hashref;
# TEMPORARY hack until the expirationdate column is added to reserves
if ( $table eq 'reserves' && $values->{'waitingdate'} ) {
my @waitingdate = split /-/, $values->{'waitingdate'};
@ -500,16 +601,51 @@ sub parseletter {
)->output();
}
if ($letter->{content} && $letter->{content} =~ /<<today>>/) {
my @da = localtime();
my $todaysdate = "$da[2]:$da[1] " . C4::Dates->today();
$letter->{content} =~ s/<<today>>/$todaysdate/go;
}
# and get all fields from the table
my $columns = C4::Context->dbh->prepare("SHOW COLUMNS FROM $table");
$columns->execute;
while ( ( my $field ) = $columns->fetchrow_array ) {
my $replacefield = "<<$table.$field>>";
$values->{$field} =~ s/\p{P}(?=$)//g if $values->{$field};
my $replacedby = $values->{$field} || '';
($letter->{title} ) and $letter->{title} =~ s/$replacefield/$replacedby/g;
($letter->{content}) and $letter->{content} =~ s/$replacefield/$replacedby/g;
# my $columns = $columns{$table};
# unless ($columns) {
# $columns = $columns{$table} = C4::Context->dbh->selectcol_arrayref("SHOW COLUMNS FROM $table");
# }
# foreach my $field (@$columns) {
while ( my ($field, $val) = each %$values ) {
my $replacetablefield = "<<$table.$field>>";
my $replacefield = "<<$field>>";
$val =~ s/\p{P}(?=$)//g if $val;
my $replacedby = defined ($val) ? $val : '';
($letter->{title} ) and do {
$letter->{title} =~ s/$replacetablefield/$replacedby/g;
$letter->{title} =~ s/$replacefield/$replacedby/g;
};
($letter->{content}) and do {
$letter->{content} =~ s/$replacetablefield/$replacedby/g;
$letter->{content} =~ s/$replacefield/$replacedby/g;
};
}
if ($table eq 'borrowers' && $letter->{content}) {
if ( my $attributes = GetBorrowerAttributes($values->{borrowernumber}) ) {
my %attr;
foreach (@$attributes) {
my $code = $_->{code};
my $val = $_->{value_description} || $_->{value};
$val =~ s/\p{P}(?=$)//g if $val;
next unless $val gt '';
$attr{$code} ||= [];
push @{ $attr{$code} }, $val;
}
while ( my ($code, $val_ar) = each %attr ) {
my $replacefield = "<<borrower-attribute:$code>>";
my $replacedby = join ',', @$val_ar;
$letter->{content} =~ s/$replacefield/$replacedby/g;
}
}
}
return $letter;
}
@ -694,31 +830,32 @@ returns your letter object, with the content updated.
sub _add_attachments {
my $params = shift;
return unless 'HASH' eq ref $params;
foreach my $required_parameter (qw( letter attachments message )) {
return unless exists $params->{$required_parameter};
}
return $params->{'letter'} unless @{ $params->{'attachments'} };
my $letter = $params->{'letter'};
my $attachments = $params->{'attachments'};
return $letter unless @$attachments;
my $message = $params->{'message'};
# First, we have to put the body in as the first attachment
$params->{'message'}->attach(
Type => 'TEXT',
Data => $params->{'letter'}->{'content'},
$message->attach(
Type => $letter->{'content-type'} || 'TEXT',
Data => $letter->{'is_html'}
? _wrap_html($letter->{'content'}, $letter->{'title'})
: $letter->{'content'},
);
foreach my $attachment ( @{ $params->{'attachments'} } ) {
$params->{'message'}->attach(
foreach my $attachment ( @$attachments ) {
$message->attach(
Type => $attachment->{'type'},
Data => $attachment->{'content'},
Filename => $attachment->{'filename'},
);
}
# we're forcing list context here to get the header, not the count back from grep.
( $params->{'letter'}->{'content-type'} ) = grep( /^Content-Type:/, split( /\n/, $params->{'message'}->header_as_string ) );
$params->{'letter'}->{'content-type'} =~ s/^Content-Type:\s+//;
$params->{'letter'}->{'content'} = $params->{'message'}->body_as_string;
( $letter->{'content-type'} ) = grep( /^Content-Type:/, split( /\n/, $params->{'message'}->header_as_string ) );
$letter->{'content-type'} =~ s/^Content-Type:\s+//;
$letter->{'content'} = $message->body_as_string;
return $params->{'letter'};
return $letter;
}
@ -785,14 +922,17 @@ sub _send_message_by_email ($;$$$) {
my $utf8 = decode('MIME-Header', $message->{'subject'} );
$message->{subject}= encode('MIME-Header', $utf8);
my $subject = encode('utf8', $message->{'subject'});
my $content = encode('utf8', $message->{'content'});
my $content_type = $message->{'content_type'} || 'text/plain; charset="UTF-8"';
my $is_html = $content_type =~ m/html/io;
my %sendmail_params = (
To => $to_address,
From => $message->{'from_address'} || C4::Context->preference('KohaAdminEmailAddress'),
Subject => encode('utf8', $message->{'subject'}),
Subject => $subject,
charset => 'utf8',
Message => $content,
'content-type' => $message->{'content_type'} || 'text/plain; charset="UTF-8"',
Message => $is_html ? _wrap_html($content, $subject) : $content,
'content-type' => $content_type,
);
$sendmail_params{'Auth'} = {user => $username, pass => $password, method => $method} if $username;
if ( my $bcc = C4::Context->preference('OverdueNoticeBcc') ) {
@ -812,6 +952,27 @@ sub _send_message_by_email ($;$$$) {
}
}
sub _wrap_html {
my ($content, $title) = @_;
my $css = C4::Context->preference("NoticeCSS") || '';
$css = qq{<link rel="stylesheet" type="text/css" href="$css">} if $css;
return <<EOS;
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html lang="en" xml:lang="en" xmlns="http://www.w3.org/1999/xhtml">
<head>
<title>$title</title>
<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
$css
</head>
<body>
$content
</body>
</html>
EOS
}
sub _send_message_by_sms ($) {
my $message = shift or return undef;
my $member = C4::Members::GetMember( 'borrowernumber' => $message->{'borrowernumber'} );

81
C4/Members.pm

@ -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;

18
C4/Members/Attributes.pm

@ -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);

12
C4/Message.pm

@ -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:

146
C4/Print.pm

@ -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__

103
C4/Reserves.pm

@ -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/>

22
C4/Suggestions.pm

@ -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;

7
acqui/booksellers.pl

@ -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
)
)

3
circ/circulation.pl

@ -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 = '';
}

32
circ/hold-transfer-slip.pl