DBIx-Knowledge

 view release on metacpan or  search on metacpan

lib/DBIx/Knowledge/Report.pm  view on Meta::CPAN

#
# $Id: Report.pm,v 1.12 2006/04/17 00:19:04 dennisl Exp $
#


package DBIx::Knowledge::Report;

use vars qw(%allowed_crit_fields %np_allowed_crit_fields);

use strict;
use CGI::AutoForm;
use DBIx::IO::Search;
use DBIx::IO::GenLib ();
use POSIX ();
use DBIx::Knowledge;
use DBIx::Knowledge::Output;
use CGI::CRUD::TableIO;

use constant OK => 0;

$DBIx::Knowledge::Report::REPORT_SELECT_LIST_TABLE_NAME = 'dbix_knowledge_data_point';

my $potential_select_fields;
##at anyway to make this readonly?
my %potential_select_fields_by_id;
##at anyway to make this readonly?
my %potential_select_fields_by_order_legend;

my $title_field = {
    FIELD_NAME => 'REPORT_TITLE',
    INPUT_CONTROL_TYPE => 'TEXT',
    SEARCH_CONTROL_TYPE => 'TEXT',
    HEADING => 'Report title',
    DATATYPE => 'CHAR',
    REQUIRED => 'N',
    INSERTABLE => 'Y',
    SEARCHABLE => 'Y',
    HELP_SUMMARY => 'Title of this report',
};

# I've been working on some Business Intelligence libraries for data sets that exhibit Linear Convergence and was able to acheive such a convergence temporally (over an axis of time) for much of the data in OP with the help of some key data aggregati...
##at should use NULLIF(poa.preopt_priority,0), NULLIF(poa.opt_priority_override,0), NULLIF(o.opt_priority_override,0), etc...
my $select_field = {
    FIELD_NAME => 'SELECT_FIELD',
    INPUT_CONTROL_TYPE => 'SELECT',
    SEARCH_CONTROL_TYPE => 'SELECT',
    SEARCH_MULT_SELECT => 7,
    HEADING => 'Report on',
    DATATYPE => 'CHAR',
    REQUIRED => 'Y',
    INSERTABLE => 'Y',
    SEARCHABLE => 'Y',
    HELP_SUMMARY => <<EOH,
Choose the data points to include
in this report.
EOH
};

##at anyway to make this readonly?
my @select_field_picklist = ();
##at anyway to make this readonly?
my @np_select_field_picklist = ();

my $subtotal_field = {
    FIELD_NAME => 'SUBTOTAL_FIELD',
    INPUT_CONTROL_TYPE => 'SELECT',
    SEARCH_CONTROL_TYPE => 'SELECT',
    SEARCH_MULT_SELECT => 4,
    HEADING => 'Summary totals on',
    DATATYPE => 'CHAR',
    REQUIRED => 'N',
    INSERTABLE => 'Y',
    SEARCHABLE => 'Y',
    HELP_SUMMARY => <<EOH,
Choose which data points will have
subtotal summary lines. Must be a
subset of the fields selected above.
EOH
};

##at anyway to make this readonly?
my @subtotal_field_picklist;

##at anyway to make this readonly?
my @np_subtotal_field_picklist = ();

