#!/usr/bin/perl -w use strict qw(vars subs); use WWW::Mechanize; use Mojo::DOM; use GD::Graph::bars; use Data::Dumper; use Date::Calc qw(:all); use Math::Round qw(nhimult); use RRDs; use FindBin; use lib "$FindBin::Bin"; use StampedeVotes; my $verbose = 0; $verbose = 1 if($ARGV[0] && ($ARGV[0] eq '-v' || $ARGV[0] eq '-d')); my $debug = 0; $debug = 1 if($ARGV[0] && $ARGV[0] eq '-d'); my $title = $StampedeVotes::config{title}; # About RRD # --------- # # Vote period start: 2009-02-23 11:23:00 # Vote period end : 2009-03-08 23:59:59 # # Each post in the topic is an update for the most recent RRD. # # The vote period is two weeks, and this is the size largest RRA. # There are day, week, and two week RRAs in each RRD. # # Every day and week in the voting period will have its own RRD file. # And the full voting period of two weeks will have its own RRD file. # # 1day/2009-02-23.rrd # 1day/2009-02-24.rrd # ... # 1day/2009-03-07.rrd # 1day/2009-03-08.rrd # 1week/2009-02-23_2009-03-01.rrd # 1week/2009-03-02_2009-03-08.rrd # 2weeks/2009-02-23_2009-03-08.rrd my $period_start = $StampedeVotes::config{period_start}; my $period_end = $StampedeVotes::config{period_end}; my $time_start = StampedeVotes::date2time($period_start.' 00:00:00'); my $time_end = StampedeVotes::date2time($period_end .' 23:59:59'); my $date_start = StampedeVotes::time2date($time_start); my $date_end = StampedeVotes::time2date($time_end); my $week1_start = $time_start; my $week1_end = $time_start + (604800 - 1); # 60 * 60 * 24 * 7 = 604800 [7d] my $week2_start = $week1_end + 1; my $week2_end = $time_end; if($debug) { print STDERR "Period Start: $period_start\n"; print STDERR "Period End : $period_end\n"; print STDERR "Time Start: $time_start\n"; print STDERR "Time End : $time_end\n"; print STDERR "Date Start: $date_start\n"; print STDERR "Date End : $date_end\n"; print STDERR "\n"; print STDERR "Week 1 Start Time: $week1_start\n"; print STDERR "Week 1 Date: ".StampedeVotes::time2date($week1_start)."\n"; print STDERR "Week 1 End Time: $week1_end\n"; print STDERR "Week 1 Date: ".StampedeVotes::time2date($week1_end) ."\n"; print STDERR "Week 2 Start Time: $week2_start\n"; print STDERR "Week 2 Date: ".StampedeVotes::time2date($week2_start)."\n"; print STDERR "Week 2 End Time: $week2_end\n"; print STDERR "Week 2 Date: ".StampedeVotes::time2date($week2_end) ."\n"; print STDERR "\n"; } # RRD settings my $rrd_dir = 'rrd/'; my $rrd_start = 0; # the start time is that of the first post my $rrd_step = 300; # count votes every 5 minutes # DS settings my $ds_heartbeat = 1209600; # max 2 weeks between posts my $ds_min = 0; # minimum number of votes my $ds_max = 'U'; # maximum number of votes # RRA settings my $rra_cf = 'MAX'; # votes only increase, so use the maximum when consolidating my $rra_xff = 0.5; # half the values may be unknown (but they should never be unknown, due to large heartbeat) my $rra_hour_steps = 1; # $rra_hour_steps (1) x $rrd_steps (300) = 300 [5m] my $rra_hour_rows = 12; # 300 [5m] x $rra_hour_rows (12) = 3600 [1h] my $rra_day_steps = 12; # $rra_day_steps (12) x $rrd_steps (300) = 3600 [1h] my $rra_day_rows = 24; # 3600 [1h] x $rra_day_rows (24) = 86400 [1d] my $rra_week_steps = 288; # $rra_week_steps (288) x $rrd_steps (300) = 86400 [1d] my $rra_week_rows = 7; # 86400 [1d] x $rra_week_rows (7) = 604800 [1w] #my $rra_2week_steps = 288; # $rra_2week_steps (288) x $rrd_steps (300) = 86400 [1d] #my $rra_2week_rows = 14; # 86400 [1d] x $rra_2week_rows (14) = 1209600 [2w] my $rra_2week_steps = 1; # $rra_2week_steps (1) x $rrd_steps (300) = 300 [5m] my $rra_2week_rows = 4032; # 300 [5m] x $rra_2week_rows (4032) = 1209600 [2w] my @rrd_files = get_rrd_files($rrd_dir); foreach my $file (@rrd_files) { remove_rrd($file); } # Stampede #XX my $query_string = '?limit=999'; my $topic_url = $StampedeVotes::config{topic_url}; my %blacklist = %StampedeVotes::blacklist; my %vote = %StampedeVotes::vote; my %vote_to_key = %StampedeVotes::vote_to_key; my %key_to_vote = %StampedeVotes::key_to_vote; my %has_voted = (); my $agent = 'StampedeVoteCount/0.2.1'; my $mech = WWW::Mechanize->new( agent => $agent, cookie_jar => {}, ); $mech->add_header('X-Cookies-Accepted', '1'); if($debug) { $mech->add_handler("request_send", sub { shift->dump; return }); $mech->add_handler("response_done", sub { shift->dump; return }); } my $url = $topic_url . $query_string; print STDERR "Downloading URL: $url ... " if($verbose); $mech->get($url); if($mech->success) { print STDERR "Success\n" if($verbose); } else { print STDERR "Failed!\n" if($verbose); my $res = $mech->response(); print STDERR "Error: Failed to retrieve URL! ($url)\n"; print STDERR "Server returned: ".$res->code." ".$res->message."\n"; exit 1; } foreach my $form ($mech->forms) { if($form->attr('id') eq 'cookieAcceptForm') { print STDERR "Submitting cookie form ... " if($verbose); $mech->form_with_fields('decision', 'returnTo', 'fragment', 'tweakers_token'); $mech->click_button(name => 'decision'); last; } } if($mech->success) { print STDERR "Success\n" if($verbose); my $data = $mech->content; print STDERR "Data:\n$data" if($debug); if($data =~ /Sessie validatie mislukt/) { print STDERR "Error: Session validation failed despite cookie acceptance!\n" if($verbose); exit 1; } my %page; my %html_url; my %xml_url; my $last_page_num = 0; #Pagina's: 1 2 last #Pagina: 3 2 last # Pagina: 1 2 Laatste while($data =~ /\(\d+)\<\/a\>/g) { if(!$page{$2}) { $html_url{$2} = $topic_url.'/'.$1 . $query_string; $last_page_num = $2 if($2 > $last_page_num); } } if($last_page_num == 0) { $page{'1'} = 0; } # Compose the list of pages by iteration, # because you can miss pages if the page links are not all listed due to length for(my $i = 1; $i <= $last_page_num; $i++) { my $num = $i - 1; print STDERR "Page: $i (/$num)\n" if($verbose); $page{"$i"} = $num; } my $total = 0; foreach(sort { $a <=> $b } keys %page) { my $page_num = $_; my $page_id = $page{$_}; my $page_url = $topic_url.'/'.$page{$_}.$query_string; print STDERR "\nDownloading URL: $page_url ... " if($verbose); $mech->get($page_url); if($mech->success) { print STDERR "Success\n" if($verbose); my $data = $mech->content; my $dom = Mojo::DOM->new($data); $dom->find('div[class~="message"]')->each(sub { my ($element, $count) = @_; my $msgid = $element->attr('data-message-id'); my $date = $element->at('div[class~="date"]')->at('p a')->all_text; my $time = StampedeVotes::gotdate2time($date); my $nick = $element->at('div[class~="poster"]')->at('div[class~="userheader"]')->at('p[class~="username"]')->at('a[class~="user"]')->all_text; if($verbose) { print STDERR '-' x 80 ."\n"; print STDERR "MSG ID: $msgid ($nick @ $date | $time)\n"; } if($time < $time_start) { print STDERR "- Skip: Posted before vote period start ($date_start)\n" if($verbose); } elsif($time > $time_end) { print STDERR "- Skip: Posted after vote period end ($date_end)\n" if($verbose); } elsif($blacklist{$msgid}) { # Every post in the topic is an entry in the RRD #update_rrd(nick => $nick, date => $date); print STDERR "- Skip: Blacklisted ($blacklist{$msgid})\n" if($verbose); } else { my $msg = $element->at('div[class~="post"]')->at('div[class~="messagecontent"]'); # Strip quoted text from content, to not count quoted votes if($msg =~ s/\.*?\<\/blockquote\>//gs) { print STDERR "Stripped quoted text\n" if($verbose); } my $voted = 0; while($msg =~ /\(.*?)\<\/b\>/g) { (my $bold = $1) =~ s/<\/?[a-zA-Z]>//; print STDERR " Bold: $bold\n" if($verbose); foreach my $option (keys %vote) { foreach my $pattern (@{$StampedeVotes::option{$option}->{matches}}) { if($bold =~ /$pattern/i) { if($voted == 0 && !exists $has_voted{$nick}) { $vote{$option} += 1; print STDERR "+ Vote: $option ($vote{$option})\n" if($verbose); $total++; $has_voted{$nick}{option} = $option; $has_voted{$nick}{date} = $date; $has_voted{$nick}{msgid} = $msgid; } elsif(exists $has_voted{$nick}) { my $option = $has_voted{$nick}{option}; my $date = $has_voted{$nick}{date}; my $msgid = $has_voted{$nick}{msgid}; print STDERR "- Skip: Has already voted: $option in $msgid ($nick @ $date)\n" if($verbose); } $voted = 1; last; } } last if($voted); } } # Update the RRDs update_rrd(nick => $nick, date => $date); } }); } else { print STDERR "Failed!\n" if($verbose); my $res = $mech->response(); print STDERR "Error: Failed to retrieve URL! ($page_url)\n"; print STDERR "Server returned: ".$res->code." ".$res->message."\n"; exit 1; } print STDERR "\n" if($verbose); } # Generate RRD Graphs graph_rrd() if($total > 0); # Show the vote tally my %percent = (); my $longest = 0; foreach(keys %vote) { if(!$total) { $percent{$_} = 0; } else { $percent{$_} = (100 / $total) * $vote{$_}; } $longest = length($vote{$_}) if(length($vote{$_}) > $longest); } foreach(sort by_count_and_name keys %vote) { my $percentage = '('. sprintf("%.2f", $percent{$_}) .'%)'; # Display tally text printf("%20s", $_); print " : "; printf("%${longest}s", $vote{$_}); print " "; printf("%9s", $percentage); print "\n"; } if($total > 0) { print "-" x 35; print "\n"; printf("%20s", 'Total Votes'); print " : $total\n"; } # Plot the graph of the vote tally print STDERR "\nPlotting graph of the vote tally.\n" if($verbose); my $width = 570; # GoT Max: 570 my $height = 430; # GoT Max: 430 print STDERR "Width: $width | Height: $height\n" if($verbose); my @x = (); my @y = (); my $max = 0; foreach(sort by_count_and_name keys %vote) { push @x, $_; push @y, $vote{$_}; $max = $vote{$_} if($vote{$_} > $max); } my $target = 10; if($max >= 100) { $target = '1'; $target .= '0' x (length(int $max) - 1); } my $max_value = nhimult($target, $max); if($verbose) { print STDERR " Max: $max\n"; print STDERR "Value: $max_value\n"; } my @data = (\@x, \@y); my $graph = GD::Graph::bars->new($width, $height); my $graph_data = GD::Graph::Data->new(\@data); my $values = $graph_data->copy; $graph->set(show_values => $values); $graph->set( x_label => 'Project', y_label => 'Votes', title => $title.' Vote Graph', values_vertical => 1, x_labels_vertical => 1, y_max_value => $max_value ) || die $graph->error; my $graph_file = 'vote-graph.png'; print STDERR "Saving graph to file: $graph_file\n" if($verbose); open(F, '>', $graph_file) || die "Error: Cannot open graph file: $graph_file ($!)"; print F $graph->plot(\@data)->png; close F; print STDERR "\n" if($verbose); } else { print STDERR "Failed!\n" if($verbose); my $res = $mech->response(); print STDERR "Error: Failed pass cookie wall! ($url)\n"; print STDERR "Server returned: ".$res->code." ".$res->message."\n"; exit 1; } ################################[ Subroutines ]################################ sub by_count_and_name { if($vote{$a} == $vote{$b}) { return $a cmp $b; } else { return $vote{$b} <=> $vote{$a}; } } sub get_rrd_files { my $dir = shift; my @files = `find $dir -name *.rrd`; foreach(@files) { chomp; } return @files; } sub remove_rrd { my $file = shift; if(-e $file) { unlink $file || die "Error: Cannot remove RRD ($!)"; } } sub create_rrd { my $file = shift; my $start = shift; print STDERR "Going to create RRD: $file\n" if($debug); my @ds = (); foreach(sort keys %vote) { my $name = $vote_to_key{$_}; push @ds, "DS:$name:GAUGE:$ds_heartbeat:$ds_min:$ds_max"; } my @rra = (); # RRA for one day # # $rra_day_steps (12) x $rrd_steps (300) = 3600 [1h] # 3600 [1h] x $rra_day_rows (24) = 86400 [1d] # push @rra, "RRA:$rra_cf:$rra_xff:$rra_day_steps:$rra_day_rows"; # RRA for one week # # $rra_week_steps (288) x $rrd_steps (300) = 86400 [1d] # 86400 [1d] x $rra_week_rows (7) = 604800 [1w] # push @rra, "RRA:$rra_cf:$rra_xff:$rra_week_steps:$rra_week_rows"; # RRA for two weeks # # $rra_2week_steps (288) x $rrd_steps (300) = 86400 [1d] # 86400 [1d] x $rra_2week_rows (14) = 1209600 [2w] # push @rra, "RRA:$rra_cf:$rra_xff:$rra_2week_steps:$rra_2week_rows"; if($debug) { print STDERR "rrdcreate $file\n"; print STDERR "\t--start $start --step $rrd_step\n"; foreach(@ds) { print STDERR "\t$_ \n"; } foreach(@rra) { print STDERR "\t$_ \n"; } } RRDs::create($file, '--start', $start, '--step', $rrd_step, @ds, @rra ); my $error = RRDs::error; die "Error: $error\n" if $error; } sub update_rrd { my (%args) = @_; print STDERR "Going to update RRDs ...\n" if($debug); my $nick = $args{nick}; my $time = StampedeVotes::gotdate2time($args{date}); my $date = StampedeVotes::time2date($time); # RRD file for the day in question my $rrd_file_1day = $rrd_dir.'1day/'; (my $day = $date) =~ s/^(\d{4}-\d{2}-\d{2}) (\d{2}:\d{2}:\d{2})$/$1/; my $day_start = StampedeVotes::date2time($day.' 00:00:00'); my $day_end = StampedeVotes::date2time($day.' 23:59:59'); $rrd_file_1day .= $day.'.rrd'; # RRD file for the week in question my $rrd_file_1week = $rrd_dir.'1week/'; my $week_start = ''; my $start = ''; my $end = ''; if($time >= $week1_start && $time <= $week1_end) { $week_start = $week1_start; ($start = StampedeVotes::time2date($week1_start)) =~ s/^(\d{4}-\d{2}-\d{2}) (\d{2}:\d{2}:\d{2})$/$1/; ($end = StampedeVotes::time2date($week1_end)) =~ s/^(\d{4}-\d{2}-\d{2}) (\d{2}:\d{2}:\d{2})$/$1/; } elsif($time >= $week2_start && $time <= $week2_end) { $week_start = $week2_start; ($start = StampedeVotes::time2date($week2_start)) =~ s/^(\d{4}-\d{2}-\d{2}) (\d{2}:\d{2}:\d{2})$/$1/; ($end = StampedeVotes::time2date($week2_end)) =~ s/^(\d{4}-\d{2}-\d{2}) (\d{2}:\d{2}:\d{2})$/$1/; } else { print STDERR "- Skip: Date out of range: $date (Week: $date_start - $date_end)\n"; return; } $rrd_file_1week .= $start.'_'.$end.'.rrd'; # RRD file for the full period of two weeks my $rrd_file_2weeks = $rrd_dir.'2weeks/'.$period_start.'_'.$period_end.'.rrd'; # initialize the RRD for the day in question if it does not exist yet create_rrd($rrd_file_1day, $day_start) if(!-r $rrd_file_1day); # initialize the RRD for the week in question if it does not exist yet create_rrd($rrd_file_1week, $week_start) if(!-r $rrd_file_1week); # initialize the RRD for te full periond if it does not exist yet create_rrd($rrd_file_2weeks, $time_start) if(!-r $rrd_file_2weeks); # Update the RRD for the day in question my $lastupdate = RRDs::last($rrd_file_2weeks); if($time == $lastupdate) { print STDERR "- Skip: No newer data than $lastupdate (".StampedeVotes::time2date($lastupdate).")\n" if($debug); return; } my $template = ''; my $update = $time.':'; foreach(sort keys %vote) { my $name = $vote_to_key{$_}; $template .= ':' if($template ne ''); $template .= $name; $update .= ':' if($update ne $time.':'); $update .= $vote{$_}; } my @rrd_files = ($rrd_file_1day, $rrd_file_1week, $rrd_file_2weeks); foreach my $file (@rrd_files) { if($debug) { print STDERR "rrdupdate $file\n"; print STDERR "\t--template $template\n"; print STDERR "\t$update\n"; } RRDs::update($file, '--template', $template, $update ); my $error = RRDs::error; die "Error: $error\n" if $error; } } sub graph_rrd { # RRD file for the full period of two weeks my $rrd_file = $rrd_dir.'2weeks/'.$period_start.'_'.$period_end.'.rrd'; (my $graph_file = $rrd_file) =~ s/\.rrd$/.png/; # 470x330 becomes 567x423 # 850x330 becomes 897x423 my $graph_width = 850; # GoT Max: 570 my $graph_height = 330; # GoT Max: 430 my @data = (); my @comment = (); # CGA Colors: # # 0 - black 8 - dark gray # 1 - low blue 9 - high blue # 2 - low green 10 - high green # 3 - low cyan 11 - high cyan # 4 - low red 12 - high red # 5 - low magenta 13 - high magenta # 6 - brown 14 - yellow # 7 - light gray 15 - white my @color = ( # 'FF0000', # red # '00FF00', # green # '0000FF', # blue # '00FFFF', # light blue # 'FF00FF', # pink # 'FFFF00', # yellow # CGA Palette '000000', # black '0000AA', # low blue '00AA00', # low green '00AAAA', # low cyan 'AA0000', # low red 'AA00AA', # low magenta 'AA5500', # brown 'AAAAAA', # light gray '555555', # dark gray '5555FF', # high blue '55FF55', # high green '55FFFF', # high cyan 'FF5555', # high red 'FF55FF', # high magenta 'FFFF55', # yellow 'FFFFFF', # white # CGA Palette '000000', # black '0000AA', # low blue '00AA00', # low green '00AAAA', # low cyan 'AA0000', # low red 'AA00AA', # low magenta 'AA5500', # brown 'AAAAAA', # light gray '555555', # dark gray '5555FF', # high blue '55FF55', # high green '55FFFF', # high cyan 'FF5555', # high red 'FF55FF', # high magenta 'FFFF55', # yellow 'FFFFFF', # white ); my $longest = 0; foreach(sort keys %vote) { my $length = length($_); $longest = $length if($length > $longest); } my $i = 0; foreach(sort by_count_and_name keys %vote) { my $name = $vote_to_key{$_}; my $padding = ''; $padding .= ' ' x ($longest - length($_)); push @data, "DEF:${name}=${rrd_file}:${name}:MAX"; push @data, "LINE1:${name}#$color[$i]:$_"; push @data, "GPRINT:${name}:LAST:${padding}Votes\\: %3.0lf \\n"; $i++; } my $c = "Period: $date_start - $date_end"; $c =~ s/:/\\:/g; push @comment, "COMMENT:$c"; if($debug) { print STDERR "rrdgraph $graph_file\n"; print STDERR "\t--start $time_start\n"; print STDERR "\t--end $time_end\n"; print STDERR "\t--title '$title Votes'\n"; print STDERR "\t--vertical-label Votes\n"; print STDERR "\t--width $graph_width\n"; print STDERR "\t--height $graph_height\n"; #print STDERR "\t--full-size-mode\n"; # requires rrdtool v1.3 print STDERR "\t--imgformat PNG\n"; foreach(@data) { print STDERR "\t$_\n"; } foreach(@comment) { print STDERR "\t$_\n"; } } my ($averages,$xsize,$ysize) = RRDs::graph( $graph_file, '--start', $time_start, '--end', $time_end, '--title', "$title Votes", '--vertical-label', 'Votes', '--width', $graph_width, '--height', $graph_height, #'--full-size-mode', # requires rrdtool v1.3 '--imgformat', 'PNG', @data, @comment ); my $error = RRDs::error; die "Error: $error\n" if $error; if($debug) { print STDERR "Image Size: ${xsize}x${ysize}\n"; print STDERR "Averages: ", (join ", ", @$averages); print STDERR "\n";; } # RRD file for week1 (my $start = StampedeVotes::time2date($week1_start)) =~ s/^(\d{4}-\d{2}-\d{2}) (\d{2}:\d{2}:\d{2})$/$1/; (my $end = StampedeVotes::time2date($week1_end)) =~ s/^(\d{4}-\d{2}-\d{2}) (\d{2}:\d{2}:\d{2})$/$1/; $graph_file = $rrd_dir.'1week/'.$start.'_'.$end.'.png'; $c = "Period: ".StampedeVotes::time2date($week1_start)." - ".StampedeVotes::time2date($week1_end); $c =~ s/:/\\:/g; @comment = ("COMMENT:$c"); if($debug) { print STDERR "rrdgraph $graph_file\n"; print STDERR "\t--start $week1_start\n"; print STDERR "\t--end $week1_end\n"; print STDERR "\t--title '$title Votes'\n"; print STDERR "\t--vertical-label Votes\n"; print STDERR "\t--width $graph_width\n"; print STDERR "\t--height $graph_height\n"; #print STDERR "\t--full-size-mode\n"; # requires rrdtool v1.3 print STDERR "\t--imgformat PNG\n"; foreach(@data) { print STDERR "\t$_\n"; } foreach(@comment) { print STDERR "\t$_\n"; } } ($averages,$xsize,$ysize) = RRDs::graph( $graph_file, '--start', $week1_start, '--end', $week1_end, '--title', "$title Votes", '--vertical-label', 'Votes', '--width', $graph_width, '--height', $graph_height, #'--full-size-mode', # requires rrdtool v1.3 '--imgformat', 'PNG', @data, @comment ); $error = RRDs::error; die "Error: $error\n" if $error; if($debug) { print STDERR "Image Size: ${xsize}x${ysize}\n"; print STDERR "Averages: ", (join ", ", @$averages); print STDERR "\n";; } # RRD file for week2 ($start = StampedeVotes::time2date($week2_start)) =~ s/^(\d{4}-\d{2}-\d{2}) (\d{2}:\d{2}:\d{2})$/$1/; ($end = StampedeVotes::time2date($week2_end)) =~ s/^(\d{4}-\d{2}-\d{2}) (\d{2}:\d{2}:\d{2})$/$1/; $graph_file = $rrd_dir.'1week/'.$start.'_'.$end.'.png'; $c = "Period: ".StampedeVotes::time2date($week2_start)." - ".StampedeVotes::time2date($week2_end); $c =~ s/:/\\:/g; @comment = ("COMMENT:$c"); if($debug) { print STDERR "rrdgraph $graph_file\n"; print STDERR "\t--start $week2_start\n"; print STDERR "\t--end $week2_end\n"; print STDERR "\t--title '$title Votes'\n"; print STDERR "\t--vertical-label Votes\n"; print STDERR "\t--width $graph_width\n"; print STDERR "\t--height $graph_height\n"; #print STDERR "\t--full-size-mode\n"; # requires rrdtool v1.3 print STDERR "\t--imgformat PNG\n"; foreach(@data) { print STDERR "\t$_\n"; } foreach(@comment) { print STDERR "\t$_\n"; } } ($averages,$xsize,$ysize) = RRDs::graph( $graph_file, '--start', $week2_start, '--end', $week2_end, '--title', "$title Votes", '--vertical-label', 'Votes', '--width', $graph_width, '--height', $graph_height, #'--full-size-mode', # requires rrdtool v1.3 '--imgformat', 'PNG', @data, @comment ); $error = RRDs::error; die "Error: $error\n" if $error; if($debug) { print STDERR "Image Size: ${xsize}x${ysize}\n"; print STDERR "Averages: ", (join ", ", @$averages); print STDERR "\n";; } my $dir = $rrd_dir.'1day/'; opendir(D, $dir) || die "Error: Cannot opendir ($!)"; foreach(sort readdir D) { if(!/^\.{1,2}$/ && /^(\d{4}-\d{2}-\d{2})\.rrd$/) { my $date = $1; my $file = $dir.$_; my $date_start = $date.' 00:00:00'; my $date_end = $date.' 23:59:59'; my $time_start = StampedeVotes::date2time($date_start); my $time_end = StampedeVotes::date2time($date_end); $graph_file = $rrd_dir.'1day/'.$date.'.png'; $c = "Period: ".StampedeVotes::time2date($time_start)." - ".StampedeVotes::time2date($time_end); $c =~ s/:/\\:/g; @comment = ("COMMENT:$c"); if($debug) { print STDERR "rrdgraph $graph_file\n"; print STDERR "\t--start $time_start\n"; print STDERR "\t--end $time_end\n"; print STDERR "\t--title '$title Votes'\n"; print STDERR "\t--vertical-label Votes\n"; print STDERR "\t--width $graph_width\n"; print STDERR "\t--height $graph_height\n"; #print STDERR "\t--full-size-mode\n"; # requires rrdtool v1.3 print STDERR "\t--imgformat PNG\n"; foreach(@data) { print STDERR "\t$_\n"; } foreach(@comment) { print STDERR "\t$_\n"; } } ($averages,$xsize,$ysize) = RRDs::graph( $graph_file, '--start', $time_start, '--end', $time_end, '--title', "$title Votes", '--vertical-label', 'Votes', '--width', $graph_width, '--height', $graph_height, #'--full-size-mode', # requires rrdtool v1.3 '--imgformat', 'PNG', @data, @comment ); $error = RRDs::error; die "Error: $error\n" if $error; if($debug) { print STDERR "Image Size: ${xsize}x${ysize}\n"; print STDERR "Averages: ", (join ", ", @$averages); print STDERR "\n";; } } } closedir D; }