File Coverage

blib/lib/Report/Porf/Framework.pm

Criterion	Covered	Total	%
statement	143	160	89.3
branch	40	66	60.6
condition	10	17	58.8
subroutine	35	37	94.5
pod	1	23	4.3
total	229	303	75.5

# Perl
#
# Class Report::Porf::Framework
#
# Perl Open Report Framework (Porf)
#
# Framework to create/configure Reports for any output format.
#
# Ralf Peine, Tue May 27 11:30:17 2014
#
# More documentation at the end of file
#------------------------------------------------------------------------------

$VERSION = "2.001";

#------------------------------------------------------------------------------
#
# Example list with 10 lines (html)
#
#
#  




22




 





 





 





 





 





 



 #                                          




23




 





 





 





 





 





 



 #  




24




 





 





 





 





 





 



 # CounTimeStamp Age    Prename    Surname  




25




 





 





 





 





 





 



 #  




26




 





 





 





 





 





 



 #                                          




27




 





 





 





 





 





 



 # 1   0.000433  10     Vorname 1  Name 1   




28




 





 





 





 





 





 



 # 2   0.000638  20     Vorname 2  Name 2   




29




 





 





 





 





 





 



 # 3   0.000781  30     Vorname 3  Name 3   




30




 





 





 





 





 





 



 # 4   0.000922  40     Vorname 4  Name 4   




31




 





 





 





 





 





 



 # 5   0.001062  50     Vorname 5  Name 5   




32




 





 





 





 





 





 



 # 6   0.001203  60     Vorname 6  Name 6   




33




 





 





 





 





 





 



 # 7   0.001346  70     Vorname 7  Name 7   




34




 





 





 





 





 





 



 # 8   0.001486  80     Vorname 8  Name 8   




35




 





 





 





 





 





 



 # 9   0.001631  90     Vorname 9  Name 9   




36




 





 





 





 





 





 



 # 10  0.001773  100    Vorname 10 Name 10  




37




 





 





 





 





 





 



 #                                          




38




 





 





 





 





 





 



 #
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
# # Time needed for export of 10 data lines: 0.002013
#
#
#

use strict;
use warnings;

#--------------------------------------------------------------------------------
#
#  Report::Porf::Framework
#
#--------------------------------------------------------------------------------

package Report::Porf::Framework;

use Carp;
use Data::Dumper;

use Report::Porf::Table::Simple;
use Report::Porf::Table::Simple::AutoColumnConfigurator;

# only for default creation
use Report::Porf::Table::Simple::HtmlReportConfigurator;
use Report::Porf::Table::Simple::TextReportConfigurator;
use Report::Porf::Table::Simple::CsvReportConfigurator;

our %store; # of named frameworks

our $DefaultFramework = '';

#--------------------------------------------------------------------------------
#
#  Creation / Filling Of Instances
#
#--------------------------------------------------------------------------------

# --- new Instance, Do NOT call direct!!! -----------------
sub _new
{
    my $caller = $_[0];
    my $class  = ref($caller) || $caller;

    # let the class go
    my $self = {};
    bless $self, $class;

    $self->{Configurators} = {};

    return $self;
}

# --- CreateInstance --------------------------------------
sub create {
	my %options = @_ if scalar @_;

	my $framework = Report::Porf::Framework->_new();
	$framework->use_default_configurator_creators();

	$framework->set_name($options{-name}) if $options{-name};
	$framework->set_description($options{-description}) if $options{-description};
	$framework->set_default_format('text');
	$framework->set_max_rows(10);

	foreach my $key (sort(keys(%options))) {
	    if ($key =~ /^\-create(\w+)ConfiguratorAction$/) {
			my $format = $1;
			$framework->set_configurator_action($format => $options{$key});
	    }
	}

	$framework->store();

	return $framework;
}

# --- Activate the default configurators for every known output format -------------
sub use_default_configurator_creators {
	my ($self,					# instance_ref
	) = @_;

	$self->set_configurator_action(HTML => sub {
		my $configurator = Report::Porf::Table::Simple::HtmlReportConfigurator->new();
		$configurator->set_alternate_row_colors('#DDDDDD', '#FFFFFF');
		return $configurator;
	});
	$self->set_configurator_action
	    (Text => sub { return Report::Porf::Table::Simple::TextReportConfigurator->new();});
	$self->set_configurator_action
	    (CSV => sub { return Report::Porf::Table::Simple::CsvReportConfigurator->new();});

	$self->set_auto_configurator_action(
		sub {return Report::Porf::Table::Simple::AutoColumnConfigurator->new();});
}

#--------------------------------------------------------------------------------
#
#  Attributes
#
#--------------------------------------------------------------------------------

# --- Name ----------------------------------------------------------------------------

sub set_name {
	my ($self,					# instance_ref
		$value					# value to set
	) = @_;

	if ($self->{Name}) {
		if ($self->{Name} ne $value) {
			die "Name of framework cannot be changed!";
		}
	}
	$self->{Name} = $value;
}

sub get_name {
	my ($self,					# instance_ref
	) = @_;

	return $self->{Name};
}

# --- Description ----------------------------------------------------------------------------

sub set_description {
	my ($self,					# instance_ref
		$value					# value to set
	) = @_;

	$self->{Description} = $value;
}

sub get_description {
	my ($self,					# instance_ref
	) = @_;

	return $self->{Description};
}

# --- Default Format ----------------------------------------------------------------------------

sub set_default_format {
	my ($self,					# instance_ref
		$value					# value to set
	) = @_;

	$self->{DefaultFormat} = $value;
}

sub get_default_format {
	my ($self,					# instance_ref
	) = @_;

	return $self->{DefaultFormat};
}

# --- MaxRows ----------------------------------------------------------------------------

