File Coverage

blib/lib/Device/Network/ConfigParser.pm

Criterion	Covered	Total	%
statement	32	66	48.4
branch	0	16	0.0
condition	0	25	0.0
subroutine	11	13	84.6
pod	1	1	100.0
total	44	121	36.3

package Device::Network::ConfigParser;
# ABSTRACT: A harness for parsing network device configuration.


use 5.006;
use strict;
use warnings;
use Modern::Perl;
use Getopt::Long;
use Pod::Usage;
use Perl6::Slurp;
use Module::Load;
use Data::Dumper;
use Scalar::Util qw{reftype};


use Exporter qw{import};

our @EXPORT_OK = qw{app};


sub app {
    local @ARGV = @_;
    my %args;

    GetOptions(
        "vendor=s"  => \$args{vendor},
        "type=s"    => \$args{type},
        "format=s"  => \$args{format},
        "output=s"  => \$args{output}
    ) or pod2usage(2);

    # Set the defaults
    $args{vendor} //= 'CheckPoint';
    $args{type}   //= 'Gaia';
    $args{format} //= 'raw';
    $args{output} //= '-';      # STDOUT


    # Load the module specified by the command line parameters
    my $parser_module_name = "Device::Network::ConfigParser::$args{vendor}::$args{type}";
    load $parser_module_name, qw{get_parser get_output_drivers parse_config post_process};

    # Check the exports
    if (!defined &get_parser ||
        !defined &get_output_drivers ||
        !defined &parse_config ||
        !defined &post_process) {
        die "$parser_module_name does not export all required subroutines\n";
    }

    # Retrieve the parser and the output drivers from the module. If 'raw' doesn't exist,
    # it's populated with the default sub from this package.
    # The active driver is then selected for use.
    my $parser = get_parser();
    my $output_drivers = get_output_drivers();
    $output_drivers->{raw} //= \&_default_raw_output_driver;
    my $active_output_driver = $output_drivers->{ $args{format} };

    if (!defined $active_output_driver || reftype $active_output_driver ne 'CODE' ) {
        die "'$args{format}' is not a valid output driver for $parser_module_name\n";
    }

    # If there are no files specified, we slurp from STDIN
    push @ARGV, \*STDIN if !@ARGV;

    for my $config_filename (@ARGV) {
        # Read in the configuration
        my $raw_config = slurp $config_filename;

        # Change the name to something sensible so it isn't stringified to something like 'GLOB(0x17c7350)'
        $config_filename = 'STDIN' if reftype($config_filename) && reftype($config_filename) eq 'GLOB';

        # Call the parser imported from the module.
        my $parsed_config = parse_config($parser, $raw_config);

        # Perform any post-processing.
        my $post_processed_config = post_process($parsed_config);

        # Open the file, which could be STDOUT
        my $fh;
        if ($args{output} eq '-') {
            local *STDOUT;
            $fh = \*STDOUT;
        } else {
            # Replace the placeholder with the filename
            my ($outfile) = $args{output} =~ s{%in_file%}{$config_filename}rxms;
            open($fh, ">>:encoding(UTF-8)", $outfile) or die "Unable to open output file '$outfile': $!\n";
        }

        # Call the output driver.
        $active_output_driver->($fh, $config_filename, $post_processed_config);

        close($fh) unless $args{output} eq '-';
    }

    return 0;
}


sub _default_raw_output_driver {
    my ($fh, $filename, $parsed_config) = @_;
    print $fh Dumper($parsed_config);
}


1; # End of Device::Network::ConfigParser

__END__