perl/DBIx/PearlReports.pm

=pod

=head1 NAME

DBIx::PearlReports -- A Versatile Report Generator

=head1 SYNOPSIS

Using the SIMPLE mode

 use DBIx::PearlReports qw(:Simple);
 create (
    -datasource => 'dbi:Pg:dbname=database;host=hostname',
    -query => 'SELECT * FROM customers ORDER BY state, city;'
 );

or

 create (
    -datasource => 'dbi:Pg:dbname=database;host=hostname',
    -query => 'SELECT * FROM customers ORDER BY state, city WHERE name = ? AND age = ?',
    -param => ['Tobi',34],
 );

 group (
    -trigger => sub { $filed{state} },
    -head => sub { "State: $field{state}\n" },
    -foot => sub { "Average Age for $field{state}".rpavg($field{age}) }
 );

 group (
    -trigger => sub { $field{city} },
    -head => sub { "City: $field{city} (".rpcnt($field{name}.")\n" },
    -foot => sub { "Total Customers in Customers in ".
                   "$field{city}: ".rpcnt($field{name})."\n" }
 );

 body (
     -contents => sub { "$field{firstname} $field{lastname} $field{age}\n" }
 );

 print makereport;

PearlReports can also be used in an Object Oriented Context:

 #!/usr/sepp/bin/perl-5.8.0
 use lib qw( /usr/pack/postgresql-7.3.2-ds/lib/site_perl /usr/isgtc/lib/perl);
 use DBIx::PearlReports;
 $r = DBIx::PearlReports::create ( ... );
 $r->group( ... );
 $r->body( ... )
 print $r->makereport;


=head1 DESCRIPTION

B<PearlReports> is a system for pulling information from an SQL database and
produce Reports from this information. B<PearlReports> provides a very
flexible system for creating reports based on SQL queries

While it is sufficient to use the simple statements provided by
PearlReports to create your reports, the full power of perl is only a
keystroke away.

Creating a Report using the PearlReports involves writing a short perl
script which first loads the PearlReports module:

 #!/usr/bin/perl
 use DBIx::PearlReports qw(:SIMPLE);

Then you call the B<create> function to create a new report:

 create (
     -username  => 'myname',
     -datasource => 'dbi:Pg:dbname=customers',
     -query => 'SELECT * from customers ORDER by state,city'
 );

When creating a report you have to define username and password for
the database you want to access. Because different people may use the
report. If you do not mention either the B<-username> or B<-password>
arguments, the module will ask you to supply one at run time.

The B<-datasource> argument defines which
database this report is going to use. Check the DBI/DBD documentation
for the syntax apropriate for your Database. In the example above we
are accessing a PostgreSQL database called I<customers> which runs on
the local host.  The B<-query> argument of the create function defines
the data we want to use in our report.

A central element of PearlReports is the ability to work with groups of
records. In this example the report contains two nested groups. Note that
the data

must arive from the database in an order which is comatible with the
required groups. (Check the ORDER BY cause above).

 group
  ( -trigger => sub { $field{state} },
    -head => sub { "Customers from $field{state}\n" },
    -foot => sub { "Avg Age for $field{state} Customer:".
                    rpavg($field{age})."\n\n"  } );

 group
  ( -trigger => sub { $field{zip} },
    -head => sub { "Customers from $field{town}\n" },
    -foot => sub { "Min Age in $field{town}:".
                   rpmin($field{age})."\n" } );


Each group definition requires a trigger and either a header or a
footer or both. Each argument of the group definition is a little perl
function definition. The Trigger function gets called for each record
in the query. Whenever the value returned from the
function changes the group iterates. Each iteration of a group is
enclosed by the apropriate header and footer.

The B<$field{xxx}> variables refer to the columns of the query.
The footer and the header (!) can contain agregation functions
(rpmin, rpmax, rpbig, rpsmall, rpsum, rpavg). See the section below

Finally the actual data can get printed.

 body
  ( -contents => sub { "$field{firstname} $field{lastname} $field{age}\n" } );

The body function will get called for each row in the database and its
return value will be printed into the report.

When groups and body are set up you can create the actual report by
executing:

 print makereport;

When you want to make a new report using the existion database connection
for another report, you can reset it with the command

 reset;

=head2 METHODS

All functions provided by PearlReports expect named arguments.

=head3 create or new

Defines the data the report should be based on. This involves
configuring the parameters for accessing the database server as well
as defining the query string.

If you are working with the OO interface you can use b<new> instead
of create to be more in line with established naming conventions.

=over

=item -username

the username for the database. If this option is not set, PearlReports will
prompt for a username.

=item -password

the password. If this option is not supplied PearlReports will prompt for a
password.

=item -datasource

the DBI connect string. Check the DBI/DBD manpage for the syntax apropriate
for your database.

=item -handle

instead of the previous 3 arguments you can also give PearlReports an
existing database handle to use.

=item -query

A SELECT query

=item -param

If you use '?' placeholders in the query, you can supply contents for them
using the reference to an arry holding the relevant data.

=back


=head2 group

The 'salt' of most reports is that some grouping structure exists. The
records in the report get collected into groups of records which bear
some common feature. Each group can have a header and a footer.

=over

=item -trigger

Is a pointer to a anonymous function. The function gets called for
each row in the result of the query. Whenever the return value from
this function changes the group goes into its next iteration.  There
are other events which can cause a new iteration: A higher order group
goes into another iteration or the last record from the query has been
consumed.

=item -head and -foot

After each iteration, the anonymouse functions pointed to by the head
and foot options get executed. The return values from the functions
are used as header and footer for the material inside the group.

=back

=head3 body

The inner most 'group' of the report does have neither foot nor head,
it has just a body which gets printed for every row in the query result.

=over

=item -contents

Stores a pointer to an anonymous function which gets executed for each
record returned by the query.

=back

=head3 makereport

returns an array containing the report ...

=head3 reset

clears the group and body data from the report. This can be used to run a
second report of the same database connection without reconnecting.

=head2 AGGREGATE FUNCTIONS

=head3 rpsum

Builds the sum of all the values its argument takes during the
traversal of the records in the current group iteration.

=head3 rpmin, rpmax

Finds the min and max values in a group iteration.

=head3 rpsmall, rpbig

Finds the first and last value when sorting alphabetically.

=head3 rpcnt

Count the rows in the current group iteration.

=head3 rpavg

The same as above only that the average gets calculated.

=head2 HOW TO WRITE NEW AGGREGATE FUNCTIONS

If you want to write your own aggregat functions. Follow the examples
below. Note that the first two lines of each function are
mandatory. The structure you store in the $arr is up to you.

 use PearlReports qw(:MyAgg);

 sub mycnt ($) {
    my $cnt = $aggmem->{counter}++;
    my $arr = \$aggmem->{array}->[$cnt];
    $$arr++
    return $$arr;
 }

 sub myavg ($) {
    my $cnt = $aggmem->{counter}++;
    my $arr = \$aggmem->{array}->[$cnt];
    $$arr->{sum} += $_[0];
    $$arr->{cnt}++;
    return $$arr->{sum} / $$arr->{cnt};
 }

If you create cool aggregate functions please drop me a line.

=head1 HISTORY

 2002-06-12 to Initial ISGTC release
 2003-07-16 to Added -handle option
 2003-07-29 to Added -param option

=head1 AUTHOR

S<Tobias Oetiker E<lt>oetiker@ee.ethz.chE<gt>>

=head1 COPYRIGHT

(C) 2000 by ETH Zurich

=head1 LICENSE

This code is made available under the GNU General Public License
Version 2.0 or later (see www.gnu.org)

=cut

package DBIx::PearlReports;

use Carp;
use strict;
use DBI;
use vars qw(%field $VERSION @EXPORT %EXPORT_TAGS @ISA);  # it's a package global
require Exporter;
$VERSION=1.0;

@ISA = qw(Exporter);
@EXPORT = qw(%field rpmin rpmax rpsum rpcnt rpavg rpsmall rpbig);
%EXPORT_TAGS = ('Simple' => [qw(create group body makereport reset)],
                'MyAgg' => [qw($aggmem)]);

#prototypes
sub argcheck ($$$$);
sub autoself (@);
sub ask ($;$);

my $DefaultSelf;
#implementation

sub create {
    my %args = @_;
    my $self = {};
    bless $self;
    $DefaultSelf = $self; # set default for SIMPLE use
    if (not exists $args{-handle}){
            argcheck "create", \%args, [qw(-datasource -query)],[qw(-username -password -param)];
            $args{-username} = ask('Username:') unless defined $args{-username};
            $args{-password} = ask('password:',1) unless defined $args{-password};
    } else {
            argcheck "create", \%args, [qw(-handle -query)],[(-param)];
            $self->{dbh} = $args{-handle};
    }
    $self->{NEW} = \%args;
    return $self;
}

sub new {
    return create @_;
}

sub group {
    my ($self, %args) = autoself @_;
    argcheck "group", \%args, [qw(-trigger)],[qw(-head -foot)];
    $args{aggmem} = {}; # this will hold info from the groups aggmem calls
    push @{$self->{GROUPS}}, \%args;
}

sub body {
    my ($self, %args) = autoself @_;
    argcheck "body", \%args, [qw(-contents)],[];
    croak "there can be only one body in a report"
      if exists $self->{BODY}->{-contents};
    $self->{BODY}->{-contents} = $args{-contents};
}

# Global variable providing static, group local memmory 
# for all agregat functions.
my $aggmem;

# reset GROUPS and BODY asignement of report;

sub reset {
   my ($self, %args) = autoself @_;
   $self->{GROUPS} = [];
   $self->{BODY} = undef;
}

sub makereport {
    my ($self, %args) = autoself @_;
    # open the database and get the data
    if ( not defined $self->{dbh} ) {
            $self->{dbh} = DBI->connect( $self->{NEW}->{-datasource},
                                         $self->{NEW}->{-username},
                                         $self->{NEW}->{-password}
                                       ) or croak $DBI::errstr;
    }

    $self->{sth} = $self->{dbh}->prepare_cached($self->{NEW}->{-query})
      or croak $self->{dbh}->errstr;

    if ($self->{NEW}->{-param}){
      my @param = @{$self->{NEW}->{-param}};
      for(1..scalar(@param)){
        #count from 1 to number_of_parameters including.
        #sql parameters start at 1. 
        $self->{sth}->bind_param($_,shift @param);
      }
    }

    $self->{sth}->execute() or croak $self->{dbh}->errstr."\n\nQuery: $self->{NEW}->{-query}";

    my @report; #this array holds the report

    # loop through query response
    while (my $row = $self->{sth}->fetchrow_hashref) {
        %field = %$row;
        my $cascade;
        my @headstack;
        my @footstack;
        foreach my $group (@{$self->{GROUPS}}) {
            # $aggmem is the temporery storage are for all aggmem functions
            # called within the current group

            $aggmem = $group->{aggmem}; # asign aggmem pointer

            #evaluate current value of the trigger functions
            my $trigval = &{$group->{-trigger}};
            if (defined $cascade or not defined $group->{trigval}
                or $trigval ne $group->{trigval}){
                $group->{trigval} = $trigval;

                # if the trigger fired, fall through all the lower groups
                # they have to rotate too
                $cascade = 1;

                $aggmem->{array} = []; # clear aggmem storage

                unshift @footstack, $group->{footsave} 
                        if defined $group->{-foot};
                # OK, this is a bit of voodo. Because I want that you can use agregate
                # functions in the head section we store a pointer to a string
                # and push it into the report. For each record in the group this
                # string gets updated (through the pointer)
                my $string = "";                
                push @headstack, \$string;
                $group->{headref} = \$string;
            }
            $aggmem->{counter} = 0; # reset aggmem storage pointer
            ${$group->{headref}} = &{$group->{-head}} if exists $group->{-head};
            $group->{footsave} = &{$group->{-foot}} if exists $group->{-foot};
        }
        push @report, @footstack;
        push @report, @headstack;
        push @report, &{$self->{BODY}->{-contents}} if defined $self->{BODY};

    }
    my @footstack;
    foreach my $group (@{$self->{GROUPS}}) {
        unshift @footstack , $group->{footsave} 
                if defined $group->{-foot};
    } 
    push @report, @footstack;
    $self->{sth}->finish;
    # $self->{dbh}->disconnect;  
    # now we resolve all the -head pointers left in the report stack    
    # and we only ship values back which evaluated to a defined value
    return grep {defined $_} map {ref $_ eq 'SCALAR' ? ${$_} : $_ } @report;
}

##### Agregat functions ##############
# agregat functions can be used within the -foot and -head
# funtions. Before each call to either of these functions
# a persistent @stor and a to 0 initialized $count variable
# is made available with local

sub rpsum ($) {
    my $cnt = $aggmem->{counter}++;
    my $arr = \$aggmem->{array}->[$cnt];
    $$arr += $_[0];
    return $$arr;
}

sub rpmin ($) {
    my $cnt = $aggmem->{counter}++;
    my $arr = \$aggmem->{array}->[$cnt];
   $$arr= $_[0]
      if not defined $$arr
        or $$arr > $_[0];
    return $$arr;
}

sub rpmax ($) {
    my $cnt = $aggmem->{counter}++;
    my $arr = \$aggmem->{array}->[$cnt];
    $$arr= $_[0]
      if not defined $$arr
        or $$arr < $_[0];
    return $$arr;
}

sub rpsmall ($) {
    my $cnt = $aggmem->{counter}++;
    my $arr = \$aggmem->{array}->[$cnt];
    $$arr= $_[0]
      if not defined $$arr
        or $$arr gt $_[0];
    return $$arr;
}

sub rpbig ($) {
    my $cnt = $aggmem->{counter}++;
    my $arr = \$aggmem->{array}->[$cnt];
    $$arr= $_[0]
      if not defined $$arr
        or $$arr lt $_[0];
    return $$arr;
}

sub rpcnt ($) {
    my $cnt = $aggmem->{counter}++;
    my $arr = \$aggmem->{array}->[$cnt];
    $$arr++;
    return $$arr;
}

sub rpavg ($) {
    my $cnt = $aggmem->{counter}++;
    my $arr = \$aggmem->{array}->[$cnt];
    $$arr->{sum} += $_[0];
    $$arr->{cnt}++;
    return $$arr->{sum} / $$arr->{cnt};
}

##### Internal Helpers #################

sub ask ($;$) {
    print STDERR $_[0]," ";
    system "stty -echo"
      if defined $_[1];
    chomp(my $answer = <>);
    if (defined $_[1]){
        system "stty echo";
        print "\n";
    }
    return $answer;
}

sub argcheck ($$$$) {
    my $func = shift;
    my $hash = shift;
    my $required = shift;
    my $optional = shift;
    foreach my $arg (@{$required}) {
        croak "$func expected $arg argument" 
          unless exists $hash->{$arg};
    }
    foreach my $arg (keys %{$hash}) {
        croak "$func does not support $arg arguments"
          unless grep /^$arg$/, @{$required}, @{$optional};
    }
}

sub autoself (@){
    return @_ if
      ref($_[0]) eq 'DBIx::PearlReports';
    return \$DefaultSelf, @_;
}

1;
1	=pod
2
3	=head1 NAME
4
5	DBIx::PearlReports -- A Versatile Report Generator
6
7	=head1 SYNOPSIS
8
9	Using the SIMPLE mode
10
11	use DBIx::PearlReports qw(:Simple);
12	create (
13	-datasource => 'dbi:Pg:dbname=database;host=hostname',
14	-query => 'SELECT * FROM customers ORDER BY state, city;'
15	);
16
17	or
18
19	create (
20	-datasource => 'dbi:Pg:dbname=database;host=hostname',
21	-query => 'SELECT * FROM customers ORDER BY state, city WHERE name = ? AND age = ?',
22	-param => ['Tobi',34],
23	);
24
25	group (
26	-trigger => sub { $filed{state} },
27	-head => sub { "State: $field{state}\n" },
28	-foot => sub { "Average Age for $field{state}".rpavg($field{age}) }
29	);
30
31	group (
32	-trigger => sub { $field{city} },
33	-head => sub { "City: $field{city} (".rpcnt($field{name}.")\n" },
34	-foot => sub { "Total Customers in Customers in ".
35	"$field{city}: ".rpcnt($field{name})."\n" }
36	);
37
38	body (
39	-contents => sub { "$field{firstname} $field{lastname} $field{age}\n" }
40	);
41
42	print makereport;
43
44	PearlReports can also be used in an Object Oriented Context:
45
46	#!/usr/sepp/bin/perl-5.8.0
47	use lib qw( /usr/pack/postgresql-7.3.2-ds/lib/site_perl /usr/isgtc/lib/perl);
48	use DBIx::PearlReports;
49	$r = DBIx::PearlReports::create ( ... );
50	$r->group( ... );
51	$r->body( ... )
52	print $r->makereport;
53
54
55	=head1 DESCRIPTION
56
57	B<PearlReports> is a system for pulling information from an SQL database and
58	produce Reports from this information. B<PearlReports> provides a very
59	flexible system for creating reports based on SQL queries
60
61	While it is sufficient to use the simple statements provided by
62	PearlReports to create your reports, the full power of perl is only a
63	keystroke away.
64
65	Creating a Report using the PearlReports involves writing a short perl
66	script which first loads the PearlReports module:
67
68	#!/usr/bin/perl
69	use DBIx::PearlReports qw(:SIMPLE);
70
71	Then you call the B<create> function to create a new report:
72
73	create (
74	-username => 'myname',
75	-datasource => 'dbi:Pg:dbname=customers',
76	-query => 'SELECT * from customers ORDER by state,city'
77	);
78
79	When creating a report you have to define username and password for
80	the database you want to access. Because different people may use the
81	report. If you do not mention either the B<-username> or B<-password>
82	arguments, the module will ask you to supply one at run time.
83
84	The B<-datasource> argument defines which
85	database this report is going to use. Check the DBI/DBD documentation
86	for the syntax apropriate for your Database. In the example above we
87	are accessing a PostgreSQL database called I<customers> which runs on
88	the local host. The B<-query> argument of the create function defines
89	the data we want to use in our report.
90
91	A central element of PearlReports is the ability to work with groups of
92	records. In this example the report contains two nested groups. Note that
93	the data
94
95	must arive from the database in an order which is comatible with the
96	required groups. (Check the ORDER BY cause above).
97
98	group
99	( -trigger => sub { $field{state} },
100	-head => sub { "Customers from $field{state}\n" },
101	-foot => sub { "Avg Age for $field{state} Customer:".
102	rpavg($field{age})."\n\n" } );
103
104	group
105	( -trigger => sub { $field{zip} },
106	-head => sub { "Customers from $field{town}\n" },
107	-foot => sub { "Min Age in $field{town}:".
108	rpmin($field{age})."\n" } );
109
110
111	Each group definition requires a trigger and either a header or a
112	footer or both. Each argument of the group definition is a little perl
113	function definition. The Trigger function gets called for each record
114	in the query. Whenever the value returned from the
115	function changes the group iterates. Each iteration of a group is
116	enclosed by the apropriate header and footer.
117
118	The B<$field{xxx}> variables refer to the columns of the query.
119	The footer and the header (!) can contain agregation functions
120	(rpmin, rpmax, rpbig, rpsmall, rpsum, rpavg). See the section below
121
122	Finally the actual data can get printed.
123
124	body
125	( -contents => sub { "$field{firstname} $field{lastname} $field{age}\n" } );
126
127	The body function will get called for each row in the database and its
128	return value will be printed into the report.
129
130	When groups and body are set up you can create the actual report by
131	executing:
132
133	print makereport;
134
135	When you want to make a new report using the existion database connection
136	for another report, you can reset it with the command
137
138	reset;
139
140	=head2 METHODS
141
142	All functions provided by PearlReports expect named arguments.
143
144	=head3 create or new
145
146	Defines the data the report should be based on. This involves
147	configuring the parameters for accessing the database server as well
148	as defining the query string.
149
150	If you are working with the OO interface you can use b<new> instead
151	of create to be more in line with established naming conventions.
152
153	=over
154
155	=item -username
156
157	the username for the database. If this option is not set, PearlReports will
158	prompt for a username.
159
160	=item -password
161
162	the password. If this option is not supplied PearlReports will prompt for a
163	password.
164
165	=item -datasource
166
167	the DBI connect string. Check the DBI/DBD manpage for the syntax apropriate
168	for your database.
169
170	=item -handle
171
172	instead of the previous 3 arguments you can also give PearlReports an
173	existing database handle to use.
174
175	=item -query
176
177	A SELECT query
178
179	=item -param
180
181	If you use '?' placeholders in the query, you can supply contents for them
182	using the reference to an arry holding the relevant data.
183
184	=back
185
186
187	=head2 group
188
189	The 'salt' of most reports is that some grouping structure exists. The
190	records in the report get collected into groups of records which bear
191	some common feature. Each group can have a header and a footer.
192
193	=over
194
195	=item -trigger
196
197	Is a pointer to a anonymous function. The function gets called for
198	each row in the result of the query. Whenever the return value from
199	this function changes the group goes into its next iteration. There
200	are other events which can cause a new iteration: A higher order group
201	goes into another iteration or the last record from the query has been
202	consumed.
203
204	=item -head and -foot
205
206	After each iteration, the anonymouse functions pointed to by the head
207	and foot options get executed. The return values from the functions
208	are used as header and footer for the material inside the group.
209
210	=back
211
212	=head3 body
213
214	The inner most 'group' of the report does have neither foot nor head,
215	it has just a body which gets printed for every row in the query result.
216
217	=over
218
219	=item -contents
220
221	Stores a pointer to an anonymous function which gets executed for each
222	record returned by the query.
223
224	=back
225
226	=head3 makereport
227
228	returns an array containing the report ...
229
230	=head3 reset
231
232	clears the group and body data from the report. This can be used to run a
233	second report of the same database connection without reconnecting.
234
235	=head2 AGGREGATE FUNCTIONS
236
237	=head3 rpsum
238
239	Builds the sum of all the values its argument takes during the
240	traversal of the records in the current group iteration.
241
242	=head3 rpmin, rpmax
243
244	Finds the min and max values in a group iteration.
245
246	=head3 rpsmall, rpbig
247
248	Finds the first and last value when sorting alphabetically.
249
250	=head3 rpcnt
251
252	Count the rows in the current group iteration.
253
254	=head3 rpavg
255
256	The same as above only that the average gets calculated.
257
258	=head2 HOW TO WRITE NEW AGGREGATE FUNCTIONS
259
260	If you want to write your own aggregat functions. Follow the examples
261	below. Note that the first two lines of each function are
262	mandatory. The structure you store in the $arr is up to you.
263
264	use PearlReports qw(:MyAgg);
265
266	sub mycnt ($) {
267	my $cnt = $aggmem->{counter}++;
268	my $arr = \$aggmem->{array}->[$cnt];
269	$$arr++
270	return $$arr;
271	}
272
273	sub myavg ($) {
274	my $cnt = $aggmem->{counter}++;
275	my $arr = \$aggmem->{array}->[$cnt];
276	$$arr->{sum} += $_[0];
277	$$arr->{cnt}++;
278	return $$arr->{sum} / $$arr->{cnt};
279	}
280
281	If you create cool aggregate functions please drop me a line.
282
283	=head1 HISTORY
284
285	2002-06-12 to Initial ISGTC release
286	2003-07-16 to Added -handle option
287	2003-07-29 to Added -param option
288
289	=head1 AUTHOR
290
291	S<Tobias Oetiker E<lt>oetiker@ee.ethz.chE<gt>>
292
293	=head1 COPYRIGHT
294
295	(C) 2000 by ETH Zurich
296
297	=head1 LICENSE
298
299	This code is made available under the GNU General Public License
300	Version 2.0 or later (see www.gnu.org)
301
302	=cut
303
304	package DBIx::PearlReports;
305
306	use Carp;
307	use strict;
308	use DBI;
309	use vars qw(%field $VERSION @EXPORT %EXPORT_TAGS @ISA); # it's a package global
310	require Exporter;
311	$VERSION=1.0;
312
313	@ISA = qw(Exporter);
314	@EXPORT = qw(%field rpmin rpmax rpsum rpcnt rpavg rpsmall rpbig);
315	%EXPORT_TAGS = ('Simple' => [qw(create group body makereport reset)],
316	'MyAgg' => [qw($aggmem)]);
317
318	#prototypes
319	sub argcheck ($$$$);
320	sub autoself (@);
321	sub ask ($;$);
322
323	my $DefaultSelf;
324	#implementation
325
326	sub create {
327	my %args = @_;
328	my $self = {};
329	bless $self;
330	$DefaultSelf = $self; # set default for SIMPLE use
331	if (not exists $args{-handle}){
332	argcheck "create", \%args, [qw(-datasource -query)],[qw(-username -password -param)];
333	$args{-username} = ask('Username:') unless defined $args{-username};
334	$args{-password} = ask('password:',1) unless defined $args{-password};
335	} else {
336	argcheck "create", \%args, [qw(-handle -query)],[(-param)];
337	$self->{dbh} = $args{-handle};
338	}
339	$self->{NEW} = \%args;
340	return $self;
341	}
342
343	sub new {
344	return create @_;
345	}
346
347	sub group {
348	my ($self, %args) = autoself @_;
349	argcheck "group", \%args, [qw(-trigger)],[qw(-head -foot)];
350	$args{aggmem} = {}; # this will hold info from the groups aggmem calls
351	push @{$self->{GROUPS}}, \%args;
352	}
353
354	sub body {
355	my ($self, %args) = autoself @_;
356	argcheck "body", \%args, [qw(-contents)],[];
357	croak "there can be only one body in a report"
358	if exists $self->{BODY}->{-contents};
359	$self->{BODY}->{-contents} = $args{-contents};
360	}
361
362	# Global variable providing static, group local memmory
363	# for all agregat functions.
364	my $aggmem;
365
366	# reset GROUPS and BODY asignement of report;
367
368	sub reset {
369	my ($self, %args) = autoself @_;
370	$self->{GROUPS} = [];
371	$self->{BODY} = undef;
372	}
373
374	sub makereport {
375	my ($self, %args) = autoself @_;
376	# open the database and get the data
377	if ( not defined $self->{dbh} ) {
378	$self->{dbh} = DBI->connect( $self->{NEW}->{-datasource},
379	$self->{NEW}->{-username},
380	$self->{NEW}->{-password}
381	) or croak $DBI::errstr;
382	}
383
384	$self->{sth} = $self->{dbh}->prepare_cached($self->{NEW}->{-query})
385	or croak $self->{dbh}->errstr;
386
387	if ($self->{NEW}->{-param}){
388	my @param = @{$self->{NEW}->{-param}};
389	for(1..scalar(@param)){
390	#count from 1 to number_of_parameters including.
391	#sql parameters start at 1.
392	$self->{sth}->bind_param($_,shift @param);
393	}
394	}
395
396	$self->{sth}->execute() or croak $self->{dbh}->errstr."\n\nQuery: $self->{NEW}->{-query}";
397
398	my @report; #this array holds the report
399
400	# loop through query response
401	while (my $row = $self->{sth}->fetchrow_hashref) {
402	%field = %$row;
403	my $cascade;
404	my @headstack;
405	my @footstack;
406	foreach my $group (@{$self->{GROUPS}}) {
407	# $aggmem is the temporery storage are for all aggmem functions
408	# called within the current group
409
410	$aggmem = $group->{aggmem}; # asign aggmem pointer
411
412	#evaluate current value of the trigger functions
413	my $trigval = &{$group->{-trigger}};
414	if (defined $cascade or not defined $group->{trigval}
415	or $trigval ne $group->{trigval}){
416	$group->{trigval} = $trigval;
417
418	# if the trigger fired, fall through all the lower groups
419	# they have to rotate too
420	$cascade = 1;
421
422	$aggmem->{array} = []; # clear aggmem storage
423
424	unshift @footstack, $group->{footsave}
425	if defined $group->{-foot};
426	# OK, this is a bit of voodo. Because I want that you can use agregate
427	# functions in the head section we store a pointer to a string
428	# and push it into the report. For each record in the group this
429	# string gets updated (through the pointer)
430	my $string = "";
431	push @headstack, \$string;
432	$group->{headref} = \$string;
433	}
434	$aggmem->{counter} = 0; # reset aggmem storage pointer
435	${$group->{headref}} = &{$group->{-head}} if exists $group->{-head};
436	$group->{footsave} = &{$group->{-foot}} if exists $group->{-foot};
437	}
438	push @report, @footstack;
439	push @report, @headstack;
440	push @report, &{$self->{BODY}->{-contents}} if defined $self->{BODY};
441
442	}
443	my @footstack;
444	foreach my $group (@{$self->{GROUPS}}) {
445	unshift @footstack , $group->{footsave}
446	if defined $group->{-foot};
447	}
448	push @report, @footstack;
449	$self->{sth}->finish;
450	# $self->{dbh}->disconnect;
451	# now we resolve all the -head pointers left in the report stack
452	# and we only ship values back which evaluated to a defined value
453	return grep {defined $_} map {ref $_ eq 'SCALAR' ? ${$_} : $_ } @report;
454	}
455
456	##### Agregat functions ##############
457	# agregat functions can be used within the -foot and -head
458	# funtions. Before each call to either of these functions
459	# a persistent @stor and a to 0 initialized $count variable
460	# is made available with local
461
462	sub rpsum ($) {
463	my $cnt = $aggmem->{counter}++;
464	my $arr = \$aggmem->{array}->[$cnt];
465	$$arr += $_[0];
466	return $$arr;
467	}
468
469	sub rpmin ($) {
470	my $cnt = $aggmem->{counter}++;
471	my $arr = \$aggmem->{array}->[$cnt];
472	$$arr= $_[0]
473	if not defined $$arr
474	or $$arr > $_[0];
475	return $$arr;
476	}
477
478	sub rpmax ($) {
479	my $cnt = $aggmem->{counter}++;
480	my $arr = \$aggmem->{array}->[$cnt];
481	$$arr= $_[0]
482	if not defined $$arr
483	or $$arr < $_[0];
484	return $$arr;
485	}
486
487	sub rpsmall ($) {
488	my $cnt = $aggmem->{counter}++;
489	my $arr = \$aggmem->{array}->[$cnt];
490	$$arr= $_[0]
491	if not defined $$arr
492	or $$arr gt $_[0];
493	return $$arr;
494	}
495
496	sub rpbig ($) {
497	my $cnt = $aggmem->{counter}++;
498	my $arr = \$aggmem->{array}->[$cnt];
499	$$arr= $_[0]
500	if not defined $$arr
501	or $$arr lt $_[0];
502	return $$arr;
503	}
504
505	sub rpcnt ($) {
506	my $cnt = $aggmem->{counter}++;
507	my $arr = \$aggmem->{array}->[$cnt];
508	$$arr++;
509	return $$arr;
510	}
511
512	sub rpavg ($) {
513	my $cnt = $aggmem->{counter}++;
514	my $arr = \$aggmem->{array}->[$cnt];
515	$$arr->{sum} += $_[0];
516	$$arr->{cnt}++;
517	return $$arr->{sum} / $$arr->{cnt};
518	}
519
520	##### Internal Helpers #################
521
522	sub ask ($;$) {
523	print STDERR $_[0]," ";
524	system "stty -echo"
525	if defined $_[1];
526	chomp(my $answer = <>);
527	if (defined $_[1]){
528	system "stty echo";
529	print "\n";
530	}
531	return $answer;
532	}
533
534	sub argcheck ($$$$) {
535	my $func = shift;
536	my $hash = shift;
537	my $required = shift;
538	my $optional = shift;
539	foreach my $arg (@{$required}) {
540	croak "$func expected $arg argument"
541	unless exists $hash->{$arg};
542	}
543	foreach my $arg (keys %{$hash}) {
544	croak "$func does not support $arg arguments"
545	unless grep /^$arg$/, @{$required}, @{$optional};
546	}
547	}
548
549	sub autoself (@){
550	return @_ if
551	ref($_[0]) eq 'DBIx::PearlReports';
552	return \$DefaultSelf, @_;
553	}
554
555	1;