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


line stmt bran cond sub pod time code
1             #*** TimePick.pm ***#
2             # Copyright (C) 2006 by Torsten Knorr
3             # torstenknorr@tiscali.de
4             # All rights reserved!
5             #-------------------------------------------------
6             package Tk::TimePick;
7             #-------------------------------------------------
8 1     1   27706 use strict;
  1         3  
  1         39  
9 1     1   5 use warnings;
  1         2  
  1         26  
10 1     1   605 use Tk::Frame;
  0            
  0            
11             use vars '$AUTOLOAD';
12             #-------------------------------------------------
13             @Tk::TimePick::ISA = qw(Tk::Frame);
14             $Tk::TimePick::VERSION = '0.02';
15             Construct Tk::Widget "TimePick";
16             #-------------------------------------------------
17             sub Populate
18             {
19             require Tk::Entry;
20             require Tk::Button;
21             my ($tp, $args) = @_;
22             #-------------------------------------------------
23             # -order
24             $tp->{_order} = (defined($args->{-order})) ?
25             $tp->SetOrder(delete($args->{-order})) : "hms";
26             # -separator
27             $tp->{_separator} = (defined($args->{-separator})) ?
28             delete($args->{-separator}) : ':';
29             # -maxhours
30             $tp->{_maxhours} = (defined($args->{-maxhours})) ?
31             delete($args->{-maxhours}) : 23;
32             $tp->{_maxhours} = 23 if(!(($tp->{_maxhours} == 12) or ($tp->{_maxhours} == 23)));
33             # -seconds
34             $tp->{_seconds} = (defined($args->{-seconds})) ?
35             delete($args->{-seconds}) : (localtime())[0];
36             # -minutes
37             $tp->{_minutes} = (defined($args->{-minutes})) ?
38             delete($args->{-minutes}) : (localtime())[1];
39             # -hours
40             $tp->{_hours} = (defined($args->{-hours})) ?
41             delete($args->{-minutes}) : (localtime())[2];
42             # -regextimeformat
43             $tp->{_regextimeformat} = (defined($args->{-regextimeformat})) ?
44             delete($args->{-regextimeformat}) : qr/(\d{1,2})(.+?)(\d{1,2})(.+?)(\d{1,2})/o;
45             $tp->SUPER::Populate($args);
46             #-------------------------------------------------
47             $tp->{entry_time} = $tp->Entry(
48             -textvariable => \$tp->{_timestring},
49             -state => "disabled",
50             -disabledforeground => "#000000",
51             -disabledbackground => "#FFFFFF"
52             )->pack(
53             -side => "top",
54             );
55             #-------------------------------------------------
56             for(split(//, $tp->{_order}))
57             {
58             $tp->{_timestring} .= $tp->{_separator} if(defined($tp->{_timestring}));
59             SWITCH:
60             {
61             ($_ eq 's') && do
62             {
63             $tp->{frame_seconds} = $tp->Frame(
64             -label => "Seconds",
65             -relief => "groove",
66             -borderwidth => 2,
67             -background => "#0000FF"
68             )->pack(
69             -side => "left",
70             );
71             $tp->{_timestring} .= $tp->{_seconds};
72             last(SWITCH);
73             };
74             ($_ eq 'm') && do
75             {
76             $tp->{frame_minutes} = $tp->Frame(
77             -label => "Minutes",
78             -relief => "groove",
79             -borderwidth => 2,
80             -background => "#0000FF"
81             )->pack(
82             -side => "left",
83             );
84             $tp->{_timestring} .= $tp->{_minutes};
85             last(SWITCH);
86             };
87             ($_ eq 'h') && do
88             {
89             $tp->{frame_hours} = $tp->Frame(
90             -label => "Hours",
91             -relief => "groove",
92             -borderwidth => 2,
93             -background => "#0000FF"
94             )->pack(
95             -side => "left",
96             );
97             $tp->{_timestring} .= $tp->{_hours};
98             last(SWITCH);
99             };
100             }
101             }
102            
103             #-------------------------------------------------
104             my $timer_repeat;
105             my $timer_after;
106             $tp->{button_seconds_reduce} = $tp->{frame_seconds}->Button(
107             -text => '<',
108             -command => [\&SecondsReduce, $tp]
109             )->pack(
110             -side => "left"
111             );
112             $tp->{button_seconds_reduce}->bind(
113             "",
114             sub
115             {
116             $timer_after = $tp->after(
117             500,
118             sub { $timer_repeat = $tp->repeat(100, [\&SecondsReduce, $tp]); }
119             );
120             }
121             );
122             $tp->{button_seconds_reduce}->bind(
123             "",
124             sub
125             {
126             $timer_after->cancel() if($timer_after);
127             $timer_repeat->cancel() if($timer_repeat);
128             }
129             );
130             #-------------------------------------------------
131             $tp->{button_seconds_increase} = $tp->{frame_seconds}->Button(
132             -text => '>',
133             -command => [\&SecondsIncrease, $tp]
134             )->pack(
135             -side => "left"
136             );
137             $tp->{button_seconds_increase}->bind(
138             "",
139             sub
140             {
141             $timer_after = $tp->after(
142             500,
143             sub { $timer_repeat = $tp->repeat(100, [\&SecondsIncrease, $tp]); }
144             );
145             }
146             );
147             $tp->{button_seconds_increase}->bind(
148             "",
149             sub
150             {
151             $timer_after->cancel() if($timer_after);
152             $timer_repeat->cancel() if($timer_repeat);
153             }
154             );
155             #-------------------------------------------------
156             $tp->{button_minutes_reduce} = $tp->{frame_minutes}->Button(
157             -text => '<',
158             -command => [\&MinutesReduce, $tp]
159             )->pack(
160             -side => "left"
161             );
162             $tp->{button_minutes_reduce}->bind(
163             "",
164             sub
165             {
166             $timer_after = $tp->after(
167             500,
168             sub { $timer_repeat = $tp->repeat(100, [\&MinutesReduce, $tp]); }
169             );
170             }
171             );
172             $tp->{button_minutes_reduce}->bind(
173             "",
174             sub
175             {
176             $timer_after->cancel() if($timer_after);
177             $timer_repeat->cancel() if($timer_repeat);
178             }
179             );
180             #-------------------------------------------------
181             $tp->{button_minutes_increase} = $tp->{frame_minutes}->Button(
182             -text => '>',
183             -command => [\&MinutesIncrease, $tp]
184             )->pack(
185             -side => "left"
186             );
187             $tp->{button_minutes_increase}->bind(
188             "",
189             sub
190             {
191             $timer_after = $tp->after(
192             500,
193             sub { $timer_repeat = $tp->repeat(100, [\&MinutesIncrease, $tp]); }
194             );
195             }
196             );
197             $tp->{button_minutes_increase}->bind(
198             "",
199             sub
200             {
201             $timer_after->cancel() if($timer_after);
202             $timer_repeat->cancel() if($timer_repeat);
203             }
204             );
205             #-------------------------------------------------
206             $tp->{button_hours_reduce} = $tp->{frame_hours}->Button(
207             -text => '<',
208             -command => [\&HoursReduce, $tp]
209             )->pack(
210             -side => "left"
211             );
212             $tp->{button_hours_reduce}->bind(
213             "",
214             sub
215             {
216             $timer_after = $tp->after(
217             500,
218             sub { $timer_repeat = $tp->repeat(100, [\&HoursReduce, $tp]); }
219             );
220             }
221             );
222             $tp->{button_hours_reduce}->bind(
223             "",
224             sub
225             {
226             $timer_after->cancel() if($timer_after);
227             $timer_repeat->cancel() if($timer_repeat);
228             }
229             );
230             #-------------------------------------------------
231             $tp->{button_hours_increase} = $tp->{frame_hours}->Button(
232             -text => '>',
233             -command => [\&HoursIncrease, $tp]
234             )->pack(
235             -side => "left"
236             );
237             $tp->{button_hours_increase}->bind(
238             "",
239             sub
240             {
241             $timer_after = $tp->after(
242             500,
243             sub { $timer_repeat = $tp->repeat(100, [\&HoursIncrease, $tp]); }
244             );
245             }
246             );
247             $tp->{button_hours_increase}->bind(
248             "",
249             sub
250             {
251             $timer_after->cancel() if($timer_after);
252             $timer_repeat->cancel() if($timer_repeat);
253             }
254             );
255             #-------------------------------------------------
256             $tp->{childs} =
257             {
258             "EntryTime" => $tp->{entry_time},
259             "FrameSeconds" => $tp->{frame_seconds},
260             "ButtonSecondsReduce" => $tp->{button_seconds_reduce},
261             "ButtonSecondsIncrease" => $tp->{button_seconds_increase},
262             "FrameMinutes" => $tp->{frame_minutes},
263             "ButtonMinutesReduce" => $tp->{button_minutes_reduce},
264             "ButtonMinutesIncrease" => $tp->{button_minutes_increase},
265             "FrameHours" => $tp->{frame_hours},
266             "ButtonHoursReduce" => $tp->{button_hours_reduce},
267             "ButtonHoursIncrease" => $tp->{button_hours_increase},
268             };
269             $tp->Advertise($_, $tp->{childs}{$_}) for(keys(%{$tp->{childs}}));
270             $tp->Delegates(
271             DEFAULT => $tp->{entry_time}
272             );
273             $tp->ConfigSpecs(
274             DEFAULT => ["ADVERTISED"]
275             );
276             }
277             #-------------------------------------------------
278             sub insert
279             {
280             my ($self, $time) = @_;
281             return(0) if(!($time =~ m/$self->{_regextimeformat}/));
282             return(0) if(!($2 eq $4));
283             $self->{_separator} = $2;
284             $self->SetTime($1, $3, $5);
285             return(1);
286             }
287             #-------------------------------------------------
288             sub SetTime
289             {
290             my ($self, @t) = @_;
291             my $index = 0;
292             $self->{_timestring} = undef;
293             for(split(//, $self->{_order}))
294             {
295             $self->{_timestring} .= $self->{_separator} if(defined($self->{_timestring}));
296             SWITCH:
297             {
298             ($_ eq 'h') && do
299             {
300             $self->{_hours} = $t[$index];
301             $self->{_timestring} .= $t[$index];
302             last(SWITCH);
303             };
304             ($_ eq 'm') && do
305             {
306             $self->{_minutes} = $t[$index];
307             $self->{_timestring} .= $t[$index];
308             last(SWITCH);
309             };
310             ($_ eq 's') && do
311             {
312             $self->{_seconds} = $t[$index];
313             $self->{_timestring} .= $t[$index];
314             last(SWITCH);
315             };
316             }
317             $index++;
318             }
319             return(1);
320             }
321             #-------------------------------------------------
322             sub GetTime
323             {
324             my ($self) = @_;
325             $self->{_timestring} = undef;
326             for(split(//, $self->{_order}))
327             {
328             $self->{_timestring} .= $self->{_separator} if(defined($self->{_timestring}));
329             SWITCH:
330             {
331             ($_ eq 'h') && do
332             {
333             $self->{_timestring} .= $self->{_hours};
334             last(SWITCH);
335             };
336             ($_ eq 'm') && do
337             {
338             $self->{_timestring} .= $self->{_minutes};
339             last(SWITCH);
340             };
341             ($_ eq 's') && do
342             {
343             $self->{_timestring} .= $self->{_seconds};
344             last(SWITCH);
345             };
346             }
347             }
348             return($self->{_timestring});
349             }
350             #-------------------------------------------------
351             sub SetSeconds
352             {
353             return(0) if(($_[1] < 0) or ($_[1] > 59));
354             $_[0]->{_seconds} = $_[1];
355             return($_[0]->GetTime());
356             }
357             #-------------------------------------------------
358             sub SetMinutes
359             {
360             return(0) if(($_[1] < 0) or ($_[1] > 59));
361             $_[0]->{_minutes} = $_[1];
362             return($_[0]->GetTime());
363             }
364             #-------------------------------------------------
365             sub SetHours
366             {
367             return(0) if(($_[1] < 1) or ($_[1] > $_[0]->{_maxhours}));
368             $_[0]->{_hours} = $_[1];
369             return($_[0]->GetTime());
370             }
371             #-------------------------------------------------
372             sub SetOrder
373             {
374             for(qw/hms hsm smh shm msh mhs/)
375             {
376             if($_ eq $_[1])
377             {
378             $_[0]->{_order} = $_[1];
379             return($_[1]);
380             }
381             }
382             return("hms");
383             }
384             #-------------------------------------------------
385             sub SetMaxHours
386             {
387             if(($_[1] == 12) or ($_[1] == 23))
388             {
389             $_[0]->{_maxhours} = $_[1];
390             }
391             else
392             {
393             $_[0]->{_maxhours} = 23;
394             }
395             return(1);
396             }
397             #-------------------------------------------------
398             sub SecondsReduce
399             {
400             if($_[0]->{_seconds} <= 0) { $_[0]->{_seconds} = 59; }
401             else { $_[0]->{_seconds}--; }
402             return($_[0]->GetTime());
403             }
404             #-------------------------------------------------
405             sub SecondsIncrease
406             {
407             if($_[0]->{_seconds} >= 59) { $_[0]->{_seconds} = 0; }
408             else { $_[0]->{_seconds}++; }
409             return($_[0]->GetTime());
410             }
411             #-------------------------------------------------
412             sub MinutesReduce
413             {
414             if($_[0]->{_minutes} <= 0) { $_[0]->{_minutes} = 59; }
415             else { $_[0]->{_minutes}--; }
416             return($_[0]->GetTime());
417             }
418             #-------------------------------------------------
419             sub MinutesIncrease
420             {
421             if($_[0]->{_minutes} >= 59) { $_[0]->{_minutes} = 0; }
422             else { $_[0]->{_minutes}++; }
423             return($_[0]->GetTime());
424             }
425             #-------------------------------------------------
426             sub HoursReduce
427             {
428             if($_[0]->{_hours} <= 0) { $_[0]->{_hours} = $_[0]->{_maxhours}; }
429             else { $_[0]->{_hours}--; }
430             return($_[0]->GetTime());
431             }
432             #-------------------------------------------------
433             sub HoursIncrease
434             {
435             if($_[0]->{_hours} >= $_[0]->{_maxhours}) { $_[0]->{_hours} = 0; }
436             else { $_[0]->{_hours}++; }
437             return($_[0]->GetTime());
438             }
439             #-------------------------------------------------
440             sub AUTOLOAD
441             {
442             no strict "refs";
443             my ($self, $value) = @_;
444             if($AUTOLOAD =~ m/(?:\w|:)*::(?i:get)_*(\w+)/)
445             {
446             my $attr = lc($1);
447             $attr = '_' . $attr;
448             if(exists($self->{$attr}))
449             {
450             *{$AUTOLOAD} = sub
451             {
452             return($_[0]->{$attr});
453             };
454             return($self->{$attr});
455             }
456             else
457             {
458             warn("NO such attribute < $attr > called by $AUTOLOAD\n");
459             }
460             }
461             elsif($AUTOLOAD =~ m/(?:\w|:)*::(?i:set)_*(\w+)/)
462             {
463             my $attr = lc($1);
464             $attr = '_' . $attr;
465             if(exists($self->{$attr}))
466             {
467             *{$AUTOLOAD} = sub
468             {
469             $_[0]->{$attr} = $_[1];
470             return(1);
471             };
472             $self->{$attr} = $value;
473             return(1);
474             }
475             else
476             {
477             warn("NO such attribute < $attr > called by $AUTOLOAD\n");
478             }
479             }
480             else
481             {
482             warn("no such method < $AUTOLOAD >\n");
483             }
484             return(1);
485             }
486             #-------------------------------------------------
487             sub DESTROY
488             {
489             print("\n" . ref($_[0]) . " object destroyed\n");
490             }
491             #-------------------------------------------------
492             1;
493             #-------------------------------------------------
494             __END__