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

# $Id$

package ObsData;

use strict;
use warnings;
use Config::IniFiles;
use POSIX qw(strftime);
use ObsData::Repository;

my @loglevel = (
    'DEBUG',
    'INFO',
    'RESULT',
    'WARNING',
    'ERROR',
    'FATAL',
);

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

=head1 NAME

ObsData - Main object to manage data files

=head1 SYNOPSIS

    use ObsData;
    my $conf = "configfile";
    my $obsdata = ObsData->new($conf);

=head1 METHODS

=head2 new($configfile)

Create a new Obsdata object from $configfile

=cut

sub new {
    my ($class, $configfile, %options) = @_;
    my $obsdata = {
        config => new Config::IniFiles(
            -file => $configfile,
            -default => 'global',
            -allowcontinue => 1
        ),
        verbose => defined($options{verbose}) ? $options{verbose} : 1,
        logcallback => $options{logcallback},
        logfile => $options{logfile},
        dry_run => $options{dry_run},
        interactive_callback => $options{interactive_callback},
        processed_lists => [],
    };

    if (!($configfile && -f $configfile && -r _)) {
        return undef;
    }

    $obsdata->{config} or return undef;

    $obsdata->{logfile} ||= $obsdata->{config}->val('.', 'logfile') || 'obsdata.log';

    bless($obsdata, $class);
}

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

    if ($self->{loghandle}) {
        close($self->{loghandle});
        $self->{loghandle} = undef;
    }
}

=head2 load

Prepare the object for usage

=cut

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

    if (!open($self->{loghandle}, ">> $self->{logfile}")) {
        $self->{loghandle} = undef;
        $self->logging(5, "Can't open log file %s, exiting", "$self->{logfile}");
        return 0;
    }
    
    return 1;
}

=head2 logging($level, $message, ...)

Pass a message into the logging process.

   $level is the level of message
   $message and or other arguments are printf format string 

=cut

sub logging {
    my ($self, $level, $fmt, @val) = @_;
    my $msg = sprintf($fmt, @val);
    my $logh = $self->{loghandle};
    if ($self->{logcallback}) {
        $self->{logcallback}->($level, $msg);
    }
    if($level >= 0 && $level >= $self->{verbose}) {
        if ($logh) {
            printf $logh 
                "%-9s %s %s\n", 
                sprintf("[%s]", $self->loglevel($level)),
                strftime("%b %d %H:%M:%S %Y", gmtime),
                $msg;
        }
    }
    $msg
}

=head2 loglevel($level)

Return the text human readable log level associate to $level number

=cut

sub loglevel {
    my $l = pop(@_);
    defined($l) or $l = pop(@_);
    return $loglevel[ $l ] || "?????";
}

=head2 checkconfig()

Check the validity of information contains in configfile.

Notice: This test does not include the syntaxe validity

=cut

sub checkconfig {
    my ($self) = @_;
    my $result = 1;
    foreach my $g ($self->{config}->GroupMembers('Obs')) {
        my ($obs) = $g =~ /\S+\s+(.*)/;
        if (!$self->{config}->SectionExists($obs)) {
            print STDERR "E: '$obs' is listed as Obs but it does not exists\n";
            next;
        }
        foreach my $param ($self->{config}->Parameters($obs)) {
        }
        foreach my $datatype ($self->list_datatype) {
            foreach my $var (qw(match match_archive)) {
                my $regexp = $self->getvalue($datatype, $var) or next; # next ? are we sure ?
                eval { qr/$regexp/ }; # Many thanks Rafael
                if ($@) {
                    $self->logging(4, "error in regexp for %s: '%s': %s",
                        $datatype,
                        $regexp,
                        $@,
                    );
                    $result = 0;
                    # TODO set this reg unavalable
                }
            }
        }
    }
    return($result);
}

=head2 getvalue($section, $var, $default)

Return a value from the configuration, $default is assumed if the value is not set

=cut

sub getvalue {
    my ($self, $section, $var, $default) = @_;
    $self->{config}->val($section, $var, $default);
}

=head2 config_mtime

Return the modification time of config file currently used

