view release on metacpan or  search on metacpan

examples/dashboard/lib/Beekeeper/Service/Dashboard/Worker.pm  view on Meta::CPAN

                foreach my $metric (keys %{$stats->{$class}}) {

                    my $src = $stats->{$class}->{$metric};
                    my $dest = $cons->{$class}->{$metric} ||= [];

                    $dest->[TOTAL] += $src->[AVERAGE];
                    $dest->[COUNT]++;

                    $dest->[MAXIMUM] = 0 unless defined $dest->[MAXIMUM];
                    if ($src->[MAXIMUM] > $dest->[MAXIMUM]) {
                        $dest->[MAXIMUM] = $src->[MAXIMUM];
                    }
                }
            }
        }

        foreach my $class (keys %$cons) {
            foreach my $metric (keys %{$cons->{$class}}) {

                my $dest = $cons->{$class}->{$metric};

                my ($total, $count) = splice(@$dest, TOTAL, COUNT);

                $dest->[MAXIMUM] = sprintf("%.2f", $dest->[MAXIMUM]);
                $dest->[AVERAGE] = sprintf("%.2f", $total / $count);
            }
        }

        $cons->{global}->{load}->[MAXIMUM] = 0;
        $cons->{global}->{load}->[AVERAGE] = 0;

        foreach my $class (keys %$cons) {

            next if ($class eq '_global');

            if ($cons->{global}->{load}->[MAXIMUM] < $cons->{$class}->{load}->[MAXIMUM]) {
                $cons->{global}->{load}->[MAXIMUM] = $cons->{$class}->{load}->[MAXIMUM];
            }
            if ($cons->{global}->{load}->[AVERAGE] < $cons->{$class}->{load}->[AVERAGE]) {
                $cons->{global}->{load}->[AVERAGE] = $cons->{$class}->{load}->[AVERAGE];
            }
        }

        push @$stats_dest, [ $start, $cons ];
    }

    if (@$stats_dest > $keep) {
        # Discard old data
        shift @$stats_dest;
    }
}

sub _save_state {
    my ($self) = @_;

    my $pool_id = $self->{_WORKER}->{pool_id};
    ($pool_id) = ($pool_id =~ m/^([\w-]+)$/); # untaint
    my $tmp_file = "/tmp/beekeeper-dashboard-$pool_id-stats.dump";

    # Avoid stampede when several workers are exiting simultaneously
    return if (-e $tmp_file && (stat($tmp_file))[9] == time());

    # Lock file because several workers may try to write simultaneously to it
    sysopen(my $fh, $tmp_file, O_RDWR|O_CREAT) or return;
    flock($fh, LOCK_EX | LOCK_NB) or return;
    truncate($fh, 0) or return;

    print $fh encode_json([
        $self->{services_1s},
        $self->{services_5s},
        $self->{services_2m},
        $self->{services_15m},
        $self->{services_1h},
    ]);

    close($fh);
}

sub _load_state {
    my ($self) = @_;

    my $pool_id = $self->{_WORKER}->{pool_id};
    ($pool_id) = ($pool_id =~ m/^([\w-]+)$/); # untaint
    my $tmp_file = "/tmp/beekeeper-dashboard-$pool_id-stats.dump";

    return unless (-e $tmp_file);

    local($/);
    open(my $fh, '<', $tmp_file) or die "Couldn't read $tmp_file: $!";
    my $data = <$fh>;
    close($fh);

    local $@;
    my $dump = eval { decode_json($data) };
    return if $@;

    $self->{services_1s}  = $dump->[0];
    $self->{services_5s}  = $dump->[1];
    $self->{services_2m}  = $dump->[2];
    $self->{services_15m} = $dump->[3];
    $self->{services_1h}  = $dump->[4];
}

1;

__END__

=pod

=encoding utf8

=head1 NAME

Beekeeper::Service::Dashboard::Worker - Dashboard backend service

=head1 VERSION

Version 0.09

=head1 SYNOPSIS