DBIx::Knowledge::Report - Handler routines to serve report builder form and report execution

 use DBIx::Knowledge::Report;
 use CGI::CRUD::SkipperOutput;

 # Example implementation in mod_perl
 $crud = new CGI::CRUD::SkipperOutput($r) or return OK;
 $report = new DBIx::Knowledge::Report($crud,'PROCESS_LOAD_LOG') or return OK;
 $report->select_list_from_table() or return OK;
 return $report->take_action();

#
# $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 aggregation
##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 = {
    FIELD_NAME => 'AUX_INFO_FIELD',
    INPUT_CONTROL_TYPE => 'SELECT',
    SEARCH_CONTROL_TYPE => 'SELECT',
    SEARCH_MULT_SELECT => 4,
    HEADING => 'Auxiliary info fields',
    DATATYPE => 'CHAR',
    REQUIRED => 'N',
    INSERTABLE => 'Y',
    SEARCHABLE => 'Y',
    HELP_SUMMARY => <<EOH,
For advanced use only.
EOH
};

my $head_repeat_field = {
    FIELD_NAME => 'HEADER_REPEAT',
    INPUT_CONTROL_TYPE => 'RADIO',
    SEARCH_CONTROL_TYPE => 'RADIO',
    HEADING => 'Repeat header on subtotals',
    DATATYPE => 'CHAR',
    DEFAULT_VALUE => '0',
    REQUIRED => 'N',
    INSERTABLE => 'Y',
    SEARCHABLE => 'Y',
    HELP_SUMMARY => <<EOH,
Repeat field headers for
every subtotal row?
EOH
};

my $head_repeat_picklist = [
    { ID => 0, MASK => 'No', },
    { ID => 1, MASK => 'Yes', },
];

my $orderby_field = {
    FIELD_NAME => 'ORDER_FIELD',
    INPUT_CONTROL_TYPE => 'TEXT',
    SEARCH_CONTROL_TYPE => 'TEXT',
    SEARCH_MULT_SELECT => 4,
    HEADING => 'Order by',
    DATATYPE => 'CHAR',
    REQUIRED => 'N',
    INSERTABLE => 'Y',
    SEARCHABLE => 'Y',
    INPUT_SIZE => 50,
    INPUT_MAXLENGTH => 200,
    HELP_SUMMARY => <<EOH,
For each data point selected above,
there is an abbreviation of the field in
parenthesis. Use those abbreviations
here separated by commas to
override the default ordering of
this report. The word "desc"
may be appended to each abbreviation
to specify order polarity.
EOH
};

my $limit_field = {
    FIELD_NAME => 'RESULT_LIMIT',
    INPUT_CONTROL_TYPE => 'TEXT',
    SEARCH_CONTROL_TYPE => 'TEXT',
    HEADING => 'Limit result set',
    DATATYPE => 'INT UNSIGNED',
    REQUIRED => 'N',
    INSERTABLE => 'Y',
    SEARCHABLE => 'Y',
    INPUT_SIZE => 6,
    INPUT_MAXLENGTH => 10,
    HELP_SUMMARY => <<EOH,
Limit the result set to this number
of rows.
EOH
};

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)' });
}

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)
    {
        my ($k,$v);
        my %select_attrs;
        while (($k,$v) = each(%$rec))
        {
            if ($k eq 'GROUP_BY_SQL' || $k eq 'HTML_CLASS')
            {
                eval("\$select_attrs{lc(\$k)} = [ $v ];") if length($v);
                if ($@)
                {
                    $self->{output}->perror("parse error for value found in $report_table_name.$k [$v]");
                    return 0;
                }
            }
            elsif ($k eq 'FIELD_NAME')
            {
                $select_attrs{ID} = $v;
            }
            else
            {
                $select_attrs{lc($k)} = $v;
            }
        }
        push(@select_list,\%select_attrs);
    }

    create_select_list(\@select_list);

    return 1;
}

