Frey/Shell/sar.pm

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

extends 'Frey';
with 'Frey::Web';

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-01 ';

        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-$2 ";
                        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;
                        }

                        # nothing works well with kernel resource format value/sz
                        s{(\d+)/\d+}{$1}sg if $cmd =~ m{-v};

                        my $start = 0;
                        foreach my $col ( 0 .. $#pos ) {
                                my $len = $pos[$col];
                                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 {
                table => 'sar',
                rows => \@rows,
                NAME => \@name,
                sar_command => $cmd,
        }
}

__PACKAGE__->meta->make_immutable;
no Moose;

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