source: trunk/soft/ObsData/ObsData/Repository.pm @ 184

# $Id$

package ObsData::Repository;

use strict;
use warnings;
use File::Path;
use POSIX qw(getcwd);
use ObsData;
use ObsData::Archive;
use ObsData::Event;
use Config::IniFiles;

our $CVSID = q$Id$;
our $CVSREV = (q$Revision$ =~ /^Revision: (.*) $/)[0];

=head1 METHODS

=head2 ObsData::Repository

=head3 new($parent, %param)

Create a new ObsData::Repository object

=over 4

=item $parent

A ObsData::Repository to take information

=item %param

A list of paramter to set in new object:

=over 4

=item datatype 

If set, only this datatype will be checked

=item obs

The obsveratory where data come from, informationnal only

=item dir

The based directory where archive are located

=item glob

Apply this glob to search files in dir

=item statusfile

The file where status info should be written

=item status

The Config::IniFiles object

=back

=back

=cut

sub new {
    my ($class, $parent, %param) = @_;

    my $or = { %$parent };
    foreach (keys %param) {
        $or->{$_} = $param{$_};
    }
    
    $or->{obsdata} or die "Error #1de8d015, please insult programmer";
    $or->{dir} or die "No dir given";
    -d $or->{dir} or return undef;
    
    $or->{status} ||= new Config::IniFiles(
        -file => (($or->{statusfile} && -f $or->{statusfile}) ? $or->{statusfile} : undef),
        # -default => '.', # Is this a good idea
    );
    $or->{statusfile} ||= $or->{status}->GetFileName;
    $or->{interactive_callback} ||= $or->{obsdata}->{interactive_callback};

    bless($or, $class);

    $or;
}

sub DESTROY {
    my ($self) = @_;
    $self->logging(0, "Destroy ObsData::Repository for %s", ref($self));
    $self->save_status;
}

=head3 update_global_status

Set standard information into status ini file

=cut

sub update_global_status {
    my ($self) = @_;
    $self->{status}->AddSection('.');
    $self->{status}->SetSectionComment('.',
        $ObsData::CVSID,
        $ObsData::Repository::CVSID,
        scalar(localtime),
    );

    my $hostname = `hostname`;
    chomp($hostname);
    $self->{status}->newval('.', 'hostname', $hostname);
    $self->{status}->SetParameterComment(
        '.',
        'hostname',
        'The computer host name'
    );

    $self->{status}->newval('.', 'directory', $self->{dir});
    $self->{status}->SetParameterComment(
        '.',
        'directory', 
        'Directory where archive where located'
    );
    
    $self->{status}->newval('.', 'runfrom', getcwd());
    $self->{status}->SetParameterComment(
        '.',
        'runfrom',
        'The current directory'
    );
}

=head3 save_status

Save current information about parsed files into status file

=cut

sub save_status {
    my ($self) = @_;
    $self->{statusfile} or return;
    if (!$self->{dry_run}) {
        $self->update_global_status;
        $self->{status}->WriteConfig($self->{statusfile});
    }
}

=head3 dump_status($output)

Dump current status file into $output, see Config::IniFiles,
function WriteConfig

=cut

sub dump_status {
    my ($self, $output) = @_;
    $self->update_global_status;
    $self->{status}->WriteConfig($output);
}

=head3 logging($level, $msg, ...)

Pass a message for logging to ObsData Object. See L<ObsData>

=cut

sub logging {
    my $self = shift;
    $self->{obsdata}->logging(@_);
}

=head2 ObsData::Repository::dir

The child class to handle directory

=cut

package ObsData::Repository::dir;

our @ISA = qw(ObsData::Repository);

=head3 new

=cut

sub new {
    my ($class, $infos, %param) = @_;

    my $or = ObsData::Repository->new($infos, %param) or return;

    bless($or, $class);
}

=head3 findfile

Return the list of files needing to be checked

=cut

