File Coverage

blib/lib/Tk/ReportBox.pm

Criterion	Covered	Total	%
statement	6	66	9.0
branch	0	22	0.0
condition	0	3	0.0
subroutine	2	8	25.0
pod			n/a
total	8	99	8.0

package ReportBox;

use strict;
use warnings;

our $VERSION = '1.02';
require Tk::Toplevel;
our @ISA = qw(Tk::Toplevel);

Tk::Widget->Construct('ReportBox');
sub Populate
{
	require Tk::Label;
	require Tk::Button;
	require Tk::Frame;
	require Tk::Entry;
	require Tk::Listbox;
	require Tk::FileSelect;
	my ($main, $args) = @_;
	my $text;
	my $file = $args->{'-file'};
	my $mode = $args->{'-mode'};
	my $headers = $args->{'-headers'};
	$headers = 2 unless $headers;
	my $startdir = $args->{'-startdir'};
	$startdir = './' unless $startdir;
	my $printstr = $args->{'-printstr'};
	$printstr = "lp $file" unless $printstr;
	$main->SUPER::Populate($args);
	open (F,$file);
	$mode = 0 unless $mode;
	if ($mode)
		{
		$text = $main->Scrolled("Listbox",
			-font => 'Courier',
			-width => '80',
			-height => '20')->pack();
		}
	else
		{
		$text = $main->Scrolled("Text",
			-font => 'Courier',
			-width => '80',
			-height => '20',
			)->pack();
		}
	while ()
		{
		chomp if $mode;
		$text->insert('end',$_);
		}
	close (F);
	if ($mode == 0)
		{
		$text->configure(-state => 'disabled');
		}
	my $okbut = $main->Button
				(
				-text => 'OK',
				-command=>sub
			     		{
					$main->{'-button'} = 0;
					$main->withdraw;
					}
				)->pack(-side => 'left');
	if ($mode)
		{
		my $editbut = $main->Button
				(
				-text => 'Edit',
				-command=>sub
			     		{
					my $line;
					my @selected = $text->curselection();
					if (@selected and $selected[0] > ($headers - 1))
						{
						$main->{'-button'} = 1;
						$main->withdraw();
						}
					}
				)->pack(-side => 'left');
		}
	my $printbut = $main->Button
				(
				-text => 'Print',
				-command=>sub
			     		{
					system("$printstr");
					}
				)->pack(-side => 'left');

	my $savebut = $main->Button
				(
				-text => 'Save',
				-command=>sub
			     		{
					my $fref = $main->FileSelect(-directory => $startdir);
					my $newfile = $fref->Show;
					print "$newfile\n";
					if ($newfile)
						{
						open (F, "$file");
						open (F1, ">$newfile");
						while ()
							{
							print (F1 $_);
							}
						close F;
						close F1;
						}
					}
				)->pack(-side => 'left');
	$main->ConfigSpecs(
			'-startdir' => ['PASSIVE'],
			'-printstr' => ['PASSIVE'],
			'-headers' => ['PASSIVE'],
			'-file' => ['PASSIVE'],
			'-button' => ['PASSIVE'],
			'-deliver' => ['METHOD'],
			'-mode' => ['PASSIVE'],
			DEFAULT => [$text]);
	$main->Advertise('list' => $text);
}#end of sub populate
sub deliver
	{
	my ($main,$temp) = @_;
	$main->waitVariable(\$main->{'-button'});
	if ($main->{'-button'})
		{
		my $list = $main->Subwidget('list');
		my @selected = $list->curselection();
		return($list->get($selected[0]));
		}
	else
		{
		return (0);
		}
	}


1;
__END__