sub take_action
{
    my ($self) = @_;
    my $r = $self->{output};
    my $action = $r->param('__SDAT_TAB_ACTION.ACTION') || '';

    if ($action eq 'RR')
    {
        $self->report_results($r);
    }
    else
    {
        $self->report_defn_request($r);
    }
    return OK;
}

sub report_defn_form
{
    my ($self,$r) = @_;
    my $form = $r->form($r->dbh());
    $form->action($self->{action});
    $form->heading($self->{form_heading} || 'Custom Reports');
    $form->submit_value('Report');

    $form->add_group('SEARCHABLE',undef,'Data Points','FORMAT');
    my $select_pick;
    my $subtotal_pick;
    if (length($r->{np_uname}))
    {
        $select_pick = \@np_select_field_picklist;
        $subtotal_pick = \@np_subtotal_field_picklist;
    }
    else
    {
        $select_pick = \@select_field_picklist;
        $subtotal_pick = \@subtotal_field_picklist;
    }

    $form->add_field($title_field);

    $form->add_field($select_field,$select_pick);
    my $field = $form->field_by_name('SELECT_FIELD');
    $field->{REQUIRED} = 'Y';
    $form->add_field($subtotal_field,$subtotal_pick);

    $form->add_field($head_repeat_field,$head_repeat_picklist);
    my $q = $r->query();
    $q->{'FORMAT.HEADER_REPEAT'} = '0' unless length($q->{'FORMAT.HEADER_REPEAT'});

    $form->add_field($aux_info_field,$select_pick);
    $form->add_field($orderby_field);
    $form->add_field($limit_field);
    
    $r->graceful_add_form_group($form,'SEARCHABLE',$self->{report_table_name},'Result Criteria','CRITERIA') or return undef;

    # disallow some criteria fields for network partner report
    if (length($r->{np_uname}))
    {
        my $fields = $form->field_list();
        my @fields_s = @$fields;
        foreach my $field (@fields_s)
        {
            $form->delete_field($field->{FIELD_NAME}) unless $np_allowed_crit_fields{$field->{FIELD_NAME}};
        }
    }
    $form->reset_group();
    
    return $form;
}

sub report_defn_request
{
    my ($self,$r) = @_;
    my $form = $self->report_defn_form($r) or return undef;
    my $q = $r->query();
    $q->{'__SDAT_TAB_ACTION.ACTION'} = 'RR';
    $r->output($form->prepare($q),($ENV{SMARTCRUDDY_FAST_TEMPLATE_MAIN} || 'smartcruddy.tpl'));
}

sub report_results
{
    my ($self,$r) = @_;
    
    # keep in mind this is NOT normalized or unescaped until later
    my $q = $r->query();

    $r->{tpl_vars}{REPORT_TITLE} = $q->{'FORMAT.REPORT_TITLE'} || 'Custom Report';
##at should use $r->{apache}->request_time()
    $r->{tpl_vars}{REPORT_DATE} = POSIX::strftime('%c',localtime());

    my $form = $self->report_defn_form($r) || return undef;
    unless ($form->validate_query($q))
    {
        $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
    
    $r->{tpl_vars}{CSS_MAIN} = '/smartcruddy.css';
    $r->output($html,($ENV{SMARTCRUDDY_FAST_TEMPLATE_MAIN} || 'smartcruddy.tpl'));
}

# AUX_INFO_FIELD columns are not displayed in the report body but are
# shown in the summary rows.  We will mark all AUX_INFO_FIELDS here in
# this sub and the DBIx::Knowledge module will then act appropriately.
# Arguments are a reference to an array of query select fields and a
# reference to an array of the aux info field names.
sub mark_aux_fields
{
    my ($select_fields, $aux_fields) = @_;

    # clear aux_info flags. they could have been cached previously by mod_perl
    for my $se (@$select_fields) {
        $se->{aux_info} = 0;
    }

    # mark aux_info flags
    for my $aux (@$aux_fields) {
        for my $sel (@$select_fields) {
            if ($aux eq $sel->{ID}) {
                $sel->{aux_info} = 1;
            }
        }    
    }
}

1;

__END__