package Lire::ReportConfig;
use strict;
use Text::ParseWords qw/ shellwords /;
use Lire::DlfSchema;
use Lire::ReportSpec;
use Lire::FilterSpec;
use Lire::FilterExpr;
use Lire::I18N qw/ set_fh_encoding /;
use Lire::Report;
use Lire::ReportSection;
use Lire::DlfAnalyserProcess;
use Lire::ReportParser::ReportBuilder;
use Lire::Utils qw/check_param check_object_param /;
use Lire::Config;
use Lire::Config::ReportSpec;
use Lire::Config::SpecParser;
use Lire::Error qw/ directory_not_readable /;
use Carp;
=pod
=head1 NAME
Lire::ReportConfig - API to the report configuration file
=head1 SYNOPSIS
use Lire::ReportConfig;
my $templates = Lire::ReportConfig->templates();
if ( Lire::ReportConfig->has_template( 'www_default' ) ) {
my $report_cfg = Lire::ReportConfig->template( 'www_default' )->as_value();
my $report = $report_cfg->generate_report( $report );
}
=head1 DESCRIPTION
This class represents report configurations. Report configurations are
stored as an XML configuration using the Lire::Report::ReportSpec
configuration type.
=head1 TEMPLATES
Template reports are configuration specification files found in the
directories specified by the 'lr_templates_path' configuration
variable.
=head2 templates()
Returns an array reference containing the names of all defined
templates.
=cut
our %TEMPLATES = ();
sub templates {
my $self = $_[0];
my %templates = map { $_ => 1} keys %TEMPLATES;
foreach my $dir ( @{ Lire::Config->get( 'lr_templates_path' ) } ) {
opendir my $dh, $dir
or die directory_not_readable( $dir ), "\n";
foreach my $name ( readdir $dh ) {
next unless $name =~ /^([-.\w]+)\.xml$/;
$templates{$1} = 1;
}
closedir $dh;
}
return [ keys %templates ];
}
sub _find_template_file {
my ( $self, $name ) = @_;
foreach my $dir ( @{ Lire::Config->get( 'lr_templates_path' ) } ) {
return "$dir/$name.xml" if -f "$dir/$name.xml";
}
return undef;
}
=pod
=head2 has_template( $name )
Returns true if there is a template named $name available.
=cut
sub has_template {
my ( $self, $name ) = @_;
check_param( $name, 'name' );
return 1 if exists $TEMPLATES{$name};
return defined $self->_find_template_file( $name );
}
=pod
=head2 template( $name )
Returns a Lire::Config::Object defining the template ReportConfig
named $name. Its spec() method would return a Lire::Config::ReportSpec
object and its as_value() method would instantiate a
Lire::ReportConfig object.
=cut
sub template {
my ( $self, $name ) = @_;
check_param( $name, 'name' );
return $TEMPLATES{$name} if exists $TEMPLATES{$name};
my $file = $self->_find_template_file( $name );
croak "no template named '$name' found in lr_templates_path"
unless defined $file;
my $parser = new Lire::Config::SpecParser();
my $spec = $parser->parsefile( $file );
croak "error in template file '$file', there is no component named '$name'"
unless $spec->has_component( $name );
return $TEMPLATES{$name} = $spec->get( $name )->instance();
}
=pod
=head1 CONSTRUCTORS
=head2 new()
This creates a new empty Lire::ReportConfig object.
The created report configuration object doesn't contain any section,
report or filter specifications.
=cut
sub new {
return bless {
'_sections' => [],
'_encoding' => undef,
'_filename' => undef,
'_title' => undef,
}, shift;
}
=pod
=head2 new_from_file( $superservice, $report_cfg )
This will create a new report configuration object for the
$superservice superservice based on the report configuration file
$report_cfg.
=cut
sub new_from_file {
my ( $class, $superservice, $report_cfg ) = @_;
check_param( $superservice, 'superservice',
sub { Lire::DlfSchema->has_superservice( $_[0] ) },
'invalid superservice' );
my $self = $class->new();
$self->_load_from_file( $superservice, $report_cfg );
return $self;
}
sub new_from_config {
my ( $self, $value ) = @_;
my $def = $value->Lire::Config::Dictionary::as_value();
my $cfg = new Lire::ReportConfig();
$cfg->title( $def->{'title'} )
if $def->{'title'};
foreach my $section ( @{$def->{'sections'}} ) {
$cfg->add_section( $section );
}
return $cfg;
}
=pod
=head1 OBJECT METHODS
=pod
=head2 filename( [ $new_filename ] )
Returns (and optionanly changes) the filename from which this
ReportConfig was loaded. It will return undef if the ReportConfig
wasn't loaded from a file.
=cut
sub filename {
$_[0]{'_filename'} = $_[1] if @_ == 2;
return $_[0]{'_filename'};
}
=pod
=head2 title( [ $new_title ] )
Returns (and optionnally changes) the title that will be assigned to
the report.
=cut
sub title {
my ( $self, $new_title ) = @_;
$self->{'_title'} = $new_title
if @_ == 2;
return $self->{'_title'};
}
sub _load_from_file {
my ( $self,$superservice, $report_cfg ) = @_;
# Reset the sections
$self->{'_sections'} = [];
# Format of the configuration file is
# ((=section <title>)
# (|filter_id <param>)*
# (report_id <param>))*)+
$self->{'_curr_section'} = undef;
$self->{'_id_cache'} = {};
# Load the report configuration file
open my $fh, $report_cfg
or die "can't open report configuration file $report_cfg: $!\n";
$self->{'_fh'} = $fh;
my $line;
while ( defined( $line = <$fh> ) ) {
next if $line =~ /^\s*#/; # Skip comments
next if $line =~ /^\s*$/; # Skip blank lines
chomp $line;
my $first_char = substr( $line, 0, 1 );
if ( $first_char eq '=' ) {
if ( $line =~ /^=encoding/ ) {
$self->_parse_encoding_line( $line );
} elsif ( $line =~ /^=section/ ) {
$self->_parse_section_line( $superservice, $line );
} else {
warn "Unknown directive at line $.: $line\n";
}
} elsif ( $first_char eq '|' ) {
$self->_parse_filter_line( $superservice, $line );
} else {
$self->_parse_report_line( $superservice, $line );
}
}
close $fh;
delete $self->{'_fh'};
delete $self->{'_curr_section'};
delete $self->{'_id_cache'};
$self->{'_filename'} = $report_cfg;
return;
}
sub _parse_encoding_line {
my ( $self, $line ) = @_;
die "'encoding' directive requires perl >= 5.8.0, at line $.\n"
unless $Lire::I18N::USE_ENCODING;
die "'encoding' directive must be the first directive, at line $.\n"
if ( defined $self->{'_curr_section'} );
die "only one 'encoding' directive allowed, at line $.\n"
if ( defined $self->{'_encoding'} );
$line =~ /^=encoding\s+([-\w.]+)$/;
die "invalid 'encoding' directive, at line $.\n"
unless ( defined $1 );
$self->{'_encoding'} = $1;
set_fh_encoding( $self->{'_fh'}, $1 );
return;
}
sub _parse_section_line {
my ( $self, $superservice, $line ) = @_;
unless ( $line =~ /^=section (.*)$/ ) {
warn "invalid section directive at line $.: $line";
return;
}
$self->{'_curr_section'} = new Lire::ReportSection( $superservice, $1 );
$self->add_section( $self->{'_curr_section'} );
return;
}
sub _parse_filter_line {
my ( $self, $superservice, $line ) = @_;
my ( $id, $params ) = _parse_param_line( substr( $line, 1 ) );
eval {
die "filter specification before any =section directive\n"
unless $self->{'_curr_section'};
die"filter specification should come before report specifications\n"
if $self->{'_curr_section'}->reports();
my $spec = Lire::FilterSpec->load( $superservice, $id );
while ( my ($name, $value) = each %$params ) {
$spec->param( $name )->value( $value );
}
$self->{'_curr_section'}->add_filter( $spec );
};
if ( $@ ) {
warn( "error at line $.: $@\n" );
warn( "Omitting filter $id defined at line $.\n" );
}
return;
}
sub _parse_report_line {
my ( $self, $superservice, $line ) = @_;
my ( $id, $params ) = _parse_param_line( $line );
eval {
die "report specification before any =section directive\n"
unless $self->{'_curr_section'};
my $report_spec = Lire::ReportSpec->load( $superservice, $id );
while ( my ($name, $value) = each %$params ) {
$report_spec->param( $name )->value( $value );
}
$self->{'_id_cache'}{$id} ||= 0;
$report_spec->subreport_id( $id . "." . $self->{'_id_cache'}{$id}++ );
$self->{'_curr_section'}->add_report( $report_spec );
};
if ( $@ ) {
warn( "error at line $.: $@\n" );
warn( "Omitting report $id defined at line $.\n" );
}
return;
}
sub _parse_param_line {
my ( $id, @p ) = shellwords( $_[0] );
my %params = ();
foreach my $param_str ( @p ) {
my ( $param, $value ) = $param_str =~ /^([-.\w]+)=(.*)$/;
unless ( defined $param ) {
warn( "error parsing parameter $param_str at line $.. Ignoring parameter.\n" );
next;
}
$value = "" unless defined $value;
$params{$param} = $value;
}
return ( $id, \%params );
}
sub create_param_line {
my ( $id, $spec ) = @_;
my @line = ( $id );
foreach my $name ( $spec->param_names() ) {
my $value = $spec->param( $name )->value();
$value =~ s/\\/\\\\/g; # Escape backslashes
$value =~ s/"/\\"/g; # and double quotes
push @line, $name . '="' . $value . '"';
}
return join( " ", @line );
}
=pod
=head2 schemas()
Returns an array reference containing the name of the schemas used
in this report.
=cut
sub schemas {
my $self = $_[0];
my %schemas = ();
foreach my $section ( $self->sections() ) {
foreach my $report ( $section->reports() ) {
foreach my $schema ( @{$report->schemas()} ) {
$schemas{$schema} = 1
}
}
}
return [ keys %schemas ];
}
=pod
=head2 sections()
Return's this report configuration's sections as an array of
Lire::Section objects.
=cut
sub sections {
my ( $self ) = @_;
return @{$self->{'_sections'}};
}
=pod
=head2 add_section( $section )
Adds a section to this report configuration. The $section parameter
should be a Lire::ReportSection object.
=cut
sub add_section {
my ( $self, $section ) = @_;
check_object_param( $section, 'section', 'Lire::ReportSection' );
push @{$self->{'_sections'}}, $section;
return;
}
=pod
=head2 merge_filters()
Calling this method will make sure that all report specifications
take into account their section's filter specification.
This method will modify all report specifications. After this their
object representation won't be identical to the one in the XML report
specification.
=cut
sub merge_filters {
my ( $self ) = @_;
foreach my $section ( $self->sections() ) {
my @filters = map { $_->filter_spec() } $section->filters();
my @reports = $section->reports();
foreach my $r ( @reports ) {
if ( @filters ) {
my $expr;
if ( $r->filter_spec || @filters > 1) {
$expr = new Lire::FilterExpr::And( 'container' => $r );
if ( $r->filter_spec ) {
$expr->expr( [ @filters, $r->filter_spec ] );
} else {
$expr->expr( [@filters] );
}
} else {
$expr = $filters[0];
}
$r->filter_spec( $expr );
}
}
}
return;
}
=pod
=head2 print( [$fh] )
Prints the report configuration on the $fh filehandle. If the $fh
parameter is omitted, the report configuration will be printed on
STDOUT.
=cut
sub print {
my ( $self, $fh ) = @_;
$fh ||= \*STDOUT;
if ( defined $self->{'_encoding'} ) {
set_fh_encoding( $fh, $self->{'_encoding'} );
print $fh "=encoding ", $self->{'_encoding'}, "\n\n";
}
foreach my $section ( $self->sections() ) {
print $fh "=section ", $section->title(), "\n";
foreach my $filter ( $section->filters() ) {
print $fh create_param_line( "|" . $filter->id(), $filter ), "\n";
}
foreach my $report ( $section->reports() ) {
print $fh create_param_line( $report->id(), $report ), "\n";
}
# Empty line
print $fh "\n"
}
}
# Used by lr_report_cfg2xml to convert file-based
# report configuration to the new XML format.
sub as_config_value {
my ( $self, $name ) = @_;
my %filters_id = ();
check_param( $name, 'name' );
my $spec = new Lire::Config::ReportSpec( 'name' => $name );
my $cfg = $spec->instance();
$cfg->get( 'id' )->set( $name );
foreach my $section ( @{$self->{'_sections'}} ) {
my $sect_cfg =
$spec->get( 'sections' )->get( 'section' )->instance();
$cfg->get( 'sections' )->append( $sect_cfg );
$sect_cfg->get( 'superservice' )->set( $section->superservice() );
$sect_cfg->get( 'title' )->set( $section->title() );
foreach my $filter ( $section->filters() ) {
my $type = $filter->id();
my $id = $filter->superservice() . ':' . $type;
my $filter_cfg = $sect_cfg->spec()->get( 'filters' )->get( $id )->instance();
$filters_id{$type} ||= 0;
$filter_cfg->get( 'id' )->set( $type . '.' . $filters_id{$type}++);
foreach my $name ( $filter->param_names() ) {
$filter_cfg->get( $name )->set( $filter->param( $name )->value() );
}
$sect_cfg->get( 'filters' )->append( $filter_cfg );
}
foreach my $report ( $section->reports() ) {
my $id = $report->superservice() . ':' . $report->id();
my $report_cfg = $sect_cfg->spec()->get( 'specs' )->get( $id )->instance();
$report_cfg->get( 'id' )->set( $report->subreport_id() );
foreach my $name ( $report->param_names() ) {
$report_cfg->get( $name )->set( $report->param( $name )->value() );
}
$sect_cfg->get( 'specs' )->append( $report_cfg );
}
}
return $cfg;
}
=pod
=head2 create_report( $timespan_start, $timespan_end )
Returns a Lire::Report object based on this report's configuration file.
The $timespan_start and $timespan_end attribute will be used to initiate
the Report object.
Used when generating an XML report from a DLF source, and
when merging XML reports.
The real job is delegated to Lire::ReportSection::create_report_section().
=cut
sub create_report {
my ( $self, $start, $end) = @_;
my $report = new Lire::Report();
$report->timespan_start( $start );
$report->timespan_end( $end );
$report->title( $self->{'_title'} )
if defined $self->{'_title'};
foreach my $s ( $self->sections() ) {
$s->create_report_section( $report );
}
return $report;
}
=pod
=head2 create_analyser_streams( $store )
This method will make sure that a DlfStream is available in the
Lire::DlfStore $store for each schema used by this report
configuration. The stream will be created by running the first
analyser which is able to generate the schema using exising streams.
=cut
sub create_analyser_streams {
my ($self, $store ) = @_;
check_object_param( $store, 'store', 'Lire::DlfStore' );
foreach my $schema ( @{$self->schemas()} ) {
$self->_create_dlf_stream( $store, $schema )
unless $store->has_dlf_stream( $schema );
}
return;
}
sub _create_dlf_stream {
my ( $self, $store, $schema_id ) = @_;
my $schema = Lire::DlfSchema::load_schema( $schema_id );
my $analysers = Lire::PluginManager->analysers_by_dst( $schema_id );
unless ( @$analysers ){
warn( "no analysers available to create '", $schema_id, "' stream" );
return;
}
my $analyser = $analysers->[0]->name();
my $cfg = Lire::Config->config_spec()->has_component( "${analyser}_properties") && Lire::Config->get( "${analyser}_properties" ) || '';
my $process = new Lire::DlfAnalyserProcess( $store, $analyser, $cfg );
$process->run_analysis_job();
return;
}
=pod
=head2 generate_report( $store )
Generates a Lire::Report from this report configuration. The report is
computed using the streams in the Lire::DlfStore $store.
=cut
sub generate_report {
my ( $self, $store ) = @_;
check_object_param( $store, 'store', 'Lire::DlfStore' );
# Merge the sections' filter specifications
$self->merge_filters();
my ( $start, $end ) = $self->_find_dlf_time( $store );
foreach my $section ( @{$self->{'_sections'}} ) {
foreach my $report_spec ( $section->reports() ) {
my $r = $report_spec->subreport_id();
unless ( $store->has_dlf_stream( $report_spec->schema()->id()) )
{
warn( "report '$r' will be skipped because of unavailable input");
$report_spec->mark_missing( "unavailable input" );
next;
}
eval {
$report_spec->set_store( $store );
};
if ( $@ ) {
warn( $@ );
$report_spec->mark_missing( 'set_store() failed: $@' );
}
}
}
return $self->create_report( $start, $end );
}
sub _find_dlf_time {
my ( $self, $store ) = @_;
my $dlf_stream =
$store->open_dlf_stream( $self->{'_sections'}[0]->superservice(), "r" );
my $start = $dlf_stream->start_time();
my $end = $dlf_stream->end_time();
$dlf_stream->close();
return ( $start, $end );
}
# Merging
=pod
=head2 merge_report_files( @report_files )
Generate a new Lire::Report based on this report configuration by
merging XML reports. Every report spec contained in the configuration
will be the result of the merging of all the subreports having the
same id.
=cut
sub merge_report_files {
my ( $self, @files ) = @_;
$self->_init_merge();
my $non_missing = {};
my $parser = new Lire::ReportParser::ReportBuilder();
foreach my $r ( @files ) {
my $report = eval { $parser->parsefile( $r ) };
if ( $@ ) {
warn( "error parsing XML report $r: $@. Skipping" );
next;
}
$self->_update_merged_timespan( $report );
$self->_merge_report( $report, $non_missing );
$report->delete();
}
$self->_end_merge( $non_missing );
return $self->create_report( $self->{'report_start'}, $self->{'report_end'} );
}
sub _init_merge {
my $self = $_[0];
foreach my $section ( $self->sections() ) {
foreach my $spec ( $section->reports() ) {
my $id = $spec->subreport_id();
eval { $spec->calc_spec()->init_merge() };
if ( $@ ) {
warn( "$@\nreport '$id' will be skipped" );
$spec->mark_missing( "init_merge() failed: $@" );
}
}
}
}
sub _end_merge {
my ( $self, $non_missing ) = @_;
foreach my $section ( $self->sections() ) {
foreach my $spec ( $section->reports() ) {
my $id = $spec->subreport_id();
eval { $spec->calc_spec()->end_merge() };
if ( $@ ) {
warn( "$@\nreport '$id' will be skipped" );
$spec->mark_missing( "end_merge() failed: $@" );
}
# Mark missing, if it was also missing in all reports
$spec->mark_missing( "missing in all merged reports" )
unless $non_missing->{$id};
}
}
}
sub _merge_report {
my ( $self, $report, $non_missing ) = @_;
foreach my $section ( $self->sections() ) {
foreach my $spec ( $section->reports() ) {
# Skip failed reports
next if $spec->is_missing();
my $id = $spec->subreport_id();
die "assertion failed: missing subreport_id on specification ",
$spec->id() unless defined $id;
# Find the matching subreport in this report
my $subreport = $report->subreport_by_id( $id );
unless ( $subreport ) {
warn( "no subreport id '$id' in this report" );
next;
}
eval { $spec->calc_spec()->merge_subreport( $subreport ); };
if ($@) {
warn( $@ );
warn( "Merge of '$id' failed" );
next;
}
$non_missing->{$id} = 1;
}
}
}
sub _update_merged_timespan {
my ( $self, $report ) = @_;
# Start and end of merged report is the union of the range of
# all the reports
# timespan_start and timespan_end are in seconds since epoch
unless ( defined $self->{'report_start'} ) {
$self->{'report_start'} = $report->timespan_start();
$self->{'report_end'} = $report->timespan_end();
}
# It is possible for a report to have
# an unknown period
if ( $report->timespan_start() ) {
$self->{'report_start'} = $report->timespan_start()
if $report->timespan_start() < $self->{'report_start'};
$self->{'report_end'} = $report->timespan_end()
if $report->timespan_end() > $self->{'report_end'};
}
}
# keep perl happy
1;
__END__
=pod
=head1 SEE ALSO
Lire::ReportSection(3pm), Lire::ReportSpec(3pm),
Lire::FilterSpec(3pm) Lire::Report(3pm)
=head1 AUTHOR
Francis J. Lacoste <flacoste@logreport.org>
=head1 VERSION
$Id: ReportConfig.pm,v 1.38 2006/07/23 13:16:29 vanbaal Exp $
=head1 COPYRIGHT
Copyright (C) 2002, 2004 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
syntax highlighted by Code2HTML, v. 0.9.1