source: obsdata/trunk/ObsData.pm @ 292

# $Id$

package ObsData;

use strict;
use warnings;
use Config::IniFiles;
use POSIX qw(strftime);
use ObsData::Repository;
use Mail::Sendmail;
use MIME::QuotedPrint;
use File::Basename;

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

our $VERSION = "0.3.3";
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;

    # directory where to search plugins
    @{ $obsdata->{plugindir} } = grep { $_ && -d $_ } (
        $options{plugindir},
        dirname($0),
        split( /\s+/, $obsdata->{config}->val( 'global', 'plugindir' ) || '' ),
    );

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

    bless( $obsdata, $class );
}

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

    $self->logging( 0, "END process: %s (%s)", $VERSION, $CVSID, );

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

    $self->logging( 0, "BEGIN process: %s (%s)", $VERSION, $CVSID, );

    my $path = `pwd`;
    chomp($path);
    $self->logging(
        0,
        "Using config file `%s' (%s)",
        $self->{config}->GetFileName(), $path,
    );

    $self->load_plugins() or return 0;

    return 1;
}

=head2 load_plugins

Load plugins files and get code reference.

=cut

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

    $self->logging(
        0,
        "Plugin will be searched in: %s",
        join( ', ', @{ $self->{plugindir} } ),
    );

    foreach my $datatype ( $self->list_datatype() ) {
        foreach my $plugin (qw/match_plugin/) {
            my ( $plugfile, @plugarg ) =
              split( /\s+/, $self->getvalue( $datatype, $plugin ) || '' );
            $plugfile or next;    # if no plugin, skipping
            my ($plugfilename) = grep { -f $_ }
              map { "$_/$plugfile" } @{ $self->{plugindir} };
            if ( !$plugfilename ) {
                $self->logging( 5, "Cannot find plugin %s (%s) for %s datatype",
                    $plugfile, $plugin, $datatype, );
                return 0;
            }
            my $sub = do $plugfilename;
            if ($@) {
                $self->logging( 4,
                    "Cannot load plugin %s for %s: %s, exiting !",
                    $plugin, $datatype, $@, );
                return 0;
            }
            if ( $sub && ref $sub eq 'CODE' ) {
                $self->{plugin}{$datatype}{$plugin} = {
                    code => $sub,
                    arg  => \@plugarg,
                };
                $self->logging( 0, "loading plugin %s for %s (%s)",
                    $plugin, $datatype, $sub, );
            }
            else {
                $self->logging(
                    4, "Cannot load plugin %s for %s (is %s)",
                    $plugin, $datatype, $sub ? ref $sub : 'undef or empty',
                );
            }
        }
    }
    return 1;
}

=head2 get_sub_plugin

Return code ref of plugintype for datatype

=cut

sub get_sub_plugin {
    my ( $self, $datatype, $plugintype ) = @_;
    if ( exists( $self->{plugin}{$datatype}{$plugintype} ) ) {
        my $ref = $self->{plugin}{$datatype}{$plugintype};
        return ( $ref->{code}, @{ $ref->{arg} } );
    }
    else {
        return undef;
    }
}

=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, $datafile, $datatype, $dest ) = @_;
    push(
        @{ $self->{processed_lists} },
        {
            obs      => $obs,
            archive  => $archive,
            datafile => $datafile,
            datatype => $datatype,
            destfile => $dest,
        }
    );
    $self->logging( 2, "Extraction of %s/%s done as %s",
        $archive, $datafile, $dest, )
      if ($dest);
}

