File Coverage

blib/lib/Business/ReportWriter.pm

Criterion	Covered	Total	%
statement	10	169	5.9
branch	0	40	0.0
condition	0	31	0.0
subroutine	3	36	8.3
pod	2	34	5.8
total	15	310	4.8

package Business::ReportWriter;

use strict;
use POSIX qw(setlocale LC_NUMERIC);

sub new {
    my ( $class, %parms ) = @_;

    my $self = {};
    $self = bless $self, $class;

    return $self;
}

sub process_report {
    my ( $self, $outfile, $report, $head, $list ) = @_;

    my %report = %$report;
    my @list   = @$list;
    push @list, {} if $#list < 1;

# Setting up the report hash with user's configuration
    $self->init_report( $report{report} );
    $self->init_page_header( $report{page}{header} );
    $self->init_body( $report{body} );
    $self->init_graphics( $report{graphics} );
    $self->init_logos( $report{page}{logo} );
    $self->init_breaks( $report{breaks} );
    $self->init_fields( $report{fields} );
    $self->print_list( \@list, \%$head );

    return $outfile ? $self->print_doc($outfile) : $self->get_doc;
}

sub init_report {
    my ( $self, $parms ) = @_;

    $self->{report} = $parms;
}

sub init_page_header {
    my ( $self, $parms ) = @_;
    $self->{report}{page} = $parms;
}

sub init_body {
    my ( $self, $parms ) = @_;

    $self->{report}{body} = $parms;
}

sub init_graphics {
    my ( $self, $parms ) = @_;

    $self->{report}{graphics} = $parms;
}

sub init_logos {
    my ( $self, $parms ) = @_;

    $self->{report}{logo} = $parms;
}

sub init_fields {
    my ( $self, $parms ) = @_;

    $self->{report}{fields} = $parms;
}

sub init_breaks {
    my ( $self, $parms ) = @_;

    $self->{report}{breaks} = $parms;
    my @breakorder;
    for ( keys %$parms ) {
        $breakorder[ $parms->{$_}{order} ] = $_;
    }
    $self->{report}{breaks}{_order} = [@breakorder];
}

# Report writing
sub begin_break {
}

sub begin_line {
}

sub begin_field {
}

sub make_field_headers {
    my ( $self, $fh ) = @_;

    if ( $fh->{show} ne 'off' ) {
        for ( @{ $self->{report}{fields} } ) {
            $self->out_field( $_->{text}, $_, $fh );
        }
    }
}

sub out_field {
}

sub break_fields {
    my ( $self, $break_name, $tot ) = @_;

    my $name = $tot->{name};
    my $rec  = $self->{totals}{$break_name};

    $self->process_field( $tot, $rec );
    $self->{totals}{$break_name}{$name} = 0;
}

sub process_break {
    my ( $self, $break_name ) = @_;

    my $p = $self->{pdf};

    my $break = $self->{report}{breaks}{$break_name};
    $self->begin_line($break);

    if ( defined( $break->{total} ) ) {
        foreach my $tot ( @{ $break->{total} } ) {
            $self->break_fields( $break_name, $tot );
        }
    }
}

sub print_break_header {
    my ( $self, $rec, $break_name ) = @_;

    my $p     = $self->{pdf};
    my $break = $self->{report}{breaks}{$break_name};

    $self->begin_break( $rec, $break );
    $self->begin_line( $rec, $break->{header} );
    for my $bh ( @{ $break->{header}{text} } ) {
        $self->process_field( $bh, $rec );
    }

    $self->begin_line( $rec, $break->{header}{FieldHeaders} );
    $self->make_field_headers( $break->{header}{FieldHeaders} );
}

sub print_break {
    my $self = shift;

    for my $break_name ( @{ $self->{report}{breaks}{_order} } ) {
        my $self_break = $self->{breaks}{$break_name} || '';
        if ( $self_break eq '_break' ) {
            $self->process_break($break_name);
        }
    }
}

sub process_field {
    my ( $self, $fld, $rec ) = @_;

    return
        if ( defined( $fld->{depends} )
        && !eval( $self->make_text( $rec, $fld->{depends} ) ) );
    my $text =
        defined( $fld->{function} )
        ? $self->make_func( $rec, $fld->{function} )
        : $self->make_text( $rec, $fld->{text} );
    $self->out_field( $text, $fld ) if $text;
}

