File Coverage

blib/lib/X10/Scheduler.pm
Criterion Covered Total %
statement 9 57 15.7
branch 0 14 0.0
condition 0 16 0.0
subroutine 3 12 25.0
pod 0 7 0.0
total 12 106 11.3


line stmt bran cond sub pod time code
1              
2             # Copyright (c) 1999-2017 Rob Fugina
3             # Distributed under the terms of the GNU Public License, Version 3.0
4              
5             package X10::Scheduler;
6              
7             # this package implements a scheduler
8              
9 1     1   4 use Data::Dumper;
  1         1  
  1         44  
10 1     1   4 use POSIX;
  1         1  
  1         5  
11              
12 1     1   1220 use strict;
  1         2  
  1         507  
13              
14             sub new
15             {
16 0     0 0   my $type = shift;
17              
18 0           my $self = bless { @_ }, $type;
19              
20 0 0         return undef unless $self->{controller};
21              
22             $self->{logger} ||= sub {
23 0     0     shift;
24 0           printf(@_);
25 0           print "\n";
26 0   0       };
27              
28 0 0         $self->{verbose} = 1 if $self->{debug};
29              
30             # $self->{controller}->register_listener($self->event_callback);
31 0           $self->{schedevents} = [];
32              
33 0 0         if ($self->{configfile})
34             {
35 0   0       my $config = eval { require $self->{configfile} } || die $@;
36              
37 0           foreach (@$config)
38             {
39 0           $self->add( new X10::SchedEvent( %$_ ) );
40             }
41             }
42              
43 0           return $self;
44             }
45              
46             ###
47              
48             sub setup
49             {
50 0     0 0   my $self = shift;
51              
52 0 0         if (@_)
53             {
54 0           while (my $key = shift)
55             {
56             }
57             }
58              
59 0           return $self->{schedevents};
60             }
61              
62             sub add
63             {
64 0     0 0   my $self = shift;
65 0           my $se = shift;
66              
67 0 0 0       return undef unless ($se && $se->isa('X10::SchedEvent'));
68              
69 0           $se->controller($self->{controller});
70 0           $se->{logger} = $self->{logger};
71 0   0       $se->{latitude} = $self->{latitude} || 38.74274;
72 0   0       $se->{longitude} = $self->{longitude} || -90.560143;
73              
74 0   0       $self->{logger}->('info', "Queueing %s for %s",
75             $se->description || 'unnamed event',
76             strftime("%a %b %e %H:%M %Y", localtime($se->next_time)),
77             );
78              
79 0           push @{$self->{schedevents}}, $se;
  0            
80              
81 0           @{$self->{schedevents}} =
82 0           sort { $a->next_time <=> $b->next_time }
83 0           @{$self->{schedevents}};
  0            
84              
85 0           return 1;
86             }
87              
88             sub next_event_time
89             {
90 0     0 0   my $self = shift;
91              
92 0 0         return 0 unless (@{$self->{schedevents}} > 0);
  0            
93              
94 0           return $self->{schedevents}->[0]->next_time;
95             }
96              
97             sub run
98             {
99 0     0 0   my $self = shift;
100              
101 0   0       while ( @{$self->{schedevents}}
  0            
102             && $self->{schedevents}->[0]->next_time <= (int(time) + 30) )
103             {
104 0           my $se = shift @{$self->{schedevents}};
  0            
105              
106 0           $se->run;
107              
108 0 0         if ($se->reschedule)
109             {
110 0           $self->add($se);
111             }
112             else
113             {
114             }
115             }
116             }
117              
118             # nothing to do with events
119             sub event_callback
120             {
121 0     0 0   my $self = shift;
122 0     0     return sub { };
123             }
124              
125             # no fds to deal with
126             sub select_fds
127             {
128 0     0 0   return ();
129             }
130              
131              
132             1;
133