1 |
dpavlin |
10 |
# |
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 |
dpavlin |
13 |
return "VPN connections"," clustered by countries"; |
31 |
dpavlin |
10 |
} |
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 |
dpavlin |
13 |
my $g = GraphViz->new( |
48 |
|
|
width => 8, height => 5, |
49 |
|
|
pagewidth => 8, pageheight => 5 |
50 |
|
|
); |
51 |
dpavlin |
10 |
|
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 |
dpavlin |
13 |
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 |
dpavlin |
10 |
); |
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 |
dpavlin |
13 |
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 |
dpavlin |
10 |
); |
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 |
dpavlin |
13 |
color => '#c0c0c0', |
113 |
dpavlin |
10 |
); |
114 |
|
|
} |
115 |
|
|
); |
116 |
|
|
|
117 |
|
|
$rep->makereport(); |
118 |
|
|
|
119 |
|
|
return 'image/png', $g->as_png; |
120 |
|
|
} |
121 |
|
|
|
122 |
|
|
1; |
123 |
|
|
|