source: trunk/soft/ObsData/ObsData.pm @ 218

Last change on this file since 218 was 218, checked in by nanardon, 18 years ago
  • add plugin loader mechanism
  • Property cvs2svn:cvs-rev set to 1.56
  • Property svn:keywords set to Author Date Id Revision
File size: 12.4 KB
Line 
1# $Id$
2
3package ObsData;
4
5use strict;
6use warnings;
7use Config::IniFiles;
8use POSIX qw(strftime);
9use ObsData::Repository;
10use Mail::Sendmail;
11use MIME::QuotedPrint;
12use File::Basename;
13
14my @loglevel = (
15    'DEBUG',
16    'INFO',
17    'RESULT',
18    'WARNING',
19    'ERROR',
20    'FATAL',
21);
22
23our $VERSION = "0.3.0";
24our $CVSID = q$Id$;
25our $CVSREV = (q$Revision$ =~ /^Revision: (.*) $/)[0];
26
27=head1 NAME
28
29ObsData - Main object to manage data files
30
31=head1 SYNOPSIS
32
33    use ObsData;
34    my $conf = "configfile";
35    my $obsdata = ObsData->new($conf);
36
37=head1 METHODS
38
39=head2 new($configfile)
40
41Create a new Obsdata object from $configfile
42
43=cut
44
45sub new {
46    my ($class, $configfile, %options) = @_;
47    my $obsdata = {
48        config => new Config::IniFiles(
49            -file => $configfile,
50            -default => 'global',
51            -allowcontinue => 1
52        ),
53        verbose => defined($options{verbose}) ? $options{verbose} : 1,
54        logcallback => $options{logcallback},
55        logfile => $options{logfile},
56        dry_run => $options{dry_run},
57        interactive_callback => $options{interactive_callback},
58        processed_lists => [],
59    };
60
61    if (!($configfile && -f $configfile && -r _)) {
62        return undef;
63    }
64
65    $obsdata->{config} or return undef;
66
67    # directory where to search plugins
68    @{$obsdata->{plugindir}} = grep { $_ && -d $_ } (
69        $options{plugindir},
70        dirname($0),
71        $obsdata->{config}->val('.', 'plugindir'),
72    );
73       
74    $obsdata->{logfile} ||= $obsdata->{config}->val('.', 'logfile') || 'obsdata.log';
75
76    bless($obsdata, $class);
77}
78
79sub DESTROY {
80    my ($self) = @_;
81
82    if ($self->{loghandle}) {
83        close($self->{loghandle});
84        $self->{loghandle} = undef;
85    }
86}
87
88=head2 load
89
90Prepare the object for usage
91
92=cut
93
94sub load {
95    my ($self) = @_;
96
97    if (!open($self->{loghandle}, ">> $self->{logfile}")) {
98        $self->{loghandle} = undef;
99        $self->logging(5, "Can't open log file %s, exiting", "$self->{logfile}");
100        return 0;
101    }
102   
103    $self->load_plugins();
104   
105    return 1;
106}
107
108sub load_plugins {
109    my ($self) = @_;
110    foreach my $datatype ($self->list_datatype()) {
111        foreach my $plugin (qw/match_plugin/) {
112            my $plugfile = $self->getvalue($datatype, $plugin)
113                or next; # if no plugin, skipping
114            my ($plugfilename) = grep { -f $_ }
115                map { "$_/$plugfile" } @{$self->{plugindir}};
116            if (!$plugfilename) {
117                $self->logging(5,
118                    "Cannot find plugin %s (%s) for %s datatype",
119                    $plugfile,
120                    $plugin,
121                    $datatype,
122                );
123                next; # FIXME die ??
124            }
125            my $sub = do $plugfilename;
126            if ($sub && ref $sub eq 'CODE') {
127                $self->{plugin}{$datatype}{$plugin} = $sub;
128                $self->logging(0,
129                    "loading plugin %s for %s (%s)",
130                    $plugin,
131                    $datatype,
132                    $sub,
133                );
134            } else {
135                $self->logging(4,
136                    "Cannot load plugin %s for %s (is %s)",
137                    $plugin,
138                    $datatype,
139                    $sub ? ref $sub : 'undef or empty',
140                );
141            }
142        }
143    }
144}
145
146=head2 logging($level, $message, ...)
147
148Pass a message into the logging process.
149
150   $level is the level of message
151   $message and or other arguments are printf format string
152
153=cut
154
155sub logging {
156    my ($self, $level, $fmt, @val) = @_;
157    my $msg = sprintf($fmt, @val);
158    my $logh = $self->{loghandle};
159    if ($self->{logcallback}) {
160        $self->{logcallback}->($level, $msg);
161    }
162    if($level >= 0 && $level >= $self->{verbose}) {
163        if ($logh) {
164            printf $logh 
165                "%-9s %s %s\n", 
166                sprintf("[%s]", $self->loglevel($level)),
167                strftime("%b %d %H:%M:%S %Y", gmtime),
168                $msg;
169        }
170    }
171    $msg
172}
173
174=head2 loglevel($level)
175
176Return the text human readable log level associate to $level number
177
178=cut
179
180sub loglevel {
181    my $l = pop(@_);
182    defined($l) or $l = pop(@_);
183    return $loglevel[ $l ] || "?????";
184}
185
186=head2 checkconfig()
187
188Check the validity of information contains in configfile.
189
190Notice: This test does not include the syntaxe validity
191
192=cut
193
194sub checkconfig {
195    my ($self) = @_;
196    my $result = 1;
197    foreach my $g ($self->{config}->GroupMembers('Obs')) {
198        my ($obs) = $g =~ /\S+\s+(.*)/;
199        if (!$self->{config}->SectionExists($obs)) {
200            print STDERR "E: '$obs' is listed as Obs but it does not exists\n";
201            next;
202        }
203        foreach my $param ($self->{config}->Parameters($obs)) {
204        }
205        foreach my $datatype ($self->list_datatype) {
206            foreach my $var (qw(match match_archive)) {
207                my $regexp = $self->getvalue($datatype, $var) or next; # next ? are we sure ?
208                eval { qr/$regexp/ }; # Many thanks Rafael
209                if ($@) {
210                    $self->logging(4, "error in regexp for %s: '%s': %s",
211                        $datatype,
212                        $regexp,
213                        $@,
214                    );
215                    $result = 0;
216                    # TODO set this reg unavalable
217                }
218            }
219        }
220    }
221    return($result);
222}
223
224=head2 getvalue($section, $var, $default)
225
226Return a value from the configuration, $default is assumed if the value is not set
227
228=cut
229
230sub getvalue {
231    my ($self, $section, $var, $default) = @_;
232    $self->{config}->val($section, $var, $default);
233}
234
235=head2 config_mtime
236
237Return the modification time of config file currently used
238
239=cut
240
241sub config_mtime {
242    my ($self) = @_;
243    return $self->{configmtime} ||= (stat($self->{config}->GetFileName))[9];
244}
245
246=head2 list_obs
247
248Return the list of observatories defined in configuration
249
250=cut
251
252sub list_obs {
253    my ($self) = @_;
254    grep { $self->{config}->SectionExists($_) }
255        map { s/^\S+\s+//; $_ }
256        $self->{config}->GroupMembers('Obs');
257}
258
259=head2 is_obs($obsname)
260
261Return True if $obsname is an observatory
262
263=cut
264
265sub is_obs {
266    my ($self, $obs) = @_;
267    scalar(grep { $_ eq "Obs $obs" } $self->{config}->GroupMembers('Obs'));
268}
269
270=head2 list_obsdatadir($obsname)
271
272Return a hash of data directories per data type for $obsname observatories
273
274=cut
275
276sub list_obsdatadir {
277    my ($self, $obs) = @_;
278    $self->is_obs($obs) or return undef;
279    map { m,^datadir/(.*),; ( ($1 || "") => $self->{config}->val($obs, $_) ) }
280        grep { m,^datadir/, || $_ eq 'datadir' }
281        $self->{config}->Parameters($obs)
282}
283
284=head2 list_typedatadir($type)
285
286List all directories for $type data
287
288=cut
289
290sub list_typedatadir {
291    my ($self, $type) = @_;
292    my %dirs;
293    foreach my $obs ($self->list_obs) {
294        $dirs{$_} = 1 foreach(grep { $_ } $self->get_datadir($obs, $type));
295    }
296    keys %dirs; 
297       
298}
299
300=head2 get_datadir($obs, $type)
301
302Return a list of directories for $type data on $obs observatory
303
304=cut
305
306sub get_datadir {
307    my ($self, $obs, $type) = @_;
308    $self->is_obs($obs) or return undef;
309    grep { defined($_) } ($self->getvalue($obs, "datadir/$type"), $self->getvalue($obs, "datadir"));
310}
311
312=head2 list_datatype
313
314Return a list of datatype handle by config
315
316=cut
317
318sub list_datatype {
319    my ($self) = @_;
320    grep { $_ ne 'global' }
321    grep { $_ !~ /^Obs\s+/ }
322    grep { !$self->is_obs($_) } $self->{config}->Sections;
323}
324
325=head2 get_obs_data_handle($obs, $datatype)
326
327Return an ObsData::Repository object about directory for $obs station
328about $datatype data. $datatype can be undefined if you want to get default
329directory
330
331=cut
332
333sub get_obs_data_handle {
334    my ($self, $obs, $datatype) = @_;
335
336    my $dir = $self->getvalue($obs, ($datatype ? "datadir/$datatype" : "datadir"));
337    if (!$dir) {
338        $self->logging(4,
339            "Can't find data directory for %s, type: %s",
340            $obs, $datatype || '(none)'
341        );
342        return undef;
343    }
344    my $or = ObsData::Repository::dir->new(
345        {
346            obsdata => $self,
347            dir => $dir,
348            obs => $obs,
349            datatype => $datatype,
350            dry_run => $self->{dry_run}, # FIXME does this have a better place ?
351            patern => $self->getvalue(
352                $obs,
353                ($datatype ? "searchfiles/$datatype" : "searchfiles")
354            ),
355            statusfile => $self->getvalue(
356                $obs, 
357                ($datatype ? "index/$datatype" : "index"),
358                "$dir/obsdata.ini"
359            ),
360        }
361    );
362    if (!defined($or)) {
363        $self->logging(4, "Can't parse %s, check directory exists", $dir);
364        return undef;
365    }
366   
367    return($or);
368}
369
370=head2 process_obs($obs)
371
372Process all data handle by $obs station
373
374=cut
375
376sub process_obs {
377    my ($self, $obs) = @_;
378    my %datadir = $self->list_obsdatadir($obs);
379    $self->logging(0, "Starting %s() for %s", (caller(0))[3], $obs);
380   
381    foreach my $datatype (keys %datadir) {
382        my $or = $self->get_obs_data_handle($obs, $datatype);
383        $or or next;
384        $or->process;
385    }
386}
387
388sub processed {
389    my ($self, $obs, $archive, $datafile, $datatype, $dest) = @_;
390    push(@{$self->{processed_lists}},
391        {
392            obs => $obs,
393            archive => $archive,
394            datafile => $datafile,
395            datatype => $datatype,
396            destfile => $dest,
397        }
398    );
399    $self->logging(
400        2, "Extraction of %s/%s done as %s",
401        $archive,
402        $datafile,
403        $dest,
404    );
405}
406
407sub generated_reported {
408    my ($self) = @_;
409    my $result = {
410        all => [],
411        users => {},
412    };
413
414    foreach my $entry (@{$self->{processed_lists}}) {
415        my @people = split(/\s*,\s*/, $self->getvalue($entry->{datatype}, 'reportto') || "");
416        @people or next;
417        foreach my $p (@people) {
418            push(@{$result->{users}{$p}{$entry->{datatype}}}, $entry);
419        }
420    }
421
422    foreach my $p (keys(%{$result->{users} || {}})) {
423        my %msg = (
424            Subject => 'ObsData Report',
425            To => $p,
426            'X-ObsData-Version' => $VERSION,
427            'Content-Type' => "TEXT/PLAIN;\n  charset=ISO-8859-1",
428            'Content-Transfer-Encoding' => 'QUOTED-PRINTABLE',
429            From => 'ObsData <robot@aerov.jussieu.fr>',
430        );
431        my $message = "";
432        foreach my $d (keys(%{$result->{users}{$p} || {}})) {
433            $message .= "\nDataType: $d\n";
434            foreach (@{$result->{users}{$p}{$d} || []}) {
435                $message .= sprintf("\tfile %s from %s\n\t=> %s\n",
436                    $_->{datafile},
437                    $_->{archive},
438                    $_->{destfile},
439                );
440            }
441        }
442        sendmail(
443            %msg,
444            smtp => 'mailhost',
445            Message => encode_qp($message),
446        ) or $self->log(4, "Cannot send mail to %s: %s",
447            $msg{To}, $Mail::Sendmail::error,
448        );
449    }
450    return $result;
451}
452
453sub postprocessed {
454    my ($self) = @_;
455    my %datastype;
456    foreach my $entry (@{$self->{processed_lists}}) {
457        push(@{$datastype{$entry->{datatype}}}, $entry);
458    }
459
460    foreach my $datatype (keys %datastype) {
461        my $command = $self->getvalue($datatype, 'postexec');
462        $self->logging(0, 'postexec for %s is %s',
463            $datatype,
464            $command ? "`$command'" : 'not set, skipping',
465        );
466        if ($command) {
467            if (open(my $posthandle, "| $command")) {
468                foreach (@{$datastype{$datatype}}) {
469                    print $posthandle "$_->{destfile}\n" or do {
470                        $self->logging(4, "cannot write to postexec handle for `%s': %s",
471                            $datatype,
472                            $!,
473                        );
474                        last;
475                    };
476                }
477                my $exitstatus = close($posthandle);
478                $self->logging($exitstatus ? 0 : 4,
479                    "postexec for %s exit %s",
480                    $datatype,
481                    $exitstatus ? "correctly" : "with failure : " . ($! ? ($!) : "(??)"),
482                );
483            } else {
484                $self->logging(4, "Cannot exec post `%s' for `%s'",
485                    $command,
486                    $datatype,
487                );
488                next;
489            }
490        }
491    }
492}
493
4941;
495
496=head1 LICENSE
497
498This software is under GPL version 2 or highter
499(c) 2005, 2006 CNRS Service d'Aeronomie
500
501=head1 AUTHOR
502
503Olivier Thauvin <olivier.thauvin@aerov.jussieu.fr>
504
505=cut
Note: See TracBrowser for help on using the repository browser.