@@ -, +, @@ - apply patch - choose a patron to checkout item - in 'Patron messaging preferences' section, of patrons 'details' page - tick 'email' box for 'Item checkout' ---------------------------------------- Days in advance Email ---------------------------------------- - cut/paste below notice, for CHECKOUT, in 'Home › Tools › Notices & Slips › Modify notice' - delete issues and message_queue tables, before test - issue a test item to patron - check message_queue table for notice, with correctly formatted dates, with stripped time --- C4/Letters.pm | 545 ++++++++++++++++++++++++++++++++++----------------------- 1 files changed, 326 insertions(+), 219 deletions(-) --- a/C4/Letters.pm +++ a/C4/Letters.pm @@ -37,13 +37,14 @@ use Carp; use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); BEGIN { - require Exporter; - # set the version for version checking + require Exporter; + + # set the version for version checking $VERSION = 3.07.00.049; - @ISA = qw(Exporter); - @EXPORT = qw( - &GetLetters &GetPreparedLetter &GetWrappedLetter &addalert &getalert &delalert &findrelatedto &SendAlerts &GetPrintMessages - ); + @ISA = qw(Exporter); + @EXPORT = qw( + &GetLetters &GetPreparedLetter &GetWrappedLetter &addalert &getalert &delalert &findrelatedto &SendAlerts &GetPrintMessages + ); } =head1 NAME @@ -101,7 +102,7 @@ sub GetLetters { my %letters; my $dbh = C4::Context->dbh; my $sth; - if (defined $cat) { + if ( defined $cat ) { my $query = "SELECT * FROM letter WHERE module = ? ORDER BY name"; $sth = $dbh->prepare($query); $sth->execute($cat); @@ -118,30 +119,34 @@ sub GetLetters { } my %letter; + sub getletter { my ( $module, $code, $branchcode ) = @_; $branchcode ||= ''; - if ( C4::Context->preference('IndependantBranches') - and $branchcode - and C4::Context->userenv ) { + if ( C4::Context->preference('IndependantBranches') + and $branchcode + and C4::Context->userenv ) + { $branchcode = C4::Context->userenv->{'branch'}; } if ( my $l = $letter{$module}{$code}{$branchcode} ) { - return { %$l }; # deep copy + return {%$l}; # deep copy } my $dbh = C4::Context->dbh; - my $sth = $dbh->prepare("select * from letter where module=? and code=? and (branchcode = ? or branchcode = '') order by branchcode desc limit 1"); + 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 }; + return {%$line}; } =head2 addalert ($borrowernumber, $type, $externalid) @@ -158,8 +163,7 @@ sub getletter { sub addalert { my ( $borrowernumber, $type, $externalid ) = @_; my $dbh = C4::Context->dbh; - my $sth = - $dbh->prepare( + my $sth = $dbh->prepare( "insert into alert (borrowernumber, type, externalid) values (?,?,?)"); $sth->execute( $borrowernumber, $type, $externalid ); @@ -177,7 +181,9 @@ sub addalert { =cut sub delalert { - my $alertid = shift or die "delalert() called without valid argument (alertid)"; # it's gonna die anyway. + my $alertid = shift + or die "delalert() called without valid argument (alertid)" + ; # it's gonna die anyway. $debug and warn "delalert: deleting alertid $alertid"; my $sth = C4::Context->dbh->prepare("delete from alert where alertid=?"); $sth->execute($alertid); @@ -195,10 +201,11 @@ sub delalert { sub getalert { my ( $borrowernumber, $type, $externalid ) = @_; - my $dbh = C4::Context->dbh; - my $query = "SELECT a.*, b.branchcode FROM alert a JOIN borrowers b USING(borrowernumber) WHERE"; + my $dbh = C4::Context->dbh; + my $query = +"SELECT a.*, b.branchcode FROM alert a JOIN borrowers b USING(borrowernumber) WHERE"; my @bind; - if ($borrowernumber and $borrowernumber =~ /^\d+$/) { + if ( $borrowernumber and $borrowernumber =~ /^\d+$/ ) { $query .= " borrowernumber=? AND "; push @bind, $borrowernumber; } @@ -213,7 +220,7 @@ sub getalert { $query =~ s/ AND $//; my $sth = $dbh->prepare($query); $sth->execute(@bind); - return $sth->fetchall_arrayref({}); + return $sth->fetchall_arrayref( {} ); } =head2 findrelatedto($type, $externalid) @@ -226,17 +233,19 @@ sub getalert { When type=issue, the id is related to a subscriptionid and this sub returns the name of the biblio. =cut - + # outmoded POD: # When type=virtual, the id is related to a virtual shelf and this sub returns the name of the sub sub findrelatedto { my $type = shift or return; my $externalid = shift or return; - my $q = ($type eq 'issue' ) ? -"select title as result from subscription left join biblio on subscription.biblionumber=biblio.biblionumber where subscriptionid=?" : - ($type eq 'borrower') ? -"select concat(firstname,' ',surname) from borrowers where borrowernumber=?" : undef; + my $q = + ( $type eq 'issue' ) + ? "select title as result from subscription left join biblio on subscription.biblionumber=biblio.biblionumber where subscriptionid=?" + : ( $type eq 'borrower' ) + ? "select concat(firstname,' ',surname) from borrowers where borrowernumber=?" + : undef; unless ($q) { warn "findrelatedto(): Illegal type '$type'"; return; @@ -265,29 +274,30 @@ sub SendAlerts { # prepare the letter... # search the biblionumber - my $sth = - $dbh->prepare( + my $sth = $dbh->prepare( "SELECT biblionumber FROM subscription WHERE subscriptionid=?"); $sth->execute($externalid); my ($biblionumber) = $sth->fetchrow - or warn( "No subscription for '$externalid'" ), - return; + or warn("No subscription for '$externalid'"), + return; my %letter; + # find the list of borrowers to alert my $alerts = getalert( '', 'issue', $externalid ); foreach (@$alerts) { - my $borinfo = C4::Members::GetMember('borrowernumber' => $_->{'borrowernumber'}); + my $borinfo = C4::Members::GetMember( + 'borrowernumber' => $_->{'borrowernumber'} ); my $email = $borinfo->{email} or next; # warn "sending issues..."; my $userenv = C4::Context->userenv; - my $letter = GetPreparedLetter ( - module => 'serial', + my $letter = GetPreparedLetter( + module => 'serial', letter_code => $letter_code, - branchcode => $userenv->{branch}, - tables => { + branchcode => $userenv->{branch}, + tables => { 'branches' => $_->{branchcode}, 'biblio' => $biblionumber, 'biblioitems' => $biblionumber, @@ -303,7 +313,7 @@ sub SendAlerts { Subject => Encode::encode( "utf8", "" . $letter->{title} ), Message => Encode::encode( "utf8", "" . $letter->{content} ), 'Content-Type' => 'text/plain; charset="utf8"', - ); + ); sendmail(%mail) or carp $Mail::Sendmail::error; } } @@ -311,8 +321,8 @@ sub SendAlerts { # prepare the letter... # search the biblionumber - my $strsth = $type eq 'claimacquisition' - ? qq{ + my $strsth = $type eq 'claimacquisition' + ? qq{ SELECT aqorders.*,aqbasket.*,biblio.*,biblioitems.*,aqbooksellers.*, aqbooksellers.id AS booksellerid FROM aqorders @@ -322,7 +332,7 @@ sub SendAlerts { LEFT JOIN aqbooksellers ON aqbasket.booksellerid=aqbooksellers.id WHERE aqorders.ordernumber IN ( } - : qq{ + : qq{ SELECT serial.*,subscription.*, biblio.*, aqbooksellers.*, aqbooksellers.id AS booksellerid FROM serial @@ -342,32 +352,34 @@ sub SendAlerts { my $databookseller = $sthbookseller->fetchrow_hashref; my @email; - push @email, $databookseller->{bookselleremail} if $databookseller->{bookselleremail}; - push @email, $databookseller->{contemail} if $databookseller->{contemail}; + push @email, $databookseller->{bookselleremail} + if $databookseller->{bookselleremail}; + push @email, $databookseller->{contemail} + if $databookseller->{contemail}; unless (@email) { warn "Bookseller $dataorders->[0]->{booksellerid} without emails"; return { error => "no_email" }; } my $userenv = C4::Context->userenv; - my $letter = GetPreparedLetter ( - module => $type, + my $letter = GetPreparedLetter( + module => $type, letter_code => $letter_code, - branchcode => $userenv->{branch}, - tables => { - 'branches' => $userenv->{branch}, + branchcode => $userenv->{branch}, + tables => { + 'branches' => $userenv->{branch}, 'aqbooksellers' => $databookseller, }, - repeat => $dataorders, + repeat => $dataorders, want_librarian => 1, ) or return; # ... then send mail my %mail = ( - To => join( ',', @email), - From => $userenv->{emailaddress}, - Subject => Encode::encode( "utf8", "" . $letter->{title} ), - Message => Encode::encode( "utf8", "" . $letter->{content} ), + To => join( ',', @email ), + From => $userenv->{emailaddress}, + Subject => Encode::encode( "utf8", "" . $letter->{title} ), + Message => Encode::encode( "utf8", "" . $letter->{content} ), 'Content-Type' => 'text/plain; charset="utf8"', ); sendmail(%mail) or carp $Mail::Sendmail::error; @@ -377,22 +389,23 @@ sub SendAlerts { $type eq 'claimissues' ? "CLAIM ISSUE" : "ACQUISITION CLAIM", undef, "To=" - . $databookseller->{contemail} - . " Title=" - . $letter->{title} - . " Content=" - . $letter->{content} + . $databookseller->{contemail} + . " Title=" + . $letter->{title} + . " Content=" + . $letter->{content} ) if C4::Context->preference("LetterLog"); } - # send an "account details" notice to a newly created user + + # send an "account details" notice to a newly created user elsif ( $type eq 'members' ) { - my $branchdetails = GetBranchDetail($externalid->{'branchcode'}); - my $letter = GetPreparedLetter ( - module => 'members', + my $branchdetails = GetBranchDetail( $externalid->{'branchcode'} ); + my $letter = GetPreparedLetter( + module => 'members', letter_code => $letter_code, - branchcode => $externalid->{'branchcode'}, - tables => { - 'branches' => $branchdetails, + branchcode => $externalid->{'branchcode'}, + tables => { + 'branches' => $branchdetails, 'borrowers' => $externalid->{'borrowernumber'}, }, substitute => { 'borrowers.password' => $externalid->{'password'} }, @@ -401,11 +414,12 @@ sub SendAlerts { return { error => "no_email" } unless $externalid->{'emailaddr'}; my %mail = ( - To => $externalid->{'emailaddr'}, - From => $branchdetails->{'branchemail'} || C4::Context->preference("KohaAdminEmailAddress"), - Subject => Encode::encode( "utf8", $letter->{'title'} ), - Message => Encode::encode( "utf8", $letter->{'content'} ), - 'Content-Type' => 'text/plain; charset="utf8"', + To => $externalid->{'emailaddr'}, + From => $branchdetails->{'branchemail'} + || C4::Context->preference("KohaAdminEmailAddress"), + Subject => Encode::encode( "utf8", $letter->{'title'} ), + Message => Encode::encode( "utf8", $letter->{'content'} ), + 'Content-Type' => 'text/plain; charset="utf8"', ); sendmail(%mail) or carp $Mail::Sendmail::error; } @@ -437,55 +451,60 @@ sub SendAlerts { sub GetPreparedLetter { my %params = @_; - my $module = $params{module} or croak "No module"; + my $module = $params{module} or croak "No module"; my $letter_code = $params{letter_code} or croak "No letter_code"; - my $branchcode = $params{branchcode} || ''; + my $branchcode = $params{branchcode} || ''; my $letter = getletter( $module, $letter_code, $branchcode ) - or warn( "No $module $letter_code letter"), - return; + or warn("No $module $letter_code letter"), + return; - my $tables = $params{tables}; + my $tables = $params{tables}; my $substitute = $params{substitute}; - my $repeat = $params{repeat}; + my $repeat = $params{repeat}; $tables || $substitute || $repeat - or carp( "ERROR: nothing to substitute - both 'tables' and 'substitute' are empty" ), - return; + 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; + while ( my ( $token, $val ) = each %$substitute ) { + $letter->{title} =~ s/<<$token>>/$val/g; $letter->{content} =~ s/<<$token>>/$val/g; - } + } } my $OPACBaseURL = C4::Context->preference('OPACBaseURL'); $letter->{content} =~ s/<>/$OPACBaseURL/go; 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; + $letter->{content} =~ + s/<>/$userenv->{emailaddress}/go; } - my ($repeat_no_enclosing_tags, $repeat_enclosing_tags); + my ( $repeat_no_enclosing_tags, $repeat_enclosing_tags ); if ($repeat) { - if (ref ($repeat) eq 'ARRAY' ) { + if ( ref($repeat) eq 'ARRAY' ) { $repeat_no_enclosing_tags = $repeat; - } else { + } + else { $repeat_enclosing_tags = $repeat; } } if ($repeat_enclosing_tags) { - while ( my ($tag, $tag_tables) = each %$repeat_enclosing_tags ) { + while ( my ( $tag, $tag_tables ) = each %$repeat_enclosing_tags ) { if ( $letter->{content} =~ m!<$tag>(.*)!s ) { my $subcontent = $1; - my @lines = map { + my @lines = map { my %subletter = ( title => '', content => $subcontent ); _substitute_tables( \%subletter, $_ ); $subletter{content}; @@ -501,8 +520,8 @@ sub GetPreparedLetter { if ($repeat_no_enclosing_tags) { if ( $letter->{content} =~ m/[^\n]*<<.*>>[^\n]*/so ) { - my $line = $&; - my $i = 1; + my $line = $&; + my $i = 1; my @lines = map { my $c = $line; $c =~ s/<>/$i/go; @@ -518,28 +537,30 @@ sub GetPreparedLetter { } } - $letter->{content} =~ s/<<\S*>>//go; #remove any stragglers -# $letter->{content} =~ s/<<[^>]*>>//go; + $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 ) { + while ( my ( $table, $param ) = each %$tables ) { next unless $param; my $ref = ref $param; my $values; - if ($ref && $ref eq 'HASH') { + 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."; + warn +"_parseletter_sth('$table') failed to return a valid sth. No substitution will be done for that table."; return; } $sth->execute( $ref ? @$param : $param ); @@ -547,39 +568,51 @@ sub _substitute_tables { $values = $sth->fetchrow_hashref; } - _parseletter ( $letter, $table, $values ); + _parseletter( $letter, $table, $values ); } } my %handles = (); + sub _parseletter_sth { my $table = shift; unless ($table) { carp "ERROR: _parseletter_sth() called without argument (table)"; return; } + # check cache first - (defined $handles{$table}) and return $handles{$table}; - my $query = - ($table eq 'biblio' ) ? "SELECT * FROM $table WHERE biblionumber = ?" : - ($table eq 'biblioitems' ) ? "SELECT * FROM $table WHERE biblionumber = ?" : - ($table eq 'items' ) ? "SELECT * FROM $table WHERE itemnumber = ?" : - ($table eq 'issues' ) ? "SELECT * FROM $table WHERE itemnumber = ?" : - ($table eq 'old_issues' ) ? "SELECT * FROM $table WHERE itemnumber = ? ORDER BY timestamp DESC LIMIT 1" : - ($table eq 'reserves' ) ? "SELECT * FROM $table WHERE borrowernumber = ? and biblionumber = ?" : - ($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 = ?" : - ($table eq 'aqorders' ) ? "SELECT * FROM $table WHERE ordernumber = ?" : - ($table eq 'opac_news' ) ? "SELECT * FROM $table WHERE idnew = ?" : - ($table eq 'borrower_modifications') ? "SELECT * FROM $table WHERE borrowernumber = ? OR verification_token =?": - undef ; + ( defined $handles{$table} ) and return $handles{$table}; + my $query = + ( $table eq 'biblio' ) ? "SELECT * FROM $table WHERE biblionumber = ?" + : ( $table eq 'biblioitems' ) + ? "SELECT * FROM $table WHERE biblionumber = ?" + : ( $table eq 'items' ) ? "SELECT * FROM $table WHERE itemnumber = ?" + : ( $table eq 'issues' ) ? "SELECT * FROM $table WHERE itemnumber = ?" + : ( $table eq 'old_issues' ) + ? "SELECT * FROM $table WHERE itemnumber = ? ORDER BY timestamp DESC LIMIT 1" + : ( $table eq 'reserves' ) + ? "SELECT * FROM $table WHERE borrowernumber = ? and biblionumber = ?" + : ( $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 = ?" + : ( $table eq 'aqorders' ) + ? "SELECT * FROM $table WHERE ordernumber = ?" + : ( $table eq 'opac_news' ) + ? "SELECT * FROM $table WHERE idnew = ?" + : ( $table eq 'borrower_modifications' ) + ? "SELECT * FROM $table WHERE borrowernumber = ? OR verification_token =?" + : undef; unless ($query) { warn "ERROR: No _parseletter_sth query for table '$table'"; - return; # nothing to get + return; # nothing to get } - unless ($handles{$table} = C4::Context->dbh->prepare($query)) { + unless ( $handles{$table} = C4::Context->dbh->prepare($query) ) { warn "ERROR: Failed to prepare query: '$query'"; return; } @@ -598,6 +631,7 @@ sub _parseletter_sth { =cut my %columns = (); + sub _parseletter { my ( $letter, $table, $values ) = @_; @@ -608,48 +642,68 @@ sub _parseletter { $dt->add( days => C4::Context->preference('ReservesMaxPickUpDelay') ); $values->{'expirationdate'} = output_pref( $dt, undef, 1 ); - $values->{'waitingdate'} = output_pref( dt_from_string( $values->{'waitingdate'} ), undef, 1 ); + $values->{'waitingdate'} = + output_pref( dt_from_string( $values->{'waitingdate'} ), undef, 1 ); } - if ($letter->{content} && $letter->{content} =~ /<>/) { + if ( $letter->{content} && $letter->{content} =~ /<>/ ) { my $todaysdate = output_pref( DateTime->now() ); $letter->{content} =~ s/<>/$todaysdate/go; } - while ( my ($field, $val) = each %$values ) { + my @dates = qq| + issues.date_due issues.returndate issues.issuedate issues.lastreneweddate + old_issues.date_due old_issues.returndate old_issues.issuedate old_issues.lastreneweddate + |; + + while ( my ( $field, $val ) = each %$values ) { + + # Bug 9084 - Dates in notices should be formatted + # according to dateformat system preference + my $match = "$table.$field"; + if ( grep /$match/, @dates ) { + + # display syspref formatted date, and strip time + my $dateonly = 1; + $val = output_pref( dt_from_string($val), undef, undef, $dateonly ); + } + my $replacetablefield = "<<$table.$field>>"; - my $replacefield = "<<$field>>"; - $val =~ s/\p{P}$// if $val && $table=~/biblio/; - #BZ 9886: Assuming that we want to eliminate ISBD punctuation here - #Therefore adding the test on biblio. This includes biblioitems, - #but excludes items. Removed unneeded global and lookahead. - - my $replacedby = defined ($val) ? $val : ''; - ($letter->{title} ) and do { - $letter->{title} =~ s/$replacetablefield/$replacedby/g; - $letter->{title} =~ s/$replacefield/$replacedby/g; + my $replacefield = "<<$field>>"; + $val =~ s/\p{P}$// if $val && $table =~ /biblio/; + + #BZ 9886: Assuming that we want to eliminate ISBD punctuation here + #Therefore adding the test on biblio. This includes biblioitems, + #but excludes items. Removed unneeded global and lookahead. + + 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} ) 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}) ) { + if ( $table eq 'borrowers' && $letter->{content} ) { + if ( my $attributes = + GetBorrowerAttributes( $values->{borrowernumber} ) ) + { my %attr; foreach (@$attributes) { my $code = $_->{code}; - my $val = $_->{value_description} || $_->{value}; + 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 ) { + while ( my ( $code, $val_ar ) = each %attr ) { my $replacefield = "<>"; - my $replacedby = join ',', @$val_ar; + my $replacedby = join ',', @$val_ar; $letter->{content} =~ s/$replacefield/$replacedby/g; } } @@ -674,11 +728,12 @@ sub EnqueueLetter { my $params = shift or return; return unless exists $params->{'letter'}; -# return unless exists $params->{'borrowernumber'}; + + # return unless exists $params->{'borrowernumber'}; return unless exists $params->{'message_transport_type'}; my $content = $params->{letter}->{content}; - $content =~ s/\s+//g if(defined $content); + $content =~ s/\s+//g if ( defined $content ); if ( not defined $content or $content eq '' ) { warn "Trying to add an empty message to the message queue" if $debug; return; @@ -687,7 +742,8 @@ sub EnqueueLetter { # If we have any attachments we should encode then into the body. if ( $params->{'attachments'} ) { $params->{'letter'} = _add_attachments( - { letter => $params->{'letter'}, + { + letter => $params->{'letter'}, attachments => $params->{'attachments'}, message => MIME::Lite->new( Type => 'multipart/mixed' ), } @@ -704,18 +760,18 @@ ENDSQL my $sth = $dbh->prepare($statement); my $result = $sth->execute( - $params->{'borrowernumber'}, # borrowernumber - $params->{'letter'}->{'title'}, # subject - $params->{'letter'}->{'content'}, # content - $params->{'letter'}->{'metadata'} || '', # metadata - $params->{'letter'}->{'code'} || '', # letter_code - $params->{'message_transport_type'}, # message_transport_type - 'pending', # status - $params->{'to_address'}, # to_address - $params->{'from_address'}, # from_address - $params->{'letter'}->{'content-type'}, # content_type + $params->{'borrowernumber'}, # borrowernumber + $params->{'letter'}->{'title'}, # subject + $params->{'letter'}->{'content'}, # content + $params->{'letter'}->{'metadata'} || '', # metadata + $params->{'letter'}->{'code'} || '', # letter_code + $params->{'message_transport_type'}, # message_transport_type + 'pending', # status + $params->{'to_address'}, # to_address + $params->{'from_address'}, # from_address + $params->{'letter'}->{'content-type'}, # content_type ); - return $dbh->last_insert_id(undef,undef,'message_queue', undef); + return $dbh->last_insert_id( undef, undef, 'message_queue', undef ); } =head2 SendQueuedMessages ([$hashref]) @@ -732,22 +788,28 @@ sub SendQueuedMessages { my $params = shift; my $unsent_messages = _get_unsent_messages(); - MESSAGE: foreach my $message ( @$unsent_messages ) { + MESSAGE: foreach my $message (@$unsent_messages) { + # warn Data::Dumper->Dump( [ $message ], [ 'message' ] ); - warn sprintf( 'sending %s message to patron: %s', - $message->{'message_transport_type'}, - $message->{'borrowernumber'} || 'Admin' ) - if $params->{'verbose'} or $debug; + warn sprintf( + 'sending %s message to patron: %s', + $message->{'message_transport_type'}, + $message->{'borrowernumber'} || 'Admin' + ) + if $params->{'verbose'} + or $debug; + # This is just begging for subclassing - next MESSAGE if ( lc($message->{'message_transport_type'}) eq 'rss' ); + next MESSAGE if ( lc( $message->{'message_transport_type'} ) eq 'rss' ); if ( lc( $message->{'message_transport_type'} ) eq 'email' ) { - _send_message_by_email( $message, $params->{'username'}, $params->{'password'}, $params->{'method'} ); + _send_message_by_email( $message, $params->{'username'}, + $params->{'password'}, $params->{'method'} ); } elsif ( lc( $message->{'message_transport_type'} ) eq 'sms' ) { - _send_message_by_sms( $message ); + _send_message_by_sms($message); } } - return scalar( @$unsent_messages ); + return scalar(@$unsent_messages); } =head2 GetRSSMessages @@ -764,10 +826,14 @@ sub GetRSSMessages { return unless $params; return unless ref $params; return unless $params->{'borrowernumber'}; - - return _get_unsent_messages( { message_transport_type => 'rss', - limit => $params->{'limit'}, - borrowernumber => $params->{'borrowernumber'}, } ); + + return _get_unsent_messages( + { + message_transport_type => 'rss', + limit => $params->{'limit'}, + borrowernumber => $params->{'borrowernumber'}, + } + ); } =head2 GetPrintMessages @@ -781,10 +847,13 @@ person). sub GetPrintMessages { my $params = shift || {}; - - return _get_unsent_messages( { message_transport_type => 'print', - borrowernumber => $params->{'borrowernumber'}, - } ); + + return _get_unsent_messages( + { + message_transport_type => 'print', + borrowernumber => $params->{'borrowernumber'}, + } + ); } =head2 GetQueuedMessages ([$hashref]) @@ -801,7 +870,7 @@ list of hashes, each has represents a message in the message queue. sub GetQueuedMessages { my $params = shift; - my $dbh = C4::Context->dbh(); + my $dbh = C4::Context->dbh(); my $statement = << 'ENDSQL'; SELECT message_id, borrowernumber, subject, content, message_transport_type, status, time_queued FROM message_queue @@ -814,7 +883,7 @@ ENDSQL push @query_params, $params->{'borrowernumber'}; } - if ( @whereclauses ) { + if (@whereclauses) { $statement .= ' WHERE ' . join( 'AND', @whereclauses ); } @@ -823,9 +892,9 @@ ENDSQL push @query_params, $params->{'limit'}; } - my $sth = $dbh->prepare( $statement ); - my $result = $sth->execute( @query_params ); - return $sth->fetchall_arrayref({}); + my $sth = $dbh->prepare($statement); + my $result = $sth->execute(@query_params); + return $sth->fetchall_arrayref( {} ); } =head2 _add_attachements @@ -845,7 +914,7 @@ returns your letter object, with the content updated. sub _add_attachments { my $params = shift; - my $letter = $params->{'letter'}; + my $letter = $params->{'letter'}; my $attachments = $params->{'attachments'}; return $letter unless @$attachments; my $message = $params->{'message'}; @@ -854,19 +923,21 @@ sub _add_attachments { $message->attach( Type => $letter->{'content-type'} || 'TEXT', Data => $letter->{'is_html'} - ? _wrap_html($letter->{'content'}, $letter->{'title'}) - : $letter->{'content'}, + ? _wrap_html( $letter->{'content'}, $letter->{'title'} ) + : $letter->{'content'}, ); - foreach my $attachment ( @$attachments ) { + 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. - ( $letter->{'content-type'} ) = grep( /^Content-Type:/, split( /\n/, $params->{'message'}->header_as_string ) ); + +# we're forcing list context here to get the header, not the count back from grep. + ( $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; @@ -877,7 +948,7 @@ sub _add_attachments { sub _get_unsent_messages { my $params = shift; - my $dbh = C4::Context->dbh(); + my $dbh = C4::Context->dbh(); my $statement = << 'ENDSQL'; SELECT mq.message_id, mq.borrowernumber, mq.subject, mq.content, mq.message_transport_type, mq.status, mq.time_queued, mq.from_address, mq.to_address, mq.content_type, b.branchcode FROM message_queue mq @@ -902,69 +973,98 @@ ENDSQL } $debug and warn "_get_unsent_messages SQL: $statement"; - $debug and warn "_get_unsent_messages params: " . join(',',@query_params); - my $sth = $dbh->prepare( $statement ); - my $result = $sth->execute( @query_params ); - return $sth->fetchall_arrayref({}); + $debug + and warn "_get_unsent_messages params: " . join( ',', @query_params ); + my $sth = $dbh->prepare($statement); + my $result = $sth->execute(@query_params); + return $sth->fetchall_arrayref( {} ); } sub _send_message_by_email { my $message = shift or return; - my ($username, $password, $method) = @_; + my ( $username, $password, $method ) = @_; my $to_address = $message->{to_address}; unless ($to_address) { - my $member = C4::Members::GetMember( 'borrowernumber' => $message->{'borrowernumber'} ); + my $member = C4::Members::GetMember( + 'borrowernumber' => $message->{'borrowernumber'} ); unless ($member) { - warn "FAIL: No 'to_address' and INVALID borrowernumber ($message->{borrowernumber})"; - _set_message_status( { message_id => $message->{'message_id'}, - status => 'failed' } ); + warn +"FAIL: No 'to_address' and INVALID borrowernumber ($message->{borrowernumber})"; + _set_message_status( + { + message_id => $message->{'message_id'}, + status => 'failed' + } + ); return; } - $to_address = C4::Members::GetNoticeEmailAddress( $message->{'borrowernumber'} ); - unless ($to_address) { - # warn "FAIL: No 'to_address' and no email for " . ($member->{surname} ||'') . ", borrowernumber ($message->{borrowernumber})"; - # warning too verbose for this more common case? - _set_message_status( { message_id => $message->{'message_id'}, - status => 'failed' } ); + $to_address = + C4::Members::GetNoticeEmailAddress( $message->{'borrowernumber'} ); + unless ($to_address) { + +# warn "FAIL: No 'to_address' and no email for " . ($member->{surname} ||'') . ", borrowernumber ($message->{borrowernumber})"; +# warning too verbose for this more common case? + _set_message_status( + { + message_id => $message->{'message_id'}, + status => 'failed' + } + ); return; } } - 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 $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'), + From => $message->{'from_address'} + || C4::Context->preference('KohaAdminEmailAddress'), Subject => $subject, charset => 'utf8', - Message => $is_html ? _wrap_html($content, $subject) : $content, + Message => $is_html ? _wrap_html( $content, $subject ) : $content, 'content-type' => $content_type, ); - $sendmail_params{'Auth'} = {user => $username, pass => $password, method => $method} if $username; + $sendmail_params{'Auth'} = + { user => $username, pass => $password, method => $method } + if $username; + if ( my $bcc = C4::Context->preference('OverdueNoticeBcc') ) { - $sendmail_params{ Bcc } = $bcc; + $sendmail_params{Bcc} = $bcc; } - _update_message_to_address($message->{'message_id'},$to_address) unless $message->{to_address}; #if initial message address was empty, coming here means that a to address was found and queue should be updated - if ( sendmail( %sendmail_params ) ) { - _set_message_status( { message_id => $message->{'message_id'}, - status => 'sent' } ); + _update_message_to_address( $message->{'message_id'}, $to_address ) + unless $message + ->{to_address}; #if initial message address was empty, coming here means that a to address was found and queue should be updated + if ( sendmail(%sendmail_params) ) { + _set_message_status( + { + message_id => $message->{'message_id'}, + status => 'sent' + } + ); return 1; - } else { - _set_message_status( { message_id => $message->{'message_id'}, - status => 'failed' } ); + } + else { + _set_message_status( + { + message_id => $message->{'message_id'}, + status => 'failed' + } + ); carp $Mail::Sendmail::error; return; } } sub _wrap_html { - my ($content, $title) = @_; + my ( $content, $title ) = @_; my $css = C4::Context->preference("NoticeCSS") || ''; $css = qq{} if $css; @@ -986,38 +1086,45 @@ EOS sub _send_message_by_sms { my $message = shift or return; - my $member = C4::Members::GetMember( 'borrowernumber' => $message->{'borrowernumber'} ); + my $member = C4::Members::GetMember( + 'borrowernumber' => $message->{'borrowernumber'} ); return unless $member->{'smsalertnumber'}; - my $success = C4::SMS->send_sms( { destination => $member->{'smsalertnumber'}, - message => $message->{'content'}, - } ); - _set_message_status( { message_id => $message->{'message_id'}, - status => ($success ? 'sent' : 'failed') } ); + my $success = C4::SMS->send_sms( + { + destination => $member->{'smsalertnumber'}, + message => $message->{'content'}, + } + ); + _set_message_status( + { + message_id => $message->{'message_id'}, + status => ( $success ? 'sent' : 'failed' ) + } + ); return $success; } sub _update_message_to_address { - my ($id, $to)= @_; + my ( $id, $to ) = @_; my $dbh = C4::Context->dbh(); - $dbh->do('UPDATE message_queue SET to_address=? WHERE message_id=?',undef,($to,$id)); + $dbh->do( 'UPDATE message_queue SET to_address=? WHERE message_id=?', + undef, ( $to, $id ) ); } sub _set_message_status { my $params = shift or return; - foreach my $required_parameter ( qw( message_id status ) ) { - return unless exists $params->{ $required_parameter }; + foreach my $required_parameter (qw( message_id status )) { + return unless exists $params->{$required_parameter}; } - my $dbh = C4::Context->dbh(); + my $dbh = C4::Context->dbh(); my $statement = 'UPDATE message_queue SET status= ? WHERE message_id = ?'; - my $sth = $dbh->prepare( $statement ); - my $result = $sth->execute( $params->{'status'}, - $params->{'message_id'} ); + my $sth = $dbh->prepare($statement); + my $result = $sth->execute( $params->{'status'}, $params->{'message_id'} ); return $result; } - 1; __END__ --