[Koha-patches] [PATCH] Perl Modules
Daniel Sweeney
daniel.sweeney at liblime.com
Tue Feb 3 23:02:09 CET 2009
From: John Beppu <john.beppu at liblime.com>
- C4::Letters:EnqueueLetter() is aware of new fields in message_queue table
- C4::Circulation::SendCirculationAlert() actually works
- C4::Category cleanup
- C4::ItemType cleanup
- C4::Message is a new module.
It presents yet another way to interact with the message_queue.
You can now take messages that have already been queued and modify
their contents before they're sent out.
Signed-off-by: Daniel Sweeney <daniel.sweeney at liblime.com>
---
C4/Category.pm | 2 +
C4/Circulation.pm | 42 ++++++-
C4/ItemType.pm | 1 +
C4/Letters.pm | 9 +-
C4/Message.pm | 342 +++++++++++++++++++++++++++++++++++++++++++++++++++++
5 files changed, 389 insertions(+), 7 deletions(-)
create mode 100644 C4/Message.pm
diff --git a/C4/Category.pm b/C4/Category.pm
index 760b396..6b503b8 100644
--- a/C4/Category.pm
+++ b/C4/Category.pm
@@ -125,6 +125,8 @@ sub AUTOLOAD {
}
}
+sub DESTROY { }
+
diff --git a/C4/Circulation.pm b/C4/Circulation.pm
index f55b7fe..95c97bd 100644
--- a/C4/Circulation.pm
+++ b/C4/Circulation.pm
@@ -31,6 +31,7 @@ use C4::Dates;
use C4::Calendar;
use C4::Accounts;
use C4::ItemCirculationAlertPreference;
+use C4::Message;
use Date::Calc qw(
Today
Today_and_Now
@@ -1024,10 +1025,11 @@ sub AddIssue {
branchcode => $branch,
categorycode => $borrower->{categorycode},
item_type => $item->{itype},
+ notification => 'CHECKOUT',
);
if ($circulation_alert->is_enabled_for(\%conditions)) {
SendCirculationAlert({
- type => 'checkout',
+ type => 'CHECKOUT',
item => $item,
borrower => $borrower,
});
@@ -1522,10 +1524,11 @@ sub AddReturn {
branchcode => $branch,
categorycode => $borrower->{categorycode},
item_type => $iteminformation->{itype},
+ notification => 'CHECKIN',
);
if ($doreturn && $circulation_alert->is_enabled_for(\%conditions)) {
SendCirculationAlert({
- type => 'check-in',
+ type => 'CHECKIN',
item => $iteminformation,
borrower => $borrower,
});
@@ -2361,11 +2364,13 @@ sub AnonymiseIssueHistory {
Send out a C<check-in> or C<checkout> alert using the messaging system.
+B<Parameters>:
+
=over 4
=item type
-Valid values for this parameter are: C<check-in> or C<checkout>.
+Valid values for this parameter are: C<CHECKIN> and C<CHECKOUT>.
=item item
@@ -2380,7 +2385,7 @@ Hashref of information about the borrower of the item.
B<Example>:
SendCirculationAlert({
- type => 'checkout',
+ type => 'CHECKOUT',
item => $item,
borrower => $borrower,
});
@@ -2389,7 +2394,34 @@ B<Example>:
sub SendCirculationAlert {
my ($opts) = @_;
- # TODO - actually send a message ...somehow.
+ my ($type, $item, $borrower) = ($opts->{type}, $opts->{item}, $opts->{borrower});
+ my $dbh = C4::Context->dbh;
+ my %message_name = (
+ CHECKIN => 'Item Check-in',
+ CHECKOUT => 'Item Checkout',
+ );
+ my $borrower_preferences = C4::Members::Messaging::GetMessagingPreferences({
+ 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', $item->{homebranch});
+ my @transports = @{ $borrower_preferences->{transports} };
+ for (@transports) {
+ my $message = C4::Message->find_last_message($borrower, $type, $_);
+ if (!$message) {
+ #warn "create new message";
+ C4::Message->enqueue($letter, $borrower->{borrowernumber}, $_);
+ } else {
+ #warn "append to old message";
+ $message->append($letter);
+ $message->update;
+ }
+ }
+ $letter;
}
=head2 updateWrongTransfer
diff --git a/C4/ItemType.pm b/C4/ItemType.pm
index d15640d..719f3bb 100644
--- a/C4/ItemType.pm
+++ b/C4/ItemType.pm
@@ -115,6 +115,7 @@ sub AUTOLOAD {
}
}
+sub DESTROY { }
diff --git a/C4/Letters.pm b/C4/Letters.pm
index 3bcc514..2f0bbdb 100644
--- a/C4/Letters.pm
+++ b/C4/Letters.pm
@@ -531,6 +531,8 @@ sub EnqueueLetter {
return unless exists $params->{'borrowernumber'};
return unless exists $params->{'message_transport_type'};
+ warn 'got passed the guard';
+
# If we have any attachments we should encode then into the body.
if ( $params->{'attachments'} ) {
$params->{'letter'} = _add_attachments(
@@ -544,9 +546,9 @@ sub EnqueueLetter {
my $dbh = C4::Context->dbh();
my $statement = << 'ENDSQL';
INSERT INTO message_queue
-( borrowernumber, subject, content, message_transport_type, status, time_queued, to_address, from_address, content_type )
+( borrowernumber, subject, content, metadata, letter_code, message_transport_type, status, time_queued, to_address, from_address, content_type )
VALUES
-( ?, ?, ?, ?, ?, NOW(), ?, ?, ? )
+( ?, ?, ?, ?, ?, ?, ?, NOW(), ?, ?, ? )
ENDSQL
my $sth = $dbh->prepare($statement);
@@ -554,12 +556,15 @@ ENDSQL
$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
);
+ warn $result;
return $result;
}
diff --git a/C4/Message.pm b/C4/Message.pm
new file mode 100644
index 0000000..dcd3bad
--- /dev/null
+++ b/C4/Message.pm
@@ -0,0 +1,342 @@
+package C4::Message;
+use strict;
+use warnings;
+use C4::Context;
+use C4::Letters;
+use YAML::Syck;
+use Carp;
+
+=head1 NAME
+
+C4::Message - object for messages in the message_queue table
+
+=head1 SYNOPSIS
+
+How to add a new message to the queue:
+
+ use C4::Message;
+ 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});
+ C4::Message->enqueue($letter, $borrower->{borrowernumber}, 'email');
+
+How to update a borrower's last checkout message:
+
+ use C4::Message;
+ my $borrower = { borrowernumber => 1 };
+ my $message = C4::Message->find_last_message($borrower, 'CHECKOUT', 'email');
+ $message->append("you also checked out some other book....");
+ $message->update;
+
+=head1 DESCRIPTION
+
+This module presents an OO interface to the message_queue. Previously, you could
+only add messages to the message_queue via C<C4::Letters::EnqueueMessage()>. With
+this module, you can also get previously inserted messages, manipulate them, and
+save them back to the database.
+
+=cut
+
+
+our $AUTOLOAD;
+
+
+=head2 Class Methods
+
+=head3 C4::Message->new(\%attributes)
+
+This method creates an in-memory version of a message object.
+
+=cut
+
+# C4::Message->new(\%attributes) -- constructor
+sub new {
+ my ($class, $opts) = @_;
+ $opts ||= {};
+ bless {%$opts} => $class;
+}
+
+
+=head3 C4::Message->find($id)
+
+This method searches the message_queue table for a row with the given
+C<message_id> and it'll return a C4::Message object if it finds one.
+
+=cut
+
+# C4::Message->find($id) -- find a message by its message_id
+sub find {
+ my ($class, $id) = @_;
+ my $dbh = C4::Context->dbh;
+ my $msgs = $dbh->selectall_arrayref(
+ qq{SELECT * FROM message_queue WHERE message_id = ?},
+ { Slice => {} },
+ $id,
+ );
+ if (@$msgs) {
+ return $class->new($msgs->[0]);
+ } else {
+ return undef;
+ }
+}
+
+=head3 C4::Message->find_last_message($borrower, $letter_code, $transport)
+
+This method is used to get the borrower's most recent, pending, check-in or
+checkout message. (This makes it possible to add more information to the
+message before it gets sent out.)
+
+=cut
+
+# C4::Message->find_last_message($borrower, $letter_code, $transport)
+# -- get the borrower's most recent pending checkin or checkout notification
+sub find_last_message {
+ my ($class, $borrower, $letter_code, $transport) = @_;
+ # $type is the message_transport_type
+ $transport ||= 'email';
+ my $dbh = C4::Context->dbh;
+ my $msgs = $dbh->selectall_arrayref(
+ qq{
+ SELECT *
+ FROM message_queue
+ WHERE status = 'pending'
+ AND borrowernumber = ?
+ AND letter_code = ?
+ AND message_transport_type = ?
+ },
+ { Slice => {} },
+ $borrower->{borrowernumber},
+ $letter_code,
+ $transport,
+ );
+ if (@$msgs) {
+ return $class->new($msgs->[0]);
+ } else {
+ return undef;
+ }
+}
+
+
+=head3 C4::Message->enqueue($letter, $borrowernumber, $transport)
+
+This is a front-end for C<C4::Letters::EnqueueLetter()> that adds metadata to
+the message.
+
+=cut
+
+# C4::Message->enqueue($letter, $borrowernumber, $transport)
+sub enqueue {
+ my ($class, $letter, $borrowernumber, $transport) = @_;
+ my $metadata = _make_metadata($letter);
+ $letter->{metadata} = Dump($metadata);
+ carp 'enqueuing...';
+ C4::Letters::EnqueueLetter({
+ letter => $letter,
+ borrowernumber => $borrowernumber,
+ message_transport_type => $transport,
+ });
+}
+
+# _make_metadata($letter) -- return the letter split into head/body/footer
+sub _make_metadata {
+ my ($letter) = @_;
+ if ($letter->{content} =~ /----/) {
+ my ($header, $body, $footer) = split(/----\r?\n?/, $letter->{content});
+ return {
+ header => $header,
+ body => [$body],
+ footer => $footer,
+ };
+ } else {
+ return {
+ header => '',
+ body => [$letter->{content}],
+ footer => '',
+ };
+ }
+}
+
+=head2 Instance Methods
+
+=head3 $message->update()
+
+This saves the $message object back to the database. It needs to have
+already been created via C<enqueue> for this to work.
+
+=cut
+
+# $object->update -- save object to database
+sub update {
+ my ($self) = @_;
+ my $dbh = C4::Context->dbh;
+ $dbh->do(
+ qq{
+ UPDATE message_queue
+ SET
+ borrowernumber = ?,
+ subject = ?,
+ content = ?,
+ metadata = ?,
+ letter_code = ?,
+ message_transport_type = ?,
+ status = ?,
+ time_queued = ?,
+ to_address = ?,
+ from_address = ?,
+ content_type = ?
+ WHERE message_id = ?
+ },
+ {},
+ $self->borrowernumber,
+ $self->subject,
+ $self->content,
+ $self->{metadata}, # we want the raw YAML here
+ $self->letter_code,
+ $self->message_transport_type,
+ $self->status,
+ $self->time_queued,
+ $self->to_address,
+ $self->from_address,
+ $self->content_type,
+ $self->message_id
+ );
+}
+
+=head3 $message->metadata(\%new_metadata)
+
+This method automatically serializes and deserializes the metadata
+attribute. (It is stored in YAML format.)
+
+=cut
+
+# $object->metadata -- this is a YAML serialized column that contains a
+# structured representation of $object->content
+sub metadata {
+ my ($self, $data) = @_;
+ if ($data) {
+ $data->{header} ||= '';
+ $data->{body} ||= [];
+ $data->{footer} ||= '';
+ $self->{metadata} = Dump($data);
+ $self->content($self->render_metadata);
+ return $data;
+ } else {
+ return Load($self->{metadata});
+ }
+}
+
+# turn $object->metadata into a string suitable for $object->content
+sub render_metadata {
+ my ($self, $format) = @_;
+ $format ||= sub { $_[0] || "" };
+ my $metadata = $self->metadata;
+ my $body = $metadata->{body};
+ my $text = join('', map { $format->($_) } @$body);
+ return $metadata->{header} . $text . $metadata->{footer};
+}
+
+=head3 $message->append(\%letter)
+
+If passed a hashref, this method will assume that the hashref is in the form
+that C<C4::Letters::getletter()> returns. It will append the body of the
+letter to the message.
+
+=head3 $message->append($string)
+
+If passed a string, it'll append the string to the message.
+
+=cut
+
+# $object->append($letter_or_item) -- add a new item to a message's content
+sub append {
+ my ($self, $letter_or_item, $format) = @_;
+ my $item;
+ if (ref($letter_or_item)) {
+ my $letter = $letter_or_item;
+ my $metadata = _make_metadata($letter);
+ $item = $metadata->{body}->[0];
+ } else {
+ $item = $letter_or_item;
+ }
+ if (not $self->metadata) {
+ carp "Can't append to messages that don't have metadata.";
+ return undef;
+ }
+ my $metadata = $self->metadata;
+ push @{$metadata->{body}}, $item;
+ $self->metadata($metadata);
+ my $new_content = $self->render_metadata($format);
+ return $self->content($new_content);
+}
+
+=head2 Attributes Accessors
+
+=head3 $message->message_id
+
+=head3 $message->borrowernumber
+
+=head3 $message->subject
+
+=head3 $message->content
+
+=head3 $message->metadata
+
+=head3 $message->letter_code
+
+=head3 $message->message_transport_type
+
+=head3 $message->status
+
+=head3 $message->time_queued
+
+=head3 $message->to_address
+
+=head3 $message->from_address
+
+=head3 $message->content_type
+
+=cut
+
+# $object->$method -- treat keys as methods
+sub AUTOLOAD {
+ my ($self, @args) = @_;
+ my $attr = $AUTOLOAD;
+ $attr =~ s/.*://;
+ if (ref($self->{$attr}) eq 'CODE') {
+ $self->{$attr}->($self, @args);
+ } else {
+ if (@args) {
+ $self->{$attr} = $args[0];
+ } else {
+ $self->{$attr};
+ }
+ }
+}
+
+sub DESTROY { }
+
+1;
+
+=head1 SEE ALSO
+
+L<C4::Circulation>, L<C4::Letters>, L<C4::Members::Messaging>
+
+=head1 AUTHOR
+
+John Beppu <john.beppu at liblime.com>
+
+=cut
+
+# Local Variables: ***
+# mode: cperl ***
+# indent-tabs-mode: nil ***
+# cperl-close-paren-offset: -4 ***
+# cperl-continued-statement-offset: 4 ***
+# cperl-indent-level: 4 ***
+# cperl-indent-parens-as-block: t ***
+# cperl-tab-always-indent: nil ***
+# End: ***
+# vim:tabstop=8 softtabstop=4 shiftwidth=4 shiftround expandtab
--
1.5.5.GIT
More information about the Koha-patches
mailing list