@@ -, +, @@
* *UserCSS type customization handling for custom CSS (in addition to or in
* per branch CSS using per-branch CSS classes on the
of slips
---
C4/Circulation.pm | 20 +-
C4/Letters.pm | 547 +++++++++++++-------
C4/Members.pm | 81 +++-
C4/Members/Attributes.pm | 18 +
C4/Message.pm | 12 +-
C4/Print.pm | 146 ++----
C4/Reserves.pm | 103 +++--
C4/Suggestions.pm | 22 +-
acqui/booksellers.pl | 7 +-
circ/circulation.pl | 3 +-
circ/hold-transfer-slip.pl | 32 +-
.../data/mysql/de-DE/mandatory/sample_notices.sql | 2 +-
.../data/mysql/en/mandatory/sample_notices.sql | 83 +++-
.../data/mysql/es-ES/mandatory/sample_notices.sql | 2 +-
.../mysql/fr-FR/1-Obligatoire/sample_notices.sql | 2 +-
installer/data/mysql/it-IT/necessari/notices.sql | 2 +-
installer/data/mysql/kohastructure.sql | 7 +-
.../mysql/nb-NO/1-Obligatorisk/sample_notices.sql | 2 +-
.../data/mysql/pl-PL/mandatory/sample_notices.sql | 2 +-
.../data/mysql/ru-RU/mandatory/sample_notices.sql | 2 +-
installer/data/mysql/sysprefs.sql | 2 +
.../data/mysql/uk-UA/mandatory/sample_notices.sql | 2 +-
installer/data/mysql/updatedatabase.pl | 100 ++++-
.../prog/en/includes/circ-toolbar.inc | 4 +-
.../en/modules/admin/preferences/circulation.pref | 5 +
.../en/modules/admin/preferences/staff_client.pref | 5 +
.../prog/en/modules/batch/print-notices.tt | 6 +-
.../prog/en/modules/circ/hold-transfer-slip.tt | 54 --
.../prog/en/modules/circ/printslip.tt | 28 +
.../intranet-tmpl/prog/en/modules/tools/letter.tt | 162 +++++--
.../prog/en/modules/tools/tools-home.tt | 2 +-
members/memberentry.pl | 5 +-
members/moremember.pl | 10 -
members/printslip.pl | 92 ++++
misc/cronjobs/advance_notices.pl | 78 ++--
misc/cronjobs/gather_print_notices.pl | 14 +-
misc/cronjobs/overdue_notices.pl | 86 ++--
t/db_dependent/lib/KohaTest/Letters.pm | 5 +-
t/db_dependent/lib/KohaTest/Letters/GetLetter.pm | 3 +-
t/db_dependent/lib/KohaTest/Members.pm | 1 +
t/db_dependent/lib/KohaTest/Print.pm | 5 +-
t/db_dependent/lib/KohaTest/Reserves.pm | 1 +
tools/letter.pl | 230 ++++++---
43 files changed, 1306 insertions(+), 689 deletions(-)
delete mode 100644 koha-tmpl/intranet-tmpl/prog/en/modules/circ/hold-transfer-slip.tt
create mode 100644 koha-tmpl/intranet-tmpl/prog/en/modules/circ/printslip.tt
create mode 100755 members/printslip.pl
--- a/C4/Circulation.pm
+++ a/C4/Circulation.pm
@@ -2667,11 +2667,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) {
@@ -2686,7 +2693,8 @@ sub SendCirculationAlert {
$message->update;
}
}
- $letter;
+
+ return $letter;
}
=head2 updateWrongTransfer
--- a/C4/Letters.pm
+++ a/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/<>/$userenv->{firstname}/g;
- $letter->{content} =~ s/<>/$userenv->{surname}/g;
- $letter->{content} =~
- s/<>/$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/<>/$userenv->{firstname}/g;
- $letter->{content} =~ s/<>/$userenv->{surname}/g;
- $letter->{content} =~ s/<>/$userenv->{emailaddress}/g;
-
- # Get Fields remplacement
- my $order_format = $1 if ( $letter->{content} =~ m/(.*<\/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_content\n$order_format/xms;
- }
- $letter->{content} =~ s/.*<\/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/<>/$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 << >> << >>
+ 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/<>/$userenv->{firstname}/go;
+ $letter->{content} =~ s/<>/$userenv->{surname}/go;
+ $letter->{content} =~ s/<>/$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/<>/$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} =~ /<>/) {
+ my @da = localtime();
+ my $todaysdate = "$da[2]:$da[1] " . C4::Dates->today();
+ $letter->{content} =~ s/<>/$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 = "<>";
+ 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{ } if $css;
+ return <
+
+
+$title
+
+$css
+
+
+$content
+
+
+EOS
+}
+
sub _send_message_by_sms ($) {
my $message = shift or return undef;
my $member = C4::Members::GetMember( 'borrowernumber' => $message->{'borrowernumber'} );
--- a/C4/Members.pm
+++ a/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;
--- a/C4/Members/Attributes.pm
+++ a/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);
--- a/C4/Message.pm
+++ a/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:
--- a/C4/Print.pm
+++ a/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__
--- a/C4/Reserves.pm
+++ a/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/g;
- $letter->{'content'} =~ s/<>/$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
--- a/C4/Suggestions.pm
+++ a/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;
--- a/acqui/booksellers.pl
+++ a/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
)
)
--- a/circ/circulation.pl
+++ a/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 = '';
}
--- a/circ/hold-transfer-slip.pl
+++ a/circ/hold-transfer-slip.pl
@@ -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;
--- a/installer/data/mysql/de-DE/mandatory/sample_notices.sql
+++ a/installer/data/mysql/de-DE/mandatory/sample_notices.sql
@@ -11,7 +11,7 @@ VALUES ('circulation','ODUE','Mahnung','Mahnung','Liebe/r <
('reserves', 'HOLD_PRINT', 'Vormerkbenachrichtigung (Print)', 'Vormerkbenachrichtigung (Print)', '<>\r\n<>\r\n<>\r\n<>\r\n<> <>\r\n\r\n\r\n\r\n\r\n\r\n\r\n\r\n<> <>\r\n<>\r\n<>\r\n<> <>\r\n<>\r\n\r\n\r\n\r\n\r\n\r\n\r\n\r\n\r\nLiebe(r) <> <>,\r\n\r\nFür Sie liegt seit dem <> eine Vormerkung zur Abholung bereit:\r\n\r\nTitel: <>\r\nVerfasser: <>\r\nSignatur: <>\r\n'),
('circulation','CHECKIN','Rückgabequittung (Zusammenfassung)','Rückgabequittung','Die folgenden Medien wurden zurückgegeben:\r\n----\r\n<>\r\n----\r\nVielen Dank.'),
('circulation','CHECKOUT','Ausleihquittung (Zusammenfassung)','Ausleihquittung','Die folgenden Medien wurden entliehen:\r\n----\r\n<>\r\n----\r\nVielen Dank für Ihren Besuch in <>.'),
-('reserves', 'HOLDPLACED', 'Neue Vormerkung', 'Neue Vormerkung','Folgender Titel wurde vorgemerkt: <> (<>) durch den Benutzer <> <> (<>).'),
+('reserves', 'HOLDPLACED', 'Neue Vormerkung', 'Neue Vormerkung','Folgender Titel wurde vorgemerkt: <> (<>) durch den Benutzer <> <> (<>).'),
('suggestions','ACCEPTED','Anschaffungsvorschlag wurde angenommen', 'Ihr Anschaffungsvorschlag wurde angenommen','Liebe(r) <> <>,\n\nSie haben der Bibliothek folgendes Medium zur Anschaffung vorgeschlagen: <> by <>.\n\nDie Bibliothek hat diesen Titel heute recherchiert und wird Ihn sobald wie möglich im Buchhandel bestellen. Sie erhalten Nachricht, sobald die Bestellung abgeschlossen ist und sobald der Titel in der Bibliotek verfügbar ist.\n\nWenn Sie Fragen haben, richten Sie Ihre Mail bitte an: <>.\n\nVielen Dank,\n\n<>'),
('suggestions','AVAILABLE','Vorgeschlagenes Medium verfügbar', 'Das vorgeschlagene Medium ist jetzt verfügbar','Liebe(r) <> <>,\n\nSie haben der Bibliothek folgendes Medium zur Anschaffung vorgeschlagen: <> von <>.\n\nWir freuen uns Ihnen mitteilen zu können, dass dieser Titel jetzt im Bestand der Bibliothek verfügbar ist.\n\nWenn Sie Fragen haben, richten Sie Ihre Mail bitte an: <>.\n\nVielen Dank,\n\n<>'),
('suggestions','ORDERED','Vorgeschlagenes Medium bestellt', 'Das vorgeschlagene Medium wurde im Buchhandel bestellt','Liebe(r) <> <>,\n\nSie haben der Bibliothek folgendes Medium zur Anschaffung vorgeschlaten: <> von <>.\n\nWir freuen uns Ihnen mitteilen zu können, dass dieser Titel jetzt im Buchhandel bestellt wurde. Nach Eintreffen wird er in unseren Bestand eingearbeitet.\n\nSie erhalten Nachricht, sobald das Medium verfügbar ist.\n\nBei Nachfragen erreichen Sie uns unter der Emailadresse <>.\n\nVielen Dank,\n\n<>'),
--- a/installer/data/mysql/en/mandatory/sample_notices.sql
+++ a/installer/data/mysql/en/mandatory/sample_notices.sql
@@ -11,8 +11,89 @@ VALUES ('circulation','ODUE','Overdue Notice','Item Overdue','Dear <>\r\n<>\r\n<>\r\n\r\n\r\nChange Service Requested\r\n\r\n\r\n\r\n\r\n\r\n\r\n\r\n<> <>\r\n<>\r\n<> <>\r\n\r\n\r\n\r\n\r\n\r\n\r\n\r\n\r\n\r\n\r\n<> <> <>\r\n\r\nYou have a hold available for pickup as of <>:\r\n\r\nTitle: <>\r\nAuthor: <>\r\nCopy: <>\r\n'),
('circulation','CHECKIN','Item Check-in (Digest)','Check-ins','The following items have been checked in:\r\n----\r\n<>\r\n----\r\nThank you.'),
('circulation','CHECKOUT','Item Check-out (Digest)','Checkouts','The following items have been checked out:\r\n----\r\n<>\r\n----\r\nThank you for visiting <>.'),
-('reserves', 'HOLDPLACED', 'Hold Placed on Item', 'Hold Placed on Item','A hold has been placed on the following item : <> (<>) by the user <> <> (<>).'),
+('reserves', 'HOLDPLACED', 'Hold Placed on Item', 'Hold Placed on Item','A hold has been placed on the following item : <> (<>) by the user <> <> (<>).'),
('suggestions','ACCEPTED','Suggestion accepted', 'Purchase suggestion accepted','Dear <> <>,\n\nYou have suggested that the library acquire <> by <>.\n\nThe library has reviewed your suggestion today. The item will be ordered as soon as possible. You will be notified by mail when the order is completed, and again when the item arrives at the library.\n\nIf you have any questions, please email us at <>.\n\nThank you,\n\n<>'),
('suggestions','AVAILABLE','Suggestion available', 'Suggested purchase available','Dear <> <>,\n\nYou have suggested that the library acquire <> by <>.\n\nWe are pleased to inform you that the item you requested is now part of the collection.\n\nIf you have any questions, please email us at <>.\n\nThank you,\n\n<>'),
('suggestions','ORDERED','Suggestion ordered', 'Suggested item ordered','Dear <> <>,\n\nYou have suggested that the library acquire <> by <>.\n\nWe are pleased to inform you that the item you requested has now been ordered. It should arrive soon, at which time it will be processed for addition into the collection.\n\nYou will be notified again when the book is available.\n\nIf you have any questions, please email us at <>\n\nThank you,\n\n<>'),
('suggestions','REJECTED','Suggestion rejected', 'Purchase suggestion declined','Dear <> <>,\n\nYou have suggested that the library acquire <> by <>.\n\nThe library has reviewed your request today, and has decided not to accept the suggestion at this time.\n\nThe reason given is: <>\n\nIf you have any questions, please email us at <>.\n\nThank you,\n\n<>');
+INSERT INTO `letter` (module, code, name, title, content, is_html)
+VALUES ('circulation','ISSUESLIP','Issue Slip','Issue Slip', '<>
+Checked out to <> <> <> <>
+(<>)
+
+<>
+
+Checked Out
+
+
+<>
+Barcode: <>
+Date due: <>
+
+
+
+Overdues
+
+
+<>
+Barcode: <>
+Date due: <>
+
+
+
+
+
+News
+
+
+ ', 1),
+('circulation','ISSUEQSLIP','Issue Quick Slip','Issue Quick Slip', '<>
+Checked out to <> <> <> <>
+(<>)
+
+<>
+
+Checked Out Today
+
+
+<>
+Barcode: <>
+Date due: <>
+
+ ', 1),
+('circulation','RESERVESLIP','Reserve Slip','Reserve Slip', 'Date: <>
+
+ Transfer to/Hold in <>
+
+
+
+
<>, <>
+
+
+ <>
+ <>
+ <>
+ <>
+ <> <>
+
+ <>
+
+
+
ITEM ON HOLD
+
<>
+
<>
+
+
Notes:
+
<>
+
+
+ ', 1);
--- a/installer/data/mysql/es-ES/mandatory/sample_notices.sql
+++ a/installer/data/mysql/es-ES/mandatory/sample_notices.sql
@@ -11,7 +11,7 @@ VALUES ('circulation','ODUE','Overdue Notice','Item Overdue','Dear <>\r\n<>\r\n<>\r\n\r\n\r\nChange Service Requested\r\n\r\n\r\n\r\n\r\n\r\n\r\n\r\n<> <>\r\n<>\r\n<> <>\r\n\r\n\r\n\r\n\r\n\r\n\r\n\r\n\r\n\r\n\r\n<> <> <>\r\n\r\nYou have a hold available for pickup as of <>:\r\n\r\nTitle: <>\r\nAuthor: <>\r\nCopy: <>\r\n'),
('circulation','CHECKIN','Item Check-in (Digest)','Check-ins','The following items have been checked in:\r\n----\r\n<>\r\n----\r\nThank you.'),
('circulation','CHECKOUT','Item Check-out (Digest)','Checkouts','The following items have been checked out:\r\n----\r\n<>\r\n----\r\nThank you for visiting <>.'),
-('reserves', 'HOLDPLACED', 'Hold Placed on Item', 'Hold Placed on Item','A hold has been placed on the following item : <> (<>) by the user <> <> (<>).'),
+('reserves', 'HOLDPLACED', 'Hold Placed on Item', 'Hold Placed on Item','A hold has been placed on the following item : <> (<>) by the user <> <> (<>).'),
('suggestions','ACCEPTED','Suggestion accepted', 'Purchase suggestion accepted','Dear <> <>,\n\nYou have suggested that the library acquire <> by <>.\n\nThe library has reviewed your suggestion today. The item will be ordered as soon as possible. You will be notified by mail when the order is completed, and again when the item arrives at the library.\n\nIf you have any questions, please email us at <>.\n\nThank you,\n\n<>'),
('suggestions','AVAILABLE','Suggestion available', 'Suggested purchase available','Dear <> <>,\n\nYou have suggested that the library acquire <> by <>.\n\nWe are pleased to inform you that the item you requested is now part of the collection.\n\nIf you have any questions, please email us at <>.\n\nThank you,\n\n<>'),
('suggestions','ORDERED','Suggestion ordered', 'Suggested item ordered','Dear <> <>,\n\nYou have suggested that the library acquire <> by <>.\n\nWe are pleased to inform you that the item you requested has now been ordered. It should arrive soon, at which time it will be processed for addition into the collection.\n\nYou will be notified again when the book is available.\n\nIf you have any questions, please email us at <>\n\nThank you,\n\n<>'),
--- a/installer/data/mysql/fr-FR/1-Obligatoire/sample_notices.sql
+++ a/installer/data/mysql/fr-FR/1-Obligatoire/sample_notices.sql
@@ -13,7 +13,7 @@ VALUES
('reserves', 'HOLD_PRINT', 'Hold Available for Pickup (print notice)', 'Hold Available for Pickup at <>', '<>\n<>\n<>\n\n\nChange Service Requested\n\n\n\n\n\n\n\n<> <>\n<>\n<> <>\n\n\n\n\n\n\n\n\n\n\n<> <> <>\n\nYou have a hold available for pickup as of <>:\r\n\r\nTitle: <>\r\nAuthor: <>\r\nCopy: <>\r\n'),
('circulation','CHECKIN','Item Check-in (Digest)','Check-ins','The following items have been checked in:\r\n----\r\n<>\r\n----\r\nThank you.'),
('circulation','CHECKOUT','Item Check-out (Digest)','Checkouts','The following items have been checked out:\r\n----\r\n<>\r\n----\r\nThank you for visiting <>.'),
-('reserves', 'HOLDPLACED', 'Hold Placed on Item', 'Hold Placed on Item','A hold has been placed on the following item : <> (<>) by the user <> <> (<>).'),
+('reserves', 'HOLDPLACED', 'Hold Placed on Item', 'Hold Placed on Item','A hold has been placed on the following item : <> (<>) by the user <> <> (<>).'),
('suggestions','ACCEPTED','Suggestion accepted', 'Purchase suggestion accepted','Dear <> <>,\n\nYou have suggested that the library acquire <> by <>.\n\nThe library has reviewed your suggestion today. The item will be ordered as soon as possible. You will be notified by mail when the order is completed, and again when the item arrives at the library.\n\nIf you have any questions, please email us at <>.\n\nThank you,\n\n<>'),
('suggestions','AVAILABLE','Suggestion available', 'Suggested purchase available','Dear <> <>,\n\nYou have suggested that the library acquire <> by <>.\n\nWe are pleased to inform you that the item you requested is now part of the collection.\n\nIf you have any questions, please email us at <>.\n\nThank you,\n\n<>'),
('suggestions','ORDERED','Suggestion ordered', 'Suggested item ordered','Dear <> <>,\n\nYou have suggested that the library acquire <> by <>.\n\nWe are pleased to inform you that the item you requested has now been ordered. It should arrive soon, at which time it will be processed for addition into the collection.\n\nYou will be notified again when the book is available.\n\nIf you have any questions, please email us at <>\n\nThank you,\n\n<>'),
--- a/installer/data/mysql/it-IT/necessari/notices.sql
+++ a/installer/data/mysql/it-IT/necessari/notices.sql
@@ -11,7 +11,7 @@ VALUES ('circulation','ODUE','Overdue Notice','Item Overdue','Dear <>\r\n<>\r\n<>\r\n\r\n\r\nChange Service Requested\r\n\r\n\r\n\r\n\r\n\r\n\r\n\r\n<> <>\r\n<>\r\n<> <>\r\n\r\n\r\n\r\n\r\n\r\n\r\n\r\n\r\n\r\n\r\n<> <> <>\r\n\r\nYou have a hold available for pickup as of <>:\r\n\r\nTitle: <>\r\nAuthor: <>\r\nCopy: <>\r\n'),
('circulation','CHECKIN','Item Check-in (Digest)','Check-ins','The following items have been checked in:\r\n----\r\n<>\r\n----\r\nThank you.'),
('circulation','CHECKOUT','Item Check-out (Digest)','Checkouts','The following items have been checked out:\r\n----\r\n<>\r\n----\r\nThank you for visiting <>.'),
-('reserves', 'HOLDPLACED', 'Hold Placed on Item', 'Hold Placed on Item','A hold has been placed on the following item : <> (<>) by the user <> <> (<>).'),
+('reserves', 'HOLDPLACED', 'Hold Placed on Item', 'Hold Placed on Item','A hold has been placed on the following item : <> (<