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

Last change on this file since 83 was 83, checked in by thauvin, 19 years ago
  • add set_status
  • Property cvs2svn:cvs-rev set to 1.26
  • Property svn:keywords set to Author Date Id Revision
File size: 6.7 KB
Line 
1# $Id$
2
3package ObsData;
4
5use strict;
6use warnings;
7use Config::IniFiles;
8use POSIX qw(strftime);
9use ObsData::Repository;
10
11my @loglevel = (
12    'DEBUG',
13    'INFO',
14    'RESULT',
15    'WARNING',
16    'ERROR',
17    'FATAL',
18);
19
20our $VERSION = 0.01;
21our $CVSID = q$Id$;
22our $CVSREV = (q$Revision$ =~ /^Revision: (.*) $/)[0];
23
24=head1 NAME
25
26ObsData - Main object to manage data files
27
28=head1 SYNOPSIS
29
30    use ObsData;
31    my $conf = "configfile";
32    my $obsdata = ObsData->new($conf);
33
34=head1 METHODS
35
36=head2 new($configfile)
37
38Create a new Obsdata object from $configfile
39
40=cut
41
42sub new {
43    my ($class, $configfile, %options) = @_;
44    my $obsdata = {
45        config => new Config::IniFiles(
46            -file => $configfile,
47            -default => 'global',
48            -allowcontinue => 1
49        ),
50        verbose => defined($options{verbose}) ? $options{verbose} : 1,
51        logcallback => $options{logcallback},
52        logfile => $options{logfile} || "obsdata.log",
53    };
54
55    if ($configfile) {
56        (-f $configfile && -r _) or return undef;
57    }
58
59    $obsdata->{config} or return undef;
60
61    bless($obsdata, $class);
62}
63
64sub DESTROY {
65    my ($self) = @_;
66
67    if ($self->{loghandle}) {
68        close($self->{loghandle});
69        $self->{loghandle} = undef;
70    }
71}
72
73sub set_status {
74    my ($self, %settings) = @_;
75    my %status_default = (
76        archive_new => 1,
77        archive_time => 0,
78        archive_size => 0,
79
80        data_new => 1,
81        data_configmtime => 0,
82
83    );
84   
85    foreach (keys %status_default) {
86        $self->{status_make_work}{$_} = defined($settings{$_}) ? $settings{$_} : $status_default{$_};
87    }
88}
89
90sub load {
91    my ($self) = @_;
92
93    if (!open($self->{loghandle}, ">> $self->{logfile}")) {
94        $self->{loghandle} = undef;
95        $self->loging(5, "Can't open log file %s, exiting", "$self->{logfile}");
96        return 0;
97    }
98   
99    return 1;
100}
101
102sub loging {
103    my ($self, $level, $fmt, @val) = @_;
104    my $msg = sprintf($fmt, @val);
105    my $logh = $self->{loghandle};
106    if ($self->{logcallback}) {
107        $self->{logcallback}->($level, $msg);
108    }
109    if($level >= 0 && $level >= $self->{verbose}) {
110        if ($logh) {
111            printf $logh 
112                "%-9s %s %s\n", 
113                sprintf("[%s]", $self->loglevel($level)),
114                strftime("%b %d %H:%M:%S %Y", gmtime),
115                $msg;
116        }
117    }
118    $msg
119}
120
121sub loglevel {
122    my $l = pop(@_);
123    defined($l) or $l = pop(@_);
124    return $loglevel[ $l ] || "?????";
125}
126
127=head2 checkconfig()
128
129Check the validity of information contains in configfile.
130
131Notice: This test does not include the syntaxe validity
132
133=cut
134
135sub checkconfig {
136    my ($self) = @_;
137    foreach my $g ($self->{config}->GroupMembers('Obs')) {
138        my ($obs) = $g =~ /\S+\s+(.*)/;
139        if (!$self->{config}->SectionExists($obs)) {
140            print STDERR "E: '$obs' is listed as Obs but it does not exists\n";
141            next;
142        }
143        foreach my $param ($self->{config}->Parameters($obs)) {
144        }
145    }
146}
147
148=head2 getvalue($section, $var, $default)
149
150Return a value from the configuration, $default is assumed if the value is not set
151
152=cut
153
154sub getvalue {
155    my ($self, $section, $var, $default) = @_;
156    $self->{config}->val($section, $var, $default);
157}
158
159sub config_mtime {
160    my ($self) = @_;
161    return $self->{configmtime} ||= (stat($self->{config}->GetFileName))[9];
162}
163
164=head2 list_obs
165
166Return the list of observatories defined in configuration
167
168=cut
169
170sub list_obs {
171    my ($self) = @_;
172    grep { $self->{config}->SectionExists($_) }
173        map { s/^\S+\s+//; $_ }
174        $self->{config}->GroupMembers('Obs');
175}
176
177=head2 is_obs($obsname)
178
179Return True if $obsname is an observatory
180
181=cut
182
183sub is_obs {
184    my ($self, $obs) = @_;
185    scalar(grep { $_ eq "Obs $obs" } $self->{config}->GroupMembers('Obs'));
186}
187
188=head2 list_obsdatadir($obsname)
189
190Return a hash of data directories per data type for $obsname observatories
191
192=cut
193
194sub list_obsdatadir {
195    my ($self, $obs) = @_;
196    $self->is_obs($obs) or return undef;
197    map { m,^datadir/(.*),; ( ($1 || "") => $self->{config}->val($obs, $_) ) }
198        grep { m,^datadir/, || $_ eq 'datadir' }
199        $self->{config}->Parameters($obs)
200}
201
202=head2 list_typedatadir($type)
203
204List all directories for $type data
205
206=cut
207
208sub list_typedatadir {
209    my ($self, $type) = @_;
210    my %dirs;
211    foreach my $obs ($self->list_obs) {
212        $dirs{$_} = 1 foreach(grep { $_ } $self->get_datadir($obs, $type));
213    }
214    keys %dirs; 
215       
216}
217
218=head2 get_datadir($obs, $type)
219
220Return a list of directories for $type data on $obs observatory
221
222=cut
223
224sub get_datadir {
225    my ($self, $obs, $type) = @_;
226    $self->is_obs($obs) or return undef;
227    grep { defined($_) } ($self->getvalue($obs, "datadir/$type"), $self->getvalue($obs, "datadir"));
228}
229
230=head2 list_datatype
231
232Return a list of datatype handle by config
233
234=cut
235
236sub list_datatype {
237    my ($self) = @_;
238    grep { $_ ne 'global' }
239    grep { $_ !~ /^Obs\s+/ }
240    grep { !$self->is_obs($_) } $self->{config}->Sections;
241}
242
243sub match_data_type {
244    my ($self, $datatype, $label) = @_;
245    my $regexp = $self->getvalue($datatype, 'match') or return;
246    my @data = $label =~ /$regexp/;
247    if (! @data) {
248        return;
249    }
250    return @data;
251}
252
253sub find_match_data_type {
254    my ($self, $label) = @_;
255    foreach my $datatype ($self->list_datatype) {
256        my @data = $self->match_data_type($datatype, $label);
257        if (@data) {
258            return($datatype, @data);
259        }
260    }
261}
262
263sub build_dest_filename {
264    my ($self, $label, $datatype) = @_;
265    my @data;
266    if ($datatype) {
267        @data = $self->match_data_type($datatype, $label);
268    } else {
269        ($datatype, @data) = $self->find_match_data_type($label);
270    }
271
272    if ($datatype && @data) {
273        my $dest = $self->getvalue($datatype, 'dest');
274        my @matcharg = split(/\s+/, $self->getvalue($datatype, 'matcharg'));
275        my @destarg = split(/\s+/, $self->getvalue($datatype, 'destarg'));
276        my @gmtime = gmtime;
277        my %val;
278        foreach (@matcharg) {
279            $val{$_} = shift(@data);
280        }
281        return ($datatype, sprintf(
282            $dest,
283            map { m/^%/ ? strftime($_, @gmtime) : $val{$_} } @destarg,
284        ));
285    }
286    undef;
287}
288
289sub find_file_obs {
290    my ($self, $obs) = @_;
291    my %datadir = $self->list_obsdatadir($obs);
292    $self->loging(0, "Starting %s() for %s", (caller(0))[3], $obs);
293   
294    foreach my $datatype (keys %datadir) {
295        my $or = ObsData::Repository->new(
296            $self,
297            $datadir{$datatype},
298            obs => $obs,
299            datatype => $datatype,
300        );
301        if (!defined($or)) {
302            $self->loging(4, "Can't parse %s, check directory exists", $datadir{$datatype});
303            next;
304        }
305        $or->parse_files;
306    }
307}
308
3091;
Note: See TracBrowser for help on using the repository browser.