File Coverage

blib/lib/File/OSS/Scan/Ruleset.pm

Criterion	Covered	Total	%
statement	24	91	26.3
branch	0	28	0.0
condition	0	11	0.0
subroutine	8	11	72.7
pod	0	3	0.0
total	32	144	22.2

=head1 NAME

File::OSS::Scan::Ruleset - initialize the scan rules

=head1 VERSION

version 0.04

=head1 SYNOPSIS

    use File::OSS::Scan::Ruleset;

    File::OSS::Scan::Ruleset->init($config_file);
    my $ruleset = File::OSS::Scan::Ruleset->get_ruleset();

=head1 DESCRIPTION

This is an internal module used by L to initialise scan rules from
the configuration file, and should not be called directly.

=head1 SEE ALSO

=over 4

=item * L

=back

=head1 AUTHOR

Harry Wang

=head1 COPYRIGHT AND LICENSE

This software is Copyright (c) 2014 by Harry Wang.

This is free software, licensed under:

    Artistic License 1.0

=cut

package File::OSS::Scan::Ruleset;

use strict;
use warnings FATAL => 'all';

use Fatal qw( open close );
use Carp;
use English qw( -no_match_vars );
use Data::Dumper; # for debug

use File::OSS::Scan::Constant qw(:all);

our $VERSION = '0.04';

my $cfg_default = $ENV{OSSSCAN_CONFIG} || ".ossscan.rc";
my @valid_sections = qw/GLOBAL FILE DIRECTORY LINE/;

# global var ...
our $ruleset = undef;

sub init {
    my $self = shift;
    my $config_file = shift || $cfg_default;

    local *CONFIG;

    if ( ! -f $config_file ) {
        carp "config file $config_file doesn't exist, using the embedded ruleset.";

        # read from __DATA__ section
        *CONFIG = *DATA;
    }
    else {
        croak "config file $config_file is not readable."
            if ( ! -r $config_file );

        open( CONFIG, $config_file ) ||
            croak "Can't open $config_file, $!.";
    }

    # clear previously set config $ruleset
    undef $ruleset;

    my ( $section, $rule ) = ( undef, undef );
    my $invalid_section_flag = UNI_FALSE;

    while() {
        chomp;      # remove newline
        s/#.*//;    # remove comments
        s/^\s+//;   # remove leading spaces
        s/\s+$//;   # remove trailing spaces

        # anything left ?
        next unless length;

        # parse sections
        if ( /^\[(\w+)\].*/ ) {
            $section = uc $1;

            # skip invalid sections
            if (  ! grep {/^$section$/} @valid_sections ) {
                carp "Invalid section name $section, skipping ...";
                $invalid_section_flag = UNI_TRUE;
                next;
            } else {
                $invalid_section_flag = UNI_FALSE;
            }

            $ruleset->{$section} = undef
                if ( not exists $ruleset->{$section} );
        }

        # parse settings
        # put them all under 'GLOBAL' section
        if ( /^(\w+)\s*\:\s*(.*)$/ ) {
            my ( $key, $val ) = ( $1, $2 );
            $ruleset->{'GLOBAL'}->{$key} = [ split /\s+/, $val ];
        }

        # parse rules
        # if ( /^([\w\%\-\s]+)$/ ) {
        if ( /^(\d+\%?.*)$/ ) {
            $rule = $1;

            # skip rules under invalid sections
            if ( $invalid_section_flag ) {
                carp "also skipping rules $rule under invalid section $section ...";
                next;
            }

            my $cur_section = $section || 'GLOBAL';

            my ( $certain, $func, @args )
                = split(' ', $rule);

            # valid level of certainty: 0 - 100
            if ( $certain =~ /^(\d+)\%?$/ ) {
                $certain = $1;

                if ( $certain > 100 or $certain < 0 ) {
                    carp "certainty $certain is not in the range of 0 to 100, skipping rules $rule ...";
                    next;
                }
            }
            else {
                carp "invalid level of certainty $certain, skipping rules $rule ...";
                next;
            }

            my $hash = {
                'cert'  => $certain,
                'func'  => $func,
                'args'  => \@args
            };

            push @{$ruleset->{$cur_section}}, $hash;
        }

    }

    close( CONFIG );

    # sort rulesets by certainty level
    sort_ruleset();

    return SUCCESS;
}

sub get_ruleset {
    my $var = $_[0] . "::ruleset";
    no strict 'refs';
    return $$var;
}

sub sort_ruleset {

    # sort every sections of ruleset according to
    # its level of certainty.
    foreach my $sec ( @valid_sections ) {

        # don't sort global setting
        next
            if ( $sec eq 'GLOBAL' );

        if ( exists $ruleset->{$sec} and
                defined $ruleset->{$sec} ) {

            my @sorted = ();
            my %raw_hash = ();
            my $rules = $ruleset->{$sec};

            foreach my $rule ( @$rules ) {
                my $cert = $rule->{'cert'};
                push @{$raw_hash{$cert}}, $rule;
            }

            foreach my $s_cert ( sort { $b <=> $a } keys %raw_hash ) {
                push @sorted, @{$raw_hash{$s_cert}};
            }

            $ruleset->{$sec} = \@sorted;
        }
    }

    return SUCCESS;
}


1;



__DATA__