File Coverage

blib/lib/BigIP/LTM/ParseConfig.pm

Criterion	Covered	Total	%
statement	42	198	21.2
branch	0	72	0.0
condition	0	36	0.0
subroutine	14	42	33.3
pod	0	24	0.0
total	56	372	15.0

package BigIP::LTM::ParseConfig;

# CURRENTLY UNDER DEVELOMENT BY CARELINE

our $VERSION = '0.8.2';
my $AUTOLOAD;

use warnings;
use strict;

# Initialize the module
sub new {
    my $class = shift;

    my $self = {};
    bless $self, $class;

    $self->{'ConfigFile'} = shift;

    return $self;
}

# Return a list of objects
sub monitors   { return shift->_objectlist('monitor'); }
sub nodes      { return shift->_objectlist('ltm node'); }
sub partitions { return shift->_objectlist('partition'); }
sub pools      { return shift->_objectlist('ltm pool'); }
sub profiles   { return shift->_objectlist('ltm profile'); }
sub routes     { return shift->_objectlist('net route'); }
sub interfaces { return shift->_objectlist('net interface'); }
sub rules      { return shift->_objectlist('ltm rule'); }
sub users      { return shift->_objectlist('auth'); }
sub virtuals   { return shift->_objectlist('ltm virtual'); }

# Return an object hash
sub monitor   { return shift->_object( 'monitor',       shift ); }
sub node      { return shift->_object( 'ltm node',      shift ); }
sub partition { return shift->_object( 'partition',     shift ); }
sub pool      { return shift->_object( 'ltm pool',      shift ); }
sub profile   { return shift->_object( 'ltm profile',   shift ); }
sub route     { return shift->_object( 'net route',     shift ); }
sub interface { return shift->_object( 'net interface', shift ); }
sub rule      { return shift->_object( 'ltm rule',      shift ); }
sub user      { return shift->_object( 'auth',          shift ); }
sub virtual   { return shift->_object( 'ltm virtual',   shift ); }

# Return a list of pool members
sub members {
    my $self = shift;
    my $pool = shift;

    $self->{'Parsed'} ||= $self->_parse();

    return 0 unless $self->{'Parsed'}->{'pool'}->{$pool}->{'members'};

    if ( ref $self->{'Parsed'}->{'pool'}->{$pool}->{'members'} eq 'ARRAY' ) {
        return @{ $self->{'Parsed'}->{'pool'}->{$pool}->{'members'} };
    }
    else {
        return $self->{'Parsed'}->{'pool'}->{$pool}->{'members'};
    }
}

# Modify an object
sub modify {
    my $self = shift;

    my ($arg);
    %{$arg} = @_;

    return 0 unless $arg->{'type'} && $arg->{'key'};

    my $obj = $arg->{'type'};
    my $key = $arg->{'key'};
    delete $arg->{'type'};
    delete $arg->{'key'};

    $self->{'Parsed'} ||= $self->_parse();

    return 0 unless $self->{'Parsed'}->{$obj}->{$key};

    foreach my $attr ( keys %{$arg} ) {
        next unless $self->{'Parsed'}->{$obj}->{$key}->{$attr};
        $self->{'Modify'}->{$obj}->{$key}->{$attr} = $arg->{$attr};
    }

    return 1;
}

# Write out a new configuration file
sub write {
    my $self = shift;
    my $file = shift || $self->{'ConfigFile'};

    die "No changes found; no write necessary" unless $self->{'Modify'};

    foreach my $obj (
        qw( self partition route user monitor auth profile node pool rule virtual )
        )
    {
        foreach my $key ( sort keys %{ $self->{'Parsed'}->{$obj} } ) {
            if ( $self->{'Modify'}->{$obj}->{$key} ) {
                $self->{'Output'} .= "$obj $key {\n";
                foreach my $attr ( $self->_order($obj) ) {
                    next unless $self->{'Parsed'}->{$obj}->{$key}->{$attr};
                    $self->{'Modify'}->{$obj}->{$key}->{$attr}
                        ||= $self->{'Parsed'}->{$obj}->{$key}->{$attr};
                    if (ref $self->{'Modify'}->{$obj}->{$key}->{$attr} eq
                        'ARRAY' )
                    {
                        if ( @{ $self->{'Modify'}->{$obj}->{$key}->{$attr} }
                            > 1 )
                        {
                            $self->{'Output'} .= "   $attr\n";
                            foreach my $val (
                                @{  $self->{'Modify'}->{$obj}->{$key}->{$attr}
                                }
                                )
                            {
                                $self->{'Output'} .= "      $val\n";
                                if ( $self->{'Parsed'}->{$obj}->{$key}
                                    ->{'_xtra'}->{$val} )
                                {
                                    $self->{'Output'}
                                        .= '         '
                                        . $self->{'Parsed'}->{$obj}->{$key}
                                        ->{'_xtra'}->{$val} . "\n";
                                }
                            }
                        }
                        else {
                            $self->{'Output'}
                                .= "   $attr "
                                . $self->{'Modify'}->{$obj}->{$key}
                                ->{$attr}[0] . "\n";
                        }
                    }
                    else {
                        $self->{'Output'}
                            .= "   $attr "
                            . $self->{'Modify'}->{$obj}->{$key}->{$attr}
                            . "\n";
                    }
                }
                $self->{'Output'} .= "}\n";
            }
            else {
                $self->{'Output'} .= $self->{'Raw'}->{$obj}->{$key};
            }
        }
    }

    open FILE, ">$file" || return 0;
    print FILE $self->{'Output'};
    close FILE;

    return 1;
}

