lib/PXElator/shell.pm

package shell;

use warnings;
use strict;

use autodie;
use Data::Dump qw/dump/;

our $command;

sub command {
        ( undef, $command ) = @_;
        __PACKAGE__;
}

sub lines {
        my ( $self, $key ) = @_;

warn "command $command key $key";

        my $info;

        my @header;

        my $split_re;

        open(my $brctl, '-|', $command);
        while(<$brctl>) {
                chomp;

                if ( ! $split_re ) {
                        $split_re = qr/\t+/ if m/\t/;
                        $split_re ||= qr/\s+/ if m/\s/;
                }

                my @cols = split( $split_re, $_);

                if ( ! @header ) {
                        @header = @cols;
                        $info->{_header} = [ @header ] if $key;
                        next;
                }

                my $hash =  { map { ( $header[$_] => $cols[$_] ) } 0 .. $#cols } ;

                if ( $key ) {
                        my $k = $cols[$key - 1];
                        $info->{$k} = $hash;
                } else {
                        push @$info, $hash;
                }

        }

        warn $command, ' ', dump( $info );

        return $info;
}

sub hash_by { lines(@_) }

1;
1	package shell;
2
3	use warnings;
4	use strict;
5
6	use autodie;
7	use Data::Dump qw/dump/;
8
9	our $command;
10
11	sub command {
12	( undef, $command ) = @_;
13	__PACKAGE__;
14	}
15
16	sub lines {
17	my ( $self, $key ) = @_;
18
19	warn "command $command key $key";
20
21	my $info;
22
23	my @header;
24
25	my $split_re;
26
27	open(my $brctl, '-\|', $command);
28	while(<$brctl>) {
29	chomp;
30
31	if ( ! $split_re ) {
32	$split_re = qr/\t+/ if m/\t/;
33	$split_re \|\|= qr/\s+/ if m/\s/;
34	}
35
36	my @cols = split( $split_re, $_);
37
38	if ( ! @header ) {
39	@header = @cols;
40	$info->{_header} = [ @header ] if $key;
41	next;
42	}
43
44	my $hash = { map { ( $header[$_] => $cols[$_] ) } 0 .. $#cols } ;
45
46	if ( $key ) {
47	my $k = $cols[$key - 1];
48	$info->{$k} = $hash;
49	} else {
50	push @$info, $hash;
51	}
52
53	}
54
55	warn $command, ' ', dump( $info );
56
57	return $info;
58	}
59
60	sub hash_by { lines(@_) }
61
62	1;