=cut

sub config_mtime {
    my ($self) = @_;
    return $self->{configmtime} ||= (stat($self->{config}->GetFileName))[9];
}

=head2 list_obs

Return the list of observatories defined in configuration

=cut

sub list_obs {
    my ($self) = @_;
    grep { $self->{config}->SectionExists($_) }
        map { s/^\S+\s+//; $_ }
        $self->{config}->GroupMembers('Obs');
}

=head2 is_obs($obsname)

Return True if $obsname is an observatory

=cut

sub is_obs {
    my ($self, $obs) = @_;
    scalar(grep { $_ eq "Obs $obs" } $self->{config}->GroupMembers('Obs'));
}

=head2 list_obsdatadir($obsname)

Return a hash of data directories per data type for $obsname observatories

=cut

sub list_obsdatadir {
    my ($self, $obs) = @_;
    $self->is_obs($obs) or return undef;
    map { m,^datadir/(.*),; ( ($1 || "") => $self->{config}->val($obs, $_) ) }
        grep { m,^datadir/, || $_ eq 'datadir' }
        $self->{config}->Parameters($obs)
}

=head2 list_typedatadir($type)

List all directories for $type data

=cut

sub list_typedatadir {
    my ($self, $type) = @_;
    my %dirs;
    foreach my $obs ($self->list_obs) {
        $dirs{$_} = 1 foreach(grep { $_ } $self->get_datadir($obs, $type));
    }
    keys %dirs; 
        
}

=head2 get_datadir($obs, $type)

Return a list of directories for $type data on $obs observatory

=cut

sub get_datadir {
    my ($self, $obs, $type) = @_;
    $self->is_obs($obs) or return undef;
    grep { defined($_) } ($self->getvalue($obs, "datadir/$type"), $self->getvalue($obs, "datadir"));
}

=head2 list_datatype

Return a list of datatype handle by config

=cut

sub list_datatype {
    my ($self) = @_;
    grep { $_ ne 'global' }
    grep { $_ !~ /^Obs\s+/ }
    grep { !$self->is_obs($_) } $self->{config}->Sections;
}

=head2 get_obs_data_handle($obs, $datatype)

Return an ObsData::Repository object about directory for $obs station
about $datatype data. $datatype can be undefined if you want to get default
directory

=cut

sub get_obs_data_handle {
    my ($self, $obs, $datatype) = @_;

    my $dir = $self->getvalue($obs, ($datatype ? "datadir/$datatype" : "datadir"));
    if (!$dir) {
        $self->logging(4,
            "Can't find data directory for %s, type: %s",
            $obs, $datatype || '(none)'
        );
        return undef;
    }
    my $or = ObsData::Repository::dir->new(
        {
            obsdata => $self,
            dir => $dir,
            obs => $obs,
            datatype => $datatype,
            dry_run => $self->{dry_run}, # FIXME does this have a better place ?
            patern => $self->getvalue(
                $obs,
                ($datatype ? "searchfiles/$datatype" : "searchfiles")
            ),
            statusfile => $self->getvalue(
                $obs, 
                ($datatype ? "index/$datatype" : "index"),
                "$dir/obsdata.ini"
            ),
        }
    );
    if (!defined($or)) {
        $self->logging(4, "Can't parse %s, check directory exists", $dir);
        return undef;
    }
    
    return($or);
}

=head2 process_obs($obs)

Process all data handle by $obs station

=cut

sub process_obs {
    my ($self, $obs) = @_;
    my %datadir = $self->list_obsdatadir($obs);
    $self->logging(0, "Starting %s() for %s", (caller(0))[3], $obs);
    
    foreach my $datatype (keys %datadir) {
        my $or = $self->get_obs_data_handle($obs, $datatype);
        $or or next;
        $or->process;
    }
}

sub processed {
    my ($self, $obs, $archive, $datatype, $dest) = @_;
    push(@{$self->{processed_lists}},
        {
            obs => $obs,
            archive => $archive,
            datatype => $datatype,
            destfile => $dest,
        }
    );
}

1;

=head1 AUTHOR

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

=cut