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-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,
        }
}

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