package Lire::Report;
use strict;
use Carp;
use POSIX qw/ strftime /;
use Lire::DataTypes qw/ check_superservice check_number /;
use Lire::I18N qw/ set_fh_encoding /;
use Lire::Utils qw/ xml_encode check_param check_object_param /;
=pod
=head1 NAME
Lire::Report - Interface to a Lire report.
=head1 SYNOPSIS
use Lire::ReportParser::ReportBuilder;
my $parser = new Lire::ReportParser::ReportBuilder;
my $report = $parser->parse( "report.xml" );
print $report->superservice(), " report\n";
print "Generated on ", scalar( localtime( $report->date() ) ), "\n";
print "Timespan starts on ", scalar( localtime( $report->timespan_start() ) ), "\n";
print "Timespan ends on ", scalar( localtime( $report->timespan_start() ) ), "\n";
foreach my $s ( $report->sections() ) {
print "Section: '", $s->title(), "' has ", scalar $s->subreports(),
" subreports in it\n";
}
=head1 DESCRIPTION
This module offers an API to the report generated by Lire. The
Lire::ReportParser::ReportBuilder(3pm) can be used to create a
Lire::Report object from an XML file that complies with the Lire Report
Markup Language DTD.
=head1 CONSTRUCTOR
A Lire::Report object can be built from an XML report file, from the
new() method or from a Lire::ReportConfig object.
=head2 new( [ $timespan_period ], [ $timespan_start ], [ $timespan_end ] )
Creates a new Lire::Report. The $timespan_period, $timespan_start and
$timespan_end parameters initialize the attributes of the same name.
=cut
sub new {
my ( $class, $period, $start, $end ) = @_;
my $self = bless { '_version' => "2.1",
'_generator' => __PACKAGE__ . "(3pm)",
'_date' => time,
'_start' => undef,
'_end' => undef,
'_period' => undef,
'_sections' => [],
}, $class;
$self->timespan_period( $period ) if defined $period;
$self->timespan_start( $start ) if defined $start;
$self->timespan_end( $end ) if defined $end;
return $self;
}
=pod
=head1 OBJECT METHODS
=head2 version()
Returns the version number of the report format which was used in the
external representation of this report. The current version is 2.1.
=cut
sub version {
return $_[0]{'_version'};
}
=pod
=head2 generator([$generator)
Returns the generator string that will be outputted in comments when
the write_report() method is used. One can change that value by
passing a new value through the $generator parameter.
=cut
sub generator {
$_[0]{'_generator'} = $_[1] if defined $_[1];
return $_[0]{'_generator'};
}
=pod
=head2 date( [ $new_date ] )
Returns (and optionanly changes) the date in seconds since
epoch on which this report was generated.
=cut
sub date {
my ( $self, $date ) = @_;
if ( @_ == 2 ) {
check_param( $date, 'date', \&check_number,
"'date' parameter should be a number of seconds since the epoch" );
$self->{'_date'} = $date;
}
return $self->{'_date'};
}
=pod
=head2 timespan_period( [ $new_period ] )
Returns (and optionnally changes) the period of the report. The period
can be 'hourly', 'daily', 'weekly', 'monthly' or 'yearly'. When the
period is undef, it is an arbitrary period.
=cut
sub timespan_period {
my ( $self, $period ) = @_;
if ( @_ == 2 ) {
check_param( $period, 'period',
qr/^(hourly|daily|weekly|monthly|yearly)$/,
"'period' parameter should be one of 'hourly', 'daily', 'weekly', 'monthly' or 'yearly'" )
if defined $period;
$self->{'_period'} = $period;
}
return $self->{'_period'};
}
=pod
=head2 timespan_start( [ $new_start ] )
Returns (and optionnally changes) the start of the timespan covered by
this report in seconds since epoch.
=cut
sub timespan_start {
my ( $self, $start ) = @_;
if ( @_ == 2 ) {
if ( $start ) {
check_param( $start, 'start', \&check_number,
"'start' parameter should be a number of seconds since the epoch" );
croak "'start' parameter is greater than timespan_end()"
if $self->{'_end'} && $start > $self->{'_end'};
}
$self->{'_start'} = $start ? $start : undef;
}
return $self->{'_start'};
}
=pod
=head2 timespan_end( [ $new_end ] )
Returns (and optionnally changes) the end of the timespan covered by
this report in seconds since epoch.
=cut
sub timespan_end {
my ( $self, $end ) = @_;
if ( @_ == 2 ) {
if ( $end ) {
check_param( $end, 'end', \&check_number,
"'end' parameter should be a number of seconds since the epoch" );
croak "'end' parameter is smaller than timespan_start()"
if $self->{'_start'} && $end < $self->{'_start'};
}
$self->{'_end'} = $end ? $end : undef;
}
return $self->{'_end'};
}
=pod
=head2 title( [$title] )
Returns the report's title, if it has one.
If the $title is parameter is set, the report's title will be set to
this new value.
=cut
sub title {
$_[0]{'title'} = $_[1] if @_ == 2;
return $_[0]{'title'};
}
=pod
=pod
=head2 description( [$new_desc] )
Returns the report description. This description is encoded in DocBook
XML.
If the $description parameter is set, this method will set the
description to this new value. If the $description parameter is undef,
that description will be removed.
=cut
sub description {
$_[0]->{'description'} = $_[1] if @_ == 2;
return $_[0]->{'description'};
}
=pod
=head2 sections( )
Returns the report's sections as an array. This will be an array of
Lire::Report::Section objects.
=cut
sub sections {
return @{$_[0]{'_sections'}};
}
=pod
=head2 add_section( $section )
Adds a section to this report. The $section parameter should be a
Lire::Report::Section object.
=cut
sub add_section {
my ( $self, $section ) = @_;
check_object_param( $section, 'section', 'Lire::Report::Section' );
push @{$self->{'_sections'}}, $section;
return;
}
=pod
=head2 subreport_by_id( $id )
Returns the Lire::Report::Subreport object with $id. Returns undef
when there is no subreport with that ID.
=cut
sub subreport_by_id {
my ( $self, $id ) = @_;
check_param( $id, 'id' );
foreach my $section ( @{$self->{'_sections'}} ) {
foreach my $subreport ( $section->subreports() ) {
return $subreport if $subreport->id() eq $id;
}
}
return undef;
}
=pod
=head2 schemas()
Returns an array reference containing all the schemas used
by this report.
=cut
sub schemas {
my $self = $_[0];
my %schemas = ();
foreach my $sect ( $self->sections() ) {
foreach my $sub ( $sect->subreports() ) {
foreach my $id ( @{$sub->schemas()} ) {
$schemas{$id} = 1;
}
}
}
return [ sort keys %schemas ];
}
=pod
=head2 write_report( [FH] );
Write the report in XML format on the FH filehandle or STDOUT if
omitted.
This method takes care of adding stuff like the XML header C<E<lt>?xml
version=[...]>. It encodes the XML report in UTF-8, using
Lire::I18N::set_fh_encoding().
=cut
sub write_report {
my ( $self, $fh ) = @_;
$fh ||= \*STDOUT;
set_fh_encoding( $fh, 'UTF-8' );
my $time = strftime '%Y-%m-%d %H:%M:%S %Z', localtime $self->date();
my $period_string = "";
if ( $self->timespan_start() ) {
my $stime = strftime( '%Y-%m-%d %H:%M:%S %Z',
localtime $self->timespan_start() );
my $etime = strftime( '%Y-%m-%d %H:%M:%S %Z',
localtime $self->timespan_end() );
$period_string = "$stime - $etime";
} else {
$period_string = "Unknown Period";
}
print $fh <<EOF;
<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE lire:report PUBLIC
"-//LogReport.ORG//DTD Lire Report Markup Language V$self->{'_version'}//EN"
"http://www.logreport.org/LRML/$self->{'_version'}/lrml.dtd">
<lire:report xmlns:lire="http://www.logreport.org/LRML/" xmlns:lrcml="http://www.logreport.org/LRCML/" version="$self->{'_version'}">
<!-- generated by $self->{'_generator'} -->
EOF
print $fh " <lire:title>", xml_encode( $self->title() ), "</lire:title>\n"
if defined $self->title();
print $fh ' <lire:date time="', $self->{'_date'}, '">', $time,
"</lire:date>\n";
{
no warnings 'uninitialized';
print $fh ' <lire:timespan ',
( $self->{'_period'} ? "period=\"$self->{'_period'}\" " : "" ),
'start="', $self->{'_start'}, '" end="', $self->{'_end'}, '">',
$period_string, "</lire:timespan>\n";
}
print $fh " <lire:description>", $self->description(),
"</lire:description>\n\n"
if ( $self->description() );
foreach my $s ( $self->sections() ) {
$s->write_report( $fh, 1 );
}
print $fh "</lire:report>\n";
return;
}
# Creates an identifier for Subreport's type $type.
# This creates an ID that will make sure that the
# subreport would be merged identically than with the
# previous merging algorithm which didn't merge by id.
sub create_subreport_id {
my ( $self, $type ) = @_;
$self->{'_id_cache'}{$type} ||= 0;
return $type . "." . $self->{'_id_cache'}{$type}++;
}
=pod
=head2 delete( )
Removes all circular references so that the object can be freed.
=cut
sub delete {
my $self = $_[0];
foreach my $s ( $self->sections() ) {
foreach my $r ( $s->subreports() ) {
$r->delete();
}
}
return;
}
# keep perl happy
1;
__END__
=pod
=head1 SEE ALSO
Lire::ReportParser::ReportBuilder(3pm) Lire::Report::Section(3pm)
Lire::Report::Subreport(3pm) Lire::Report::Entry(3pm)
Lire::Report::Group(3pm)
Lire::ReportParser(3pm)
=head1 AUTHOR
Francis J. Lacoste <flacoste@logreport.org>
=head1 VERSION
$Id: Report.pm,v 1.35 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