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 |
orders_id,orders_date,orders_qty, |
60 |
product_hid,product_description |
61 |
FROM customer,orders,product |
62 |
WHERE orders_product=product_id |
63 |
AND customer_id = ? |
64 |
AND orders_customer = customer_id |
65 |
AND orders_date >= ? |
66 |
AND orders_date <= ? |
67 |
ORDER BY customer_id,orders_date,orders_id |
68 |
|
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 |
$rep->group( |
83 |
-trigger => sub { $field{orders_date} }, |
84 |
-head => sub { "Orders for $field{orders_date}\n" } |
85 |
); |
86 |
|
87 |
$rep->body |
88 |
( -contents => sub { |
89 |
sprintf " %10d %7d %8s %s\n", |
90 |
$field{orders_id}, |
91 |
$field{orders_qty}, |
92 |
$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 |
# |