Frey/Shell/sar.pm

package Frey::Shell::sar;
use Moose;

extends 'Frey';
with 'Frey::Web';
#with 'Frey::Storage';

has sar_command => (
        is => 'rw',
        isa => 'Str',
        required => 1,
        default => 'sar',
);

sub as_sponge {
        my ($self,$opts) = @_;

        $opts ||= $self->sar_command !~ m{-\w} ? '-u' : '';

        my @rows;
        my @name;

        my @pos;

        my $cmd = $self->sar_command . ' ' . $opts;
        warn "# cmd: $cmd";

        my $date = '1970-01-01T';

        open(my $fh, '-|', $cmd) || die "can't open pipe to $cmd $!";
        while(<$fh>) {
                chomp;

                if ( m{(\d\d)/(\d\d)/(\d\d\d\d)$} ) {
                        $date = "$3-$1-$2T";
                        warn "# date $date";
                        next;
                }

                next unless m{^\d\d:\d\d:\d\d};

                my @l;

                if ( s{_([^_]+)_$}{} ) {
                        my $line = $_;
                        warn "# header $1 from $line";
                        while ( $line =~ s{^(\s*\S+)}{} ) {
                                push @pos, length($1);
                        }
                        warn "# pos: ", $self->dump( @pos );
                        my @l = split(/\s+/,$_);
                        warn "# l: ", $self->dump( @l );
                        $l[0] =~ s{\d\d:\d\d:\d\d}{time} || die "can't locate time column in header";
                        @name = @l;
                        next;
                } elsif ( @pos ) {
                        my @cols = split(/\s+/,$_);
                        if ( $#cols < $#name ) {
                                warn "# skip too short line: '$_'";
                                next;
                        }
                        my $start = 0;
                        foreach my $len ( @pos ) {
                                my $v = substr($_, $start, $len);
                                $v =~ s/^\s+//g;
                                push @l, $v;
                                $start += $len;
                        }
                } else {
                        die "got: $_ before header!";
                }

                $l[0] = $date . $l[0];

                push @rows, [ @l ];
        }

        return {
                rows => \@rows,
                NAME => \@name,
        }
}

1;
1	dpavlin	866	package Frey::Shell::sar;
2			use Moose;
3
4			extends 'Frey';
5			with 'Frey::Web';
6			#with 'Frey::Storage';
7
8			has sar_command => (
9			is => 'rw',
10			isa => 'Str',
11			required => 1,
12			default => 'sar',
13			);
14
15			sub as_sponge {
16			my ($self,$opts) = @_;
17
18	dpavlin	871	$opts \|\|= $self->sar_command !~ m{-\w} ? '-u' : '';
19	dpavlin	866
20			my @rows;
21			my @name;
22
23	dpavlin	871	my @pos;
24
25	dpavlin	866	my $cmd = $self->sar_command . ' ' . $opts;
26			warn "# cmd: $cmd";
27
28	dpavlin	867	my $date = '1970-01-01T';
29
30	dpavlin	866	open(my $fh, '-\|', $cmd) \|\| die "can't open pipe to $cmd $!";
31			while(<$fh>) {
32			chomp;
33	dpavlin	871
34	dpavlin	867	if ( m{(\d\d)/(\d\d)/(\d\d\d\d)$} ) {
35			$date = "$3-$1-$2T";
36			warn "# date $date";
37	dpavlin	871	next;
38	dpavlin	867	}
39	dpavlin	871
40	dpavlin	866	next unless m{^\d\d:\d\d:\d\d};
41	dpavlin	871
42			my @l;
43
44			if ( s{_([^_]+)_$}{} ) {
45			my $line = $_;
46			warn "# header $1 from $line";
47			while ( $line =~ s{^(\s*\S+)}{} ) {
48			push @pos, length($1);
49			}
50			warn "# pos: ", $self->dump( @pos );
51			my @l = split(/\s+/,$_);
52			warn "# l: ", $self->dump( @l );
53	dpavlin	874	$l[0] =~ s{\d\d:\d\d:\d\d}{time} \|\| die "can't locate time column in header";
54	dpavlin	866	@name = @l;
55			next;
56	dpavlin	871	} elsif ( @pos ) {
57			my @cols = split(/\s+/,$_);
58			if ( $#cols < $#name ) {
59			warn "# skip too short line: '$_'";
60			next;
61			}
62			my $start = 0;
63			foreach my $len ( @pos ) {
64			my $v = substr($_, $start, $len);
65			$v =~ s/^\s+//g;
66			push @l, $v;
67			$start += $len;
68			}
69			} else {
70			die "got: $_ before header!";
71	dpavlin	866	}
72
73	dpavlin	867	$l[0] = $date . $l[0];
74
75	dpavlin	866	push @rows, [ @l ];
76			}
77
78			return {
79			rows => \@rows,
80			NAME => \@name,
81			}
82			}
83
84			1;