First pass at adding key files
This commit is contained in:
		
							
								
								
									
										267
									
								
								site/slowtwitch.com/cgi-bin/articles/GT/Mail/Editor/HTML.pm
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										267
									
								
								site/slowtwitch.com/cgi-bin/articles/GT/Mail/Editor/HTML.pm
									
									
									
									
									
										Normal file
									
								
							@@ -0,0 +1,267 @@
 | 
			
		||||
 | 
			
		||||
package GT::Mail::Editor::HTML;
 | 
			
		||||
 | 
			
		||||
use vars qw/$ERROR_MESSAGE/;
 | 
			
		||||
use strict;
 | 
			
		||||
use bases 'GT::Mail::Editor' => '';
 | 
			
		||||
 | 
			
		||||
$ERROR_MESSAGE = 'GT::Mail::Editor';
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
sub display {
 | 
			
		||||
# ----------------------------------------------------------------
 | 
			
		||||
    my ( $self, $tags ) = @_;
 | 
			
		||||
    my $page = $self->{html_tpl_name};
 | 
			
		||||
 | 
			
		||||
    if ( $self->{fields}{page} and $self->{fields}{page} =~ /^(?:editor|email)_/ ) {
 | 
			
		||||
        $page = $self->{fields}{page};
 | 
			
		||||
    }
 | 
			
		||||
    my $ret = $self->print_page( $page, $tags );
 | 
			
		||||
    $self->{displayed} = 1;
 | 
			
		||||
    return $ret;
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
sub message_from_input {
 | 
			
		||||
# ----------------------------------------------------------------
 | 
			
		||||
    my ( $self ) = @_;
 | 
			
		||||
    $self->set_headers;
 | 
			
		||||
 | 
			
		||||
# If we have a part ID, this isn't a new text part
 | 
			
		||||
    my ( $part, $id );
 | 
			
		||||
    $part = $self->{part};
 | 
			
		||||
    $part->set( 'content-type' => 'text/html; charset="'.( $self->{fields}{charset} || 'US-ASCII' ).'"' );
 | 
			
		||||
    if ( exists( $self->{fields}{msg} ) ) {
 | 
			
		||||
        my $msg = $self->{fields}{msg};
 | 
			
		||||
        $self->urls_to_inlines( $self->{part}, \$msg );
 | 
			
		||||
        $part->body_data( $msg );
 | 
			
		||||
    }
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
sub munge_message {
 | 
			
		||||
# ----------------------------------------------------------------
 | 
			
		||||
    my ( $self ) = @_;
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
    my $root_part = $self->{message}->root_part;
 | 
			
		||||
 | 
			
		||||
# Simple case if the message is not multipart
 | 
			
		||||
    if ( !$root_part->is_multipart ) {
 | 
			
		||||
        $self->munge_non_multipart( $root_part );
 | 
			
		||||
    }
 | 
			
		||||
 | 
			
		||||
# We have a multipart. First thing we do is look for an alternative part
 | 
			
		||||
# to use.
 | 
			
		||||
    elsif ( my ( $alt ) = $self->{message}->find_multipart( 'alternative' ) ) {
 | 
			
		||||
        $self->munge_alternative( $alt );
 | 
			
		||||
    }
 | 
			
		||||
    else {
 | 
			
		||||
        $self->munge_other;
 | 
			
		||||
    }
 | 
			
		||||
    $self->fix_alt_parts;
 | 
			
		||||
    $self->fix_related_parts;
 | 
			
		||||
    $self->delete_empty_multiparts;
 | 
			
		||||
    my ( $alt_part ) = $self->{message}->find_multipart( 'alternative' );
 | 
			
		||||
    my @skip = $alt_part->parts;
 | 
			
		||||
    $self->find_attachments( @skip );
 | 
			
		||||
    $self->{alt_part} = $alt_part;
 | 
			
		||||
    $self->{part} = $skip[1];
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
sub html_part {
 | 
			
		||||
# ----------------------------------------------------------------
 | 
			
		||||
    my $self = shift;
 | 
			
		||||
    return $self->{alt_part}->parts->[1];
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
sub text_part {
 | 
			
		||||
# ----------------------------------------------------------------
 | 
			
		||||
    my $self = shift;
 | 
			
		||||
    return $self->{alt_part}->parts->[0];
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
sub munge_non_multipart {
 | 
			
		||||
# ----------------------------------------------------------------
 | 
			
		||||
    my ( $self, $root_part ) = @_;
 | 
			
		||||
 | 
			
		||||
# We need to munge the message into a multipart
 | 
			
		||||
    my $new_alt = $self->alt_part(
 | 
			
		||||
        html         => $root_part,
 | 
			
		||||
        charset      => $root_part->mime_attr( 'content-type.charset' ),
 | 
			
		||||
        headers_part => $root_part
 | 
			
		||||
    );
 | 
			
		||||
    $root_part->set( 'content-type' => 'multipart/mixed' );
 | 
			
		||||
    $root_part->parts( $new_alt );
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
sub munge_alternative {
 | 
			
		||||
# ----------------------------------------------------------------
 | 
			
		||||
    my ( $self, $alt_part ) = @_;
 | 
			
		||||
    my $root_part = $self->{message}->root_part;
 | 
			
		||||
 | 
			
		||||
# Make anything we can not view an attachment
 | 
			
		||||
    $self->{message}->move_parts_last(
 | 
			
		||||
        $root_part,
 | 
			
		||||
        grep {
 | 
			
		||||
            $_->content_type ne 'text/plain' and $_->content_type ne 'text/html'
 | 
			
		||||
        } $alt_part->parts
 | 
			
		||||
    );
 | 
			
		||||
 | 
			
		||||
# Anything left is either text or html
 | 
			
		||||
    my ( $html_part, $text_part );
 | 
			
		||||
    for ( $alt_part->parts ) {
 | 
			
		||||
        if ( $_->content_type eq 'text/html' ) {
 | 
			
		||||
            $html_part = $_;
 | 
			
		||||
        }
 | 
			
		||||
        else {
 | 
			
		||||
            $text_part = $_;
 | 
			
		||||
        }
 | 
			
		||||
    }
 | 
			
		||||
# If we do not have an editble part we need to make an empty html one
 | 
			
		||||
    if ( !defined( $text_part ) and !defined( $html_part ) ) {
 | 
			
		||||
        $html_part = $self->{message}->new_part(
 | 
			
		||||
            'content-type' => 'text/html; charset="'.( $self->{fields}{charset} || 'US-ASCII' ).'"',
 | 
			
		||||
            -body_data     => '<html><body></body></html>'
 | 
			
		||||
        );
 | 
			
		||||
    }
 | 
			
		||||
    my $new_alt = $self->alt_part(
 | 
			
		||||
        html    => $html_part,
 | 
			
		||||
        text    => $text_part,
 | 
			
		||||
        charset => $self->{fields}{charset}
 | 
			
		||||
    );
 | 
			
		||||
    if ( $alt_part == $root_part ) {
 | 
			
		||||
        $root_part->set( 'content-type' => 'multipart/mixed' );
 | 
			
		||||
        $self->{message}->delete_parts( $root_part->parts );
 | 
			
		||||
        $root_part->parts( $new_alt );
 | 
			
		||||
    }
 | 
			
		||||
    else {
 | 
			
		||||
        $self->{message}->replace_part( $alt_part, $new_alt );
 | 
			
		||||
    }
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
sub munge_other {
 | 
			
		||||
# ----------------------------------------------------------------
 | 
			
		||||
    my ( $self ) = @_;
 | 
			
		||||
 | 
			
		||||
# Else we need to search through the parts to find the displayable parts
 | 
			
		||||
    my ( $html_part, $text_part );
 | 
			
		||||
    for my $part ( $self->{message}->all_parts ) {
 | 
			
		||||
        if ( !$html_part and $part->content_type eq 'text/html' and $part->mime_attr( 'content-disposition' ) ne 'attachment' ) {
 | 
			
		||||
            $html_part = $part;
 | 
			
		||||
        }
 | 
			
		||||
        elsif ( !$text_part and $part->content_type eq 'text/plain' and $part->mime_attr( 'content-disposition' ) ne 'attachment' ) {
 | 
			
		||||
            $text_part = $part;
 | 
			
		||||
        }
 | 
			
		||||
        last if $html_part and $text_part;
 | 
			
		||||
    }
 | 
			
		||||
# If we do not have an editble part we need to make an empty html one
 | 
			
		||||
    if ( !defined( $text_part ) and !defined( $html_part ) ) {
 | 
			
		||||
        $html_part = $self->{message}->new_part(
 | 
			
		||||
            'content-type' => 'text/html; charset="'.( $self->{fields}{charset} || 'US-ASCII' ).'"',
 | 
			
		||||
            -body_data     => '<html><body></body></html>'
 | 
			
		||||
        );
 | 
			
		||||
        my $new_alt = $self->alt_part(
 | 
			
		||||
            html    => $html_part,
 | 
			
		||||
            text    => $text_part,
 | 
			
		||||
            charset => $self->{fields}{charset}
 | 
			
		||||
        );
 | 
			
		||||
        $self->{message}->add_parts_start( $self->{message}->root_part, $new_alt );
 | 
			
		||||
        my $parent = $self->{message}->parent_part( $new_alt );
 | 
			
		||||
        if ( $parent and $parent->content_type eq 'multipart/related' ) {
 | 
			
		||||
            $parent->set( 'content-type' => 'multipart/mixed' );
 | 
			
		||||
        }
 | 
			
		||||
    }
 | 
			
		||||
    else {
 | 
			
		||||
        my $new_alt = $self->alt_part(
 | 
			
		||||
            html    => $html_part,
 | 
			
		||||
            text    => $text_part,
 | 
			
		||||
            charset => $self->{fields}{charset}
 | 
			
		||||
        );
 | 
			
		||||
        my $parent_part = $self->{message}->parent_part( $html_part );
 | 
			
		||||
        if ( !$parent_part ) { $parent_part = $self->{message}->parent_part( $text_part ) }
 | 
			
		||||
        if ( $parent_part and $parent_part->content_type eq 'multipart/related' ) {
 | 
			
		||||
            if ( !$html_part ) {
 | 
			
		||||
                $parent_part->set( 'content-type' => 'multipart/mixed' );
 | 
			
		||||
                $self->{message}->add_parts_start( $parent_part, $new_alt );
 | 
			
		||||
                if ( $text_part ) {
 | 
			
		||||
                    $self->{message}->delete_part( $text_part );
 | 
			
		||||
                }
 | 
			
		||||
            }
 | 
			
		||||
            else {
 | 
			
		||||
                $self->{message}->replace_part( $parent_part->parts->[0], $new_alt );
 | 
			
		||||
            }
 | 
			
		||||
        }
 | 
			
		||||
        else {
 | 
			
		||||
            if ( $text_part ) {
 | 
			
		||||
                $self->{message}->delete_part( $text_part );
 | 
			
		||||
            }
 | 
			
		||||
            if ( $html_part ) {
 | 
			
		||||
                $self->{message}->delete_part( $html_part );
 | 
			
		||||
            }
 | 
			
		||||
            $self->{message}->add_parts_start( $self->{message}->root_part, $new_alt );
 | 
			
		||||
        }
 | 
			
		||||
    }
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
sub alt_part {
 | 
			
		||||
# ----------------------------------------------------------------
 | 
			
		||||
    my ( $self, %opts ) = @_;
 | 
			
		||||
    my ( $text, $html, $header_from, $charset ) = @opts{qw/text html headers_part charset/};
 | 
			
		||||
 | 
			
		||||
    my $text_type = 'text/plain; charset="'.( $self->{fields}{charset} || 'US-ASCII' ).'"';
 | 
			
		||||
    my $html_type = 'text/html; charset="'.( $self->{fields}{charset} || 'US-ASCII' ).'"';
 | 
			
		||||
 | 
			
		||||
    if ( defined( $text ) ) {
 | 
			
		||||
        $text = $self->new_part_from( $text, $text_type );
 | 
			
		||||
    }
 | 
			
		||||
    elsif ( defined( $html ) ) {
 | 
			
		||||
        $text = $self->{message}->new_part(
 | 
			
		||||
            'content-type' => $text_type,
 | 
			
		||||
            -body_data     => $self->html_to_text( ref( $html ) ? $html->body_data : $html )
 | 
			
		||||
        );
 | 
			
		||||
    }
 | 
			
		||||
    else {
 | 
			
		||||
        $self->fatal( BADARGS => "Either text or html must be defined" );
 | 
			
		||||
    }
 | 
			
		||||
    if ( defined( $html ) ) {
 | 
			
		||||
        $html = $self->new_part_from( $html, $html_type );
 | 
			
		||||
    }
 | 
			
		||||
    elsif ( defined( $text ) ) {
 | 
			
		||||
        $html = $self->{message}->new_part(
 | 
			
		||||
            'content-type' => $html_type,
 | 
			
		||||
            -body_data     => $self->text_to_html( $text->body_data )
 | 
			
		||||
        );
 | 
			
		||||
    }
 | 
			
		||||
    # logic error, one must be defined
 | 
			
		||||
    else {
 | 
			
		||||
        $self->fatal( BADARGS => "Either text or html must be defined" );
 | 
			
		||||
    }
 | 
			
		||||
    my @header = ();
 | 
			
		||||
    if ( $header_from ) {
 | 
			
		||||
        @header = map { $_ => [$header_from->get( $_ )] } $header_from->get;
 | 
			
		||||
    }
 | 
			
		||||
    return $self->{message}->new_part(
 | 
			
		||||
        @header,
 | 
			
		||||
        'content-type' => 'multipart/alternative',
 | 
			
		||||
        -parts         => [$text, $html]
 | 
			
		||||
    );
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
sub new_part_from {
 | 
			
		||||
# ----------------------------------------------------------------
 | 
			
		||||
    my ( $self, $from, $type ) = @_;
 | 
			
		||||
    if ( !ref( $from ) ) {
 | 
			
		||||
        return $self->{message}->new_part(
 | 
			
		||||
            'content-type' => $type,
 | 
			
		||||
            -body_data     => $from
 | 
			
		||||
        );
 | 
			
		||||
    }
 | 
			
		||||
    elsif ( ref( $from ) ) {
 | 
			
		||||
        return $self->{message}->new_part(
 | 
			
		||||
            'content-type' => $type,
 | 
			
		||||
            -body_data     => $from->body_data
 | 
			
		||||
        );
 | 
			
		||||
    }
 | 
			
		||||
}
 | 
			
		||||
    
 | 
			
		||||
1;
 | 
			
		||||
 | 
			
		||||
							
								
								
									
										147
									
								
								site/slowtwitch.com/cgi-bin/articles/GT/Mail/Editor/Text.pm
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										147
									
								
								site/slowtwitch.com/cgi-bin/articles/GT/Mail/Editor/Text.pm
									
									
									
									
									
										Normal file
									
								
							@@ -0,0 +1,147 @@
 | 
			
		||||
 | 
			
		||||
package GT::Mail::Editor::Text;
 | 
			
		||||
 | 
			
		||||
use vars qw/$ERROR_MESSAGE/;
 | 
			
		||||
use strict;
 | 
			
		||||
use bases 'GT::Mail::Editor' => '';
 | 
			
		||||
 | 
			
		||||
$ERROR_MESSAGE = 'GT::Mail::Editor';
 | 
			
		||||
 | 
			
		||||
sub display {
 | 
			
		||||
# ----------------------------------------------------------------
 | 
			
		||||
    my ( $self, $tags ) = @_;
 | 
			
		||||
    my $page = $self->{text_tpl_name};
 | 
			
		||||
 | 
			
		||||
    if ( $self->{fields}{page} and $self->{fields}{page} =~ /^(?:editor|email)_/ ) {
 | 
			
		||||
        $page = $self->{fields}{page};
 | 
			
		||||
    }
 | 
			
		||||
    my $ret = $self->print_page( $page, $tags );
 | 
			
		||||
    $self->{displayed} = 1;
 | 
			
		||||
    return $ret;
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
sub message_from_input {
 | 
			
		||||
# ----------------------------------------------------------------
 | 
			
		||||
    my ( $self ) = @_;
 | 
			
		||||
    $self->set_headers;
 | 
			
		||||
 | 
			
		||||
# If we have a part ID, this isn't a new text part
 | 
			
		||||
    my ( $part, $id );
 | 
			
		||||
    $part = $self->{part};
 | 
			
		||||
    $part->set( 'content-type' => 'text/plain; charset="'.( $self->{fields}{charset} || 'US-ASCII' ).'"' );
 | 
			
		||||
    if ( exists( $self->{fields}{msg} ) ) {
 | 
			
		||||
        $part->body_data( $self->{fields}{msg} );
 | 
			
		||||
    }
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
sub munge_message {
 | 
			
		||||
# ----------------------------------------------------------------
 | 
			
		||||
    my ( $self ) = @_;
 | 
			
		||||
    
 | 
			
		||||
    my $root_part = $self->{message}->root_part;
 | 
			
		||||
 | 
			
		||||
# Simple case if the message is not multipart
 | 
			
		||||
    my ( $text_part, $html_part, $related_part, $alt_part );
 | 
			
		||||
    if ( !$root_part->is_multipart ) {
 | 
			
		||||
        $text_part = $root_part;
 | 
			
		||||
    }
 | 
			
		||||
 | 
			
		||||
# We have a multipart. First thing we do is look for an alternative part
 | 
			
		||||
# to use.
 | 
			
		||||
    else {
 | 
			
		||||
    
 | 
			
		||||
# First we look for the proper alternative mime parts
 | 
			
		||||
        $alt_part = ($self->{message}->find_multipart( 'alternative' ))[0];
 | 
			
		||||
        if ( $alt_part ) {
 | 
			
		||||
            my @alt_parts = $alt_part->parts;
 | 
			
		||||
            for ( @alt_parts ) {
 | 
			
		||||
                if ( $_->content_type eq 'text/plain' ) {
 | 
			
		||||
                    $text_part = $self->{message}->delete_part( $_ );
 | 
			
		||||
                }
 | 
			
		||||
                elsif ( $_->content_type eq 'text/html' ) {
 | 
			
		||||
                    $html_part = $self->{message}->delete_part( $_ );
 | 
			
		||||
                }
 | 
			
		||||
            }
 | 
			
		||||
            if ( !$text_part and $html_part ) {
 | 
			
		||||
                $text_part = $self->{message}->new_part(
 | 
			
		||||
                    'content-type' => 'text/plain',
 | 
			
		||||
                    -body_data     => $self->html_to_text( $html_part->body_data )
 | 
			
		||||
                );
 | 
			
		||||
            }
 | 
			
		||||
            elsif ( !$text_part ) {
 | 
			
		||||
                $text_part = $self->{message}->new_part(
 | 
			
		||||
                    'content-type' => 'text/plain',
 | 
			
		||||
                    -body_data     => ''
 | 
			
		||||
                );
 | 
			
		||||
            }
 | 
			
		||||
 | 
			
		||||
# Make anything we can not view an attachment
 | 
			
		||||
            $self->{message}->move_parts_last(
 | 
			
		||||
                $root_part,
 | 
			
		||||
                map {
 | 
			
		||||
                    unless ( $_->is_multipart ) {
 | 
			
		||||
                        $_->set( 'content-disposition' => 'attachment' );
 | 
			
		||||
                    }
 | 
			
		||||
                    $_;
 | 
			
		||||
                } $alt_part->parts
 | 
			
		||||
            );
 | 
			
		||||
 | 
			
		||||
            if ( $alt_part == $root_part ) {
 | 
			
		||||
                $alt_part->set( 'content-type' => 'multipart/mixed' );
 | 
			
		||||
            }
 | 
			
		||||
            else {
 | 
			
		||||
                $self->{message}->delete_part( $alt_part );
 | 
			
		||||
            }
 | 
			
		||||
            $self->{message}->add_parts_start( $self->{message}->root_part, $text_part );
 | 
			
		||||
        }
 | 
			
		||||
        else {
 | 
			
		||||
 | 
			
		||||
# Else we can just stick the text part at the beginning
 | 
			
		||||
            for my $part ( $self->{message}->all_parts ) {
 | 
			
		||||
                my $disp = $part->mime_attr( 'content-disposition' );
 | 
			
		||||
                next if $disp and $disp eq 'attachment';
 | 
			
		||||
                if ( $part->content_type eq 'text/plain' ) {
 | 
			
		||||
                    $text_part = $self->{message}->delete_part( $part );
 | 
			
		||||
                }
 | 
			
		||||
                elsif ( $part->content_type eq 'text/html' ) {
 | 
			
		||||
                    $html_part = $self->{message}->delete_part( $part );
 | 
			
		||||
                }
 | 
			
		||||
            }
 | 
			
		||||
            if ( !$text_part and $html_part ) {
 | 
			
		||||
                $text_part = $self->{message}->new_part(
 | 
			
		||||
                    'content-type' => 'text/plain',
 | 
			
		||||
                    -body_data     => $self->html_to_text( $html_part->body_data )
 | 
			
		||||
                );
 | 
			
		||||
            }
 | 
			
		||||
            elsif ( !$text_part ) {
 | 
			
		||||
                $text_part = $self->{message}->new_part(
 | 
			
		||||
                    'content-type' => 'text/plain',
 | 
			
		||||
                    -body_data     => ''
 | 
			
		||||
                );
 | 
			
		||||
            }
 | 
			
		||||
            $self->{message}->add_parts_start( $self->{message}->root_part, $text_part );
 | 
			
		||||
        }
 | 
			
		||||
    }
 | 
			
		||||
    my $parent = $self->{message}->parent_part( $text_part );
 | 
			
		||||
    if ( $parent and $parent->content_type eq 'multipart/related' ) {
 | 
			
		||||
        $parent->set( 'content-type' => 'multipart/mixed' );
 | 
			
		||||
    }
 | 
			
		||||
    $self->fix_alt_parts;
 | 
			
		||||
    $self->fix_related_parts;
 | 
			
		||||
    $self->delete_empty_multiparts;
 | 
			
		||||
    $self->find_attachments( $text_part );
 | 
			
		||||
 | 
			
		||||
    if ( @{[$self->{message}->all_parts]} == 1 and $self->{message}->root_part->is_multipart ) {
 | 
			
		||||
        $self->{message}->delete_part( $text_part );
 | 
			
		||||
        my $root_part = $self->{message}->root_part;
 | 
			
		||||
        $root_part->set( 'content-type' => 'text/plain' );
 | 
			
		||||
        $root_part->body_data( $text_part->body_data );
 | 
			
		||||
    }
 | 
			
		||||
    $self->{part} = $text_part;
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
sub html_part { return }
 | 
			
		||||
sub text_part { return shift()->{part} }
 | 
			
		||||
 | 
			
		||||
1;
 | 
			
		||||
 | 
			
		||||
		Reference in New Issue
	
	Block a user