File Coverage

blib/lib/Tk/TimePick.pm

Criterion	Covered	Total	%
statement	7	9	77.7
branch			n/a
condition			n/a
subroutine	3	3	100.0
pod			n/a
total	10	12	83.3

#*** TimePick.pm ***#
# Copyright (C) 2006 by Torsten Knorr
# [e-mail]
# All rights reserved!
#-------------------------------------------------
 package Tk::TimePick;
#-------------------------------------------------
 use strict;
 use warnings;
 use Tk::Frame;
 use vars '$AUTOLOAD';
#-------------------------------------------------
 @Tk::TimePick::ISA = qw(Tk::Frame);
 $Tk::TimePick::VERSION = '0.02';
 Construct Tk::Widget "TimePick";
#-------------------------------------------------
 sub Populate
 	{
 	require Tk::Entry;
 	require Tk::Button;
 	my ($tp, $args) = @_;
#-------------------------------------------------
# -order
 	$tp->{_order} = (defined($args->{-order})) ?
 		$tp->SetOrder(delete($args->{-order})) : "hms";
# -separator
 	$tp->{_separator} = (defined($args->{-separator})) ?
 		delete($args->{-separator}) : ':';
# -maxhours
 	$tp->{_maxhours} = (defined($args->{-maxhours})) ?
 		delete($args->{-maxhours}) : 23;
 	$tp->{_maxhours} = 23 if(!(($tp->{_maxhours} == 12) or ($tp->{_maxhours} == 23)));
# -seconds
 	$tp->{_seconds} = (defined($args->{-seconds})) ?
 		delete($args->{-seconds}) : (localtime())[0];
# -minutes
 	$tp->{_minutes} = (defined($args->{-minutes})) ?
 		delete($args->{-minutes}) : (localtime())[1];
# -hours
 	$tp->{_hours} = (defined($args->{-hours})) ?
 		delete($args->{-minutes}) : (localtime())[2];
# -regextimeformat
 	$tp->{_regextimeformat} = (defined($args->{-regextimeformat})) ?
 		delete($args->{-regextimeformat}) : qr/(\d{1,2})(.+?)(\d{1,2})(.+?)(\d{1,2})/o;
 	$tp->SUPER::Populate($args);
#-------------------------------------------------
 	$tp->{entry_time} = $tp->Entry(
 		-textvariable		=> \$tp->{_timestring},
 		-state			=> "disabled",
 		-disabledforeground	=> "#000000",
 		-disabledbackground	=> "#FFFFFF"
 		)->pack(
 		-side		=> "top",
 		);
#-------------------------------------------------
 	for(split(//, $tp->{_order}))
 		{
 		$tp->{_timestring} .= $tp->{_separator} if(defined($tp->{_timestring}));
 		SWITCH:
 			{
 			($_ eq 's')	&& do
 				{
  				$tp->{frame_seconds} = $tp->Frame(
 					-label		=> "Seconds",
					-relief		=> "groove",
 					-borderwidth	=> 2,
 					-background	=> "#0000FF"
 					)->pack(
 					-side		=> "left",
 					);
 				$tp->{_timestring} .= $tp->{_seconds};
 				last(SWITCH);
 				};
 			($_ eq 'm')	&& do
 				{
  				$tp->{frame_minutes} = $tp->Frame(
 					-label		=> "Minutes",
					-relief		=> "groove",
 					-borderwidth	=> 2,
 					-background	=> "#0000FF"
 					)->pack(
 					-side		=> "left",
 					);
 				$tp->{_timestring} .= $tp->{_minutes};
 				last(SWITCH);
 				};
 			($_ eq 'h')	&& do
 				{
  				$tp->{frame_hours} = $tp->Frame(
 					-label		=> "Hours",
					-relief		=> "groove",
 					-borderwidth	=> 2,
 					-background	=> "#0000FF"
 					)->pack(
 					-side		=> "left",
 					);
 				$tp->{_timestring} .= $tp->{_hours};
 				last(SWITCH);
 				};
 			}
 		}

#-------------------------------------------------
 my $timer_repeat;
 my $timer_after;
 	$tp->{button_seconds_reduce} = $tp->{frame_seconds}->Button(
 		-text		=> '<',
 		-command	=> [\&SecondsReduce, $tp]
 		)->pack(
 		-side		=> "left"
 		);
 	$tp->{button_seconds_reduce}->bind(
 		"",
		sub
 			{
 			$timer_after = $tp->after(
 				500,
 				sub { $timer_repeat = $tp->repeat(100, [\&SecondsReduce, $tp]); }
 				);
 			}
 		);
 	$tp->{button_seconds_reduce}->bind(
 		"",
		sub
 			{
 			$timer_after->cancel() if($timer_after);
 			$timer_repeat->cancel() if($timer_repeat);
 			}
 		);
#-------------------------------------------------
 	$tp->{button_seconds_increase} = $tp->{frame_seconds}->Button(
 		-text		=> '>',
 		-command	=> [\&SecondsIncrease, $tp]
 		)->pack(
 		-side		=> "left"
 		);
 	$tp->{button_seconds_increase}->bind(
 		"",
 		sub
 			{
 			$timer_after = $tp->after(
 				500,
 				sub { $timer_repeat = $tp->repeat(100, [\&SecondsIncrease, $tp]); }
 				);
 			}
 		);
	 $tp->{button_seconds_increase}->bind(
 		"",
 		sub
 			{
 			$timer_after->cancel() if($timer_after);
 			$timer_repeat->cancel() if($timer_repeat);
 			}
 		);
#-------------------------------------------------
 	$tp->{button_minutes_reduce} = $tp->{frame_minutes}->Button(
 		-text		=> '<',
 		-command	=> [\&MinutesReduce, $tp]
 		)->pack(
 		-side		=> "left"
 		);
 	$tp->{button_minutes_reduce}->bind(
 		"",
 		sub
 			{
 			$timer_after = $tp->after(
 				500,
 				sub { $timer_repeat = $tp->repeat(100, [\&MinutesReduce, $tp]); }
 				);
 			}
 		);
 	$tp->{button_minutes_reduce}->bind(
 		"",
 		sub
 			{
 			$timer_after->cancel() if($timer_after);
 			$timer_repeat->cancel() if($timer_repeat);
 			}
 		);
#-------------------------------------------------
 	$tp->{button_minutes_increase} = $tp->{frame_minutes}->Button(
 		-text		=> '>',
 		-command	=> [\&MinutesIncrease, $tp]
 		)->pack(
 		-side		=> "left"
 		);
 	$tp->{button_minutes_increase}->bind(
 		"",
 		sub
 			{
 			$timer_after = $tp->after(
 				500,
 				sub { $timer_repeat = $tp->repeat(100, [\&MinutesIncrease, $tp]); }
 				);
 			}
 		);
 	$tp->{button_minutes_increase}->bind(
 		"",
 		sub
 			{
 			$timer_after->cancel() if($timer_after);
 			$timer_repeat->cancel() if($timer_repeat);
 			}
 		);
#-------------------------------------------------
 	$tp->{button_hours_reduce} = $tp->{frame_hours}->Button(
 		-text		=> '<',
 		-command	=> [\&HoursReduce, $tp]
 		)->pack(
 		-side		=> "left"
 		);
 	$tp->{button_hours_reduce}->bind(
 		"",
 		sub
 			{
 			$timer_after = $tp->after(
 				500,
 				sub { $timer_repeat = $tp->repeat(100, [\&HoursReduce, $tp]); }
 				);
 			}
 		);
 	$tp->{button_hours_reduce}->bind(
 		"",
 		sub
 			{
 			$timer_after->cancel() if($timer_after);
 			$timer_repeat->cancel() if($timer_repeat);
 			}
 		);
#-------------------------------------------------
 	$tp->{button_hours_increase} = $tp->{frame_hours}->Button(
 		-text		=> '>',
 		-command	=> [\&HoursIncrease, $tp]
 		)->pack(
 		-side		=> "left"
 		);
 	$tp->{button_hours_increase}->bind(
 		"",
 		sub
 			{
 			$timer_after = $tp->after(
 				500,
 				sub { $timer_repeat = $tp->repeat(100, [\&HoursIncrease, $tp]); }
 				);
 			}
 		);
 	$tp->{button_hours_increase}->bind(
 		"",
 		sub
 			{
 			$timer_after->cancel() if($timer_after);
 			$timer_repeat->cancel() if($timer_repeat);
 			}
 		);
#-------------------------------------------------
 	$tp->{childs} =
 		{
 		"EntryTime"		=> $tp->{entry_time},
 		"FrameSeconds"		=> $tp->{frame_seconds},
 		"ButtonSecondsReduce"	=> $tp->{button_seconds_reduce},
 		"ButtonSecondsIncrease"	=> $tp->{button_seconds_increase},
 		"FrameMinutes"		=> $tp->{frame_minutes},
 		"ButtonMinutesReduce"	=> $tp->{button_minutes_reduce},
 		"ButtonMinutesIncrease"	=> $tp->{button_minutes_increase},
 		"FrameHours"		=> $tp->{frame_hours},
 		"ButtonHoursReduce"	=> $tp->{button_hours_reduce},
 		"ButtonHoursIncrease"	=> $tp->{button_hours_increase},
 		};
 	$tp->Advertise($_, $tp->{childs}{$_}) for(keys(%{$tp->{childs}}));
 	$tp->Delegates(
 		DEFAULT	=> $tp->{entry_time}
 		);
 	$tp->ConfigSpecs(
 		DEFAULT	=> ["ADVERTISED"]
 		);
 	}
#-------------------------------------------------
 sub insert
 	{
 	my ($self, $time) = @_;
 	return(0) if(!($time =~ m/$self->{_regextimeformat}/));
 	return(0) if(!($2 eq $4));
 	$self->{_separator} = $2;
 	$self->SetTime($1, $3, $5);
 	return(1);
 	}
#-------------------------------------------------
 sub SetTime
 	{
 	my ($self, @t) = @_;
 	my $index = 0;
 	$self->{_timestring} = undef;
 	for(split(//, $self->{_order}))
 		{
 		$self->{_timestring} .= $self->{_separator} if(defined($self->{_timestring}));
 		SWITCH:
 			{
 			($_ eq 'h')	&& do
 				{
 				$self->{_hours}		= $t[$index];
 				$self->{_timestring}	.= $t[$index];
 				last(SWITCH);
 				};
 			($_ eq 'm')	&& do
 				{
 				$self->{_minutes}		= $t[$index];
 				$self->{_timestring}	.= $t[$index];
 				last(SWITCH);
 				};
 			($_ eq 's')	&& do
 				{
 				$self->{_seconds}		= $t[$index];
 				$self->{_timestring}	.= $t[$index];
 				last(SWITCH);
 				};
 			}
 		$index++;
 		}
 	return(1);
 	}
#-------------------------------------------------
 sub GetTime
 	{
 	my ($self) = @_;
 	$self->{_timestring} = undef;
 	for(split(//, $self->{_order}))
 		{
 		$self->{_timestring} .= $self->{_separator} if(defined($self->{_timestring}));
 		SWITCH:
 			{
 			($_ eq 'h')	&& do
 				{
 				$self->{_timestring}	.= $self->{_hours};
 				last(SWITCH);
 				};
 			($_ eq 'm')	&& do
 				{
 				$self->{_timestring}	.= $self->{_minutes};
 				last(SWITCH);
 				};
 			($_ eq 's')	&& do
 				{
 				$self->{_timestring}	.= $self->{_seconds};
 				last(SWITCH);
 				};
 			}
 		}
 	return($self->{_timestring});
 	}
#-------------------------------------------------
 sub SetSeconds
 	{
 	return(0) if(($_[1] < 0) or ($_[1] > 59));
 	$_[0]->{_seconds} = $_[1];
 	return($_[0]->GetTime());
 	}
#-------------------------------------------------
 sub SetMinutes
 	{
 	return(0) if(($_[1] < 0) or ($_[1] > 59));
 	$_[0]->{_minutes} = $_[1];
 	return($_[0]->GetTime());
 	}
#-------------------------------------------------
 sub SetHours
 	{
 	return(0) if(($_[1] < 1) or ($_[1] > $_[0]->{_maxhours}));
 	$_[0]->{_hours} = $_[1];
 	return($_[0]->GetTime());
 	}
#-------------------------------------------------
 sub SetOrder
 	{
 	for(qw/hms hsm smh shm msh mhs/)
 		{
 		if($_ eq $_[1])
 			{
 			$_[0]->{_order} = $_[1];
 			return($_[1]);
 			}
 		}
 	return("hms");
 	}
#-------------------------------------------------
 sub SetMaxHours
 	{
 	if(($_[1] == 12) or ($_[1] == 23))
 		{
 		$_[0]->{_maxhours} = $_[1];
 		}
 	else
 		{
 		$_[0]->{_maxhours} = 23;
 		}
 	return(1);
 	}
#-------------------------------------------------
 sub SecondsReduce
 	{
 	if($_[0]->{_seconds} <= 0) { $_[0]->{_seconds} = 59; }
 	else { $_[0]->{_seconds}--; }
 	return($_[0]->GetTime());
 	}
#-------------------------------------------------
 sub SecondsIncrease
 	{
 	if($_[0]->{_seconds} >= 59) { $_[0]->{_seconds} = 0; }
 	else { $_[0]->{_seconds}++; }
	return($_[0]->GetTime());
 	}
#-------------------------------------------------
 sub MinutesReduce
 	{
 	if($_[0]->{_minutes} <= 0) { $_[0]->{_minutes} = 59; }
 	else { $_[0]->{_minutes}--; }
 	return($_[0]->GetTime());
 	}
#-------------------------------------------------
 sub MinutesIncrease
 	{
 	if($_[0]->{_minutes} >= 59) { $_[0]->{_minutes} = 0; }
 	else { $_[0]->{_minutes}++; }
 	return($_[0]->GetTime());
 	}
#-------------------------------------------------
 sub HoursReduce
 	{
 	if($_[0]->{_hours} <= 0) { $_[0]->{_hours} = $_[0]->{_maxhours}; }
 	else { $_[0]->{_hours}--; }
 	return($_[0]->GetTime());
 	}
#-------------------------------------------------
 sub HoursIncrease
 	{
 	if($_[0]->{_hours} >= $_[0]->{_maxhours}) { $_[0]->{_hours} = 0; }
 	else { $_[0]->{_hours}++; }
 	return($_[0]->GetTime());
 	}
#-------------------------------------------------
 sub AUTOLOAD
 	{
 	no strict "refs";
 	my ($self, $value) = @_;
 	if($AUTOLOAD =~ m/(?:\w|:)*::(?i:get)_*(\w+)/)
 		{
 		my $attr = lc($1);
 		$attr = '_' . $attr;
 		if(exists($self->{$attr}))
 			{
 			*{$AUTOLOAD} = sub
 				{
 				return($_[0]->{$attr});
 				};
 			return($self->{$attr});
 			}
 		else
 			{
 			warn("NO such attribute < $attr > called by $AUTOLOAD\n");
 			}
 		}
 	elsif($AUTOLOAD =~ m/(?:\w|:)*::(?i:set)_*(\w+)/)
 		{
 		my $attr = lc($1);
 		$attr = '_' . $attr;
 		if(exists($self->{$attr}))
 			{
 			*{$AUTOLOAD} = sub
 				{
 				$_[0]->{$attr} = $_[1];
 				return(1);
 				};
 			$self->{$attr} = $value;
 			return(1);
 			}
 		else
 			{
 			warn("NO such attribute < $attr > called by $AUTOLOAD\n");
 			}
 		}
 	else
 		{
 		warn("no such method < $AUTOLOAD >\n");
 		}
 	return(1);
 	}
#-------------------------------------------------
 sub DESTROY
 	{
 	print("\n" . ref($_[0]) . " object destroyed\n");
 	}
#-------------------------------------------------
1;
#-------------------------------------------------
__END__