package DADA::App::FormatMessages; use strict; use lib qw(./ ../ ../DADA ../DADA/perllib); use DADA::Config qw(!:DEFAULT); use MIME::Parser; use MIME::Entity; use DADA::Config qw(!:DEFAULT); use DADA::App::Guts; use DADA::MailingList::Settings; use Carp; use vars qw($AUTOLOAD); =pod =head1 NAME DADA::App::FormatMessages =head1 SYNOPSIS my $fm = DADA::App::FormatMessages->new(-List => $list); # The subject of the message is... $fm->Subject('This is the subject!'); # Use information you find in the headers $fm->use_header_info(1); # Use the list template $fm->use_list_template(1); # Use the email template. $fm->use_email_templates(1); # Consider this message as if it's from a discussion list $fm->treat_as_discussion_msg(1); my ($header_str, $body_str) = $fm->format_headers_and_body(-msg => $msg); # (... later on... use DADA::MAilingList::Settings; use DADA::Mail::Send; my $ls = DADA::MailingList::Settings->new(-List => $list); my $mh = DADA::Mail::Send->new($ls->get); $mh->send( $mh->return_headers($header_str), Body => $body_str, ); =head1 DESCRIPTION DADA::App::FormatMessages is used to get a email message ready for sending to your mailing list. Most of its magic is behind the scenes, and isn't something you have to worry about, but we'll go through some detail. =head1 METHODS =cut my %allowed = ( Subject => undef, use_list_template => 0, use_html_email_template => 1, use_plaintext_email_template => 1, treat_as_discussion_msg => 0, use_header_info => 0, orig_entity => undef, ); =pod =head2 new my $fm = DADA::App::FormatMessages->new(-List => $list); =cut sub new { my $that = shift; my $class = ref($that) || $that; my $self = { _permitted => \%allowed, %allowed, }; bless $self, $class; my %args = (-List => undef, @_); die "no list!" if ! $args{-List}; $self->_init(\%args); return $self; } sub AUTOLOAD { my $self = shift; my $type = ref($self) or croak "$self is not an object"; my $name = $AUTOLOAD; $name =~ s/.*://; #strip fully qualifies portion unless (exists $self -> {_permitted} -> {$name}) { croak "Can't access '$name' field in object of class $type"; } if(@_) { return $self->{$name} = shift; } else { return $self->{$name}; } } sub _init { my $self = shift; my $args = shift; my $parser = new MIME::Parser; $parser = optimize_mime_parser($parser); $self->{parser} = $parser; my $ls = DADA::MailingList::Settings->new(-List => $args->{-List}); $self->{li} = $ls->get; $self->{-List} = $args->{-List}; $self->Subject($self->{li}->{list_name}); $self->use_email_templates(1); $self->use_list_template($self->{li}->{apply_list_template_to_html_msgs}); } sub use_email_templates { my $self = shift; my $v = shift; if($v == 1 || $v == 0) { $self->use_html_email_template($v); $self->use_plaintext_email_template($v); $self->{use_email_templates} = $v; return $self->{use_email_templates}; }else{ return $self->{use_email_templates}; } } sub format_message { my $self = shift; my %args = (-msg => undef, @_); die "no msg!" if ! $args{-msg}; my $entity = $self->{parser}->parse_data($args{-msg}); $self->Subject($entity->head->get('Subject', 0)) if $entity->head->get('Subject', 0); $entity = $self->_format_headers($entity) if $self->treat_as_discussion_msg; $entity = $self->_fix_for_only_html_part($entity); $entity = $self->_format_text($entity); return $entity->as_string; } =pod =head2 format_headers_and_body my ($header_str, $body_str) = $fm->format_headers_and_body(-msg => $msg); Given a string, $msg, returns two variables; $header_str, which will have all the headers and $body_str, that holds the body of your message. =head1 ACCESSORS =head2 Subject Set the subject of a message =head2 use_list_template If set to a true value, will apply the list template to the HTML part of your message =head2 use_email_templates If set to a true value, will apply your email templates to the HTML/PlainText parts of your message. =head2 treat_as_discussion_msg When set to a true value, will try the message as if it was from a discussion list. =head2 use_header_info If set to a true value, will inspect the headers of a message (for example, the From: line) to work with =cut sub format_headers_and_body { my $self = shift; my %args = (-msg => undef, @_ ); die "no msg!" if ! $args{-msg}; my $entity = $self->{parser}->parse_data($args{-msg}); $self->orig_entity($entity); $self->Subject($entity->head->get('Subject', 0)) if $entity->head->get('Subject', 0); $entity = $self->_format_headers($entity) if $self->treat_as_discussion_msg; $entity = $self->_fix_for_only_html_part($entity); $entity = $self->_format_text($entity); # yeah, don't know why you have to do it # RIGHT BEFORE you make it a string... $entity->head->delete('X-Mailer') if $entity->head->get('X-Mailer', 0); return ($entity->head->as_string, $entity->body_as_string) ; } =pod =head1 PRIVATE METHODS =head2 _fix_for_only_html_part $entity = $self->_fix_for_only_html_part($entity); Changes the single part, HTML entity into a multipart/alternative message, with an auto plaintext version. =cut sub _fix_for_only_html_part { my $self = shift; my $entity = shift; $entity = $self->_create_multipart_from_html($entity); return $entity; } =pod =head2 _format_text $entity = $self->_format_text($entity); Given an MIME::Entity (may be multipart) will attempt to: =over =item * Apply the List Template =item * Apply the Email Template =item * interpolate the message to change Dada Mail's pseudo tags to their real value =back =cut sub _format_text { my $self = shift; my $entity = shift; my @parts = $entity->parts; if(@parts){ my $i; foreach $i (0 .. $#parts) { $parts[$i]= $self->_format_text($parts[$i]); } $entity->sync_headers('Length' => 'COMPUTE', 'Nonstandard' => 'ERASE'); }else{ my $is_att = 0; if (defined($entity->head->mime_attr('content-disposition'))) { $is_att = 1 if $entity->head->mime_attr('content-disposition') =~ m/attachment/; } if( ( ($entity->head->mime_type eq 'text/plain') || ($entity->head->mime_type eq 'text/html') ) && ($is_att != 1) ) { my $body = $entity->bodyhandle; my $content = $body->as_string; if($content){ # do I need this? my $switch = 1; $switch = 0 if $self->treat_as_discussion_msg && $self->{li}->{group_list} == 1 && $self->{li}->{allow_group_interpolation} != 1; if($switch){ $content = $self->_parse_in_list_info(-data => $content, -type => $entity->head->mime_type, ); } $content = $self->_apply_template(-data => $content, -type => $entity->head->mime_type, ); if($DADA::Config::GIVE_PROPS_IN_EMAIL == 1){ $content = $self->_give_props( -data => $content, -type => $entity->head->mime_type, ); } $content = $self->_add_opener_image($content) if $self->{li}->{enable_open_msg_logging} == 1 && $entity->head->mime_type eq 'text/html'; my $io = $body->open('w'); $io->print( $content ); $io->close; $entity->sync_headers('Length' => 'COMPUTE', 'Nonstandard' => 'ERASE'); } } return $entity; } return $entity; } sub _give_props { my $self = shift; my %args = (-data => undef, -type => 'text/plain', @_); if($DADA::Config::GIVE_PROPS_IN_EMAIL == 1){ my $html_props = "\n" . '
' . "\n"; my $text_props = "\n\nMailing List Powered by Dada Mail\n$DADA::Config::PROGRAM_URL/what_is_dada_mail/"; $args{-type} = 'HTML' if $args{-type} eq 'text/html'; $args{-type} = 'PlainText' if $args{-type} eq 'text/plain'; if($args{-type} eq 'HTML'){ if($args{-data} =~ m{}){ $args{-data} =~ s{}{$html_props}i; } elsif($args{-data} =~ m{