| 1 |
dpavlin |
1 |
# |
| 2 |
|
|
# Sample Gedafe Pearl |
| 3 |
|
|
# Pearls are normally created as decendants of |
| 4 |
|
|
# the Gedafe::Pearl Module |
| 5 |
|
|
# |
| 6 |
|
|
# |
| 7 |
|
|
package demo; |
| 8 |
|
|
|
| 9 |
|
|
use strict; |
| 10 |
|
|
use Gedafe::Pearl qw(format_desc date_print); |
| 11 |
|
|
use POSIX qw(strftime); |
| 12 |
|
|
use vars qw(@ISA); |
| 13 |
|
|
@ISA = qw(Gedafe::Pearl); |
| 14 |
|
|
|
| 15 |
|
|
use DBIx::PearlReports; |
| 16 |
|
|
|
| 17 |
|
|
# ok this is just to show how it is done |
| 18 |
|
|
# if your new needs anything else |
| 19 |
|
|
#sub new($;@){ |
| 20 |
|
|
# my $proto = shift; |
| 21 |
|
|
# my $class = ref($proto) || $proto; |
| 22 |
|
|
# my $self = $class->SUPER::new(@_); |
| 23 |
|
|
# return $self; |
| 24 |
|
|
#} |
| 25 |
|
|
|
| 26 |
|
|
# Information about what this pearl will do |
| 27 |
|
|
sub info($){ |
| 28 |
|
|
#my $self = shift; |
| 29 |
|
|
return "Customers Orders","List all Orders of a particular customer"; |
| 30 |
|
|
} |
| 31 |
|
|
|
| 32 |
|
|
# what information do I need to go into action |
| 33 |
|
|
sub template ($){ |
| 34 |
|
|
#my $self = shift; |
| 35 |
|
|
# return a list of lists with the following elements |
| 36 |
|
|
# name desc widget |
| 37 |
|
|
return [['start', 'Start Date (YYYY-MM-DD)', 'text', |
| 38 |
|
|
date_print('month_first'),'\d+-\d+-\d+'], |
| 39 |
|
|
['end', 'End Date (YYYY-MM-DD)', 'text', |
| 40 |
|
|
date_print('month_last'),'\d+-\d+-\d+' ], |
| 41 |
|
|
['customer', 'Customer', 'idcombo(combo=customer_combo)','','\d+' ], |
| 42 |
|
|
]; |
| 43 |
|
|
} |
| 44 |
|
|
|
| 45 |
|
|
# check the PearlReports Documentation for details |
| 46 |
|
|
|
| 47 |
|
|
sub run ($$){ |
| 48 |
|
|
my $self = shift; |
| 49 |
|
|
my $s = shift; |
| 50 |
|
|
$self->SUPER::run($s); |
| 51 |
|
|
# run the parent ( this will set the params) |
| 52 |
|
|
my $p = $self->{param}; |
| 53 |
|
|
my $rep = DBIx::PearlReports::new |
| 54 |
|
|
( |
| 55 |
|
|
-handle => $s->{dbh}, |
| 56 |
|
|
-query => <<SQL, |
| 57 |
|
|
|
| 58 |
|
|
SELECT customer_id,customer_name, |
| 59 |
dpavlin |
2 |
orders_id,orders_date,orders_qty, |
| 60 |
dpavlin |
1 |
product_hid,product_description |
| 61 |
dpavlin |
2 |
FROM customer,orders,product |
| 62 |
|
|
WHERE orders_product=product_id |
| 63 |
dpavlin |
1 |
AND customer_id = ? |
| 64 |
dpavlin |
2 |
AND orders_customer = customer_id |
| 65 |
|
|
AND orders_date >= ? |
| 66 |
|
|
AND orders_date <= ? |
| 67 |
|
|
ORDER BY customer_id,orders_date,orders_id |
| 68 |
dpavlin |
1 |
|
| 69 |
|
|
SQL |
| 70 |
|
|
-param => [ $p->{customer},$p->{start},$p->{end}] |
| 71 |
|
|
|
| 72 |
|
|
); |
| 73 |
|
|
|
| 74 |
|
|
$rep->group |
| 75 |
|
|
( -trigger => sub { $field{customer_id} }, |
| 76 |
|
|
-head => sub { "Report for $field{customer_id} - $field{customer_name}\n". |
| 77 |
|
|
"Date: $p->{start} - $p->{end}\n". |
| 78 |
|
|
"-------------------------------------------------------------\n"}, |
| 79 |
|
|
-foot => sub { "Total Items Shipped :".rpcnt($field{product_id})."\n" } |
| 80 |
|
|
); |
| 81 |
|
|
|
| 82 |
dpavlin |
2 |
$rep->group( |
| 83 |
|
|
-trigger => sub { $field{orders_date} }, |
| 84 |
|
|
-head => sub { "Orders for $field{orders_date}\n" } |
| 85 |
|
|
); |
| 86 |
dpavlin |
1 |
|
| 87 |
|
|
$rep->body |
| 88 |
|
|
( -contents => sub { |
| 89 |
|
|
sprintf " %10d %7d %8s %s\n", |
| 90 |
dpavlin |
2 |
$field{orders_id}, |
| 91 |
|
|
$field{orders_qty}, |
| 92 |
dpavlin |
1 |
$field{product_hid}, |
| 93 |
|
|
$field{product_desc} } ); |
| 94 |
|
|
|
| 95 |
|
|
return 'text/plain', |
| 96 |
|
|
join '', (map { defined $_ ? $_ : '' } $rep->makereport); |
| 97 |
|
|
} |
| 98 |
|
|
|
| 99 |
|
|
1; |
| 100 |
|
|
|
| 101 |
|
|
# Emacs Configuration |
| 102 |
|
|
# |
| 103 |
|
|
# Local Variables: |
| 104 |
|
|
# mode: cperl |
| 105 |
|
|
# eval: (cperl-set-style "PerlStyle") |
| 106 |
|
|
# mode: flyspell |
| 107 |
|
|
# mode: flyspell-prog |
| 108 |
|
|
# End: |
| 109 |
|
|
# |
Parent Directory
| 
Revision Log