/[gedafe]/trunk/network_topology/mypearls/demo.pm
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Contents of /trunk/network_topology/mypearls/demo.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3 - (show annotations)
Mon Feb 14 20:58:20 2005 UTC (19 years, 1 month ago) by dpavlin
File size: 2730 byte(s)
my own application about Network Topology

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 #

  ViewVC Help
Powered by ViewVC 1.1.26