my $aux_info_field = {

lib/DBIx/Knowledge/Report.pm  view on Meta::CPAN

=item C<new> (constructor)

 $report = new DBIx::Knowledge::Report($crud_output, $report_table_name[, $data_points, $cache_list]);

Create a $report object where $crud_output is a L<CGI::CRUD> output object and $report_table_name
is the name of the table or view to be reported upon.
An optional array reference $data_points may be given as described in L<Data point definitions>,
otherwise you must invoke C<select_list_from_table()>.
Optional boolean $cache_list will cache the data point list.

Upon error, C<server_error()> will be called on $crud_output and undef will be returned.

=cut

sub new
{
    my $caller = shift;

    my ($output,$report_table_name,$potential_select_fields_in,$cache_list) = @_;

    my $self = {
        report_table_name => $report_table_name,
        output => $output,
    };

    create_select_list($potential_select_fields_in,$cache_list) if defined($potential_select_fields_in);

    my $class = ref($caller) || $caller;
    bless($self,$class);

    my $sqlclass = $self->_pull_driver($output->dbh());
    ($output->server_error(),return undef) unless defined($sqlclass);

    $self->{sql_gen} = $sqlclass->new();
    
    return $self;
}

sub _pull_driver
{
    my ($caller,$dbh) = @_;

    return $caller->{sqlclass} if ref($caller) && defined($caller->{sqlclass});

    # SQL classes must be named after the DBI driver name
    my $sqlclass = "DBIx::Knowledge::$dbh->{Driver}{Name}SQL";
    eval qq(require $sqlclass) || (warn("Database driver not supported"),return undef);

    $caller->{sqlclass} = $sqlclass if ref($caller);
    return $sqlclass;
}

sub create_select_list
{
    my ($potential_select_fields_in,$cache_list) = @_;
    return 1 if $cache_list && $potential_select_fields;

    $potential_select_fields = $potential_select_fields_in;

    %potential_select_fields_by_id = ();
    %potential_select_fields_by_order_legend = ();
    @select_field_picklist = ();
    @np_select_field_picklist = ();
    @subtotal_field_picklist = ();
    @np_subtotal_field_picklist = ();

    map { $potential_select_fields_by_id{$_->{ID}} = $_ } @$potential_select_fields;

    map { $potential_select_fields_by_order_legend{$_->{order_legend}} = $_ } @$potential_select_fields;
    @select_field_picklist = map({ ID => $_->{ID}, MASK => "$_->{header} ($_->{order_legend})" },@$potential_select_fields);
    map { push(@np_select_field_picklist,{ ID => $_->{ID}, MASK => ($_->{np_header} ? $_->{np_header} : $_->{header}) . ' ($_->{order_legend})' }) if $_->{np_allow} } @$potential_select_fields;
    map { push(@subtotal_field_picklist,
                {
                    ID => $_->{ID},
                    MASK => "$_->{header} ($_->{order_legend})"
                }
               )
            unless $_->{group_by_expr}
        }
        reverse @$potential_select_fields;
    push(@subtotal_field_picklist,{ ID => $DBIx::Knowledge::REPORT_TOTAL_KEY, MASK => 'Report grand total (GRANDTOT)' });
    map { push(@np_subtotal_field_picklist,
                {
                    ID => $_->{ID},
                    MASK => "$_->{header} ($_->{order_legend})"
                }
               )
            if $_->{np_allow} && !$_->{group_by_expr}
        }
        reverse @$potential_select_fields;
    push(@np_subtotal_field_picklist,{ ID => $DBIx::Knowledge::REPORT_TOTAL_KEY, MASK => 'Report grand total (GRANDTOT)' });
}

=pod

=item C<select_list_from_table>

 $bool = $report->select_list_from_table([$report_table_name, $cache_list, $dbh, $select_field_table_name]);

Retrieve the list of data points for report building from a database table.
Optional $report_table_name overrides the same parameter given to the constructor only for the purpose of identifying the group of datapoints by matching the C<TABLE_NAME>
column in the data points table. 
Boolean $cache_list will cache the data point list, $dbh is an appropriate DBI database handle.
The table that stores the data points may be given by
$select_field_table_name table, which defaults to $DBIx::Knowledge::Report::REPORT_SELECT_LIST_TABLE_NAME.

Upon error, C<server_error()> or C<perror> will be called on $crud_output and false will be returned, otherwise return true.

=cut

sub select_list_from_table
{
    my ($self,$report_table_name,$cache_list,$dbh,$select_field_table_name) = @_;
    return 1 if $cache_list && $potential_select_fields;

    my @select_list;

    $dbh ||= $self->{output}->dbh();
    $report_table_name ||= $self->{report_table_name};
    $select_field_table_name ||= $DBIx::Knowledge::Report::REPORT_SELECT_LIST_TABLE_NAME;

    my $searcher = new DBIx::IO::Search($dbh,$select_field_table_name);
    my $recs;
    if (ref($searcher))
    {
        $searcher->build_scalar_crit('TABLE_NAME','=',$report_table_name);
        $recs = $searcher->search(undef,[ 'APPEAR_ORDER' ]) || return undef;
    }
    elsif (!defined($searcher))
    {
        $self->{output}->server_error();
        return undef;
    }
    elsif (!$searcher)
    {
        warn("$report_table_name does not seem to exist so no select list could be found");
        return 1;
    }
    else
    {
        die("A horrible death");
    }

    foreach my $rec (@$recs)
    {

lib/DBIx/Knowledge/Report.pm  view on Meta::CPAN

        $r->output($form->prepare($q),($ENV{SMARTCRUDDY_FAST_TEMPLATE_MAIN} || 'smartcruddy.tpl'));
        return OK;
    }

    $q = $form->format_query($r->query());

    my $tq = $r->query();
    $r->{tpl_vars}{FULL_SAVED_QUERY} = CGI::CRUD::TableIO::stringify_query($tq);
    $tq = { %$tq };
    delete($tq->{'__SDAT_TAB_ACTION.ACTION'});
    $r->{tpl_vars}{CUSTOM_SAVED_QUERY} = CGI::CRUD::TableIO::stringify_query($tq);

    my $select_fields_q = $q->{FORMAT}{SELECT_FIELD};
    $select_fields_q = [ $select_fields_q ] unless ref($select_fields_q);
    my %select_fields_q;
    @select_fields_q{ @$select_fields_q } = (1) x @$select_fields_q;
    my @select_fields = ();

    if (length($r->{np_uname})) 
    {
        foreach my $item (@np_select_field_picklist) 
        {
            if ($select_fields_q{$item->{ID}}) 
            {
                my %f = %{$potential_select_fields_by_id{$item->{ID}}}; 
                # overwrite header with np_header for np report
                $f{header} = $f{np_header} if ($f{np_header}); 
                push(@select_fields, \%f);
            }
        }
    }
    else 
    {
        map { push(@select_fields,$potential_select_fields_by_id{$_->{ID}}) if $select_fields_q{$_->{ID}} } @select_field_picklist;
    }

    my $subtotal_fields_q = $q->{FORMAT}{SUBTOTAL_FIELD};
    my @subtotal_fields = ();
    if ($subtotal_fields_q)
    {
        $subtotal_fields_q = [ $subtotal_fields_q ] unless ref($subtotal_fields_q);
        my %subtotal_fields_q;
        @subtotal_fields_q{ @$subtotal_fields_q } = (1) x @$subtotal_fields_q;
        map { ($r->perror("'Summary totals on' fields must be a subset of the 'Report on' fields [$_ is not], please try again"),return undef)
            unless exists($select_fields_q{$_}) || $_ eq $DBIx::Knowledge::REPORT_TOTAL_KEY } @$subtotal_fields_q;
        map { push(@subtotal_fields,$_->{ID}) if $subtotal_fields_q{$_->{ID}} } @subtotal_field_picklist;
##at on freeform field, please mind the LEGEND key 'GRANDTOT'
    }

##at by default, results will be sorted in the same order as the order of the select list
    my $orderby_q = $q->{FORMAT}{ORDER_FIELD};
    my @order_fields = ();
    if (length($orderby_q))
    {
        foreach my $order_term (split(/\s*,\s*/,$orderby_q))
        {
            my $desc_needed = $order_term =~ s/\s+desc//i;
            $order_term = uc($order_term);
##at should be done in validate_query()
            ($r->perror("Invalid term entered in 'Order by' sequence [$order_term], please go back and correct"),return undef)
                unless exists($potential_select_fields_by_order_legend{$order_term});
            my $term_id = $potential_select_fields_by_order_legend{$order_term};
            ($r->perror("'Ordered by' fields must be a subset of the 'Report on' fields [$order_term is not], please try again"),return undef)
                unless exists($select_fields_q{$term_id->{ID}});
            my %order_field = ( %{$term_id} );
            $order_field{descending_order} = $desc_needed;
            push(@order_fields,\%order_field) unless length($r->{np_uname}) && !$term_id->{np_allow};
        }
    }

    my $result_limit = $q->{FORMAT}{RESULT_LIMIT};

    my $where_sql = '';
    if ($q->{CRITERIA})
    {
        my $crit = $q->{CRITERIA};
        my @keys = keys(%$crit);
        foreach my $key (@keys)
        {
            delete($crit->{$key}) if length($r->{np_uname}) && !$np_allowed_crit_fields{$key};
        }
        $crit->{NP_USERNAME} = $r->{np_uname} if length($r->{np_uname});
        my $where = new CGI::CRUD::TableIO($r->dbh());
        $where_sql = $where->where_sql($crit,$self->{report_table_name});
        defined($where_sql) or ($r->server_error(),return undef);
    }

    my %want_subtotal_fields = ();

    my $sql = $self->{sql_gen}->sql_rollup($self->{report_table_name},\@select_fields,$where_sql,\@subtotal_fields,\@order_fields,\%want_subtotal_fields) or
        ($r->perror("Report definition is invalid:<br>$self->{sql_gen}->{errstr}<br>Please go back and try again"),return undef);

    my $dbh = $r->dbh();
    my $report_sth = $dbh->prepare($sql) or ($r->perror("Report definition is invalid, please go back and try again"),return undef);
    $report_sth->execute() or ($r->server_error(),return undef);

    my $title = CGI::AutoForm->escape($r->{tpl_vars}{REPORT_TITLE});
    my $tdate = CGI::AutoForm->escape($r->{tpl_vars}{REPORT_DATE});
    
    my $html = <<HTML;
<H3 style="padding-bottom:0px;margin-bottom:0px;margin-top: 10px;">$title</H3>
<p style="padding-top:0px;margin-top:0px;">Report created $tdate</p>
HTML

    my $aux_info_fields = $q->{FORMAT}{AUX_INFO_FIELD};
    $aux_info_fields = [ $aux_info_fields ] unless ref $aux_info_fields;

    mark_aux_fields(\@select_fields, $aux_info_fields);

    my $out = new DBIx::Knowledge::Output($q->{FORMAT}{HEADER_REPEAT});
#OPDebugUtil::ddump(\@select_fields);
    my $outp = $out->generate_html($report_sth,\@select_fields,\%want_subtotal_fields) or ($r->server_error(),return undef);

    $html .= $$outp;
    
    $html .= <<HTML;
<p style="margin: 30px;">
<a href="$r->{action}?$r->{tpl_vars}{FULL_SAVED_QUERY}">Save report URL for later</a><br>
<a href="$r->{action}?$r->{tpl_vars}{CUSTOM_SAVED_QUERY}">Further customize this report</a>
</p>
HTML