lib/PXElator/ip.pm

package ip;

use warnings;
use strict;

use Data::Dump qw/dump/;

use html;
use server;

sub lines {
        my ( $object ) = @_;

        my $debug = server::debug;

        $object ||= 'link';

        my $i = 0;
        my @objects;

        my @headers;
        my $headers;

        foreach my $line ( split(/\n/, `ip $object`) ) {
                warn "# $line\n" if $debug;
                my $add_header;

                if ( $line =~ s{^(\d+):\s+(\w+):\s+}{} ) {
                        $i = $1;
                        $objects[$i] = { dev => $2 };
                        $add_header = $object;
                } elsif ( $line =~ s{^\s+}{} ) {
                        # line continues
                } else {
                        $i++;
                        $line =~ s{^(\S+)\s+}{};
                        $objects[$i] = {
                                $object => $1
                        };
                        $add_header = $object;
                }

                push @headers, $add_header if $add_header && ! $headers->{$add_header}++;

                if ( $line =~ s{<(\S+)>\s+}{} ) {
                        $add_header = 'flags';
                        $objects[$i]->{$add_header} = $1;
                        push @headers, $add_header unless $headers->{$add_header}++;
                }

                my @p = split(/\s+/, $line);
                while (@p) {
                        my ($n,$v) = splice @p, 0, 2;
                        if ( ! defined $v ) {
                                $objects[$i]->{''} = $n;
                                $n = '';
                        } elsif ( $n =~ m{^(.+)/(.+)$} ) {
                                $n = $1;
                                $objects[$i]->{$n} = $2;
                                $objects[$i]->{mac} = $v;
                        } else {
                                $objects[$i]->{$n} = $v;
                        }
                        push @headers, $n unless $headers->{$n}++;
                }

#               warn dump( $objects[$i] );
        }

        return unless @objects;

        $objects[0] = [ @headers ];

        return @objects;
}

sub html {
        my @objects = ip::lines( @_ );
        return '' unless @objects;

        my @headers = @{ shift @objects };

        my @table = ( -( $#headers + 1), @headers );
        foreach my $o ( @objects ) {
                foreach ( 0 .. $#headers ) {
                        my $h = $headers[$_];
                        push @table, $o->{$h};
                }
        }

        return html::table( @table );
}

sub devices_up {
        my @links = ip::lines( 'link' );
        my @devs;
        foreach ( 1 .. $#links ) {
                push @devs, $links[$_]->{dev} if $links[$_]->{flags} =~ m{UP};
        }
        return @devs;
}

sub default_route_dev {
        my @routes = ip::lines 'route';

        return
                map { $_->{dev} }
                grep { $_->{route} eq 'default' }
                splice @routes, 1 # FIXME ship header
        ;
}

sub to_int {
        pack( 'C*', split(/\./, shift) )
}

sub from_int {
        join( '.', unpack('C4', shift) )
}

1;
1	dpavlin	224	package ip;
2
3			use warnings;
4			use strict;
5
6			use Data::Dump qw/dump/;
7
8			use html;
9	dpavlin	265	use server;
10	dpavlin	224
11			sub lines {
12			my ( $object ) = @_;
13
14	dpavlin	265	my $debug = server::debug;
15
16	dpavlin	224	$object \|\|= 'link';
17
18			my $i = 0;
19			my @objects;
20
21			my @headers;
22			my $headers;
23
24			foreach my $line ( split(/\n/, `ip $object`) ) {
25	dpavlin	265	warn "# $line\n" if $debug;
26	dpavlin	224	my $add_header;
27
28			if ( $line =~ s{^(\d+):\s+(\w+):\s+}{} ) {
29			$i = $1;
30	dpavlin	265	$objects[$i] = { dev => $2 };
31	dpavlin	224	$add_header = $object;
32			} elsif ( $line =~ s{^\s+}{} ) {
33			# line continues
34			} else {
35			$i++;
36			$line =~ s{^(\S+)\s+}{};
37			$objects[$i] = {
38			$object => $1
39			};
40			$add_header = $object;
41			}
42
43			push @headers, $add_header if $add_header && ! $headers->{$add_header}++;
44
45			if ( $line =~ s{<(\S+)>\s+}{} ) {
46			$add_header = 'flags';
47			$objects[$i]->{$add_header} = $1;
48			push @headers, $add_header unless $headers->{$add_header}++;
49			}
50
51			my @p = split(/\s+/, $line);
52			while (@p) {
53			my ($n,$v) = splice @p, 0, 2;
54			if ( ! defined $v ) {
55			$objects[$i]->{''} = $n;
56			$n = '';
57			} elsif ( $n =~ m{^(.+)/(.+)$} ) {
58			$n = $1;
59			$objects[$i]->{$n} = $2;
60			$objects[$i]->{mac} = $v;
61			} else {
62			$objects[$i]->{$n} = $v;
63			}
64			push @headers, $n unless $headers->{$n}++;
65			}
66
67			# warn dump( $objects[$i] );
68			}
69
70			return unless @objects;
71
72			$objects[0] = [ @headers ];
73
74			return @objects;
75			}
76
77			sub html {
78			my @objects = ip::lines( @_ );
79			return '' unless @objects;
80
81			my @headers = @{ shift @objects };
82
83			my @table = ( -( $#headers + 1), @headers );
84			foreach my $o ( @objects ) {
85			foreach ( 0 .. $#headers ) {
86			my $h = $headers[$_];
87			push @table, $o->{$h};
88			}
89			}
90
91			return html::table( @table );
92			}
93
94	dpavlin	265	sub devices_up {
95			my @links = ip::lines( 'link' );
96			my @devs;
97			foreach ( 1 .. $#links ) {
98			push @devs, $links[$_]->{dev} if $links[$_]->{flags} =~ m{UP};
99			}
100			return @devs;
101			}
102
103	dpavlin	278	sub default_route_dev {
104			my @routes = ip::lines 'route';
105	dpavlin	265
106	dpavlin	278	return
107			map { $_->{dev} }
108			grep { $_->{route} eq 'default' }
109			splice @routes, 1 # FIXME ship header
110			;
111			}
112
113			sub to_int {
114			pack( 'C*', split(/\./, shift) )
115			}
116
117			sub from_int {
118			join( '.', unpack('C4', shift) )
119			}
120
121	dpavlin	224	1;