sub set_max_rows {
	my ($self,					# instance_ref
		$value					# value to set
	) = @_;

	$self->{MaxRows} = $value;
}

sub get_max_rows {
	my ($self,					# instance_ref
	) = @_;

	return $self->{MaxRows};
}

# --- Configurator ---------------------------------------------------------------

sub set_configurator_action {
	my ($self,					# instance_ref
		$format,				# (html/text/csv)
		$action					# value to set
	) = @_;

	die "Format not set" unless $format;
	die "No action given" unless ref ($action) eq 'CODE';

	$self->{Configurators}->{lc($format)} = $action;
}

sub get_configurator_action {
	my ($self,					# instance_ref
		$format,				# (html/text/csv)
	) = @_;

	die "Format not set" unless $format;

	return $self->{Configurators}->{lc($format)};
}

# --- AutoConfigurator ---------------------------------------------------------------

sub set_auto_configurator_action {
	my ($self,					# instance_ref
		$action					# value to set
	) = @_;

	die "No action given" unless ref ($action) eq 'CODE';

	$self->{AutoConfigurator} = $action;
}

sub get_auto_configurator_action {
	my ($self,					# instance_ref
	) = @_;

	return $self->{AutoConfigurator};
}

#--------------------------------------------------------------------------------
#
#  Methods
#
#--------------------------------------------------------------------------------

# --- get framework --- Creates default, if not existing ------------------------
sub get {
	my ($name					# Optional: name of framework
	) = @_;

	my $framework;

	$name = $DefaultFramework unless $name;

	unless ($name) {
		$name = '-default';
		$framework = $store{$name};
		$framework = create(
			-name        => $name,
			-description => 'Automatic created default framework')
			->store()
				unless $framework;
	}

	$framework = $store{$name};

	confess "No report framework with name '$name' stored"
		unless $framework;

	return $framework;
}

# --- store Framework in internal %store ------------------------------------------

sub store {
	my ($self,					# instance_ref
	) = @_;

	my $name = $self->get_name();

	confess "cannot store unnamed framework" unless $name;

	$store{$name} = $self;
}

# --- Define the default framework to use --------------------------------------------------
sub set_default_framework {
	my ($name,					# instance_ref
	) = @_;

	get($name);					# dies if not existing
	my $old = $DefaultFramework;
	$DefaultFramework = $name;

	return $old;
}

# --- create Report Configurator --------------------------------------------------

sub create_report_configurator {
	my ($self,					# instance_ref
		$format					# format of report
	) = @_;

	my $action = $self->get_configurator_action(lc($format));

	die "don't know how to configure report for format '$format'"
	    unless $action;

	return $action->();
}

# --- create Report ---------------------------------------------------------------

sub create_report {
	my ($self,					# instance_ref
		$format					# format of report
	) = @_;

	$format = $self->set_default_format('text') unless $format;

	my $report_configurator = $self->create_report_configurator($format);
	return $report_configurator->create_and_configure_report();
}

# --- extract format out of file name, if $file is an file name ---------------
sub extract_format_of_filename {
	my ($self,					# instance_ref
		$file_name				# format of report
	) = @_;

	my $format = '';

	if ($file_name && ref($file_name) eq '') {
		return 'Text' if $file_name =~ /\.(txt|text)$/io;
		return 'Html' if $file_name =~ /\.(htm|html)$/io;
		return 'Csv'  if $file_name =~ /\.csv$/io;
	}

	return '';
}


# --- create auto report configuration -----------------------------------------------------------------
sub create_auto_report_configuration {
    my $report_framework = Report::Porf::Framework::get();
    my $configurator     = $report_framework->get_auto_configurator_action()->();

	return $configurator->create_report_configuration(@_);
}

# --- create auto report configuration -----------------------------------------------------------------
sub report_configuration_as_string {
    my $report_framework = Report::Porf::Framework::get();
    my $configurator     = $report_framework->get_auto_configurator_action()->();

	return $configurator->report_configuration_as_string(@_);
}


# --- auto report -----------------------------------------------------------------
sub auto_report {
    my ($list_ref,				# what to print out
		@all_args				# named args
	) = @_;

    return 0 unless defined $list_ref;

	unless (ref($list_ref) eq 'ARRAY') {
		my $type = ref($list_ref) || "no reference";
		die "auto_report() needs ref to array as first arg but is $type";
	}

    return 0 unless scalar @$list_ref;

    my $report_framework = Report::Porf::Framework::get();
    my $configurator     = $report_framework->get_auto_configurator_action()->();

	my %args = ();
	my $file_item = '';
	my $format    = '';

	if (scalar @all_args == 1) {
		$file_item = $all_args[0];
	}
	else {
		%args = @all_args;
		$file_item = $args{-file} if $args{-file};
	}

    my $max_rows = '';
    $max_rows = $args{-max_rows} if defined $args{-max_rows};
	$max_rows = '' unless defined $max_rows;

	if (defined $args{-format}) {
		$format = $args{-format};
	}
	else {
		$format = $report_framework->extract_format_of_filename($file_item);
	}

	$format = $report_framework->get_default_format() unless $format;

    my $report = $configurator->create_report($list_ref, $report_framework, $format);

    # only max rows without file item set (print not too many rows to stdout)
    if (!$file_item || $max_rows) {
		$max_rows = $report_framework->get_max_rows() if $max_rows eq '' && !$file_item;
		if ($max_rows > 0 && scalar @$list_ref > $max_rows) {
			$max_rows--;
			my @rows = @{$list_ref}[0..$max_rows];
			$list_ref = \@rows;
		}
    }

    $report->write_all($list_ref, $file_item);

	return scalar @$list_ref; # rows printed out
}

1;

__END__