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

# $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.01;
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} || "obsdata.log",
    };

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

    $obsdata->{config} or return undef;

    bless($obsdata, $class);
}

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

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

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

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

sub loging {
    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
}

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) = @_;
    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)) {
        }
    }
}

=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);
}

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;
}

sub match_data_type {
    my ($self, $datatype, $label) = @_;
    my $regexp = $self->getvalue($datatype, 'match') or return;
    my @data = $label =~ /$regexp/;
    if (! @data) {
        return;
    }
    return @data;
}

sub find_match_data_type {
    my ($self, $label) = @_;
    foreach my $datatype ($self->list_datatype) {
        my @data = $self->match_data_type($datatype, $label);
        if (@data) {
            return($datatype, @data);
        }
    }
}

sub build_dest_filename {
    my ($self, $label, $datatype) = @_;
    my @data;
    if ($datatype) {
        @data = $self->match_data_type($datatype, $label);
    } else {
        ($datatype, @data) = $self->find_match_data_type($label);
    }

    if ($datatype && @data) {
        my $dest = $self->getvalue($datatype, 'dest');
        my @matcharg = split(/\s+/, $self->getvalue($datatype, 'matcharg'));
        my @destarg = split(/\s+/, $self->getvalue($datatype, 'destarg'));
        my @gmtime = gmtime;
        my %val;
        foreach (@matcharg) {
            $val{$_} = shift(@data);
        }
        return ($datatype, sprintf(
            $dest,
            map { m/^%/ ? strftime($_, @gmtime) : $val{$_} } @destarg,
        ));
    }
    undef;
}

sub process_obs {
    my ($self, $obs) = @_;
    my %datadir = $self->list_obsdatadir($obs);
    $self->loging(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 get_obs_data_handle {
    my ($self, $obs, $datatype) = @_;

    my $dir = $self->getvalue($obs, ($datatype ? "datadir/$datatype" : "datadir"));
    if (!$dir) {
        $self->loging(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,
            statusfile => "$dir/obsdata.ini"
        }
    );
    if (!defined($or)) {
        $self->loging(4, "Can't parse %s, check directory exists", $dir);
        return undef;
    }
    
    return($or);
}

1;