JaM

 view release on metacpan or  search on metacpan

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


	} elsif ( open (IN, $source_filename) ) {
		# external file request
		while (<IN>) {
			print OUT;
		}
		close IN;
	} else {
		print STDERR "Error opening $source_filename for reading!\n!";
	}

	close OUT;

	1;
}

sub cb_url_requested {
	my $self = shift;
	my ($widget, $url, $handle) = @_;

	my $image_dir = $self->image_dir;
	my $filename = "$image_dir/$url";
	my $fh = new FileHandle;
	
	if ( $url =~ m!^pool://(.*)! ) {
		# internal image pool request
		$widget->write ($handle, $self->image_pool->{$1}->{body}->as_string);
		$widget->end ($handle,'ok');

	} elsif ( open ($fh, $filename) ) {
		# external file request
		while (<$fh>) {
			$widget->write ($handle, $_);
		}
		close $fh;
		$widget->end ($handle,'ok');

	} else {
		# error reading file
		warn ("can't read $filename");
		$widget->end ($handle,'error');
	}
	
	1;
}

sub begin {
	my $self = shift;
	my %par = @_;
	my ($charset) = $par{'charset'};
	
	$charset ||= "iso-8859-1";

	if ( $self->widget->can ("set_default_content_type") ) {
		$self->widget->set_default_content_type("text/html; charset=$charset");
	}

	$self->handle($self->widget->begin);
	$self->image_pool ({});
	$self->write(
		'<meta http-equiv="content-type" '.
		'content="text/html; charset='.$charset.'">'."\n"
	);

	my $color = $self->config('mail_bgcolor');
	$self->write ("<html><body bgcolor=\"$color\">");

	1;
}

sub end {
	my $self = shift;
	$self->write ('</body></html>');
	$self->widget->end ($self->handle, 'ok');
	1;
}

sub write {
	my $self = shift;
	local $_;
	for (@_) { $self->widget->write ($self->handle, $_) if length($_) }
	1;
}


sub fixed {
	shift->write ('<font face="Courier">'.$_[0].'</font>');
}

sub fixed_start {
	shift->write ('<font face="Courier">');
}

sub fixed_end {
	shift->write ('</font>');
}


sub bold {
	shift->write ('<b>'.$_[0].'</b>');
}

sub bold_start {
	shift->write ('<b>');
}

sub bold_end {
	shift->write ('</b>');
}


sub color {
	shift->write ('<font color="'.$_[0].'">'.$_[1].'</font>');
}

sub color_start {
	shift->write ('<font color="'.$_[0].'">');
}

sub color_end {
	shift->write ('</font>');



( run in 0.331 second using v1.01-cache-2.11-cpan-d7f47b0818f )