Apache-App-Mercury
view release on metacpan or search on metacpan
POSSIBILITY OF SUCH DAMAGES.
END OF TERMS AND CONDITIONS
How to Apply These Terms to Your New Programs
If you develop a new program, and you want it to be of the greatest
possible use to the public, the best way to achieve this is to make it
free software which everyone can redistribute and change under these terms.
To do so, attach the following notices to the program. It is safest
to attach them to the start of each source file to most effectively
convey the exclusion of warranty; and each file should have at least
the "copyright" line and a pointer to where the full notice is found.
<one line to give the program's name and a brief idea of what it does.>
Copyright (C) 19yy <name of author>
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
} elsif ($q->param('reset')) {
$self->reset_compose_message;
} elsif ($q->param('change_recip')) {
$self->{compose_msg}->{'action'} .= "-changed_recip";
} elsif ($q->param('memo')) {
$self->{compose_msg}->{'sent_to'} = $self->{user_manager}->userprofile('user');
$self->{compose_msg}->{'recipient_desc'} = $self->{user_manager}->userprofile('user_desc');
} elsif ($q->param('nonmemo')) {
$self->{compose_msg}->{'sent_to'} = '';
$self->{compose_msg}->{'recipient_desc'} = '';
} elsif (defined (my $attach_no = $q->param('remove_attach'))) {
splice(@{$self->{compose_msg}->{'Attachments'}}, $attach_no, 1);
}
$self->show_mail_compose;
} elsif ($self->{'state'} eq 'preview_message') {
$self->save_compose_message_fields;
$controller->sitemark('/messaging.preview');
$controller->infomsg("You must take action on your existing composition before creating a transaction-related message.")
sub save_compose_message_fields {
my ($self) = @_;
my $q = $self->{q};
$self->{compose_msg}->{'sent_to'} = $q->param('recipient')
if defined $q->param('recipient');
$self->{compose_msg}->{'subject'} = $q->param('subject')
if defined $q->param('subject');
$self->{compose_msg}->{'body'} = $q->param('body')
if defined $q->param('body');
$self->{compose_msg}->{'num_to_attach'} =
$q->param('num_files_to_attach')
if defined $q->param('num_files_to_attach');
$self->{compose_msg}->{'security'} = $q->param('security')
if defined $q->param('security');
}
sub reset_compose_message {
my ($self) = @_;
my $q = $self->{q};
$self->{compose_msg} = Apache::App::Mercury::Message->new
({ 'sender' => $self->{user_manager}->userprofile('user') });
$self->{compose_msg}->initialize($self);
delete $self->{compose_msg};
}
sub message_send {
my ($self) = @_;
my $q = $self->{q};
my $compose = $self->{compose_msg};
my $is_memo = ($compose->{'sender'} eq $compose->{'sent_to'});
# add to msg object new attachments from CGI POST data that browser sent
$compose->read_attachments_from_cgi;
# tell message object to store itself
if ($compose->store) {
$self->{controller}->infomsg(!$is_memo ? "Your message has been sent." : "Your memo has been committed.");
delete $self->{compose_msg};
} else {
$self->{controller}->infomsg("There was an error ".(!$is_memo ? "sending your message" : "committing your memo").". Please contact technical support.");
}
}
tables in the database you just created:
CREATE TABLE messages (
id int(10) unsigned DEFAULT '0' NOT NULL auto_increment,
recipient varchar(16) DEFAULT '' NOT NULL,
sent_to varchar(255) DEFAULT '' NOT NULL,
sender varchar(16) DEFAULT '' NOT NULL,
timestamp timestamp(14),
subject varchar(100),
body text,
attachments text NOT NULL,
status enum('unread','read','replied','forwarded','deleted') DEFAULT 'unread',
status_sender enum('unread','read','replied','forwarded','deleted') DEFAULT 'unread',
status_smtp enum('unsent','sent','checked') DEFAULT 'unsent' NOT NULL,
code varchar(15) DEFAULT '' NOT NULL,
box varchar(16) DEFAULT '' NOT NULL,
trans enum('hide','show') DEFAULT 'hide' NOT NULL,
security enum('low','medium','high') DEFAULT 'medium',
PRIMARY KEY (id),
KEY recipient (recipient),
KEY timestamp (timestamp),
KEY sender (sender),
KEY code (code),
KEY box (box),
KEY sent_to (sent_to(34)),
KEY trans (trans),
KEY status_smtp (status_smtp)
);
CREATE TABLE message_attachments (
aid int(10) unsigned DEFAULT '0' NOT NULL auto_increment,
filesys char(255) DEFAULT '' NOT NULL,
attachment char(255) DEFAULT '' NOT NULL,
msg_ids char(255) DEFAULT '' NOT NULL,
PRIMARY KEY (aid),
UNIQUE filesys (filesys)
);
=head1 ACCESSORS
=over 4
=item controller()
Mercury/Config.pm view on Meta::CPAN
use constant BASE_URL => "https://www.your.domain.com";
use constant BASE_URI => "/messaging";
use constant ADMIN_EMAIL => 'postmaster@your.domain.com';
# Your application's name - displayed in HTML <title>
use constant APPLICATION_NAME => 'Apache::App::Mercury';
use constant DBI_CONNECT_STR => "DBI:mysql:database=mercury;host=localhost";
use constant DBI_LOGIN => "nobody";
use constant DBI_PASS => "";
use constant DBI_SQL_MSG_TABLE => "messages";
use constant DBI_MSG_ATTACHMENT_TABLE => "message_attachments";
# where to store attachments on filesystem (apache user must have write access)
use constant ATTACHMENT_FILESYS_BASE => "/var/www/html/attachments/";
# attachment base URI: this should be an absolute URI on your virtual host
# e.g. "/attachments/" for http://www.mydomain.org/attachments/
use constant ATTACHMENT_BASE_URI => "/attachments/";
# these are only for outgoing auto-forwarded e-mail messages (smtp_send script)
use constant SMTP_SERVER => "smtp";
use constant SMTP_HELLO => "your.domain.com";
use constant SMTP_TIMEOUT => 30; # in seconds
use constant SMTP_DEBUG => 0;
use constant MIME_NOTIFY_HDR => "Notification from Apache::App::Mercury";
use constant MIME_NOTIFY_MSG => 'This is an automated note to inform you that you have received an Apache::App::Mercury message. It can be read from:
Mercury/DBI.pm view on Meta::CPAN
return 0;
}
$self->warn("->change_box: moved ".(@ids ? join(', ', @ids) : "all in $all_in_this_box")." to $to_box");
return ($#ids + 1);
}
# returns a hash of Message objects
sub get_messages {
my ($self, $box, $trans_code, $ids, $smtp_status, $no_attachments) = @_;
my (@index, %msgs);
my $user = $self->{user_manager}->userprofile('user');
unless (($box and $user) or $trans_code or ref $ids eq 'ARRAY' or $smtp_status) {
$self->log_error("->get_messages: must send mailbox name and user, or transaction code, or a ref to an id list, or a status_smtp value!");
return {};
}
my $sorter = (($box and $self->{$box}->{'sortby'} and
Mercury/DBI.pm view on Meta::CPAN
}
}
eval {
my $dbh = DBI->connect
(Apache::App::Mercury::Config::DBI_CONNECT_STR,
Apache::App::Mercury::Config::DBI_LOGIN,
Apache::App::Mercury::Config::DBI_PASS,
{'RaiseError' => 1});
my $sth = $dbh->prepare_cached
("SELECT id,recipient,sent_to,sender,timestamp,DATE_FORMAT(timestamp, '%a %b %d %r %Y'),subject,body,attachments,status,status_smtp,code,trans,security,box FROM ".Apache::App::Mercury::Config::DBI_SQL_MSG_TABLE()." $where_clause ORDER BY $sorter...
$sth->execute(@bind_params);
my ($id, $recip, $sent_to, $sender, $timestamp, $time_recvd, $subj,
$body, $attach, $status, $smtp_status, $code, $display_trans,
$security, $thebox);
$sth->bind_columns
(\ ($id, $recip, $sent_to, $sender, $timestamp, $time_recvd, $subj,
$body, $attach, $status, $smtp_status, $code, $display_trans,
$security, $thebox) );
while ($sth->fetchrow_arrayref) {
$msgs{$id} = Apache::App::Mercury::Message->new
({ 'id' => $id,
'recipient' => $recip,
'sent_to' => $sent_to,
'sender' => $sender,
'time' => $timestamp,
'time_formatted' => $time_recvd,
'subject' => $subj,
Mercury/DBI.pm view on Meta::CPAN
'transcode' => $code,
'display_trans' => $display_trans,
'security' => $security,
'box' => $thebox });
$msgs{$id}->initialize($self);
$msgs{$id}->{'security_fixed'} = 1 if $security eq 'high';
$msgs{$id}->{'Attachments'} =
[ map {
Apache::App::Mercury::Message::Attachment->new
({ 'AttachmentID' => $_ })->retrieve;
} grep($_ ne '', split(/\s+/, $attach)) ]
if $attach && !$no_attachments;
push(@index, $id);
}
$sth->finish;
$dbh->disconnect;
};
if ($@) {
$self->log_error;
return {};
}
$self->{$box}->{'index'} = \@index if $box;
Mercury/Display.pm view on Meta::CPAN
if (ref $self->{compose_msg} eq "Apache::App::Mercury::Message" and
$self->{compose_msg}->{'transcode'}) {
my $is_memo = ($self->{compose_msg}->{'sender'} eq
$self->{compose_msg}->{'sent_to'});
$message = ($q->p . $q->em("You are about to ".(!$is_memo ? "send a message in response to" : "commit a memo regarding")." a transaction (Reference number: ".$self->{compose_msg}->{'transcode'}."). Anyone with permission to view this transaction wi...
} else {
$message = ($q->p . "Please review your message before sending.");
}
$message .= ($q->p . "Be sure to select the files you wish to attach.")
if $self->{compose_msg}->{'num_to_attach'};
$message .= ($q->p . "Your message is marked as <B>low</B>-security. This means it may be forwarded over the internet via insecure e-mail. If this message contains <B>any</B> patient-identifiable information, it is your responsibility to raise ...
if $self->{compose_msg}->{'security'} eq 'low';
return $message;
}
sub display_mail_settings {
my ($self) = @_;
my $q = $self->{q};
Mercury/Message.pm view on Meta::CPAN
sub initialize {
my ($self, $messaging) = @_;
$self->{messaging} = $messaging;
}
# CGI display methods and helpers
sub read_attachments_from_cgi {
my ($self) = @_;
my $q = $self->{messaging}->{q};
$self->{'Attachments'} = [] if ref $self->{'Attachments'} ne "ARRAY";
foreach (0..$self->{'num_to_attach'}-1) {
my $fh = $q->param('attachment'.$_);
next if !$fh;
my $new_attach = Apache::App::Mercury::Message::Attachment->new;
( $new_attach->{'Name'} ) = ( $fh =~ m/([^\\]+)$/ );
$new_attach->{'Name'} = $fh unless $new_attach->{'Name'};
my $buffer;
while (read($fh, $buffer, 10240)) {
$new_attach->{'Data'} .= $buffer;
}
push(@{$self->{'Attachments'}}, $new_attach);
}
}
sub pretty_print {
my ($self, $body) = @_;
# split long lines (60 char max)
$Text::Wrap::columns = 60;
$body = wrap('', '', $body);
Mercury/Message.pm view on Meta::CPAN
foreach (@{$self->{'recip_info'}}) {
$recip_desc .=
(($recip_desc ? "; " : "") .
($dispclass->can("USER_INFO_HREF")
? $dispclass->USER_INFO_HREF($_->{'user'}, $q)
: '') .
" (" . $_->{'fname'}." ".$_->{'lname'} . ")");
}
}
# generate attachment HTML
my @attach_html;
if (ref $self->{'Attachments'} eq "ARRAY") {
foreach (0..$#{$self->{'Attachments'}}) {
my $a = $self->{'Attachments'}->[$_];
next unless
$a->{'Filename'} and $a->{'Name'} and $a->{'AttachmentID'};
push(@attach_html,
($q->td({-align => 'right', -nowrap},
$q->b("Attachment ".($_+1).":")) .
$q->td({-nowrap},
$q->a({-href => $self->uri_escape_noamp
(Apache::App::Mercury::Config::ATTACHMENT_BASE_URI() .
$a->{'Filename'}),
-class => 'attach',
-target => 'theAttachmentWindow'},
$a->{'Name'}))));
}
}
my $markedup_body = $self->pretty_print($self->{'body'});
return
($q->table
($q->Tr
Mercury/Message.pm view on Meta::CPAN
? $user
: ($dispclass->can("USER_INFO_HREF")
? $dispclass->USER_INFO_HREF($self->{'sender'}, $q)
: '')) .
" (".$self->{'sender_info'}->{'fname'}." ".
$self->{'sender_info'}->{'lname'}.")"),
(!$is_memo
? ($q->td({-align => 'right', -valign => 'top', -nowrap},
$q->b("To:")) . $q->td($recip_desc))
: ()),
@attach_html,
($self->{'action'}
? ()
: ($q->td({-align => 'right', -nowrap}, $q->b("Security level:")) .
$q->td({-nowrap}, $q->font({-face => 'fixed'},
uc $self->{'security'}))))
])
) .
$q->hr({-width => '200', -align => 'left', -size => '1'}) .
$q->pre($markedup_body)
);
Mercury/Message.pm view on Meta::CPAN
my $messaging = $self->{messaging};
my $q = $messaging->{q};
my $sender = $messaging->{user_manager}->userprofile('user');
# see if there are defaults (a msg in composition, or a reply/forward...)
my $recipient = $self->{'sent_to'};
my $is_memo = ($sender eq $recipient);
# generate attachment HTML
my @attach_html;
if (ref $self->{'Attachments'} eq "ARRAY") {
foreach (0..$#{$self->{'Attachments'}}) {
my $a = $self->{'Attachments'}->[$_];
next unless
$a->{'Filename'} and $a->{'Name'} and $a->{'AttachmentID'};
push(@attach_html,
($q->b("Attachment ".($_+1).": ") .
$q->a({-href => $self->uri_escape_noamp
(Apache::App::Mercury::Config::ATTACHMENT_BASE_URI() .
$a->{'Filename'}),
-class => 'attach',
-target => 'theAttachmentWindow'},
$a->{'Name'}) .
" (".$q->a({-href => Apache::App::Mercury::Config::BASE_URI()."?remove_attach=".$_},
"remove").")"
));
}
}
return
((!$is_memo
? ($q->b("From: ") . $sender." (".
$messaging->{user_manager}->userprofile('fname')." ".
$messaging->{user_manager}->userprofile('lname').")".$q->br.$q->br.
Mercury/Message.pm view on Meta::CPAN
$q->textfield(-name => 'subject', -override => 1,
-default => $self->{'subject'},
-size => 40, -maxlength => 100) . $q->br .
($self->{'transcode'}
? $q->br.$q->b("Trans: ").$self->{'transcode'}.$q->br.$q->br : '') .
$q->b("Body: ") . $q->br .
$q->textarea(-name => 'body', -override => 1,
-default => $self->{'body'},
-rows => 13, -columns => 60, -wrap => 'soft') .
$q->br .
join($q->br, @attach_html) .
$q->br .
$q->b("Attach ") .
$q->textfield(-name => 'num_files_to_attach', -override => 1,
-default => ($self->{'num_to_attach'}
? $self->{'num_to_attach'} : 0),
-size => 2, -maxlength => 2) .
$q->b(" file(s)") . $q->br .
$q->b("Security level of this message: ") .
($self->{'security_fixed'} && $self->{'security'}
? $q->font({-face => 'fixed'}, uc($self->{'security'}))
: $q->popup_menu(-name => 'security', -override => 1,
-values => ['low', 'medium', 'high'],
-default => ($self->{'security'}
? $self->{'security'} : 'medium'),
-labels => { 'low' => "Low", 'medium' => "Medium",
Mercury/Message.pm view on Meta::CPAN
$q->table
({-width => '96%', -cellspacing => 0, -cellpadding => 2,
-border => 3, -bgcolor => '#cccccc'},
$q->Tr
($q->td
({-width => '70%', -valign => 'top', -align => 'left'},
$q->table({-width => '100%', -height => '100%', -cellpadding => 2,
-cellspacing => 0, -border => 0, -bgcolor => '#ffffff'},
$q->Tr([$q->td({-valign => 'top', -height => '100%',
-bgcolor => '#ffffff'}, $self->display),
($self->{'num_to_attach'}
? $q->td({-valign=>'bottom', -bgcolor=>'#cccccc'},
$q->b("Select new attachments:") .$q->p.
join('', map {
("$_: " . $q->filefield(-name => 'attachment'.($_-1)) . $q->br)
} 1..$self->{'num_to_attach'}))
: $q->td({-bgcolor=>'#ffffff', -valign=>'bottom'},
' ')),
$q->td({-bgcolor => '#cccccc'},
$q->b("Security level: ") .
($self->{'security_fixed'} &&
$self->{'security'}
? $q->font({-face => 'fixed'},
uc($self->{'security'}))
: $q->popup_menu
(-name => 'security', -override => 1,
Mercury/Message.pm view on Meta::CPAN
([$q->td({-align => 'right'},
$q->submit('send', (!$is_memo ? "Send message"
: "Commit memo"))),
$q->td({-align => 'right'},
$q->submit('make_changes', "Make changes")),
$q->td({-align => 'right'}, $q->submit('cancel', "Cancel")),
$q->td(' ' . $q->br . ' '),
$q->td({-align => 'right', -valign => 'bottom'},
$q->submit('return', "Store and return to '".
ucfirst($messaging->{'current_box'})."'").
($self->{'num_to_attach'}
? ($q->br .
$q->font({-size => '-2'},
$q->em("Selected attached files will " .
$q->b('NOT') .
" be remembered when stored")))
: ''))
]))))) .
$q->endform
);
}
1;
Mercury/Message/Attachment.pm view on Meta::CPAN
syswrite(FILE, $self->{'Data'});
close FILE;
return 1;
}
sub store {
my ($self) = @_;
if ($self->stored) {
$self->log_error("->store: attachment already stored!");
return 0;
}
unless (ref $self->{'MessageIDs'} eq "HASH") {
$self->log_error("->store: no MessageIDs of messages containing this attachment!");
return 0;
}
unless ($self->store_to_filesystem) {
$self->log_error("->store: filesystem store failed.");
return 0;
}
eval {
my $dbh = DBI->connect(Apache::App::Mercury::Config::DBI_CONNECT_STR(),
Apache::App::Mercury::Config::DBI_LOGIN(),
Apache::App::Mercury::Config::DBI_PASS(),
{'RaiseError' => 1});
my $sth = $dbh->prepare_cached
("INSERT INTO ".SQL_ATTACHMENT_TABLE." SET filesys=?, attachment=?, msg_ids=?");
$sth->execute($self->{'Filename'}, $self->{'Name'},
join(' ', sort {$a<=>$b} keys %{$self->{'MessageIDs'}}));
$sth->finish;
my $sth2 = $dbh->prepare_cached("SELECT LAST_INSERT_ID()");
$sth2->execute;
$self->{'AttachmentID'} = '';
$sth2->bind_columns(\$self->{'AttachmentID'});
$sth2->fetchrow_arrayref;
$sth2->finish;
Mercury/Message/Attachment.pm view on Meta::CPAN
$where_clause = 'filesys=?';
push(@bind_params, $self->{'Filename'});
}
eval {
my $dbh = DBI->connect(Apache::App::Mercury::Config::DBI_CONNECT_STR(),
Apache::App::Mercury::Config::DBI_LOGIN(),
Apache::App::Mercury::Config::DBI_PASS(),
{'RaiseError' => 1});
my $sth2 = $dbh->prepare_cached
("SELECT aid,filesys,attachment,msg_ids FROM ".SQL_ATTACHMENT_TABLE." WHERE $where_clause");
$sth2->execute(@bind_params);
$self->{'AttachmentID'} = '';
$self->{'Name'} = '';
$self->{'Filename'} = '';
my $msg_ids;
$sth2->bind_columns(\ ($self->{'AttachmentID'}, $self->{'Filename'},
$self->{'Name'}, $msg_ids) );
$sth2->fetchrow_arrayref;
$self->{'MessageIDs'} = { map { $_ => 1 } split(/\s+/, $msg_ids) };
Mercury/Message/DBI.pm view on Meta::CPAN
$after_first = 1;
}
$dbh->disconnect;
};
if ($@) {
$self->log_error;
return undef;
}
# store all attachments
if (ref $self->{'Attachments'} eq "ARRAY") {
foreach my $a (@{$self->{'Attachments'}}) {
# make sure each attachment references all msg ids in this store
foreach my $mid (keys %{$self->{'MessageIDs'}}) {
# if this attachment has already been stored but needs updating
if ($a->stored and !$a->{'MessageIDs'}->{$mid}) {
$a->{'MessageIDs'}->{$mid} = 1;
$a->{'needs_update'} = 1;
}
}
if ($a->{'needs_update'}) {
# if attachment already exists but needs update, update it
return undef unless $a->update_messages_containing;
} else {
next if $a->stored;
# otherwise store the new attachment
$a->{'MessageIDs'} = $self->{'MessageIDs'};
return undef unless $a->store;
}
}
return undef unless $self->log_attachments;
}
return 1;
}
sub log_attachments {
my ($self) = @_;
my @msgids = keys %{$self->{'MessageIDs'}};
my $placeholders = join(', ', map {'?'} @msgids);
my $attachment_ids =
join(' ', map { $_->{'AttachmentID'} } @{$self->{'Attachments'}});
eval {
my $dbh = DBI->connect(Apache::App::Mercury::Config::DBI_CONNECT_STR(),
Apache::App::Mercury::Config::DBI_LOGIN(),
Apache::App::Mercury::Config::DBI_PASS(),
{'RaiseError' => 1});
my $sth = $dbh->prepare_cached
("UPDATE ".Apache::App::Mercury::Config::DBI_SQL_MSG_TABLE()." SET attachments=?,timestamp=timestamp WHERE id IN($placeholders)");
$sth->execute($attachment_ids, @msgids);
$dbh->disconnect;
};
if ($@) {
$self->log_error;
return undef;
}
return 1;
}
Mercury/SMTP_Message.pm view on Meta::CPAN
To => join(', ', @to),
Subject => $self->{'subject'},
Date => $self->datestamp,
Data => $self->{'body'} . MIME_FOOTER,
Type => "text/plain",
);
if (ref $self->{'Attachments'} eq "ARRAY") {
foreach my $a (@{$self->{'Attachments'}}) {
$msg->attach
(Path => (Apache::App::Mercury::Config::ATTACHMENT_FILESYS_BASE() .
$a->{'Filename'}),
Filename => $a->{'Name'},
Type => $self->autotype_by_ext($a->{'Filename'}),
);
}
}
return $msg;
}
( run in 2.777 seconds using v1.01-cache-2.11-cpan-e1769b4cff6 )