view release on metacpan or  search on metacpan

lib/StorageDisplay/Collect.pm  view on Meta::CPAN

        if (scalar(@missing_files)) {
            print STDERR "I: skipping ", $col->module, " due to missing file(s): '",
                join("', '", @missing_files), "'\n";
            $collector_state->{$_} = 3 for $col->provides;
            return;
        }
        my $opencmd = $col->depends('root') ?
            'open_cmd_pipe_root' : 'open_cmd_pipe';
        # are programs present?
        my @missing_progs =
            grep {
                my @cmd=('which', $_);
                my $dh = $col->$opencmd(@cmd);
                my $path = <$dh>;
                close($dh);
                not defined($path);
            } $col->depends('progs');
        if (scalar(@missing_progs)) {
            print STDERR "I: skipping ", $col->module, " due to missing program(s): '",
                join("', '", @missing_progs), "'\n";
            $collector_state->{$_} = 3 for $col->provides;
            return;
        }
        # collecting data while providing required data
        my $collected_infos = $col->collect(
            {
                map { $_ => $infos->{$_} } $col->requires
            }, $req);
        # registering provided data
        $infos->{$_} = $collected_infos->{$_} for $col->provides;
        $collector_state->{$_} = 1 for $col->provides;
        #print STDERR "loaded $cn\n";
    };
    # Be sure to collect all collectors
    foreach my $col ($self->collectors) {
        $load->($col);
    }

    return $self->cmdreader->data_finish($infos);
}

1;

###########################################################################
package StorageDisplay::Collect::JSON;

BEGIN {
    # Mark current package as loaded;
    # else, we cannot use 'use StorageDisplay::Collect::JSON;' latter
    my $p = __PACKAGE__;
    $p =~ s,::,/,g;
    chomp(my $cwd = `pwd`);
    $INC{$p.'.pm'} = $cwd.'/'.__FILE__;#k"current file";
}

# This package contains
# - two public subroutines
#   - `use_pp_parser` to know if JSON:PP makes all the work alone
#   - `decode_json` to decode a json text with the $json_parser object
# - a public `new` class method that returns
#   - a plain JSON::PP object (if boolean_values method exists)
#   - a __PACKAGE__ object (if not) that inherit from JSON::PP
# - an overrided `decode` method that
#   - calls SUPER::decode
#   - manually transforms JSON:::PP::Boolean into plain scalar
# $json_parser is
# - either a JSON::PP object (if boolean_values method exists)
# - or a StorageDisplay::Collect::JSON that inherit of JSON::PP
#   but override the decode method

use base 'JSON::PP';

my $has_boolean_values;

sub new {
    my $class = shift;
    my $json_pp_parser;
    if (!defined($has_boolean_values)) {
	$json_pp_parser = JSON::PP->new;
	$has_boolean_values = 0;
	eval {
	    # workaround if not supported
	    $json_pp_parser->boolean_values(0, 1);
	    $has_boolean_values = 1;
	};
    }
    my $parser;
    if ($has_boolean_values) {
	$parser = JSON::PP->new(@_);
	$parser->boolean_values(0, 1);
    } else {
	$parser = JSON::PP::new(__PACKAGE__, @_);
    }
    eval {
	# ignore if not supported
	$parser->allow_bignum;
    };
    return $parser;
}

sub decode {
    my $self = shift;

    my $data = $self->SUPER::decode(@_);

    my %unrecognized;

    local *_convert_bools = sub {
        my $ref_type = ref($_[0]);
        if (!$ref_type) {
            # Nothing.
        }
        elsif ($ref_type eq 'HASH') {
            _convert_bools($_) for values(%{ $_[0] });
        }
        elsif ($ref_type eq 'ARRAY') {
            _convert_bools($_) for @{ $_[0] };
        }
        elsif ($ref_type eq 'JSON::PP::Boolean') {
            $_[0] = $_[0] ? 1 : 0;
        }
	elsif ($ref_type eq 'Math::BigInt') {
	    if ($_[0]->beq($_[0]->numify())) {
		# old versions of JSON::PP always use Math::Big*
		# even if this is not required
		$_[0] = $_[0]->numify();
	    }
	}
	elsif ($ref_type eq 'Math::BigFloat') {
	    if ($_[0]->is_int()
		&& $_[0]->beq($_[0]->numify())) {
		$_[0] = $_[0]->numify();
	    }
	}
        else {
            ++$unrecognized{$ref_type};
        }
    };

    &_convert_bools($data);

    warn("Encountered an object of unrecognized type $_")
        for sort values(%unrecognized);

    return $data;
}

my $json_parser;

sub decode_json {
    if (not defined($json_parser)) {
	$json_parser = __PACKAGE__->new();
    }

    $json_parser->decode(@_);
}

sub pp_parser_has_boolean_values {
    return $has_boolean_values;
}

sub jsonarray2perlhash {
    my $json = shift;
    my $root = shift;
    my $key = shift;
    my $info = {
        map { $_->{$key} => $_ }
	(@{decode_json($json)->{$root}})
    };
    return $info;
}

1;

###########################################################################
package StorageDisplay::Collect::CMD;

sub new {
    my $class = shift;
    my $self = {};
    bless $self, $class;
    return $self;
}

sub cmd2str {
    my $self = shift;
    my @cmd = @_;
    my $str = join(' ', map {
        my $s = $_;
        $s =~ s/(['\\])/\\$1/g;
        if ($s !~ /^[0-9a-zA-Z_@,:\/=-]+$/) {
            $s="'".$s."'";
        }
        $s;
    } @cmd);
    return $str;
}

sub data_init {
    my $self = shift;
    my $data = shift;

    return $data;
}

sub data_finish {
    my $self = shift;
    my $data = shift;

    return $data;
}

sub open_file {
    my $self = shift;
    my $filename = shift;

    return $self->open_cmd_pipe('cat', $filename);

    my $dh;