network_topology/mypearls/vpn_map.pm

#
# Sample Gedafe Pearl
# Pearls are normally created as decendants of
# the Gedafe::Pearl Module
#
#
package vpn_map;

use strict;
use Gedafe::Pearl qw(format_desc date_print);
use POSIX qw(strftime);
use vars qw(@ISA);
@ISA = qw(Gedafe::Pearl);

use DBIx::PearlReports;
use GraphViz;

# ok this is just to show how it is done
# if your new needs anything else
#sub new($;@){
#    my $proto = shift;
#    my $class = ref($proto) || $proto;
#    my $self = $class->SUPER::new(@_);
#    return $self;
#}

# Information about what this pearl will do
sub info($){
    #my $self = shift;
    return "VPN connections"," clustered by countries";
}

# what information do I need to go into action
sub template ($) {
        return [];
}

# check the PearlReports Documentation for details

sub run ($$){
    my $self = shift;
    my $s = shift;
    $self->SUPER::run($s);
    # run the parent ( this will set the params)
    my $p = $self->{param};

    my $g = GraphViz->new(
        width => 8, height => 5,
        pagewidth => 8, pageheight => 5
    );

    my $rep = DBIx::PearlReports::new
       (
        -handle => $s->{dbh},
        -query => <<SQL,

        select
                vpn_from_location_id,
                vpn_to_location_id,
                fl.location_name as from_location,
                fc.country_name as from_country,
                vpn_local_gw,
                tl.location_name as to_location,
                tc.country_name as to_country,
                vpn_remote_gw,
                link_name,
                vpn_comment
        from vpn, location fl, location tl, link, country fc, country tc
        where fl.location_id = vpn_from_location_id
                and tl.location_id = vpn_to_location_id
                and fl.location_country_id = fc.country_id
                and tl.location_country_id = tc.country_id
                and link_id = vpn_link ;
SQL
       );

        $rep->group(
                -trigger => sub { $field{from_location} },
                -head => sub {
                        $g->add_node(
                                'l'.$field{vpn_from_location_id},
                                label => "$field{from_location}\n$field{vpn_local_gw}",
                                cluster => {
                                        name => $field{from_country},
                                        color => '#e0e0e0',
                                },
                                color => '#e0e0ff',
                                style => 'filled',
                        );
                },
        );

        $rep->group(
                -trigger => sub { $field{to_location} },
                -head => sub {
                        $g->add_node(
                                'l'.$field{vpn_to_location_id},
                                label => "$field{to_location}\n$field{vpn_remote_gw}",
                                cluster => {
                                        name => $field{to_country},
                                        color => '#e0e0e0',
                                },
                                color => '#e0ffe0',
                                style => 'filled',
                        );
                },
        );
         
        $rep->body(-contents => sub {
                        $g->add_edge(
                                'l'.$field{vpn_from_location_id} => 'l'.$field{vpn_to_location_id}, label => $field{link_name},
                                color => '#c0c0c0',
                        );
                }
        );

        $rep->makereport();

        return 'image/png', $g->as_png;
}

1;

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