sub make_fieldtext {
    my ( $self, $rec, $text ) = @_;

    my @fields = ( $text =~ /(\w*)/g );
    for my $field (@fields) {
        $text =~ s/$field/$rec->{$field}/eg;
    }

    return $text;
}

sub process_linefield {
    my ( $self, $fld, $rec ) = @_;

    return
        if ( defined( $fld->{depends} )
        && !eval( $self->make_text( $rec, $fld->{depends} ) ) );

    $self->begin_field($fld);
    my $text =
        defined( $fld->{function} )
        ? $self->make_func( $rec, $fld->{function} )
        : $self->make_fieldtext( $rec, $fld->{name} );
    $self->out_field( $text, $fld ) if $text;
}

sub out_textarray {
    my ( $self, $fld, $rec ) = @_;

    for ( @{ $rec->{ $fld->{name} } } ) {
        $self->begin_field($fld);
        $self->out_field( $_, $fld ) if $_;
    }
}

sub print_line {
    my ( $self, $rec ) = @_;

    $self->begin_line($rec);
    for ( @{ $self->{report}{fields} } ) {
        $self->out_textarray( $_, $rec ), next
            if lc( $_->{fieldtype} ) eq 'textarray';
        $self->process_linefield( $_, $rec );
    }
}

sub sum_totals {
    my ($self, $rec) = @_;

    for my $break ( @{ $self->{report}{breaks}{_order} } ) {
        if ( defined( $self->{report}{breaks}{$break}{total} ) ) {
            foreach my $tot ( @{ $self->{report}{breaks}{$break}{total} } ) {
                my $name = $tot->{name};
                $self->{totals}{$break}{$name} += $rec->{$name};
            }
        }
    }
}

sub check_for_break {
    my ($self, $rec, $last) = @_;

    my $brk = '';
    for my $break ( reverse @{ $self->{report}{breaks}{_order} } ) {
        my $self_break = $self->{breaks}{$break} || '';
        my $rec_break  = $rec->{$break}          || '';
        if ( ( $last && !( $break eq '_page' ) )
            || $self_break ne $rec_break )
        {
            $brk = '_break';
        }
        $self->{breaks}{$break} = $brk if $brk;
    }
}

sub save_breaks {
    my $self = shift;

    my ( $rec, $first ) = @_;
    for my $break ( reverse @{ $self->{report}{breaks}{_order} } ) {
        my $self_break = $self->{breaks}{$break} || '';
        my $rec_break  = $rec->{$break}          || '';
        $self->print_break_header( $rec, $break )
            if ( $first and $break ne '_total' and $break ne '_page' )
            || $self_break ne $rec_break;
        $self->{breaks}{$break} = $rec->{$break};
    }
}

sub process_totals {
    my ($self, $rec) = @_;

    my $first = ( !defined( $self->{started} ) );
    $self->{started} = 1;
    my $last = ( ref $rec ne 'HASH' );
    $self->print_totals($rec) if !$first;
    $self->save_breaks( $rec, $first ) if !$last;
    $self->sum_totals($rec) if !$last;
}

sub begin_list {
}

sub check_page {
}

sub print_list {
    my ( $self, $list, $page ) = @_;

    my @list = @$list;
    $self->{pageData} = $page;

    $self->begin_list;

    foreach my $rec (@list) {
        $self->check_page;
        $self->process_totals($rec);
        $self->print_line($rec);
    }
    $self->end_print();
}

sub print_totals {
    my ( $self, $rec ) = @_;

    my $last = ( ref $rec ne 'HASH' );
    $self->check_for_break( $rec, $last );
    $self->print_break();
}

sub end_print {
    my $self = shift;

    $self->process_totals();
}

# Support

sub make_text {
    my ( $self, $rec, $text ) = @_;

    my @fields = ( $text =~ /\$(\w*)/g );
    for my $field (@fields) {
        $text =~ s/\$$field/$rec->{$field}/eg;
    }
    return $text;
}

sub make_func {
    my ( $self, $rec, $func ) = @_;

    my @fields = ( $func =~ /\$(\w*)/g );
    for my $field (@fields) {
        $func =~ s/\$$field/\$rec->{$field}/g;
    }

    my $text;
    setlocale( LC_NUMERIC, $self->{report}{locale} );
    eval( '$text = ' . $func );
    setlocale( LC_NUMERIC, "C" );
    return $text;
}

1;
__END__