sub findfile {
    my ($self) = @_;
    my @files;

    if (!-d $self->{dir}) {
        $self->logging(3,
            "directory %s does not exists",
            $self->{dir},
        );
        return;
    }

    my $patern = $self->{patern} || '*';
    foreach my $f (glob("$self->{dir}/$patern")) {

        -f $f or next; # skip no regular files
        $f =~ m/obsdata\.ini$/ and next; # avoid default status file
        
        my $bf = $f;
        $bf =~ s!^\Q$self->{dir}\E/*!!;
        push(@files, $bf);
    }
    @files
}

=head3 process

Process all files in directory

=cut

sub process {
    my ($self) = @_;
    $self->logging(0, "%s() start for %s", (caller(0))[3], $self->{dir});

    foreach my $file ($self->findfile) {
        my $orda = ObsData::Repository::dir::archive->new(
            $self,
            archivefile => $file,
        );

        my $oe = ObsData::Event->new('do_archive', "Should I parse $file");
        
        $oe->add_test('archive_exists',
            $self->{status}->SectionExists($orda->{archivefile}) ?
            ("Archive file found in index", 1) :
            ("Archive file not found in index", 0)
        );
        
        if (defined(my $oldsize = $orda->getvalue('size'))) {
            my $size = (stat("$orda->{dir}/$orda->{archivefile}"))[7];
            
            $oe->add_test('archive_size',
                ($size <=> $oldsize) == 0 ?
                (sprintf("does not differ (%d)", $size), 1) :
                (sprintf("differ %d => %d", $oldsize, $size), 0)
            );
        }

        if (defined(my $oldmtime = $orda->getvalue('mtime'))) {
            my $mtime = (stat("$orda->{dir}/$orda->{archivefile}"))[9];
            $oe->add_test('archive_mtime',
                ($mtime <=> $oldmtime) == 0 ?
                (sprintf("does not differ (%d)", $mtime), 1) :
                (sprintf("differ %d => %d", $oldmtime, $mtime), 0)
            );
        }
        
        $orda->ask_user($oe) or next;
        
        $orda->process;
    }
}

=head2 ObsData::Repository::dir::archive

Object to handle archive and to dispatch data

=cut

package ObsData::Repository::dir::archive;

our @ISA = qw(ObsData::Repository);

=head3 new($info, %param)

Return a new ObsData::Repository::dir::archive object.

$info is an ObsData::Repository or ObsData::Repository::dir object

%param are:
    
    archivefile => the archive file to read

=cut

sub new {
    my ($class, $infos, %param) = @_;

    my $or = ObsData::Repository->new($infos, %param) or return;
    # dir directory to parse
    $or->{archivefile} or die "No archivefile given";

    # $or->{interactive_callback}
    $or->{_cache_checks} = {};
    
    $or->logging(0,
        "Preparing to parse %s/%s",
         $or->{dir},
         $or->{archivefile}
    );

    bless($or, $class);
}

=head3 load_archive

Try to read archive, return 1 on success

=cut

sub load_archive {
    my ($self) = @_;
    if ($self->{Oarchive}) {
        return 1;
    } else {
        $self->{Oarchive} = ObsData::Archive->new("$self->{dir}/$self->{archivefile}");
        if ($self->{Oarchive}) {
            $self->logging(0,
                "Archive %s/%s properly load",
                $self->{dir}, $self->{archivefile}
            );
            return 1;
        } else {
            $self->logging(4, 
                "Can't handle archive %s/%s: %s, skipping",
                $self->{dir}, $self->{archivefile},
                ObsData::Archive->error
            );
            return 0;
        }
    }
}

=head2 getvalue($var, $default)

Return a value from status file related to current archive.

=cut

sub getvalue {
    my ($self, $var, $default) = @_;
    return $self->{status}->val($self->{archivefile}, $var, $default);
}

=head2 setvalue

Define a value related to current archive file.

=cut

sub setvalue {
    my ($self, $var, $val, $comment) = @_;
    if (!$self->{status}->SectionExists($self->{archivefile})) {
        $self->{status}->AddSection($self->{archivefile});
    }
    $self->{status}->newval($self->{archivefile}, $var, $val) if(defined($val));
    $self->{status}->SetParameterComment(
        $self->{archivefile}, $var, $comment
    ) if(defined($comment));
}

=head2 get_data_value($datafile, $var, $default)

Return a value from status file related to current archive about $datafile.

=cut

sub get_data_value {
    my ($self, $datafile, $var, $default) = @_;
    return $self->getvalue(
        sprintf('data_%s_%s', $var, $datafile),
        $var, 
        $default
    );
}

=head2 set_data_value($datafile, $var, $val, $comment)

Set a value and optionnaly a comment for $datafile found in archive file

=cut

sub set_data_value {
    my ($self, $datafile, $var, $val, $comment) = @_;
    $self->setvalue(
        sprintf('data_%s_%s', $var, $datafile),
        $val,
        $comment
    );
}

=head3 checks

=cut

=head3 default_choice($oevent)

=cut

sub default_choice {
    my ($self, $oevent) = @_;

    for ($oevent->id) {
        /^do_archive$/ and do {
            return($oevent->test_result('archive_exists') ? 0 : 1);
            last;
        };
        /^do_data$/ and do {
            return 1; # TODO
            last;
        };
        /^overwrite$/ and do {
            return($oevent->test_result('dest_exists') ? 0 : 1);
            last;
        };
    }
}

sub ask_user {
    my ($self, $oevent) = @_;

    $self->logging(0, "Event(%s): %s",
        $oevent->id,
        $oevent->message);
    foreach ($oevent->list_test) {
        $self->logging(0, "  (%s) %s: %s",
            $_,
            $oevent->test_message($_),
            $oevent->test_result($_),
        );
    }

    my $res =
        $self->{interactive_callback} ?
        $self->{interactive_callback}->($self, $oevent) :
        $self->default_choice($oevent);

    $self->logging(0, "Event(%s): Result: %s", $oevent->id, $res);
    return($res);
}

=head3 list_archive

Return archive content

=cut

sub list_archive {
    my ($self) = @_;
    $self->load_archive or return;
    
    return $self->{Oarchive}->ls;
}

=head3 update_status

Update status information about current archive

=cut

sub update_status {
    my ($self) = @_;
    my @filestats = stat("$self->{dir}/$self->{archivefile}");
    
    $self->setvalue('mtime', $filestats[9]);
    $self->setvalue('size', $filestats[7]);
    $self->setvalue('configtime', $self->{obsdata}->config_mtime);
}

# Sub data function:



=head3 get_data_dest($datafile)

Return the datatype and destination for $datafile

=cut

sub get_data_dest {
    my ($self, $datafile) = @_;

    my ($t, $d) = $self->{obsdata}->build_dest_filename(
        $datafile,
        $self->{datatype}
    );
    $self->logging(0, "%s/%s file, datatype %s, destination %s",
        $self->{archivefile},
        $datafile,
        $t || '(none)',
        $d || '(none)',
    );
    if ($t) {
        $self->set_data_value($datafile, 'type', $t);
    }
    return($t, $d);
}

=head3 extract_data($datafile, $datatype, $destfile)

Extract data file into $destfile, $datafile is informationnal only.

$datatype and $destfile are the result of L<get_data_dest>.

A basic call is:
    $o->extract_data($file, $self->get_data_dest($file));

Return 1 on success

=cut

sub extract_data {
    # $datatype, informationnal only here
    my ($self, $datafile, $datatype, $destfile) = @_;
    $self->load_archive or return 0;
    my $ltime = time;

    $self->set_data_value(
        $datafile,
        'processtime',
        $ltime,
        scalar(localtime($ltime)) .
        ", $ObsData::VERSION: $ObsData::CVSREV, $ObsData::Repository::CVSREV",
    );
    $self->set_data_value(
        $datafile,
        'processversion',
        $ObsData::VERSION,
    );
   
    if (!$destfile) {
        $self->logging(3,
            "%s/%s has no destination",
            $self->{archivefile}, $datafile,
        );
        return 0;
    }
   
    my $oe = ObsData::Event->new('overwrite',
        "Should I overwrite $destfile"
    );

    $oe->add_test(
        'dest_exists',
        -e $destfile ? ("$destfile exists", 1) : ("$destfile don't exists", 0)
    );
    $self->ask_user($oe) or return 0;
    
    $self->logging(0,
        "Trying to extract %s from %s/%s",
        $destfile,
        $self->{archivefile}, $datafile
    );

    my ($dirname) = $destfile =~ m!(?:(.*)/)?(.*)$!; #! vim syntax sux
    
    if ($dirname && ! -d $dirname) {
        $self->logging(1, "Creating directory %s", $dirname);
        if ($self->{dry_run}) {
            $self->logging(1,
                "Testing mode, assume %s was correctly created",
                $dirname
            );
        } else {
            if( ! File::Path::mkpath($dirname)) { 
                $self->logging(
                    4, "Can't create directory %s", 
                    $dirname
                );
                return 0;
            }
        }
    }

    if ($self->{dry_run}) {
        $self->logging(2,
            "Testing mode, %s/%s would be extracted as %s",
            $self->{archivefile},
            $datafile,
            $destfile,
        );
    } else {
        if ($self->{Oarchive}->extract($datafile, $destfile)) {
            $self->set_data_value($datafile, 'dest', $destfile);
            $self->logging(
                2, "Extraction of %s/%s done as %s",
                $self->{archivefile},
                $datafile,
                $destfile,
            );
        } else {
            $self->logging(
                4, "Can't extract %s/%s to %s: %s",
                $self->{archivefile}, $datafile, $destfile,
                $self->{Oarchive}->error,
            );
            return 0;
        }
    }
    
    return 1;
}

=head3 process

Process all files in the archive

=cut

sub process {
    my ($self) = @_;

    foreach my $data ($self->list_archive) {
        my $oe = ObsData::Event->new('do_data',
            "Should I extract $data from $self->{archivefile}"
        );
        
        $self->ask_user($oe) or next;

        $self->extract_data($data, $self->get_data_dest($data));
    }
    
    $self->update_status;

    return 1;
}

=head1 AUTHOR

Olivier Thauvin <olivier.thauvin@aerov.jussieu.fr>

=cut

1;