package Lire::Records; use strict; use base qw/ Lire::Aggregator /; use Carp; use POSIX qw/ strftime /; use Lire::DataTypes qw/ is_time_type is_quantity_type format_numeric_type /; use Lire::Utils qw/ check_param check_object_param tempfile /; =pod =head1 NAME Lire::Records - Base class for implementation of the records operator. =head1 SYNOPSIS use Lire::Records; =head1 DESCRIPTION This module is the base class for implementation of the records operator. The records operator isn't an aggregator nor a group operation. It only collects information on each DLF records which will be included in the report. =head1 CONSTRUCTOR =head2 new( %params ) Creates a new instance of a records operator. In addition to the normal report operator parameters, the records operator takes one additional parameter: =over =item fields A reference to an array containing the names of the DLF field that should be included in the report. =back =cut sub new { my ( $class, %args ) = @_; check_param( $args{'fields'}, 'fields' ); my $self = bless {}, $class; $self->SUPER::init( %args, 'op' => 'records' ); $self->fields( $args{'fields'} ); return $self; } #------------------------------------------------------------------------ # Method print( $fh, $prefix ) # # Implementaion of the method required by Lire::ReportOperator. sub print { my ($self,$fh, $prefix) = @_; $fh ||= \*STDOUT; $prefix ||= 0; my $pfx = " " x $prefix; print $fh $pfx, '{'fields'}}), qq{"/>\n}; } =pod =head1 METHOD =head2 fields( [$new_fields] ) Returns a reference to an array containing the DLF field names that will be included in the report. You can use the $new_fields parameter to change that value. =cut sub fields { my ($self, $fields) = @_; if ( @_ == 2 ) { if ( defined $fields ) { check_object_param( $fields, 'fields', 'ARRAY' ); croak "fields cannot be empty\n" unless @$fields; foreach my $f ( @$fields ) { croak "$f isn't a defined field in the specfication's schemas" unless $self->report_spec()->has_field( $f ); } } else { croak "undefined fields\n"; } $self->{'fields'} = $fields; } $self->{'fields'}; } =pod =head2 ops() FIXME =cut sub ops { return [] if (@_ == 1); croak "records cannot contain any children"; } # Implements Lire::ReportOperator::name() sub name { return 'records:' . @{$_[0]->fields()}; } # Implements Lire::Aggregator::create_categorical_info sub create_categorical_info { my ( $self, $group_info ) = @_; foreach my $field ( @{ $self->fields() } ) { my $dlf_field = $self->report_spec()->field( $field ); $group_info->create_column_info( $field, 'categorical', $dlf_field->type, $dlf_field->label, ); } } # Overrides Lire::Aggregator::build_query sub build_query { my ($self, $query ) = @_; $self->SUPER::build_query( $query ); foreach my $field ( @{$self->{'fields'}} ) { $query->add_field( $field ); } $query->set_sort_spec( $self->report_spec()->schema()->timestamp_field()->name()) ; return; } sub create_entry { my ( $self, $group, $row ) = @_; my $entry = $group->create_entry(); for ( my $i=0; $i < @{$self->{'fields'}}; $i++ ) { my $value = $row->{$self->{'fields'}[$i]}; my $type = $group->group_info()->info_by_index( $i )->type(); if ( is_time_type( $type ) ) { $entry->add_name( strftime( '%Y-%m-%d %H:%M:%S', localtime $value ), $value ); } elsif ( is_quantity_type( $type ) ) { $entry->add_name( format_numeric_type( $value, $type ), $value ); } else { $entry->add_name( $value ); } } return $entry; } # Implements Lire::ReportOperator::init_merge() sub init_merge { my $self = $_[0]; # We use a temporary file to sort the DLF records according to # the group id we are using. $self->{'fh'} = tempfile(); $self->{'group_no'} = 0; return; } # Implements Lire::Aggregator::init_aggregator_data() sub init_aggregator_data { my ( $self ) = @_; my $value = $self->{'group_no'}++; return $value; } # Implements Lire::Aggregator::merge_aggregator_data() sub merge_aggregator_data { my ( $self, $group, $data ) = @_; croak "value should be of type Lire::Report::Group, not $group\n" unless UNIVERSAL::isa( $group, "Lire::Report::Group" ); my $fh = $self->{'fh'}; foreach my $e ( $group->entries() ) { my @fields = $e->data; print $fh join( " ", $data, map { $_->{'value'}} @fields ), "\n"; } } # Implements Lire::Aggregator::end_aggregator_data() sub end_aggregator_data { my ( $self, $data ) = @_; my $fh = $self->{'fh'}; print $fh $data, " LIRE_RECORDS_GROUP_DATA_END\n"; } # Implements Lire::Aggregator::create_group_entries() sub create_group_entries { my ( $self, $group, $data ) = @_; seek $self->{'fh'}, 0, 0 or croak "can't seek at the beginning of the temporary DLF file: $!\n"; my $dlf_fh = $self->{'fh'}; my $rx = qr/^$data /; while (<$dlf_fh>) { # Only keep the records matching the group id next unless /$rx/; chomp; my ( $id, @fields) = split / /, $_; # Check for end of group data marker last if $fields[0] eq 'LIRE_RECORDS_GROUP_DATA_END'; my $row = {}; foreach ( my $i=0; $i < @{$self->{'fields'}}; $i++ ) { $row->{ $self->{'fields'}[$i] } = $fields[$i]; } $self->create_entry( $group, $row ); } } # keep perl happy 1; __END__ =head1 SEE ALSO Lire::ReportSpec(3pm), Lire::Aggregate(3pm), Lire::ReportOperator(3pm), Lire::Group(3pm), Lire::Timegroup(3pm), Lire::Timeslot(3pm), Lire::Rangegroup(3pm) =head1 AUTHORS Francis J. Lacoste Wolfgang Sourdeau =head1 VERSION $Id: Records.pm,v 1.24 2006/07/23 13:16:29 vanbaal Exp $ =head1 COPYRIGHT Copyright (C) 2001-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