source: branches/v0_2/soft/ObsData/ObsData/Repository.pm @ 206

Last change on this file since 206 was 206, checked in by thauvin, 18 years ago
  • backport from HEAD the lazy mode for status file
  • Property cvs2svn:cvs-rev set to 1.74.2.3
  • Property svn:keywords set to Author Date Id Revision
File size: 17.1 KB
Line 
1# $Id$
2
3package ObsData::Repository;
4
5use strict;
6use warnings;
7use File::Path;
8use POSIX qw(getcwd);
9use ObsData;
10use ObsData::Archive;
11use ObsData::Event;
12use Config::IniFiles;
13use POSIX qw(strftime);
14
15our $CVSID = q$Id$;
16our $CVSREV = (q$Revision$ =~ /^Revision: (.*) $/)[0];
17
18=head1 METHODS
19
20=head2 ObsData::Repository
21
22=head3 new($parent, %param)
23
24Create a new ObsData::Repository object
25
26=over 4
27
28=item $parent
29
30A ObsData::Repository to take information
31
32=item %param
33
34A list of paramter to set in new object:
35
36=over 4
37
38=item datatype
39
40If set, only this datatype will be checked
41
42=item obs
43
44The obsveratory where data come from, informationnal only
45
46=item dir
47
48The based directory where archive are located
49
50=item glob
51
52Apply this glob to search files in dir
53
54=item statusfile
55
56The file where status info should be written
57
58=item status
59
60The Config::IniFiles object
61
62=back
63
64=back
65
66=cut
67
68sub new {
69    my ($class, $parent, %param) = @_;
70
71    my $or = { %$parent };
72    foreach (keys %param) {
73        $or->{$_} = $param{$_};
74    }
75   
76    $or->{obsdata} or die "Error #1de8d015, please insult programmer";
77    $or->{dir} or die "No dir given";
78    -d $or->{dir} or return undef;
79   
80    $or->{status} ||= new Config::IniFiles(
81        -file => (($or->{statusfile} && -f $or->{statusfile}) ? $or->{statusfile} : undef),
82        # -default => '.', # Is this a good idea
83    );
84    $or->{statusfile} ||= $or->{status}->GetFileName;
85    $or->{interactive_callback} ||= $or->{obsdata}->{interactive_callback};
86
87    bless($or, $class);
88
89    $or;
90}
91
92sub DESTROY {
93    my ($self) = @_;
94    $self->logging(0, "Destroy ObsData::Repository for %s", ref($self));
95    $self->save_status;
96}
97
98=head3 update_global_status
99
100Set standard information into status ini file
101
102=cut
103
104sub update_global_status {
105    my ($self) = @_;
106    $self->{status}->AddSection('.');
107    $self->{status}->SetSectionComment('.',
108        $ObsData::CVSID,
109        $ObsData::Repository::CVSID,
110        scalar(localtime),
111    );
112
113    my $hostname = `hostname`;
114    chomp($hostname);
115    $self->{status}->newval('.', 'hostname', $hostname);
116    $self->{status}->SetParameterComment(
117        '.',
118        'hostname',
119        'The computer host name'
120    );
121
122    $self->{status}->newval('.', 'directory', $self->{dir});
123    $self->{status}->SetParameterComment(
124        '.',
125        'directory', 
126        'Directory where archive where located'
127    );
128   
129    $self->{status}->newval('.', 'runfrom', getcwd());
130    $self->{status}->SetParameterComment(
131        '.',
132        'runfrom',
133        'The current directory'
134    );
135}
136
137=head3 save_status
138
139Save current information about parsed files into status file
140
141=cut
142
143sub save_status {
144    my ($self) = @_;
145    $self->{statusfile} or return;
146    if (!$self->{dry_run}) {
147        $self->logging(0,
148            "Writing status file: %s",
149            $self->{statusfile},
150        );
151        $self->update_global_status;
152        $self->{status}->WriteConfig($self->{statusfile});
153    }
154}
155
156=head3 dump_status($output)
157
158Dump current status file into $output, see Config::IniFiles,
159function WriteConfig
160
161=cut
162
163sub dump_status {
164    my ($self, $output) = @_;
165    $self->update_global_status;
166    $self->{status}->WriteConfig($output);
167}
168
169=head3 logging($level, $msg, ...)
170
171Pass a message for logging to ObsData Object. See L<ObsData>
172
173=cut
174
175sub logging {
176    my $self = shift;
177    $self->{obsdata}->logging(@_);
178}
179
180=head2 ObsData::Repository::dir
181
182The child class to handle directory
183
184=cut
185
186package ObsData::Repository::dir;
187
188our @ISA = qw(ObsData::Repository);
189
190=head3 new
191
192=cut
193
194sub new {
195    my ($class, $infos, %param) = @_;
196
197    my $or = ObsData::Repository->new($infos, %param) or return;
198
199    bless($or, $class);
200}
201
202=head3 findfile
203
204Return the list of files needing to be checked
205
206=cut
207
208sub findfile {
209    my ($self) = @_;
210    my @files;
211
212    if (!-d $self->{dir}) {
213        $self->logging(3,
214            "directory %s does not exists",
215            $self->{dir},
216        );
217        return;
218    }
219
220    my $patern = $self->{patern} || '*';
221    foreach my $f (glob("$self->{dir}/$patern")) {
222
223        -f $f or next; # skip no regular files
224        $f =~ m/obsdata\.ini$/ and next; # avoid default status file
225       
226        my $bf = $f;
227        $bf =~ s!^\Q$self->{dir}\E/*!!;
228        push(@files, $bf);
229    }
230    @files
231}
232
233=head3 list_archive_from_status()
234
235Return the list of archive currently registered in status file.
236
237=cut
238
239sub list_archive_from_status {
240    my ($self) = @_;
241
242    grep { $_ ne '.' } $self->{status}->Sections
243}
244
245=head3 process
246
247Process all files in directory
248
249=cut
250
251sub process {
252    my ($self) = @_;
253    $self->logging(0, "%s() start for %s", (caller(0))[3], $self->{dir});
254
255    foreach my $file ($self->findfile) {
256        my $orda = ObsData::Repository::dir::archive->new(
257            $self,
258            archivefile => $file,
259        );
260
261        my $oe = ObsData::Event->new('do_archive', "Should I parse $file");
262       
263        $oe->add_test('archive_exists',
264            $self->{status}->SectionExists($orda->{archivefile}) ?
265            ("Archive file found in index", 1) :
266            ("Archive file not found in index", 0)
267        );
268       
269        if (defined(my $oldsize = $orda->getvalue('size'))) {
270            my $size = (stat("$orda->{dir}/$orda->{archivefile}"))[7];
271           
272            $oe->add_test('archive_size',
273                ($size <=> $oldsize) == 0 ?
274                (sprintf("size does not differ (%d)", $size), 1) :
275                (sprintf("differ %d => %d", $oldsize, $size), 0)
276            );
277        }
278
279        if (defined(my $oldmtime = $orda->getvalue('mtime'))) {
280            my $mtime = (stat("$orda->{dir}/$orda->{archivefile}"))[9];
281            $oe->add_test('archive_mtime',
282                ($mtime <=> $oldmtime) == 0 ?
283                (sprintf("mtime does not differ (%d)", $mtime), 1) :
284                (sprintf("differ %d => %d", $oldmtime, $mtime), 0)
285            );
286        }
287       
288        $orda->ask_user($oe) or next;
289       
290        $orda->process;
291    }
292}
293
294=head2 ObsData::Repository::dir::archive
295
296Object to handle archive and to dispatch data
297
298=cut
299
300package ObsData::Repository::dir::archive;
301
302use POSIX qw(strftime);
303
304our @ISA = qw(ObsData::Repository);
305
306=head3 new($info, %param)
307
308Return a new ObsData::Repository::dir::archive object.
309
310$info is an ObsData::Repository or ObsData::Repository::dir object
311
312%param are:
313   
314    archivefile => the archive file to read
315
316=cut
317
318sub new {
319    my ($class, $infos, %param) = @_;
320
321    my $or = ObsData::Repository->new($infos, %param) or return;
322    # dir directory to parse
323    $or->{archivefile} or die "No archivefile given";
324
325    # $or->{interactive_callback}
326    $or->{_cache_checks} = {};
327   
328    $or->logging(0,
329        "Preparing to parse %s/%s",
330         $or->{dir},
331         $or->{archivefile}
332    );
333
334    bless($or, $class);
335}
336
337sub DESTROY {
338    my ($self) = @_;
339    $self->logging(0, "Destroy ObsData::Repository for %s", ref($self));
340    if ($self->{status_changed}) {
341        $self->save_status
342    }
343}
344
345=head3 load_archive
346
347Try to read archive, return 1 on success
348
349=cut
350
351sub load_archive {
352    my ($self) = @_;
353    if ($self->{Oarchive}) {
354        return 1;
355    } else {
356        $self->{Oarchive} = ObsData::Archive->new("$self->{dir}/$self->{archivefile}");
357        if ($self->{Oarchive}) {
358            $self->logging(0,
359                "Archive %s/%s properly load",
360                $self->{dir}, $self->{archivefile}
361            );
362            return 1;
363        } else {
364            $self->logging(4, 
365                "Can't handle archive %s/%s: %s, skipping",
366                $self->{dir}, $self->{archivefile},
367                ObsData::Archive->error
368            );
369            return 0;
370        }
371    }
372}
373
374=head2 getvalue($var, $default)
375
376Return a value from status file related to current archive.
377
378=cut
379
380sub getvalue {
381    my ($self, $var, $default) = @_;
382    return $self->{status}->val($self->{archivefile}, $var, $default);
383}
384
385=head2 setvalue
386
387Define a value related to current archive file.
388
389=cut
390
391sub setvalue {
392    my ($self, $var, $val, $comment) = @_;
393    if (!$self->{status}->SectionExists($self->{archivefile})) {
394        $self->{status}->AddSection($self->{archivefile});
395    }
396    $self->{status}->newval($self->{archivefile}, $var, $val) if(defined($val));
397    $self->{status}->SetParameterComment(
398        $self->{archivefile}, $var, $comment
399    ) if(defined($comment));
400    $self->{status_changed} = 1;
401}
402
403=head2 get_data_value($datafile, $var, $default)
404
405Return a value from status file related to current archive about $datafile.
406
407=cut
408
409sub get_data_value {
410    my ($self, $datafile, $var, $default) = @_;
411    return $self->getvalue(
412        sprintf('data_%s_%s', $var, $datafile),
413        $var, 
414        $default
415    );
416}
417
418=head2 set_data_value($datafile, $var, $val, $comment)
419
420Set a value and optionnaly a comment for $datafile found in archive file
421
422=cut
423
424sub set_data_value {
425    my ($self, $datafile, $var, $val, $comment) = @_;
426    $self->setvalue(
427        sprintf('data_%s_%s', $var, $datafile),
428        $val,
429        $comment
430    );
431}
432
433=head3 checks
434
435=cut
436
437=head3 default_choice($oevent)
438
439In batch mode, check ObsData::event content and return result about behaviour
440soft whould have.
441
442=cut
443
444sub default_choice {
445    my ($self, $oevent) = @_;
446
447    for ($oevent->id) {
448        /^do_archive$/ and do {
449            return($oevent->test_result('archive_exists') ? 0 : 1);
450            last;
451        };
452        /^do_data$/ and do {
453            return 1; # TODO
454            last;
455        };
456        /^overwrite$/ and do {
457            return($oevent->test_result('dest_exists') ? 0 : 1);
458            last;
459        };
460    }
461}
462
463=head3 ask_user($oevent)
464
465The function take a filled ObsData::Event object, and perform return
466default_choice verification or result the callback set by the application.
467
468=cut
469
470sub ask_user {
471    my ($self, $oevent) = @_;
472
473    $self->logging(0, "Event(%s): %s",
474        $oevent->id,
475        $oevent->message);
476    foreach ($oevent->list_test) {
477        $self->logging(0, "  (%s) %s: %s",
478            $_,
479            $oevent->test_message($_),
480            $oevent->test_result($_),
481        );
482    }
483
484    my $res =
485        $self->{interactive_callback} ?
486        $self->{interactive_callback}->($self, $oevent) :
487        $self->default_choice($oevent);
488
489    $self->logging(0, "Event(%s): Result: %s", $oevent->id, $res);
490    return($res);
491}
492
493=head3 list_archive
494
495Return archive content
496
497=cut
498
499sub list_archive {
500    my ($self) = @_;
501    $self->load_archive or return;
502   
503    return $self->{Oarchive}->ls;
504}
505
506=head3 update_status
507
508Update status information about current archive
509
510=cut
511
512sub update_status {
513    my ($self) = @_;
514    my @filestats = stat("$self->{dir}/$self->{archivefile}");
515   
516    $self->setvalue('mtime', $filestats[9]);
517    $self->setvalue('size', $filestats[7]);
518    $self->setvalue('configtime', $self->{obsdata}->config_mtime);
519}
520
521=head3 find_match_data_type($label)
522
523Check if datafile match one of the regexp associate to datatype in the
524configuration, if yes, return the datatype and assiociate values, else
525return nothing
526
527=cut
528
529sub match_data_type {
530    my ($self, $datafile) =  @_;
531    foreach my $datatype (($self->{datatype}) || $self->{obsdata}->list_datatype) {
532        my $regexp = $self->{obsdata}->getvalue($datatype, 'match') or next;
533        my @data = $datafile =~ /$regexp/;
534        if (@data) {
535            return ($datatype, @data);
536        }
537    }
538}
539
540=head3 archive_match($datatype)
541
542Apply matching to archive filename
543
544=cut
545
546sub archive_match {
547    my ($self, $datatype) = @_;
548    my $regexp = $self->{obsdata}->getvalue($datatype, 'match_archive') or next;
549    my @data = $self->{archivefile} =~ /$regexp/;
550    return @data;
551}
552
553=head3 build_dest_filename($datafile)
554
555Build the destination file from original filename and optionnaly.
556Return the datatype and the filename. If no datatype apply,
557return undef, if destination file cannot be build, return only the datatype.
558
559If object datatype is not defined, the function try to find the right datatype from
560configuration.
561
562=cut
563
564sub build_dest_filename {
565    my ($self, $datafile) = @_;
566    my ($datatype, @data) = $self->match_data_type($datafile);
567   
568    if (! $datatype) {
569        return;
570    }
571
572    my @ardata = ();
573    if (my $arregexp = $self->{obsdata}->getvalue($datatype, 'match_archive')) {
574        @ardata = $self->{archivefile} =~ /$arregexp/;
575        if (!@ardata) {
576            return; # FIXME is this what we want ?
577        }
578    }
579
580    my $dest = $self->{obsdata}->getvalue($datatype, 'dest');
581    my @matcharg = split(/\s+/, $self->{obsdata}->getvalue($datatype, 'matcharg'));
582    my @matcharg_ar = split(/\s+/, $self->{obsdata}->getvalue($datatype, 'matcharg_archive')||"");
583    my @destarg = split(/\s+/, $self->{obsdata}->getvalue($datatype, 'destarg'));
584    my @gmtime = gmtime;
585    my %val;
586    foreach (@matcharg) {
587        $val{$_} = shift(@data);
588    }
589    foreach (@matcharg_ar) {
590        $val{$_} = shift(@ardata);
591    }
592    # FIXME Is this need ?
593    # foreach (keys %{$magic_words || {}}) {
594    #    $val{'$' . $_} = $magic_words->{$_};
595    #}
596   
597    $val{'$datafile'} = $datafile;
598    $val{'$archivefile'} = $self->{archivefile};
599    my $destfile = sprintf(
600        $dest,
601        map { m/^%/ ? strftime($_, @gmtime) : $val{$_} } @destarg,
602    );
603    if (!$destfile) {
604        $self->logging(4, "Can evaluate destination file from %s, %s",
605            $dest,
606            join(", ", map { m/^%/ ? strftime($_, @gmtime) : $val{$_} } @destarg)
607        );
608        return();
609    }
610    return($datatype, $destfile);
611}
612
613# Sub data function:
614
615=head3 get_data_dest($datafile)
616
617Return the datatype and destination for $datafile
618
619=cut
620
621sub get_data_dest {
622    my ($self, $datafile) = @_;
623
624    my ($t, $d) = $self->build_dest_filename(
625        $datafile,
626        $self->{datatype}
627    );
628    $self->logging(0, "%s/%s file, datatype %s, destination %s",
629        $self->{archivefile},
630        $datafile,
631        $t || '(none)',
632        $d || '(none)',
633    );
634    if ($t) {
635        $self->set_data_value($datafile, 'type', $t);
636    }
637    return($t, $d);
638}
639
640=head3 extract_data($datafile, $datatype, $destfile)
641
642Extract data file into $destfile, $datafile is informationnal only.
643
644$datatype and $destfile are the result of L<get_data_dest>.
645
646A basic call is:
647    $o->extract_data($file, $self->get_data_dest($file));
648
649Return 1 on success
650
651=cut
652
653sub extract_data {
654    # $datatype, informationnal only here
655    my ($self, $datafile, $datatype, $destfile) = @_;
656    $self->load_archive or return 0;
657    my $ltime = time;
658
659    $self->set_data_value(
660        $datafile,
661        'processtime',
662        $ltime,
663        scalar(localtime($ltime)) .
664        ", $ObsData::VERSION: $ObsData::CVSREV, $ObsData::Repository::CVSREV",
665    );
666    $self->set_data_value(
667        $datafile,
668        'processversion',
669        $ObsData::VERSION,
670    );
671   
672    if (!$destfile) {
673        $self->logging(3,
674            "%s/%s has no destination",
675            $self->{archivefile}, $datafile,
676        );
677        return 0;
678    }
679   
680    my $oe = ObsData::Event->new('overwrite',
681        "Should I overwrite $destfile"
682    );
683
684    $oe->add_test(
685        'dest_exists',
686        -e $destfile ? ("$destfile exists", 1) : ("$destfile don't exists", 0)
687    );
688    $self->ask_user($oe) or return 0;
689   
690    $self->logging(0,
691        "Trying to extract %s from %s/%s",
692        $destfile,
693        $self->{archivefile}, $datafile
694    );
695
696    my ($dirname) = $destfile =~ m!(?:(.*)/)?(.*)$!; #! vim syntax sux
697   
698    if ($dirname && ! -d $dirname) {
699        $self->logging(1, "Creating directory %s", $dirname);
700        if ($self->{dry_run}) {
701            $self->logging(1,
702                "Testing mode, assume %s was correctly created",
703                $dirname
704            );
705        } else {
706            eval { File::Path::mkpath($dirname) };
707            if($@) {
708                $self->logging(
709                    4, "Can't create directory %s: %s", 
710                    $dirname,
711                    $@
712                );
713                return 0;
714            }
715        }
716    }
717
718    if ($self->{dry_run}) {
719        $self->logging(2,
720            "Testing mode, %s/%s would be extracted as %s",
721            $self->{archivefile},
722            $datafile,
723            $destfile,
724        );
725    } else {
726        if ($self->{Oarchive}->extract($datafile, $destfile)) {
727            $self->set_data_value($datafile, 'dest', $destfile);
728            $self->logging(
729                2, "Extraction of %s/%s done as %s",
730                $self->{archivefile},
731                $datafile,
732                $destfile,
733            );
734        } else {
735            $self->logging(
736                4, "Can't extract %s/%s to %s: %s",
737                $self->{archivefile}, $datafile, $destfile,
738                $self->{Oarchive}->error,
739            );
740            return 0;
741        }
742    }
743   
744    return 1;
745}
746
747=head3 process
748
749Process all files in the archive
750
751=cut
752
753sub process {
754    my ($self) = @_;
755
756    foreach my $data ($self->list_archive) {
757        my $oe = ObsData::Event->new('do_data',
758            "Should I extract $data from $self->{archivefile}"
759        );
760       
761        $self->ask_user($oe) or next;
762
763        $self->extract_data($data, $self->get_data_dest($data));
764    }
765   
766    $self->update_status;
767
768    return 1;
769}
770
771=head1 AUTHOR
772
773Olivier Thauvin <olivier.thauvin@aerov.jussieu.fr>
774
775=cut
776
7771;
Note: See TracBrowser for help on using the repository browser.