Net-Route-v0.02/0000755000175000017500000000000011302464601013716 5ustar tequetertequeterNet-Route-v0.02/t/0000755000175000017500000000000011302464601014161 5ustar tequetertequeterNet-Route-v0.02/t/20-exception.t0000444000175000017500000000230611302464601016562 0ustar tequetertequeteruse strict; use warnings; use lib 't/lib'; use Net::Route::Parser::Test; use Net::Route::Table; use Test::Exception; use Test::More tests => 3; use English qw( -no_match_vars ); my $parser_ref = Net::Route::Parser::Test->new(); my $command = $parser_ref->command_line( '/does/not/exist' ); my $message; if ( $OSNAME eq 'MSWin32' ) { $message = qr/'$command' returned non-zero value/; } else { $message = qr/Cannot execute '$command'/; } diag( "Ignore the following warning (Can't exec...)" ); # Module::Build bug throws_ok { $parser_ref->from_system() } $message, 'Die message contents on invalid command'; SKIP: { skip "/bin/false doesn't exist", 1 unless -x '/bin/false'; $command = $parser_ref->command_line( '/bin/false' ); throws_ok { $parser_ref->from_system() } qr/'$command' returned non-zero value \d+/, 'Die message contents when command returned non-zero value'; } SKIP: { skip "No POSIX signals on Windows systems", 1 unless $OSNAME ne 'MSWin32'; $command = $parser_ref->command_line( "$EXECUTABLE_NAME t/bin/suicide.pl" ); throws_ok { $parser_ref->from_system() } qr/'$command' died with signal \d+/, 'Die message contents when command had been killed'; } Net-Route-v0.02/t/00-load.t0000444000175000017500000000031411302464601015476 0ustar tequetertequeter#!perl -T use strict; use warnings; use Test::More tests => 2; BEGIN { use_ok( 'Net::Route' ); use_ok( 'Net::Route::Table' ); } diag( "Testing Net::Route $Net::Route::VERSION, Perl $], $^X" ); Net-Route-v0.02/t/50-integration.t0000444000175000017500000000202411302464601017107 0ustar tequetertequeteruse strict; use warnings; use Test::More tests => 2; use Net::Route::Table; use Net::Route::Parser; use NetAddr::IP; use IPC::Run3; use English qw( -no_match_vars ); sub diag_system_command { local $EVAL_ERROR; require "Net/Route/Parser/$OSNAME.pm"; my $parser_ref = "Net::Route::Parser::$OSNAME"->new(); my $routes_as_text; eval { IPC::Run3::run3( $parser_ref->command_line(), undef, \$routes_as_text ) }; my $command = join q{ }, @{ $parser_ref->command_line() }; $routes_as_text =~ s/[1-9]/1/g; # CPAN testers may wish to remain anonymous diag( qq{'$command' output:\n}, $routes_as_text ); return; } my $table_ref; if ( !eval { $table_ref = Net::Route::Table->from_system(); 1 } ) { diag_system_command(); die $EVAL_ERROR; } my $default_network = NetAddr::IP->new( '0.0.0.0', '0.0.0.0' ); is( $table_ref->default_route()->destination(), $default_network, 'The default gateway is 0.0.0.0' ); my $size = @{ $table_ref->all_routes() }; cmp_ok( $size, '>' , 1, 'There are at least two routes' ); Net-Route-v0.02/t/perlcriticrc0000444000175000017500000000220011302464601016561 0ustar tequetertequeterseverity = brutal exclude = ValuesAndExpressions::ProhibitEmptyQuotes ValuesAndExpressions::RequireInterpolationOfMetachars ErrorHandling::RequireCarping NamingConventions::Capitalization ValuesAndExpressions::RequireConstantVersion [Miscellanea::RequireRcsKeywords] keywords = Revision [InputOutput::RequireCheckedSyscalls] functions = open opendir read readline readdir close closedir print [Documentation::RequirePodSections] # - no SUBROUTINES/METHODS (replaced by PACKAGE/OBJECT methods as applicable) # - no CONFIGURATION/DIAGNOSTICS/DEPENDENCIES/INCOMPATIBILITIES/BUGS (useful for main module only) lib_sections = NAME | SYNOPSIS | VERSION | DESCRIPTION | AUTHOR | LICENSE AND COPYRIGHT [Documentation::PodSpelling] spell_command = aspell --lang=en list stop_words = Straton API Accessors filehandles filehandle ie IPs CLI whitelist Whitelist TODO Equeter perldoc CPAN's AnnoCPAN CPAN Storoz arrayref Linux' BSD's SOLARIS GCC perl Solaris IP ROADMAP Cancerbero bugfixes [Variables::ProhibitPackageVars] [CodeLayout::RequireTidyCode] perltidyrc = t/perltidyrc [TestingAndDebugging::ProhibitNoWarnings] allow_with_category_restriction = 1 Net-Route-v0.02/t/02-pod.t0000444000175000017500000000056411302464601015352 0ustar tequetertequeter#!perl -T use strict; use warnings; use Test::More; if ( !$ENV{'AUTHOR_TEST'} && !$ENV{'AUTHOR_TEST_NET_ROUTE'} ) { plan( skip_all => 'This test is only run when AUTHOR_TEST is set' ); } # Ensure a recent version of Test::Pod my $min_tp = 1.22; eval "use Test::Pod $min_tp"; plan skip_all => "Test::Pod $min_tp required for testing POD" if $@; all_pod_files_ok(); Net-Route-v0.02/t/perltidyrc0000444000175000017500000000170411302464601016265 0ustar tequetertequeter# Adapted from -pbp -l=120 # chars per line -i=4 # 4-space indents -ci=2 # Continuation indentation -vt=2 # Max vertical tightness (compact - PBP setting, let's see) -cti=0 # No extra indentation on data structure closing braces/.. -pt=0 # Always spaces inside () -bt=1 # Spaces between data {} if complex -sbt=1 # Same for [] -bbt=0 # Always spaces inside block {} -nsfs # Do not add extra spaces around for(;;) semicolons -nolq # Do not unindent long string lines to respect -l # Break before these: -wbb="% + - * / x != == >= <= =~ !~ < > | & = **= += *= &= <<= &&= -= /= |= >>= ||= //= .= %= ^= x=" # Own settings -lp # Required by -vt -bl # Code braces go on a new line -otr # Do not break lines between a comma and an opening token -sot # Compact multiple opening tokens on same line -sct # Compact multiple cloising tokens on same line # IO -se # Error to stderr instead of .ERR -w # Enable warnings Net-Route-v0.02/t/lib/0000755000175000017500000000000011302464601014727 5ustar tequetertequeterNet-Route-v0.02/t/lib/Net/0000755000175000017500000000000011302464601015455 5ustar tequetertequeterNet-Route-v0.02/t/lib/Net/Route/0000755000175000017500000000000011302464601016553 5ustar tequetertequeterNet-Route-v0.02/t/lib/Net/Route/Parser/0000755000175000017500000000000011302464601020007 5ustar tequetertequeterNet-Route-v0.02/t/lib/Net/Route/Parser/Test.pm0000444000175000017500000000046111302464601021263 0ustar tequetertequeterpackage Net::Route::Parser::Test; use strict; use warnings; use version; our ( $VERSION ) = '$Revision: 254 $' =~ m{(\d+)}xms; use Moose; extends 'Net::Route::Parser'; has 'command_line' => ( is => 'rw', ); sub parse_routes { return []; } no Moose; __PACKAGE__->meta->make_immutable(); 1; Net-Route-v0.02/t/bin/0000755000175000017500000000000011302464601014731 5ustar tequetertequeterNet-Route-v0.02/t/bin/suicide.pl0000444000175000017500000000005311302464601016707 0ustar tequetertequeteruse strict; use warnings; kill KILL => $$; Net-Route-v0.02/t/02-perlcritic.t0000444000175000017500000000070311302464601016723 0ustar tequetertequeter#!perl use strict; use warnings; use Test::More; if (!eval { require Test::Perl::Critic } ) { plan( skip_all => "Test::Perl::Critic required for testing PBP compliance" ); } if ( !$ENV{'AUTHOR_TEST'} && !$ENV{'AUTHOR_TEST_NET_ROUTE'} ) { plan( skip_all => 'This test is only run when AUTHOR_TEST is set' ); } Test::Perl::Critic->import( -profile => 't/perlcriticrc', -verbose => 8, ); Test::Perl::Critic::all_critic_ok(); Net-Route-v0.02/t/02-pod-coverage.t0000444000175000017500000000126311302464601017140 0ustar tequetertequeteruse strict; use warnings; use Test::More; if ( !$ENV{'AUTHOR_TEST'} && !$ENV{'AUTHOR_TEST_NET_ROUTE'} ) { plan( skip_all => 'This test is only run when AUTHOR_TEST is set' ); } # Ensure a recent version of Test::Pod::Coverage my $min_tpc = 1.08; eval "use Test::Pod::Coverage $min_tpc"; plan skip_all => "Test::Pod::Coverage $min_tpc required for testing POD coverage" if $@; # Test::Pod::Coverage doesn't require a minimum Pod::Coverage version, # but older versions don't recognize some common documentation styles my $min_pc = 0.18; eval "use Pod::Coverage $min_pc"; plan skip_all => "Pod::Coverage $min_pc required for testing POD coverage" if $@; all_pod_coverage_ok(); Net-Route-v0.02/META.yml0000444000175000017500000000201411302464601015162 0ustar tequetertequeter--- name: Net-Route version: v0.02 author: - 'Straton IT ' abstract: Portable interface to the routing table license: perl resources: license: http://dev.perl.org/licenses/ requires: IPC::Run3: 0 Moose: 0 NetAddr::IP: 0 Readonly: 0 perl: 5.8.0 version: 0.74 build_requires: Test::More: 0 recommends: Class::C3: 0 Class::MOP: 0 Devel::GlobalDestruction: 0 Sub::Exporter: 0 provides: Net::Route: file: lib/Net/Route.pm version: v0.02 Net::Route::Parser: file: lib/Net/Route/Parser.pm version: 363 Net::Route::Parser::MSWin32: file: lib/Net/Route/Parser/MSWin32.pm version: 366 Net::Route::Parser::linux: file: lib/Net/Route/Parser/linux.pm version: 363 Net::Route::Parser::solaris: file: lib/Net/Route/Parser/solaris.pm version: 363 Net::Route::Table: file: lib/Net/Route/Table.pm version: 363 generated_by: Module::Build version 0.280801 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.2.html version: 1.2 Net-Route-v0.02/Build.PL0000444000175000017500000000204311302464601015207 0ustar tequetertequeteruse strict; use warnings; use Module::Build; die "OS unsupported: $^O" unless -e "lib/Net/Route/Parser/$^O.pm"; my $builder = Module::Build->new( module_name => 'Net::Route', license => 'perl', dist_author => 'Straton IT ', dist_version_from => 'lib/Net/Route.pm', requires => { 'perl' => '5.8.0', 'version' => 0.74, 'NetAddr::IP' => 0, 'Readonly' => 0, 'IPC::Run3' => 0, 'Moose' => 0, }, recommends => { # Moose dependencies for complete CPANT reports 'Class::MOP' => 0, 'Devel::GlobalDestruction' => 0, 'Sub::Exporter' => 0, 'Class::C3' => 0, }, build_requires => { 'Test::More' => 0, }, add_to_cleanup => [ 'Net-Route-*' ], create_makefile_pl => 'passthrough', ); $builder->create_build_script(); Net-Route-v0.02/README0000444000175000017500000000217511302464601014601 0ustar tequetertequeterNet-Route Every OS provides its custom interface to the routing table: Linux' "route" utility is different from BSD's "route show", from Windows' "route print", etc. Parsing all these different output styles in an (otherwise portable) script can quickly become inconvenient. Net::Route abstracts the system specifics and provides a single, portable interface. INSTALLATION To install this module, run the following commands: perl Build.PL ./Build ./Build test ./Build install SUPPORT AND DOCUMENTATION After installing, you can find documentation for this module with the perldoc command. perldoc Net::Route You can also look for information at: RT, CPAN's request tracker http://rt.cpan.org/NoAuth/Bugs.html?Dist=Net-Route AnnoCPAN, Annotated CPAN documentation http://annocpan.org/dist/Net-Route CPAN Ratings http://cpanratings.perl.org/d/Net-Route Search CPAN http://search.cpan.org/dist/Net-Route COPYRIGHT AND LICENCE Copyright (C) 2009 Straton IT. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Net-Route-v0.02/lib/0000755000175000017500000000000011302464601014464 5ustar tequetertequeterNet-Route-v0.02/lib/Net/0000755000175000017500000000000011302464601015212 5ustar tequetertequeterNet-Route-v0.02/lib/Net/Route.pm0000444000175000017500000001133711302464601016651 0ustar tequetertequeterpackage Net::Route; use 5.008; use Moose; use version; our $VERSION = qv( 'v0.02' ); use NetAddr::IP; has 'destination' => ( is => 'ro', required => 1, isa => 'NetAddr::IP' ); has 'gateway' => ( is => 'ro', required => 1, isa => 'NetAddr::IP' ); has 'metric' => ( is => 'ro', required => 1, isa => 'Int' ); has 'interface' => ( is => 'ro', required => 1, isa => 'Str' ); has 'is_active' => ( is => 'ro', required => 1, ); has 'is_dynamic' => ( is => 'ro', required => 1, ); no Moose; __PACKAGE__->meta->make_immutable(); 1; __END__ =head1 NAME Net::Route - Portable interface to the routing table =head1 SYNOPSIS use Net::Route::Table; my $table_ref = Net::Route::Table->from_system(); my $route_ref = $table_ref->default_route(); print "Default gateway: ", $route_ref->gateway(), "\n"; =head1 VERSION Version 0.02, $Revision: 372 $ =head1 DESCRIPTION =head2 The Net::Route Module Every OS provides its custom interface to the routing table: Linux' C utility is different from BSD's C, from Windows' C, etc. Parsing all these different output styles in an (otherwise portable) script can quickly become inconvenient. L abstracts the system specifics and provides a single, portable interface. =head2 The Net::Route Class L objects represent single entries from a L. =head1 INTERFACE This documents L as a class. To know how to use the module, refer to the L or L (the entry point from a user perspective). =head2 Object Methods =head3 destination() =head3 gateway() =head3 metric() =head3 interface() =head3 is_active() =head3 is_dynamic() =head1 INSTALLING DEPENDENCIES ON SUN SOLARIS SYSTEMS WITH GCC The perl interpreter shipped with Solaris was compiled with Sun's proprietary C compiler, and therefore attempts to compile XS modules with the same tool and options. However, Solaris comes by default with the GNU C Compiler (C) only, which has its own set of incompatible command-line arguments. Mixing these two to compile C Perl modules doesn't work. Therefore, when you need to install CPAN modules (such as L's dependencies) which make use of C (C code) on a system without the Sun C Compiler, you have to use the wrapper script provided by Sun which will invoke C correctly (replace C as needed): /usr/perl5/bin/perlgcc -MCPAN -e 'install Module'. =head1 STATUS AND ROADMAP Please refer to the Changes file for a detailed history. =head2 0.01 - First Public Release L meets our goals for a first public release: =over =item * It can list all routes =item * It can get the default route =item * It can provide the most common characteristics of routes =item * It is portable on Linux, Solaris and Windows =back L is used in other Straton IT (L) software, such as Cancerbero 0.7 (L) and Confdump/Sys (L). =head2 0.xx - Community Releases These releases will include features and bugfixes suggested, reported and/or contributed by the community. For example: =over =item * Differentiating between C-as-a-class and C-as-a-module =item * Support for more operating systems =item * Getting rid of CPAN dependencies that are troublesome to install on some platforms. =item * Your idea (L) here... =back The API might change somewhat, if necessary. =head2 1.0 - API Freeze When appropriate (according to the user reports), we will freeze the interface and release version 1.0. =head1 BUGS Please report any bugs or feature requests to C, or through the web interface at L. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. =head1 SUPPORT You can find documentation for this module with the perldoc command. perldoc Net::Route You can also look for information at: =over 4 =item * RT: CPAN's request tracker L =item * AnnoCPAN: Annotated CPAN documentation L =item * CPAN Ratings L =item * Search CPAN L =back =head1 AUTHOR Created by Alexandre Storoz, C<< >> Maintained by Thomas Equeter, C<< >> =head1 LICENSE AND COPYRIGHT Copyright (C) 2009 Straton IT. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Net-Route-v0.02/lib/Net/Route/0000755000175000017500000000000011302464601016310 5ustar tequetertequeterNet-Route-v0.02/lib/Net/Route/Parser/0000755000175000017500000000000011302464601017544 5ustar tequetertequeterNet-Route-v0.02/lib/Net/Route/Parser/MSWin32.pm0000444000175000017500000000352411302464601021246 0ustar tequetertequeterpackage Net::Route::Parser::MSWin32; use 5.008; use strict; use warnings; use version; our ( $VERSION ) = '$Revision: 366 $' =~ m{(\d+)}xms; use Moose; use Readonly; use Net::Route; use Net::Route::Parser qw(:ip_re :route_re); extends 'Net::Route::Parser'; sub command_line { return [qw(c:\WINDOWS\system32\route print)]; } sub parse_routes { my ( $self, $text_lines_ref ) = @_; my @routes; foreach my $line ( @{$text_lines_ref} ) { chomp $line; if ( my @values = ( $line =~ $ROUTE_RE ) ) { my ( $dest, $dest_mask, $gateway, $interface, $metric ) = @values; my $route_ref = Net::Route->new( { 'destination' => $self->create_ip_object( $dest, $dest_mask ), 'gateway' => $self->create_ip_object( $gateway ), 'is_active' => 1, # TODO 'is_dynamic' => 0, # TODO 'metric' => $metric, 'interface' => $interface, } ); push @routes, $route_ref; } } return \@routes; } no Moose; __PACKAGE__->meta->make_immutable(); 1; __END__ =head1 NAME Net::Route::Parser::MSWin32 - Internal class =head1 SYNOPSIS Internal. =head1 VERSION Revision $Revision: 366 $. =head1 DESCRIPTION This class parses Windows' C output. It implements L. =head2 Object Methods =head3 command_line() =head3 parse_routes() =head1 INTERFACE See L. =head1 AUTHOR Created by Alexandre Storoz, C<< >> Maintained by Thomas Equeter, C<< >> =head1 LICENSE AND COPYRIGHT Copyright (C) 2009 Straton IT. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Net-Route-v0.02/lib/Net/Route/Parser/solaris.pm0000444000175000017500000000760211302464601021561 0ustar tequetertequeterpackage Net::Route::Parser::solaris; use 5.008; use strict; use warnings; use version; our ( $VERSION ) = '$Revision: 363 $' =~ m{(\d+)}xms; use Moose; use Net::Route; use Net::Route::Parser qw(:ip_re); use Readonly; extends 'Net::Route::Parser'; # /m is broken in <5.10 ## no critic (RegularExpressions::RequireLineBoundaryMatching) Readonly my $netstat_ipv4_line_re => qr{ ($IPV4_RE | default) \s+ # destination ($IPV4_RE) \s+ # mask ($IPV4_RE) \s+ # gateway (?: ( [\w:]+ ) \s+ )? # interface (\d+\*?) \s+ # mxfrg (\d+) \s+ # rtt (\d+) \s+ # metric ([A-Z]+) \s+ # flags (\d+) \s+ # out (\d+)}xs; # in_fwd Readonly my $netstat_ipv6_line_re => qr{ ($IPV6_RE | default) \s+ # destination ($IPV6_RE) \s+ # gateway (?: (\w+) \s+ )? # interface (\d+) \s+ # rtt (\d+) \s+ # metric ([A-Z]+) \s+ # flags (\d+) \s+ # out (\d+)}xs; # in_fwd ## use critic sub command_line { return [qw( /bin/netstat -rnv )]; } sub parse_routes { my ( $self, $text_lines_ref ) = @_; my @routes; my ( $dest, $mask, $gateway, $interface, $mxfrg, $rtt, $metric, $flags, $out, $in_fwd ); foreach my $line ( @{$text_lines_ref} ) { # These values will be stored in a configuration hash if ( ( $dest, $gateway, $interface, $rtt, $metric, $flags, $out, $in_fwd ) = ( $line =~ $netstat_ipv6_line_re ) ) { my $is_active = $flags =~ /U/xms; my $is_dynamic = $flags =~ /[RDM]/xms; my $route_ref = Net::Route->new( { 'destination' => NetAddr::IP->new( $dest ), 'gateway' => NetAddr::IP->new( $gateway ), 'is_active' => $is_active, 'is_dynamic' => $is_dynamic, 'metric' => $metric, 'interface' => $interface, } ); push @routes, $route_ref; } elsif ( ( $dest, $mask, $gateway, $interface, $mxfrg, $rtt, $metric, $flags, $out, $in_fwd ) = ( $line =~ $netstat_ipv4_line_re ) ) { if ( $dest eq 'default' ) { $dest = '0.0.0.0'; } if ( !defined $interface ) { $interface = ''; } my $is_active = $flags =~ /U/xms; my $is_dynamic = $flags =~ /[RDM]/xms; my $route_ref = Net::Route->new( { 'destination' => $self->create_ip_object( $dest, $mask ), 'gateway' => $self->create_ip_object( $gateway ), 'is_active' => $is_active, 'is_dynamic' => $is_dynamic, 'metric' => $metric, 'interface' => $interface, } ); push @routes, $route_ref; } } return \@routes; } no Moose; __PACKAGE__->meta->make_immutable(); 1; __END__ =head1 NAME Net::Route::Parser::solaris - Internal class =head1 SYNOPSIS Internal. =head1 VERSION Revision $Revision: 363 $. =head1 DESCRIPTION This class parses Solaris' C output. It implements L. =head1 INTERFACE See L. =head2 Object Methods =head3 command_line() =head3 parse_routes() =head1 AUTHOR Created by Alexandre Storoz, C<< >> Maintained by Thomas Equeter, C<< >> =head1 LICENSE AND COPYRIGHT Copyright 2009 Straton IT, all rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Net-Route-v0.02/lib/Net/Route/Parser/linux.pm0000444000175000017500000000355511302464601021247 0ustar tequetertequeterpackage Net::Route::Parser::linux; use 5.008; use strict; use warnings; use version; our ( $VERSION ) = '$Revision: 363 $' =~ m{(\d+)}xms; use Moose; use Net::Route; extends 'Net::Route::Parser'; sub command_line { return [qw(/sbin/route -n )]; } sub parse_routes { my ( $self, $text_lines_ref ) = @_; splice @{$text_lines_ref}, 0, 2; my @routes; foreach my $line ( @{$text_lines_ref} ) { chomp $line; my @values = split /\s+/xms, $line; # These values will be stored in a configuration hash my ( $dest, $gateway, $dest_mask, $flags, $metric, $ref, $use, $interface ) = @values; my $is_active = $flags =~ /U/xms; my $is_dynamic = $flags =~ /[RDM]/xms; my $route_ref = Net::Route->new( { 'destination' => $self->create_ip_object( $dest, $dest_mask ), 'gateway' => $self->create_ip_object( $gateway ), 'is_active' => $is_active, 'is_dynamic' => $is_dynamic, 'metric' => $metric, 'interface' => $interface, } ); push @routes, $route_ref; } return \@routes; } no Moose; __PACKAGE__->meta->make_immutable(); 1; __END__ =head1 NAME Net::Route::Parser::linux - Internal class =head1 SYNOPSIS Internal. =head1 VERSION Revision $Revision: 363 $. =head1 DESCRIPTION This class parses Linux' C output. It implements L. =head1 INTERFACE See L. =head2 Object Methods =head3 command_line() =head3 parse_routes() =head1 AUTHOR Created by Alexandre Storoz, C<< >> Maintained by Thomas Equeter, C<< >> =head1 LICENSE AND COPYRIGHT Copyright (C) 2009 Straton IT. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Net-Route-v0.02/lib/Net/Route/Table.pm0000444000175000017500000000441311302464601017675 0ustar tequetertequeterpackage Net::Route::Table; use 5.008; use strict; use warnings; use version; our ( $VERSION ) = '$Revision: 363 $' =~ m{(\d+)}xms; use Moose; use NetAddr::IP; use English qw( -no_match_vars ); has 'routes' => ( is => 'ro', reader => 'all_routes' ); sub default_route { my ( $self ) = @_; foreach my $route_ref ( @{ $self->all_routes() } ) { if ( $route_ref->destination->addr eq '0.0.0.0' ) { return $route_ref; } } return; } sub from_system { require "Net/Route/Parser/$OSNAME.pm"; ## no critic (Modules::RequireBareWordIncludes) my $parser_ref = "Net::Route::Parser::$OSNAME"->new(); my @routes = sort _up_routes_by_metric @{ $parser_ref->from_system() }; return Net::Route::Table->new( { 'routes' => \@routes } ); } sub _up_routes_by_metric { my $is_up_sort = ( $a->is_active() <=> $b->is_active() ); if ( $is_up_sort == 0 ) { return ( $a->metric() <=> $b->metric() ); } else { return $is_up_sort; } } no Moose; __PACKAGE__->meta->make_immutable(); 1; __END__ =head1 NAME Net::Route::Table - A routing table, such as your system's. =head1 SYNOPSIS use Net::Route::Table; $table_ref = Net::Route::Table->from_system(); my $default_route_ref = $table_ref->default_route(); my $routes_ref = $table_ref->all_routes(); =head1 VERSION Revision $Revision: 363 $. =head1 DESCRIPTION This class represents a routing table. It can be read from the system and gives access to appropriate selections of routes. =head1 INTERFACE =head2 Class Methods =head3 from_system() Returns the system's routing table as a L object. =head2 Object Methods =head2 default_route() Returns the current default route of the system as a L object. =head2 all_routes() Returns the complete routing table as an arrayref of L objects. The active routes are listed first, then the results are sorted by increasing metric. =head1 AUTHOR Created by Alexandre Storoz, C<< >> Maintained by Thomas Equeter, C<< >> =head1 LICENSE AND COPYRIGHT Copyright (C) 2009 Straton IT. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Net-Route-v0.02/lib/Net/Route/Parser.pm0000444000175000017500000000722111302464601020102 0ustar tequetertequeterpackage Net::Route::Parser; use 5.008; use Moose; use English qw( -no_match_vars ); use POSIX qw( WIFEXITED WEXITSTATUS WIFSIGNALED WTERMSIG WIFSTOPPED WSTOPSIG ); use Readonly; use Exporter qw( import ); use version; our ( $VERSION ) = '$Revision: 363 $' =~ m{(\d+)}xms; use IPC::Run3; # /m is broken in <5.10 ## no critic (RegularExpressions::RequireLineBoundaryMatching) # Very loose matching, it's just meant to filter lines Readonly our $IPV4_RE => qr/ (?: \d+ \.){3} \d+ /xs; Readonly our $IPV6_RE => qr/ (?: \p{IsXDigit}+ : :? )+ \p{IsXDigit}+ /xs; Readonly our $IP_RE => qr/ (?: $IPV4_RE | $IPV6_RE ) /xs; Readonly our $ROUTE_RE => qr/^ \s* ($IP_RE) \s+ ($IP_RE) \s+ ($IP_RE) \s+ ($IP_RE) \s+ (\d+) \s* $ /xs; ## use critic our %EXPORT_TAGS = ( ip_re => [qw($IPV4_RE $IPV6_RE $IP_RE)], route_re => [qw($ROUTE_RE)], ); our @EXPORT_OK = ( @{ $EXPORT_TAGS{'ip_re'} }, @{ $EXPORT_TAGS{'route_re'} }, ); sub create_ip_object { my ( $self, $address, $mask ) = @_; my $ip_object_ref = NetAddr::IP->new( $address, $mask ); if ( !defined $ip_object_ref ) { $mask = defined $mask ? $mask : q{}; die "Cannot create ip object (address: $address, mask: $mask)"; } else { return $ip_object_ref; } } sub from_system { my ( $self ) = @_; my $command_ref = $self->command_line(); my $human_command = ref $command_ref ? ( join q{ }, @{$command_ref} ) : $command_ref; my @routes_as_text; if ( !eval { IPC::Run3::run3( $command_ref, undef, \@routes_as_text ); 1 } ) { die "Cannot execute '$human_command': $EVAL_ERROR"; } if ( $CHILD_ERROR ) { if ( $OSNAME eq 'MSWin32' ) { die "'$human_command' returned non-zero value $CHILD_ERROR"; } elsif ( WIFSIGNALED( $CHILD_ERROR ) ) { die "'$human_command' died with signal ", WTERMSIG( $CHILD_ERROR ); } elsif ( WEXITSTATUS( $CHILD_ERROR ) ) { die "'$human_command' returned non-zero value ", WEXITSTATUS( $CHILD_ERROR ); } } chomp @routes_as_text; my $routes_ref = $self->parse_routes( \@routes_as_text ); return $routes_ref; } no Moose; __PACKAGE__->meta->make_immutable(); 1; __END__ =head1 NAME Net::Route::Parser - Internal class =head1 SYNOPSIS Not used directly. =head1 VERSION Revision $Revision: 363 $. =head1 DESCRIPTION This is a base class for the system-specific parsers. It is not usable directly (abstract). System-specific parsers should inherit from this class to obtain common functionality. =head1 INTERFACE This interface is subject to change until version 1. =head2 Object Methods =head3 from_system() Implementation of C. =head3 command_line() [pure virtual] What you want to read the information from, as either: =over =item * a string - it will undergo shell expansion =item * an arrayref - the command and its arguments, without shell expansion =back Implement this in subclasses. =head3 parse_routes( $text_lines_ref ) [pure virtual] Reads and parses the routes from the output of the command, returns an arrayref of L objects. =head3 create_ip_object ( $address, $mask ) Factory of L objects for centralized error management. Dies if the arguments do not constitute a valid IP or network address. =head1 AUTHOR Created by Alexandre Storoz, C<< >> Maintained by Thomas Equeter, C<< >> =head1 LICENSE AND COPYRIGHT Copyright (C) 2009 Straton IT. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Net-Route-v0.02/MANIFEST0000444000175000017500000000060111302464601015042 0ustar tequetertequeterBuild.PL Changes MANIFEST README lib/Net/Route.pm lib/Net/Route/Parser/MSWin32.pm lib/Net/Route/Parser/linux.pm lib/Net/Route/Parser/solaris.pm lib/Net/Route/Table.pm lib/Net/Route/Parser.pm t/00-load.t t/02-perlcritic.t t/02-pod-coverage.t t/02-pod.t t/20-exception.t t/50-integration.t t/bin/suicide.pl t/lib/Net/Route/Parser/Test.pm t/perltidyrc t/perlcriticrc Makefile.PL META.yml Net-Route-v0.02/Changes0000444000175000017500000000300011302464601015200 0ustar tequetertequeterRevision history for Net-Route 0.02 2009-11-23 - Fixed a typo on MSWin32 that would render the module unusable - Moved secondary dependencies to recommendations - Documentation fixes 0.01 2009-11-12 Version bump. 0.00_11 2009-11-10 More CPANT-related changes. 0.00_10 2009-10-30 Improved testing behavior for CPANT (thanks Andreas Koenig!) 0.00_09 2009-10-29 Build process changes (CPANT reports, user-friendliness) 0.00_08 2009-10-28 Proper IP parsing error management for Solaris CPANT report investigation. 0.00_07 2009-10-22 Solaris and regex fixes according to CPAN testers reports. 0.00_06 2009-10-16 Fixed some tests, added Perl version requirements to keep Perl::Critic::Pulp happy. 0.00_05 2009-10-14 - Added diag output for unparsable system routes on some CPAN testers' systems (we can't reproduce the issue here) - Added Perl version requirement on each source file for Perl::Critic correctness 0.00_04 2009-10-08 Updated MANIFEST (oops.) 0.00_03 2009-10-07 This alpha release adds support for solaris and more thorough tests. Warning: the internal API changed as we are now using IPC::Run3. 0.00_02 2009-10-02 This alpha release adds support for MSWin32. 0.00_01 2009-09-22 First version, released on an unsuspecting world. This alpha release supports Linux only, although there is a tentative win32 implementation. Net-Route-v0.02/Makefile.PL0000444000175000017500000000214111302464601015664 0ustar tequetertequeter# Note: this file was auto-generated by Module::Build::Compat version 0.2808_01 require 5.8.0; unless (eval "use Module::Build::Compat 0.02; 1" ) { print "This module requires Module::Build to install itself.\n"; require ExtUtils::MakeMaker; my $yn = ExtUtils::MakeMaker::prompt (' Install Module::Build now from CPAN?', 'y'); unless ($yn =~ /^y/i) { die " *** Cannot install without Module::Build. Exiting ...\n"; } require Cwd; require File::Spec; require CPAN; # Save this 'cause CPAN will chdir all over the place. my $cwd = Cwd::cwd(); CPAN::Shell->install('Module::Build::Compat'); CPAN::Shell->expand("Module", "Module::Build::Compat")->uptodate or die "Couldn't install Module::Build, giving up.\n"; chdir $cwd or die "Cannot chdir() back to $cwd: $!"; } eval "use Module::Build::Compat 0.02; 1" or die $@; Module::Build::Compat->run_build_pl(args => \@ARGV); require Module::Build; Module::Build::Compat->write_makefile(build_class => 'Module::Build');