1 |
# |
2 |
# Sample Gedafe Pearl |
3 |
# Pearls are normally created as decendants of |
4 |
# the Gedafe::Pearl Module |
5 |
# |
6 |
# |
7 |
package vpn_map; |
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 |
use GraphViz; |
17 |
|
18 |
# ok this is just to show how it is done |
19 |
# if your new needs anything else |
20 |
#sub new($;@){ |
21 |
# my $proto = shift; |
22 |
# my $class = ref($proto) || $proto; |
23 |
# my $self = $class->SUPER::new(@_); |
24 |
# return $self; |
25 |
#} |
26 |
|
27 |
# Information about what this pearl will do |
28 |
sub info($){ |
29 |
#my $self = shift; |
30 |
return "VPN map","Map of all VPN links and connecitons"; |
31 |
} |
32 |
|
33 |
# what information do I need to go into action |
34 |
sub template ($) { |
35 |
return []; |
36 |
} |
37 |
|
38 |
# check the PearlReports Documentation for details |
39 |
|
40 |
sub run ($$){ |
41 |
my $self = shift; |
42 |
my $s = shift; |
43 |
$self->SUPER::run($s); |
44 |
# run the parent ( this will set the params) |
45 |
my $p = $self->{param}; |
46 |
|
47 |
my $g = GraphViz->new(); |
48 |
|
49 |
my $rep = DBIx::PearlReports::new |
50 |
( |
51 |
-handle => $s->{dbh}, |
52 |
-query => <<SQL, |
53 |
|
54 |
select |
55 |
vpn_from_location_id, |
56 |
vpn_to_location_id, |
57 |
fl.location_name as from_location, |
58 |
fc.country_name as from_country, |
59 |
vpn_local_gw, |
60 |
tl.location_name as to_location, |
61 |
tc.country_name as to_country, |
62 |
vpn_remote_gw, |
63 |
link_name, |
64 |
vpn_comment |
65 |
from vpn, location fl, location tl, link, country fc, country tc |
66 |
where fl.location_id = vpn_from_location_id |
67 |
and tl.location_id = vpn_to_location_id |
68 |
and fl.location_country_id = fc.country_id |
69 |
and tl.location_country_id = tc.country_id |
70 |
and link_id = vpn_link ; |
71 |
SQL |
72 |
); |
73 |
|
74 |
$rep->group( |
75 |
-trigger => sub { $field{from_location} }, |
76 |
-head => sub { |
77 |
$g->add_node( |
78 |
'l'.$field{vpn_from_location_id}, |
79 |
label => "$field{from_location}\n$field{from_country}\n$field{vpn_local_gw}" |
80 |
); |
81 |
}, |
82 |
); |
83 |
|
84 |
$rep->group( |
85 |
-trigger => sub { $field{to_location} }, |
86 |
-head => sub { |
87 |
$g->add_node( |
88 |
'l'.$field{vpn_to_location_id}, |
89 |
label => "$field{to_location}\n$field{to_country}\n$field{vpn_remote_gw}" |
90 |
); |
91 |
}, |
92 |
); |
93 |
|
94 |
$rep->body(-contents => sub { |
95 |
$g->add_edge( |
96 |
'l'.$field{vpn_from_location_id} => 'l'.$field{vpn_to_location_id}, label => $field{link_name}, |
97 |
); |
98 |
} |
99 |
); |
100 |
|
101 |
$rep->makereport(); |
102 |
|
103 |
return 'image/png', $g->as_png; |
104 |
} |
105 |
|
106 |
1; |
107 |
|