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	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	$opts \|\|= $self->sar_command !~ m{-\w} ? '-u' : '';
18
19	my @rows;
20	my @name;
21
22	my @pos;
23
24	my $cmd = $self->sar_command . ' ' . $opts;
25	warn "# cmd: $cmd";
26
27	my $date = '1970-01-01 ';
28
29	open(my $fh, '-\|', $cmd) \|\| die "can't open pipe to $cmd $!";
30	while(<$fh>) {
31	chomp;
32
33	if ( m{(\d\d)/(\d\d)/(\d\d\d\d)$} ) {
34	$date = "$3-$1-$2 ";
35	warn "# date $date";
36	next;
37	}
38
39	next unless m{^\d\d:\d\d:\d\d};
40
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	$l[0] =~ s{\d\d:\d\d:\d\d}{time} \|\| die "can't locate time column in header";
53	@name = @l;
54	next;
55	} elsif ( @pos ) {
56	my @cols = split(/\s+/,$_);
57	if ( $#cols < $#name ) {
58	warn "# skip too short line: '$_'";
59	next;
60	}
61
62	# nothing works well with kernel resource format value/sz
63	s{(\d+)/\d+}{$1}sg if $cmd =~ m{-v};
64
65	my $start = 0;
66	foreach my $col ( 0 .. $#pos ) {
67	my $len = $pos[$col];
68	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	}
76
77	$l[0] = $date . $l[0];
78
79	push @rows, [ @l ];
80	}
81
82	return {
83	table => 'sar',
84	rows => \@rows,
85	NAME => \@name,
86	sar_command => $cmd,
87	}
88	}
89
90	__PACKAGE__->meta->make_immutable;
91	no Moose;
92
93	1;