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

Annotation of /trunk/network_topology/mypearls/vpn_map2.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 13 - (hide annotations)
Wed Feb 16 22:49:57 2005 UTC (19 years, 1 month ago) by dpavlin
File size: 2505 byte(s)
clustering by countries, added spread-out graph

1 dpavlin 13 #
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    

  ViewVC Help
Powered by ViewVC 1.1.26