JaM

 view release on metacpan or  search on metacpan

lib/JaM/GUI/Mail.pm  view on Meta::CPAN

# $Id: Mail.pm,v 1.26 2001/11/15 22:26:03 joern Exp $

package JaM::GUI::Mail;

@ISA = qw ( JaM::GUI::Component );

use strict;
use FileHandle;
use JaM::Func;
use JaM::GUI::Component;
use JaM::GUI::HTMLSurface;

# get/set gtk object for mail content scrolled window
sub gtk_mail_html	{ my $s = shift; $s->{gtk_mail_html}
		          = shift if @_; $s->{gtk_mail_html}		}

# get/set gtk object for mail content HTMLSurface object
sub gtk_mail_html_object{ my $s = shift; $s->{gtk_mail_html_object}
		          = shift if @_; $s->{gtk_mail_html_object}	}

# get/set gtk object for mail popup menu
sub gtk_popup		{ my $s = shift; $s->{gtk_popup}
		          = shift if @_; $s->{gtk_popup}		}

# get/set actual viewed mail (JaM::Mail object)
sub mail 		{ my $s = shift; $s->{mail}
		          = shift if @_; $s->{mail}			}

# get/set actual flag for viewing all header fields or only common fields
sub show_all_header 	{ my $s = shift; $s->{show_all_header}
		          = shift if @_; $s->{show_all_header}		}

# this flag controls whether mails status should be changed when viewd
sub no_status_change_on_show 	{ my $s = shift; $s->{no_status_change_on_show}
		          	  = shift if @_; $s->{no_status_change_on_show}		}

# build mail viewer widget
sub build {
	my $self = shift;

	# Create a table to hold the text widget and scrollbars
	my $sw = new Gtk::ScrolledWindow(undef, undef);
	$sw->set_policy('automatic', 'automatic');

	my $html = JaM::GUI::HTMLSurface->new (
		image_dir => "/tmp",
		button3_callback => sub { $self->popup_menu(@_) },
		mail_link_callback => sub { $self->open_mail_link_window ( @_ ) }
	);
	my $widget = $html->widget;
	$sw->show;
	$sw->add($widget);

	# Add a handler to put a message in the html widget when it is realized
	$self->gtk_mail_html ($widget);
	$self->gtk_mail_html_object ($html);

	$self->widget ($sw);

	# build popup menu for right click
	my $item;
	my $popup = $self->gtk_popup (Gtk::Menu->new);

	$item = Gtk::MenuItem->new ("Show only common header fields");
	$popup->append($item);
	$item->signal_connect ("activate", sub { $self->cb_show_all_header(0) } );
	$item->show;

	$item = Gtk::MenuItem->new ("Show complete header");
	$popup->append($item);
	$item->signal_connect ("activate", sub { $self->cb_show_all_header(1) } );
	$item->show;
	
	return $self;
}	

sub show {
	my $self = shift;
	my %par = @_;
	my ($mail_id) = @par{'mail_id'};

	$self->clear;

	my $html = $self->gtk_mail_html_object;
	$html->widget->freeze;

	if ( not $mail_id ) {
		$html->begin;
		$html->end;
		$html->widget->thaw;
		$self->mail(undef);
		return;
	}

	my $mail = JaM::Mail->load (
		dbh => $self->dbh,
		mail_id  => $mail_id,
	);
	
	$self->mail ($mail);

	$html->begin (
		charset => $self->mail->head->mime_attr('content-type.charset')
	);
	
	# first print the header
	$self->print_entity_head (
		entity => $mail,
		widget => $html,
	);

	# print primary body, if given
	if ( $mail->body ) {
		if ( $mail->content_type eq 'text/html' ) {
			$self->put_mail_text (
				widget => $html,
				data => "\nWARNING: FILTERED HTML MAIL!!!\n\n".
				        $self->html_filter($mail->body->as_string),
			 	wrap_length => $self->config('wrap_line_length_show'),
			);
		} else {
			$self->put_mail_text (
				widget => $html,
				data => $mail->body->as_string,
				wrap_length => $self->config('wrap_line_length_show'),
			);
		}
	}

	# print child entitities

lib/JaM/GUI/Mail.pm  view on Meta::CPAN

}

sub put_inline_download_link {
	my $self = shift;
	my %par = @_;
	my  ($widget, $entity) =
	@par{'widget','entity'};
	
	my $name = $entity->entity_id;
	$widget->image_pool->{$name}->{body} = $entity->body;
	$widget->image_pool->{$name}->{head} = $entity->head;
	
	$widget->write (
		"<a href=\"pool://".$entity->entity_id."\">".
		"<b>[ Save attachment as... ]</b>".
		"</a><p>"
	);
	
	1;
}

sub put_image_part {
	my $self = shift;
	my %par = @_;
	my  ($widget, $entity, $no_display) =
	@par{'widget','entity','no_display'};
	
	my $name = $entity->entity_id;
	$widget->image_pool->{$name}->{body} = $entity->body;
	$widget->image_pool->{$name}->{head} = $entity->head;
	
	$widget->write ('<table border="0" cellpadding="0" cellspacing="2"><tr><td>');
	if ( $no_display ) {
		$widget->write (
			"<a href=\"pool://".$entity->entity_id."\">".
			"<b>This attachment is not presentable</b>".
			"</a>"
		);
	} else {
		$widget->image ( pool => $name );
	}

	$widget->write ("</td></tr>");
	$widget->write ("<tr><td>");

	$widget->bold ("Mime-Type: ");
	$widget->write ($entity->content_type);
	$widget->br;
	
	$widget->bold ("Filename: ");
	$widget->write ($entity->filename);
	$widget->br;

	$widget->bold ("Size: ");
	$widget->write (int($entity->content_length/1024)." KB");
	$widget->br;

	$widget->write ("</td></tr></table>");
}

sub popup_menu {
	my $self = shift;
	my ($event) = @_;

	$self->gtk_popup->popup (undef, undef, $event->{button}, 0);
}

sub cb_show_all_header {
	my $self = shift;
	my ($flag) = @_;
	$self->show_all_header($flag);
	return if not $self->mail;
	$self->show (mail_id => $self->mail->mail_id);
	1;
}

sub open_compose_window {
	my $self = shift; $self->trace_in;
	
	my $account = JaM::Account->load_default ( dbh => $self->dbh );
	if ( not $account->smtp_server or
	     not $account->from_name or
	     not $account->from_adress ) {
		$self->account_window;
		return 1;
	}
	
	my $compose = JaM::GUI::Compose->new (
		dbh => $self->dbh
	);
	
	$compose->no_signature(1);
	$compose->build;

	$compose->insert_template_message (
		mail => $self->mail,
	);
	
	return $compose;

}

sub open_mail_link_window {
	my $self = shift; $self->trace_in,
	my %par = @_;
	my ($address) = @par{'address'};

	my $account = JaM::Account->load_default ( dbh => $self->dbh );
	if ( not $account->smtp_server or
	     not $account->from_name or
	     not $account->from_adress ) {
		$self->account_window;
		return 1;
	}
	
	my $compose = JaM::GUI::Compose->new (
		dbh => $self->dbh
	);
	
	$compose->build;
	$compose->add_recipient (
		field => 'To',
		address => $address
	);
	



( run in 1.013 second using v1.01-cache-2.11-cpan-364913b4093 )