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

# $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;

    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,
        );
        if(!$orda->do_continue('do_archive')) {
            $self->logging(0,
                "Archive %s/%s allready parsed, skipping",
                $self->{dir},
                $file
            );
            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

=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->{interative_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

=cut

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

=head2 setvalue

=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

=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

=cut

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

=head3 checks

=cut

my $checks = {
    archive_exists => sub {
        my ($self) = @_;
        my $res;
        if($self->{status}->SectionExists($self->{archivefile})) {
            $res = 1;
        } else {
            $res = 0;
        }
        return(
            $res, 
            $self->logging(0,
                "%s/%s is%s new archive",
                $self->{dir},
                $self->{archivefile},
                $res ? " not" : "",
            )
        );      
    },

    archive_size => sub {
        my ($self) = @_;
        my $res;
        if (defined(my $oldsize = $self->getvalue('size')) &&
            defined(my $size = (stat("$self->{dir}/$self->{archivefile}"))[7])) {
            my $res = $size <=> $oldsize;
            return $res, $self->logging(0,
                "Size for %s/%s %s",
                $self->{dir},
                $self->{archivefile},
                $res == 0 ?
                    sprintf("does not differ (%d)", $size) :
                    sprintf("differ %d => %d", $oldsize, $size)
            );
        }
    },

    archive_mtime => sub {
        my ($self) = @_;
        my $res;
        if (defined(my $oldmtime = $self->getvalue('mtime')) &&
            defined(my $mtime = (stat("$self->{dir}/$self->{archivefile}"))[9])) {
            my $res = $mtime <=> $oldmtime;
            return $res, $self->logging(0,
                "Mtime for %s/%s %s",
                $self->{dir},
                $self->{archivefile},
                $res == 0 ?
                    sprintf("does not differ (%d)", $mtime) :
                    sprintf("differ %d => %d", $oldmtime, $mtime)
            );
        }
    },

    dest_exists => sub {
        my ($self, $check, $datafile, $dest) = @_;
        if (-e $dest) {
            return 1, "$dest exists";
        } else {
            return 0, "$dest don't exists";
        }
    },

    data_extracted => sub {
        my ($self, $check, $datafile) = @_;
        my $last_process = $self->get_data_value($datafile, 'processtime');
        if ($last_process) {
            $self->logging(0, "%s/%s has been already processed at %s",
                $self->{archivefile},
                $datafile,
                scalar(localtime($last_process)),
            );
        }
        $last_process
    },
};

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

=head3 do_check($check, @args)

Perform $check with @args if exists and return result of check

=cut

sub do_check {
    my ($self, $check, @args) = @_;
    
    if (!$checks->{$check}) {
        die $self->logging(5,
            "check %s does not exists, exiting now",
            $check
        );
    }
    
    return $checks->{$check}->($self, $check, @args);
}

sub populate_event {
    my ($self, $oevent, @args) = @_;
    my ($code, $text);
    
    for ($oevent->id) {
        /^do_archive$/ and do {
            foreach my $t (qw(archive_size archive_mtime archive_exists)) {
                ($code, $text) = $self->do_check($t);
                $oevent->add_test($t, $text, $code);
            }
            last;
        };
        /^do_data$/ and do {
            last;
        };
        /^overwrite$/ and do {
            ($code, $text) = $self->do_check('dest_exists', @args);
            $oevent->add_test('dest_exists', $text, $code);
            last;
        };
    }
}

=head3 default_choice($oevent)

=cut

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

    for ($oevent->id) {
        /^do_archive$/ and do {
            last;
        };
        /^do_data$/ and do {
            last;
        };
        /^overwrite$/ and do {
            last;
        };
    }
}

=head3 do_continue($why, @args)

Perform default or call the interactive callback.

    $why is the reason of the call
    @args are argument to passed to callback

=cut

sub do_continue {
    my ($self, $why, @args) = @_;

    my $oevent = ObsData::Event->new($why, $why);
    $self->populate_event(
        $oevent, @args
    );

    if ($self->{interative_callback}) {
        return $self->{interative_callback}->($self, $oevent);
    } else {
        return $self->default_choice($oevent);
    }
}

=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;
    }
    
    if(!$self->do_continue('overwrite', $datafile, $destfile)) {
        $self->logging(3,
            "%s extracted from %s/%s already exists, I won't overwrite it",
            $destfile,
            $self->{archivefile}, $datafile,
        );
        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) {
        if (!$self->do_continue('do_data', $data)) {
            $self->logging(0,
                "%s/%s has allready processed, skipping",
                $self->{archivefile},
                $data
            );
            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;