lire 2:2.1.1-2.1 / usr / share / perl5 / Lire / Program.pm

package Lire::Program;

use strict;

use base qw/ Exporter /;
use vars qw/ @EXPORT_OK %EXPORT_TAGS
	     $LR_TAG $LR_ID $PROG $LR_SUPERSERVICE $LR_SERVICE $start
	     $init_called /;

use File::Basename qw/ basename /;
# Make sure the all script which uses Lire::Program
# also get Lire::Config inited

use Lire::Config;
use Lire::Error qw/ file_not_readable /;

=pod

=head1 NAME

Lire::Program - Lire's programs common infrastructure.

=head1 SYNOPSIS

Any program:

    use Lire::Program qw/ :msg /;

    lr_info( "doing stuff " );
    lr_debug( "debugging information" );
    lr_warn( "encountered unexpected value: ", $value );
    open( CFGFILE, "my.conf" ) or lr_err( "open error: ", $! );

=head1 DESCRIPTION

This module should be used by all Lire programs (at least the Perl ones :-).

It includes:

=over

=item 1.

Common behavior for good integration in the Lire suite. (Output of
performance information and other stuff).

=item 2.

Functions for portability.

=item 3.

Logging functions

=back

=head1 COMMON BEHAVIOR FOR LIRE PROGRAMS

When you use the Lire::Program module, you make sure that your program
will behave correctly in the Lire tool chain. This module will install
BEGIN and END blocks to comply with Lire's policy.

=over

=item 1.

Only messages in the proper logging format

    I<superservice> I<service> I<lr_id> I<program> I<level> I<msg>

should be output. This module will install a __WARN__ signal
handler that makes sure that all modules that use warn to output messages
are rewritten in the proper format.

See also lr_run(1).

=item 2.

All programs should start by a C<info> message which logs their
arguments. This module takes care of this.

=item 3.

All programs should end by printing C<info> messages with performance
statistics and the message 'ended'. Using this module takes care of
this. At the end of your program the following will be output
(stripped off the common information):

    memory stats: vsize=10688K rss=9380K majflt=406
    elapsed time in seconds real=9 user=8.72 system=0.06
    stopped

The memory profiling information will only be output on platforms
running the Linux kernel.

=back

=head2 COMMON VARIABLES

As a convenience, you can import in your namespace using the :env tag
some variables common to all Lire programs. (Note that you can also
use those variables without importing them by prefixing the variables
with the Lire::Program:: namespace.)

=over

=item $PROG

