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 connections"," clustered by countries"; |
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 |
width => 8, height => 5, |
49 |
pagewidth => 8, pageheight => 5 |
50 |
); |
51 |
|
52 |
my $rep = DBIx::PearlReports::new |
53 |
( |
54 |
-handle => $s->{dbh}, |
55 |
-query => <<SQL, |
56 |
|
57 |
select |
58 |
vpn_from_location_id, |
59 |
vpn_to_location_id, |
60 |
fl.location_name as from_location, |
61 |
fc.country_name as from_country, |
62 |
vpn_local_gw, |
63 |
tl.location_name as to_location, |
64 |
tc.country_name as to_country, |
65 |
vpn_remote_gw, |
66 |
link_name, |
67 |
vpn_comment |
68 |
from vpn, location fl, location tl, link, country fc, country tc |
69 |
where fl.location_id = vpn_from_location_id |
70 |
and tl.location_id = vpn_to_location_id |
71 |
and fl.location_country_id = fc.country_id |
72 |
and tl.location_country_id = tc.country_id |
73 |
and link_id = vpn_link ; |
74 |
SQL |
75 |
); |
76 |
|
77 |
$rep->group( |
78 |
-trigger => sub { $field{from_location} }, |
79 |
-head => sub { |
80 |
$g->add_node( |
81 |
'l'.$field{vpn_from_location_id}, |
82 |
label => "$field{from_location}\n$field{vpn_local_gw}", |
83 |
cluster => { |
84 |
name => $field{from_country}, |
85 |
color => '#e0e0e0', |
86 |
}, |
87 |
color => '#e0e0ff', |
88 |
style => 'filled', |
89 |
); |
90 |
}, |
91 |
); |
92 |
|
93 |
$rep->group( |
94 |
-trigger => sub { $field{to_location} }, |
95 |
-head => sub { |
96 |
$g->add_node( |
97 |
'l'.$field{vpn_to_location_id}, |
98 |
label => "$field{to_location}\n$field{vpn_remote_gw}", |
99 |
cluster => { |
100 |
name => $field{to_country}, |
101 |
color => '#e0e0e0', |
102 |
}, |
103 |
color => '#e0ffe0', |
104 |
style => 'filled', |
105 |
); |
106 |
}, |
107 |
); |
108 |
|
109 |
$rep->body(-contents => sub { |
110 |
$g->add_edge( |
111 |
'l'.$field{vpn_from_location_id} => 'l'.$field{vpn_to_location_id}, label => $field{link_name}, |
112 |
color => '#c0c0c0', |
113 |
); |
114 |
} |
115 |
); |
116 |
|
117 |
$rep->makereport(); |
118 |
|
119 |
return 'image/png', $g->as_png; |
120 |
} |
121 |
|
122 |
1; |
123 |
|