/[gedafe]/trunk/network_topology/mypearls/vpn_map.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/vpn_map.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 13 - (show annotations)
Wed Feb 16 22:49:57 2005 UTC (16 years, 8 months ago) by dpavlin
File size: 2578 byte(s)
clustering by countries, added spread-out graph

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

  ViewVC Help
Powered by ViewVC 1.1.26