The name of your program (that's the value of $0 without the directory path).

=item $LR_SUPERSERVICE

The superservice which you are processing, or C<all> if this
information isn't available.

=item $LR_SERVICE

The service which you are processing, or C<all> if this information
isn't specified.

=item $LR_ID

That's the job identifier. It should be shared by all commands in a
Lire job. This is the value UNSET when none was specified.

=item $LR_TAG

That's the prefix to all log messages. Should correspond to

    $LR_SUPERSERVICE $LR_SERVICE $LR_ID $PROG

=back

=cut

BEGIN {
    ($PROG) = basename( $0 );
    $LR_SUPERSERVICE = $ENV{'LR_SUPERSERVICE'}   || 'all';
    $LR_SERVICE	     = $ENV{'LR_SERVICE'}	    || 'all';
    $LR_ID  	     = $ENV{'LR_ID'}	    || "UNSET";
    $LR_TAG	     = "$LR_SUPERSERVICE $LR_SERVICE $LR_ID $PROG";

    @EXPORT_OK = qw/ tempfile tempdir /;

    require Lire::Utils;
    *tempfile = \&Lire::Utils::tempfile;
    *tempdir = \&Lire::Utils::tempdir;

    require Lire::Logger;
    *lr_emerg = \&Lire::Logger::lr_emerg;
    *lr_crit = \&Lire::Logger::lr_emerg;
    *lr_err = \&Lire::Logger::lr_err;
    *lr_warn = \&Lire::Logger::lr_warn;
    *lr_notice = \&Lire::Logger::lr_notice;
    *lr_info= \&Lire::Logger::lr_info;
    *lr_debug= \&Lire::Logger::lr_debug;

    $SIG{'__WARN__'} = sub {
	Lire::Logger::lr_warn( @_ );
    };

    %EXPORT_TAGS = (
		    'dlf' => [ qw/ init_dlf_converter end_dlf_converter lire_chomp / ],
		    'msg' => [qw/ lr_emerg lr_crit lr_err lr_warn
				lr_notice lr_info lr_debug/ ],
		    'env'	=> [ qw/ $PROG $LR_SUPERSERVICE $LR_SERVICE $LR_TAG $LR_ID / ],
		   );

    foreach my $tag ( keys %EXPORT_TAGS ) {
	Exporter::export_ok_tags( $tag );
    }

    Lire::Config->lire_program_config_init;
}

=pod

=head1 LOGGING FUNCTIONS

The logging functions are now part of the Lire::Logger module. Consult
Lire::Logger(3pm) for more information. The old names are still
exported from this module by using the ':msg' tag.

=head1 DLF CONVERTERS FUNCTIONS

The DLF converter API is now defined in Lire::DlfConverter(3pm). The
Lire::OldDlfAdapter(3pm) can be used to work with old-style DLF
Converters.

=cut

sub init_dlf_converter {
    my ( $superservice ) = @_;

    # Empty for now
    $init_called = $superservice;
}

sub end_dlf_converter {
    my ( $lines, $dlflines, $errorlines ) = @_;

    $errorlines ||= 0;

    lr_err( "Lire::Program::init_dlf_converter wasn't called" )
      unless $init_called;

    lr_info( "read $lines lines; output $dlflines DLF lines; $errorlines errors" );

    $init_called = undef;
}

sub lire_chomp(;$) {
    if ( @_ == 1 ) {
	$_[0] =~ s/\r?\n?$//;
    } else {
	$_ =~ s/\r?\n?$//;
    }
}

# This is executed after the function were compiled
BEGIN {
    $start  = time;
    if ( @ARGV ) {
	lr_info ( "started with ", join " ", @ARGV );
    } else {
	lr_info ( "started with no argument" );
    }
}

# FIXME: Make this portable to other OS then Linux 2.X
sub print_linux_memory_stats {
    my $stat_file = '/proc/self/stat';
    open PROC, $stat_file
      or die file_not_readable( $stat_file );
    my @stats = split /\s+/, <PROC>;
    close PROC;

    # Stat layout is in linux, from proc(5)
    #  0 pid	    10 cminflt	    20 itrealvalue  30 blocked
    #  1 comm	    11 majflt	    21 starttime    31 sigignore
    #  2 state	    12 cmajflt	    22 vsize	    32 sigcatch
    #  3 ppid	    13 utime	    23 rss	    33 wchan
    #  4 pgrp	    14 stime	    24 rlim
    #  5 session    15 cutime	    25 startcode
    #  6 tty	    16 cstime	    26 endcode
    #  7 tpgid	    17 counter	    27 startstack
    #  8 flags	    18 priority	    28 kstkesp
    #  9 minflt	    19 timeout	    29 signal

    # Sanity check to see if we read the good structure
    die "layout of /proc/self/stat doesn't match we expect"
      unless $stats[0] == $$ &&
	$stats[3] == getppid &&
	  $stats[4] == getpgrp 0;

    my $vsize = $stats[22] / 1024;
    my $rss   = $stats[23] * 4;
    my $majflt = $stats[11];
    lr_info( "memory stats: vsize=${'vsize'}K rss=${'rss'}K majflt=$majflt" );
}

END {
    eval { print_linux_memory_stats() }
      if -e "/proc/self/stat";

    my $real = time - $start;
    my ($user, $system ) = times;

    # Print performance data
    lr_info( "elapsed time in seconds real=$real user=$user system=$system" );
    lr_info( "stopped" );
}

1;

__END__

=pod

=head1 SEE ALSO

Lire::DlfSchema(3pm), lr_run(1)

=head1 AUTHOR

  Francis J. Lacoste <flacoste@logreport.org>

=head1 VERSION

$Id: Program.pm,v 1.35 2006/07/23 13:16:29 vanbaal Exp $

=head1 COPYRIGHT

Copyright (C) 2001 Stichting LogReport Foundation LogReport@LogReport.org

This file is part of Lire.

Lire is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program (see COPYING); if not, check with
http://www.gnu.org/copyleft/gpl.html. 

=cut