1 |
# |
2 |
# Sample Gedafe Pearl |
3 |
# Pearls are normally created as decendants of |
4 |
# the Gedafe::Pearl Module |
5 |
# |
6 |
# |
7 |
package vpn_map2; |
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 spread out map","shows connections more cleanly"; |
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 |
directed => 0, |
49 |
layout => 'circo', |
50 |
width => 8, height => 5, |
51 |
pagewidth => 8, pageheight => 5 |
52 |
); |
53 |
|
54 |
my $rep = DBIx::PearlReports::new |
55 |
( |
56 |
-handle => $s->{dbh}, |
57 |
-query => <<SQL, |
58 |
|
59 |
select |
60 |
vpn_from_location_id, |
61 |
vpn_to_location_id, |
62 |
fl.location_name as from_location, |
63 |
fc.country_name as from_country, |
64 |
vpn_local_gw, |
65 |
tl.location_name as to_location, |
66 |
tc.country_name as to_country, |
67 |
vpn_remote_gw, |
68 |
link_name, |
69 |
vpn_comment |
70 |
from vpn, location fl, location tl, link, country fc, country tc |
71 |
where fl.location_id = vpn_from_location_id |
72 |
and tl.location_id = vpn_to_location_id |
73 |
and fl.location_country_id = fc.country_id |
74 |
and tl.location_country_id = tc.country_id |
75 |
and link_id = vpn_link ; |
76 |
SQL |
77 |
); |
78 |
|
79 |
$rep->group( |
80 |
-trigger => sub { $field{from_location} }, |
81 |
-head => sub { |
82 |
$g->add_node( |
83 |
'l'.$field{vpn_from_location_id}, |
84 |
label => "$field{from_location}\n$field{from_country}\n$field{vpn_local_gw}", |
85 |
color => '#ffe0e0', |
86 |
style => 'filled', |
87 |
); |
88 |
}, |
89 |
); |
90 |
|
91 |
$rep->group( |
92 |
-trigger => sub { $field{to_location} }, |
93 |
-head => sub { |
94 |
$g->add_node( |
95 |
'l'.$field{vpn_to_location_id}, |
96 |
label => "$field{to_location}\n$field{to_country}\n$field{vpn_remote_gw}", |
97 |
color => '#e0ffe0', |
98 |
style => 'filled', |
99 |
); |
100 |
}, |
101 |
); |
102 |
|
103 |
$rep->body(-contents => sub { |
104 |
$g->add_edge( |
105 |
'l'.$field{vpn_from_location_id} => 'l'.$field{vpn_to_location_id}, label => $field{link_name}, |
106 |
color => '#e0e0e0', |
107 |
); |
108 |
} |
109 |
); |
110 |
|
111 |
$rep->makereport(); |
112 |
|
113 |
return 'image/png', $g->as_png; |
114 |
} |
115 |
|
116 |
1; |
117 |
|