# Return an object hash
sub _object {
    my $self = shift;
    my $obj  = shift;
    my $var  = shift;

    $self->{'Parsed'} ||= $self->_parse();

    return $self->{'Parsed'}->{$obj}->{$var} || 0;
}

# Return a list of objects
sub _objectlist {
    my $self = shift;
    my $obj  = shift;

    $self->{'Parsed'} ||= $self->_parse();

    if ( $self->{'Parsed'}->{$obj} ) {
        return keys %{ $self->{'Parsed'}->{$obj} };
    }
    else {
        return 0;
    }
}

# Define object attribute ordering
sub _order {
    my $self = shift;

    for (shift) {
        /auth/ && return qw( bind login search servers service ssl user );
        /monitor/
            && return
            qw( default base debug filter mandatoryattrs password security username interval timeout manual dest recv send );
        /node/      && return qw( monitor screen );
        /partition/ && return qw( description );
        /pool/      && return qw( lb nat monitor members );
        /self/      && return qw( netmask unit floating vlan allow );
        /user/ && return qw( password description id group home shell role );
        /virtual/
            && return
            qw( translate snat pool destination ip rules profiles persist );

        return 0;
    }
}

# Parse the configuration file
sub _parse {
    my $self = shift;
    my $file = shift || $self->{'ConfigFile'};

    die "File not found: $self->{'ConfigFile'}\n"
        unless -e $self->{'ConfigFile'};

    open FILE, $file || return 0;
    my @file = ;
    close FILE;

    my ( $data, $parsed );

    until ( !$file[0] ) {
        my $ln = shift @file;

        if ( $ln
            =~ /^(auth|patition|cli|ltm node|ltm pool|ltm profile|ltm rule|ltm virtual|net self|net route|net interface)\s(.*)\s\{(\s?\}?)$/
            )
        {
            $data->{'obj'} = $1;
            $data->{'key'} = $2;
        }

        if ( $data->{'obj'} && $data->{'key'} ) {
            $self->{'Raw'}->{ $data->{'obj'} }->{ $data->{'key'} } .= $ln;

            #缩进为4且{}非空哈希
            if ( $ln =~ /^\s{4}(\S+)\s\{$/ ) {
                $data->{'list1'} = $1;
                next;
            }

            #缩进为8且{}非空哈希
            if ( $ln =~ /^\s{8}(\S+)\s\{$/ ) {
                $data->{'list2'} = $1;
                next;
            }

            #捕捉代码块结束符并清空
            if ( $ln =~ /^\s{4}\}$/ ) {
                delete $data->{'list1'};
                next;
            }

            #捕捉代码块结束符并清空
            if ( $ln =~ /^\s{8}\}$/ ) {
                delete $data->{'list2'};
                next;
            }

            #缩进为4且携带{}空哈希
            if ( $ln =~ /^\s{4}(\S+)\s\{\s\}$/ ) {
                no strict 'refs';
                $parsed->{ $data->{'obj'} }->{ $data->{'key'} }->{$1} = undef;
                use strict 'refs';
                next;
            }

            if ( $data->{'list1'} ) {

                #缩进为8且携带{}空哈希
                if ( $ln =~ /^\s{8}(\S+)\s\{\s\}$/ ) {
                    no strict 'refs';
                    $parsed->{ $data->{'obj'} }->{ $data->{'key'} }
                        ->{ $data->{'list1'} }->{$1} = undef;
                    use strict 'refs';
                    next;
                }

                #缩进为8且为键值对
                if ( $ln =~ /^\s{8}(\S+)\s(\S+)$/ ) {
                    no strict 'refs';
                    $parsed->{ $data->{'obj'} }->{ $data->{'key'} }
                        ->{ $data->{'list1'} }->{$1} = $2;
                    use strict 'refs';
                    next;
                }

                #缩进为8且为标量数据
                if ( $ln =~ /^\s{8}(\S+)$/ ) {
                    no strict 'refs';
                    $parsed->{ $data->{'obj'} }->{ $data->{'key'} }
                        ->{ $data->{'list1'} } = $1;
                    use strict 'refs';
                    next;
                }
            }

            if ( $data->{'list2'} ) {

             #缩进为12且为空哈希(暂时忽略缩进为12且嵌套键值对的清空) -- 待完善
                if ( $ln =~ /^\s{12}(\S+)\s\{\s\}$/ ) {
                    no strict 'refs';
                    $parsed->{ $data->{'obj'} }->{ $data->{'key'} }
                        ->{ $data->{'list1'} }->{ $data->{'list2'} }->{$1}
                        = undef;
                    use strict 'refs';
                    next;
                }

                #缩进为12且为键值对
                if ( $ln =~ /^\s{12}(\S+)\s(\S+)$/ ) {
                    no strict 'refs';
                    $parsed->{ $data->{'obj'} }->{ $data->{'key'} }
                        ->{ $data->{'list1'} }->{ $data->{'list2'} }->{$1}
                        = $2;
                    use strict 'refs';
                    next;
                }
            }

            #兜底策略解析
            if ( $ln =~ /^\s{4}(\S+)\s(\S+)\s+?$/ ) {
                say $ln;
                $parsed->{ $data->{'obj'} }->{ $data->{'key'} }->{$1} = $2;
                next;
            }
        }
    }

    # Fill in ill-formatted objects
    foreach my $obj ( keys %{ $self->{'Raw'} } ) {
        foreach my $key ( keys %{ $self->{'Raw'}->{$obj} } ) {
            $parsed->{$obj}->{$key} ||= $self->{'Raw'}->{$obj}->{$key};
        }
    }

    return $parsed;
}

1;