sub generated_reported {
    my ($self) = @_;
    my $result = {
        all   => [],
        users => {},
    };

    foreach my $entry ( @{ $self->{processed_lists} } ) {
        my %people = map { $_ => 1 } grep { $_ } (
            (
                $entry->{datatype}
                ? split( /\s*,\s*/,
                    $self->getvalue( $entry->{datatype}, 'reportto' ) || "" )
                : split(
                    /\s*,\s*/,
                    $self->getvalue( 'global', 'nodestreportto' ) || ""
                )
            ),
            split(
                /\s*,\s*/, $self->getvalue( $entry->{obs}, 'reportto' ) || ""
            ),
            split(
                /\s*,\s*/, $self->getvalue( 'global', 'allreportto' ) || ""
            )
        );
        keys %people or next;
        foreach my $p ( keys %people ) {
            push( @{ $result->{users}{$p} }, $entry );
        }
    }

    foreach my $p ( keys( %{ $result->{users} || {} } ) ) {
        my %obs_entries = ();
        foreach ( @{ $result->{users}{$p} } ) {
            push( @{ $obs_entries{ $_->{obs} } }, $_ );
        }

        foreach my $obs ( keys %obs_entries ) {
            my %datatype_entries = ();
            foreach ( @{ $obs_entries{$obs} } ) {
                push( @{ $datatype_entries{ $_->{datatype} || '!' } }, $_ );
            }

            my %msg = (
                Subject => 'ObsData Report: '
                  . $self->getvalue( $obs, 'description', $obs ),
                To                  => $p,
                'X-ObsData-Version' => $VERSION,
                'X-ObsData-Obs'     => $obs,
                'Content-Type'      => "TEXT/PLAIN;\n  charset=ISO-8859-15",
                'Content-Transfer-Encoding' => 'QUOTED-PRINTABLE',
                From                        => $self->getvalue(
                    'global', 'reportfrom',
                    'ObsData <robot@aero.jussieu.fr>'
                ),
            );
            my $message = "";
            foreach my $d ( sort keys(%datatype_entries) ) {
                if ( $d eq '!' ) {
                    $message .= "\nNot proceed:\n";
                    foreach ( @{ $datatype_entries{$d} || [] } ) {
                        $message .= sprintf( "  file %s from %s\n",
                            $_->{datafile}, $_->{archive}, );
                    }
                }
                else {
                    $message .= "\nDataType: $d\n";
                    foreach ( @{ $datatype_entries{$d} || [] } ) {
                        $message .= sprintf( "  file %s from %s => %s\n",
                            $_->{datafile}, $_->{archive}, $_->{destfile}, );
                    }
                }
            }
            $message .=
              sprintf(
"\n-- \nMail automatically generated by:\nObsdata Robot %s (SVN: %s)\n",
                $VERSION, $CVSREV, );
            if (
                sendmail(
                    %msg,
                    smtp    => 'mailhost',
                    Message => encode_qp($message),
                )
              )
            {
                $self->logging(
                    1,
                    "Mail sent to %s for %s (%d files done)",
                    $p, $obs,
                    scalar(
                        map { @{ $datatype_entries{$_} || [] } }
                          keys(%datatype_entries)
                    ),
                );
            }
            else {
                $self->logging(
                    4,        "Cannot send mail to %s: %s",
                    $msg{To}, $Mail::Sendmail::error,
                );
            }
        }
        return $result;
    }
}

sub postprocessed {
    my ($self) = @_;
    my %datastype;
    foreach my $entry ( @{ $self->{processed_lists} } ) {
        $entry->{datatype} or next;
        push( @{ $datastype{ $entry->{datatype} } }, $entry );
    }

    foreach my $datatype ( keys %datastype ) {
        my $command = $self->getvalue( $datatype, 'postexec' );
        $self->logging(
            0, 'postexec for %s is %s',
            $datatype, $command ? "`$command'" : 'not set, skipping',
        );
        if ($command) {
            if ( open( my $posthandle, "| $command" ) ) {
                foreach ( @{ $datastype{$datatype} } ) {
                    print $posthandle "$_->{destfile}\n" or do {
                        $self->logging( 4,
                            "cannot write to postexec handle for `%s': %s",
                            $datatype, $!, );
                        last;
                    };
                }
                my $exitstatus = close($posthandle);
                $self->logging(
                    $exitstatus ? 0 : 4,
                    "postexec for %s exit %s",
                    $datatype,
                    $exitstatus
                    ? "correctly"
                    : "with failure : " . ( $! ? ($!) : "(??)" ),
                );
            }
            else {
                $self->logging( 4, "Cannot exec post `%s' for `%s'",
                    $command, $datatype, );
                next;
            }
        }
    }
}

1;

=head1 LICENSE

This software is under GPL version 2 or highter
(c) 2005, 2006 CNRS Service d'Aeronomie

=head1 AUTHOR

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

=cut