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 |
|
|
order_id,order_date,order_qty, |
60 |
|
|
product_hid,product_description |
61 |
|
|
FROM customer,order,product |
62 |
|
|
WHERE order_product=product_id |
63 |
|
|
AND customer_id = ? |
64 |
|
|
AND order_customer = customer_id |
65 |
|
|
AND order_date >= ? |
66 |
|
|
AND order_date <= ? |
67 |
|
|
ORDER BY customer_id,order_date,order_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{order_date} }, |
84 |
|
|
-head => sub { Orders for $field{order_date}\n"} |
85 |
|
|
); |
86 |
|
|
|
87 |
|
|
$rep->body |
88 |
|
|
( -contents => sub { |
89 |
|
|
sprintf " %10d %7d %8s %s\n", |
90 |
|
|
$field{order_id}, |
91 |
|
|
$field{order_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 |
|
|
# |