Skip to content
Browse files

graph

  • Loading branch information...
1 parent 15959a0 commit ab1549b1a1dbb0f1e1d9182fa1c69abbe9cdaece @kazeburo committed Nov 19, 2011
Showing with 316 additions and 7 deletions.
  1. +2 −0 .gitignore
  2. +1 −0 Makefile.PL
  3. +151 −0 lib/GrowthForecast/RRD.pm
  4. +45 −7 lib/GrowthForecast/Web.pm
  5. +101 −0 lib/GrowthForecast/Worker.pm
  6. +16 −0 worker.pl
View
2 .gitignore
@@ -10,4 +10,6 @@ nytprof.out
MANIFEST.bak
*.sw[po]
*~
+data/*.rrd
+data/*.db
View
1 Makefile.PL
@@ -5,6 +5,7 @@ WriteMakefile(
VERSION_FROM => 'lib/GrowthForecast.pm',
PREREQ_PM => {
'Kossy' => '0.01',
+ 'DBIx::Sunny' => '0.14',
},
MIN_PERL_VERSION => '5.010000',
);
View
151 lib/GrowthForecast/RRD.pm
@@ -3,7 +3,158 @@ package GrowthForecast::RRD;
use strict;
use warnings;
use utf8;
+use RRDs;
+use HTTP::Date;
+use File::Temp;
+sub new {
+ my $class = shift;
+ my $root_dir = shift;
+ bless { root_dir => $root_dir }, $class;
+}
+
+sub update {
+ my $self = shift;
+ my $data = shift;
+
+ my $file = $self->{root_dir} . '/data/' . $data->{md5} . '.rrd';
+ if ( ! -f $file ) {
+ eval {
+ RRDs::create(
+ $file,
+ '--step', '60',
+ 'DS:num:GAUGE:600:0:U',
+ 'RRA:AVERAGE:0.5:1:11520',
+ 'RRA:AVERAGE:0.5:30:1536',
+ 'RRA:AVERAGE:0.5:120:768',
+ 'RRA:AVERAGE:0.5:1440:794',
+ 'RRA:MAX:0.5:30:1536',
+ 'RRA:MAX:0.5:120:768',
+ 'RRA:MAX:0.5:1440:794'
+ );
+ my $ERR=RRDs::error;
+ die $ERR if $ERR;
+ };
+ }
+ eval {
+ RRDs::update(
+ $file,
+ '-t', 'num',
+ '--', 'N:'.$data->{number},
+ );
+ my $ERR=RRDs::error;
+ die $ERR if $ERR;
+ };
+ die "udpate rrdfile failed: $@" if $@;
+}
+
+sub graph {
+ my $self = shift;
+ my ($span, $from, $to, @datas) = @_;
+ $span ||= 'd';
+
+ my $period_title;
+ my $period;
+ my $end = 'now';
+ my $xgrid;
+ if ( $span eq 'c' ) {
+ my $from_time = HTTP::Date::str2time($from);
+ die "invalid from date: $from" unless $from_time;
+ my $to_time = $to ? HTTP::Date::str2time($to) : time;
+ die "invalid to date: $to" unless $to_time;
+ die "from($from) is newer than to($to)" if $from_time > $to_time;
+
+ $period_title = "$from to $to" ;
+ $period = $from_time;
+ $end = $to_time;
+ my $diff = $to_time - $from_time;
+ if ( $diff < 3 * 60 * 60 ) {
+ $xgrid = 'MINUTE:10:MINUTE:10:MINUTE:10:0:%M';
+ }
+ elsif ( $diff < 2 * 24 * 60 * 60 ) {
+ $xgrid = 'HOUR:1:HOUR:1:HOUR:2:0:%H';
+ }
+ elsif ( $diff < 14 * 24 * 60 * 60) {
+ $xgrid = 'DAY:1:DAY:1:DAY:2:86400:%m/%d';
+ }
+ elsif ( $diff < 45 * 24 * 60 * 60) {
+ $xgrid = 'DAY:1:WEEK:1:WEEK:1:0:%F';
+ }
+ else {
+ $xgrid = 'WEEK:1:MONTH:1:MONTH:1:2592000:%b';
+ }
+ }
+ elsif ( $span eq 'w' ) {
+ $period_title = 'Weekly';
+ $period = -1 * 60 * 60 * 24 * 8;
+ $xgrid = 'DAY:1:DAY:1:DAY:1:86400:%a'
+ }
+ elsif ( $span eq 'm' ) {
+ $period_title = 'Monthly';
+ $period = -1 * 60 * 60 * 24 * 35;
+ $xgrid = 'DAY:1:WEEK:1:WEEK:1:604800:Week %W'
+ }
+ elsif ( $span eq 'y' ) {
+ $period_title = 'Yearly';
+ $period = -1 * 60 * 60 * 24 * 400;
+ $xgrid = 'WEEK:1:MONTH:1:MONTH:1:2592000:%b'
+ }
+ else {
+ $period_title = 'Daily';
+ $period = -1 * 60 * 60 * 33; # 33 hours
+ $xgrid = 'HOUR:1:HOUR:2:HOUR:2:0:%H';
+ }
+
+ my ($tmpfh, $tmpfile) = File::Temp::tempfile(UNLINK => 0, SUFFIX => ".png");
+ my @args = (
+ $tmpfile,
+ '-w', 385,
+ '-h', 110,
+ '-a', 'PNG',
+ '-t', "$period_title",
+ '-l', 0, #minimum
+ '-u', 2, #maximum
+ '-x', $xgrid,
+ '-s', $period,
+ '-e', $end,
+ );
+
+ my $i=0;
+ for my $data ( @datas ) {
+ my $type = ( $i == 0 ) ? 'AREA' : 'STACK';
+ my $file = $self->{root_dir} . '/data/' . $data->{md5} . '.rrd';
+ push @args,
+ sprintf('DEF:num%d=%s:num:AVERAGE', $i, $file),
+ sprintf('%s:num%d#00C000:%s ', $type, $i, $data->{graph_name}),
+ sprintf('GPRINT:num%d:LAST:Cur\: %%4.1lf', $i),
+ sprintf('GPRINT:num%d:AVERAGE:Ave\: %%4.1lf', $i),
+ sprintf('GPRINT:num%d:MAX:Max\: %%4.1lf', $i),
+ sprintf('GPRINT:num%d:MIN:Min\: %%4.1lf\l',$i);
+ $i++;
+ }
+
+ use Log::Minimal;
+ local $Log::Minimal::AUTODUMP = 1;
+
+ eval {
+ RRDs::graph(map { Encode::encode_utf8($_) } @args);
+ my $ERR=RRDs::error;
+ die $ERR if $ERR;
+ };
+ if ( $@ ) {
+ unlink($tmpfile);
+ die "draw graph failed: $@";
+ }
+
+ open( my $fh, '<:bytes', $tmpfile ) or die "cannot open graph tmpfile: $!";
+ local $/;
+ my $graph_img = <$fh>;
+ unlink($tmpfile);
+
+ die 'something wrong with image' unless $graph_img;
+
+ return $graph_img;
+}
1;
View
52 lib/GrowthForecast/Web.pm
@@ -4,21 +4,21 @@ use strict;
use warnings;
use utf8;
use Kossy;
+use Time::Piece;
use GrowthForecast::Data;
+use GrowthForecast::RRD;
sub data {
my $self = shift;
$self->{__data} ||= GrowthForecast::Data->new($self->root_dir);
$self->{__data};
}
-filter 'dummy' => sub {
- my $app = shift;
- sub {
- my ( $self, $c ) = @_;
- $app->($self,$c);
- }
-};
+sub rrd {
+ my $self = shift;
+ $self->{__rrd} ||= GrowthForecast::RRD->new($self->root_dir);
+ $self->{__rrd};
+}
get '/' => sub {
my ( $self, $c ) = @_;
@@ -48,6 +48,44 @@ get '/list/:service_name/:section_name' => sub {
$c->render('list.tx',{ graphs => $rows });
};
+get '/graph/:service_name/:section_name/:graph_name' => sub {
+ my ( $self, $c ) = @_;
+ my $result = $c->req->validator([
+ 'span' => {
+ default => 'd',
+ rule => [
+ [['CHOICE',qw/y m w d c/],'invalid span'],
+ ],
+ },
+ 'from' => {
+ default => localtime(time-86400*8)->strftime('%Y/%m/%d %T'),
+ rule => [
+ [sub{ HTTP::Date::str2time($_[1]) }, 'invalid From datetime'],
+ ],
+ },
+ 'to' => {
+ default => localtime()->strftime('%Y/%m/%d %T'),
+ rule => [
+ [sub{ HTTP::Date::str2time($_[1]) }, 'invalid To datetime'],
+ ],
+ }
+ ]);
+
+ my $row = $self->data->get(
+ $c->args->{service_name}, $c->args->{section_name}, $c->args->{graph_name},
+ );
+ $c->halt(404) unless $row;
+
+ my $img = $self->rrd->graph(
+ $result->valid('span'), $result->valid('from'),
+ $result->valid('to'), $row
+ );
+
+ $c->res->content_type('image/png');
+ $c->res->body($img);
+ return $c->res;
+};
+
get '/api/:service_name/:section_name/:graph_name' => sub {
my ( $self, $c ) = @_;
my $row = $self->data->get(
View
101 lib/GrowthForecast/Worker.pm
@@ -0,0 +1,101 @@
+package GrowthForecast::Worker;
+
+use strict;
+use warnings;
+use utf8;
+use Time::Piece;
+use GrowthForecast::Data;
+use GrowthForecast::RRD;
+use Log::Minimal;
+use POSIX ":sys_wait_h";
+
+sub new {
+ my $class = shift;
+ my $root_dir = shift;
+ bless { root_dir => $root_dir }, $class;
+}
+
+sub data {
+ my $self = shift;
+ $self->{__data} ||= GrowthForecast::Data->new($self->{root_dir});
+ $self->{__data};
+}
+
+sub rrd {
+ my $self = shift;
+ $self->{__rrd} ||= GrowthForecast::RRD->new($self->{root_dir});
+ $self->{__rrd};
+}
+
+sub run {
+ my $self = shift;
+
+ local $Log::Minimal::AUTODUMP = 1;
+
+ my @signals_received;
+ $SIG{$_} = sub {
+ push @signals_received, $_[0];
+ } for (qw/INT TERM HUP/);
+ $SIG{PIPE} = 'IGNORE';
+
+ my $now = time;
+ my $next = $now - ( $now % 60 ) + 60;
+ my $pid;
+
+ infof( sprintf( "first updater start in %s", scalar localtime $next) );
+
+ while ( 1 ) {
+ select( undef, undef, undef, 0.5 );
+ if ( $pid ) {
+ my $kid = waitpid( $pid, WNOHANG );
+ if ( $kid == -1 ) {
+ infof('no child processes');
+ $pid = undef;
+ }
+ elsif ( $kid ) {
+ infof( sprintf("update finished pid: %d, code:%d", $kid, $? >> 8) );
+ infof( sprintf( "next radar start in %s", scalar localtime $next) );
+ $pid = undef;
+ }
+ }
+
+ if ( scalar @signals_received ) {
+ warnf( "signals_received:" . join ",", @signals_received );
+ last;
+ }
+
+ $now = time;
+ if ( $now >= $next ) {
+ infof( sprintf( "(%s) updater start ", scalar localtime $next) );
+ $next = $now - ( $now % 60 ) + 60;
+
+ if ( $pid ) {
+ warnf( "Previous radar exists, skipping this time");
+ next;
+ }
+
+ $pid = fork();
+ die "failed fork: $!" unless defined $pid;
+ next if $pid; #main process
+
+ #child process
+ my $all_rows = $self->data->get_all_graphs;
+ for my $row ( @$all_rows ) {
+ debugf( "update %s", $row);
+ $self->rrd->update($row);
+ }
+ exit 0;
+ }
+ }
+
+ if ( $pid ) {
+ warnf( "waiting for updater process finishing" );
+ waitpid( $pid, 0 );
+ }
+
+}
+
+
+1;
+
+
View
16 worker.pl
@@ -0,0 +1,16 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use FindBin;
+use lib "$FindBin::Bin/extlib/lib/perl5";
+use lib "$FindBin::Bin/lib";
+use File::Basename;
+use GrowthForecast::Worker;
+
+my $root_dir = File::Basename::dirname(__FILE__);
+
+my $worker = GrowthForecast::Worker->new($root_dir);
+$worker->run;
+
+

0 comments on commit ab1549b

Please sign in to comment.
Something went wrong with that request. Please try again.