Navigation

↑ Up to parent level (..)

@{[ ($tgt->{suppress} =~ /h/ or $tgt->{config}{interval} ne '1') ? '' : 'Hourly|' ]} @{[ $tgt->{suppress} =~ /d/ ? '' : 'Daily|' ]} @{[ $tgt->{suppress} =~ /w/ ? '' : 'Weekly|' ]} @{[ $tgt->{suppress} =~ /m/ ? '' : 'Monthly|' ]} @{[ $tgt->{suppress} =~ /y/ ? '' : 'Yearly|' ]} Historical| Archived Graphs

{pagetop};

Title

$tgt->{pagetop}

EOT print <{ignoretimestamps};

Timestamp

@{[ strftime("%A, %d %B, %H:%M:%S %Z", localtime($mtime)) ]} EOT print <

RRDs::graph(', join(",\n", $file, '-s', "-$back", @local_args, @{$target->{args}}, @graph_args, "VRULE:$oldsec#ff0000", "VRULE:$seconds#ff0000"), ')

EOT generate_calendar($q, $mode, $m, $d, $y, $resource_dir); print 'Switch mode to:'; for my $m ('daily', 'monthly', 'yearly') { print $mode eq $m ? ' ' . $m : ' [' . $m . ']'; } print '
'; for my $target ( @targets ) { if( exists $targets{$target}{suppress} and ($targets{$target}{suppress} =~ /d/ and $mode eq 'daily' or $targets{$target}{suppress} =~ /m/ and $mode eq 'monthly' or $targets{$target}{suppress} =~ /y/ and $mode eq 'yearly') ) { # target is suppressed for this mode print '', $targets{$target}{title}, '
', '', $mode, ' archive mode is suppressed', ' (try another mode above)
'; next; } my $image_file; my $image_dir = $directories{$dir}{config}{archivedir} . '/' . $dir; for( $mode ) { /daily/ && do { $image_file = "$y/$m/$target-$y-$m-$d"; last; }; /monthly/ && do { $image_file = "$y/$target-$y-$m"; last; }; /yearly/ && do { $image_file = "$target-$y"; last; }; print_error('Undefined mode, ', $mode); } # strip directory name from the file $image_file =~ s/$dir\/?//; $image_file .= '.' . $imagetype; unless( -f "$image_dir/$image_file" ) { my $current_month_year = strftime "%m-%Y", localtime; my( $cur_m, $cur_y ) = split /-/, $current_month_year; my $error_date = $mode eq 'daily' ? "$m-$d-$y" : $mode eq 'monthly' ? "$m-$y" : $y; # archived image does not exist for this mode # perhaps archival of images was started after that date print '', $targets{$target}{title}, ' does not have a ', $mode, ' archived image for ', $error_date, '.
'; if( $mode eq 'monthly' and $cur_y <= $y and $cur_m <= $m ) { my $avail_month = sprintf("%02d", $m+1); my $avail_year = $y; # be careful when incrementing months beyond 12 if( $m eq '12' ) { $avail_month = '01'; $avail_year = $y+1; } print 'It will become available on ', $avail_month, '-01-', $avail_year, '.
', "\n"; } if( $mode eq 'yearly' and $cur_y <= $y ) { print 'It will become available on ', '01-01-', $y+1, '.
', "\n"; } next; } print <$targets{$target}{title}

EOT } print < @{[ SCRIPT_VERSION ]} EOT } # generate code for JavaScript calendar # remember that, in JavaScript, the 2nd argument to # Date($y,@{[$m-1]},$d) needs to have 1 subtracted from it as the # JavaScript months go from 0 to 11 sub generate_calendar($$$$$$) { my $q = shift; my $mode = shift; my $m = shift; my $d = shift; my $y = shift; my $resource_dir = shift; print <

EOT print < EOT print < EOT my( $prev, $next, $parse_date ); if( $mode eq 'daily' ) { $parse_date = ParseDate($m.'/'.$d.'/'.$y); $prev = UnixDate(DateCalc($parse_date, '-1 day'), '%m-%d-%Y'); $prev = 'date=' . $prev . '&mode=daily'; $next = UnixDate(DateCalc($parse_date, '+1 day'), '%m-%d-%Y'); $next = 'date=' . $next . '&mode=daily'; } elsif( $mode eq 'monthly' ) { $parse_date = ParseDate($m.'/01/'.$y); $prev = UnixDate(DateCalc($parse_date, '-1 month'), '%m-%d-%Y'); $prev = 'date=' . $prev . '&mode=monthly'; $next = UnixDate(DateCalc($parse_date, '+1 month'), '%m-%d-%Y'); $next = 'date=' . $next . '&mode=monthly'; } elsif( $mode eq 'yearly') { $parse_date = ParseDate('01/01/'.$y); $prev = UnixDate(DateCalc($parse_date, '-1 year'), '%m-%d-%Y'); $prev = 'date=' . $prev . '&mode=yearly'; $next = UnixDate(DateCalc($parse_date, '+1 year'), '%m-%d-%Y'); $next = 'date=' . $next . '&mode=yearly'; } print <

«prev next»

EOT } sub try_read_config($) { my ($prefix) = (@_); $prefix =~ s/\/[^\/]*$//; # Verify the version of RRDtool: if (!defined $RRDs::VERSION || $RRDs::VERSION < 1.2013) { print_error("Please install more up-to date RRDtool - need at least 1.2013"); } my $read_cfg; if (!defined $config_time) { # must read config files initially $read_cfg = 1; } else { for my $file (@all_config_files) { my $mtime = (stat $file)[9]; if ($config_time < $mtime) { # modification time is newer than last read time $read_cfg = 1; last; } } } return unless $read_cfg; %targets = (); @all_config_files = @config_files; my $order = 0; for my $cfgfile (@all_config_files) { my $cfgref = { refresh => 300, interval => 5, resourcedir => $prefix }; read_rrd_config($cfgfile, $cfgref, \$order); } delete $targets{_}; parse_directories(); $config_time = time; } sub read_rrd_config($$$) { my ($file, $cfgref, $order) = @_; my @lines; open(CFG, "<$file") || print_error("Cannot open config file $file: $!"); while () { chomp; # remove newline s/\s+$//; # remove trailing space s/\s+/ /g; # collapse white spaces to one space next if /^ *\#/; # skip comment lines next if /^\s*$/; # skip empty lines if (scalar @lines and /^\s+\S/) { # lines beginning with whitespace followed # by content are really a continuation, so # combine them $lines[$#lines] .= $_; } else { push @lines, $_; } } close CFG; my $dir = ''; foreach (@lines) { if (/^\s*([\w\d]+)\[(\S+)\]\s*:\s*(.*)$/) { # reading a target line with square brackets my ($opt, $tgt, $val) = (lc($1), lc($2), $3); if( $opt eq 'directory' ) { if( exists $targets{$tgt} ) { print_error("Parse error in

$file

", "near

$_

", "A Directory[] directive must appear before any ", "other directives for a target."); } $dir = $val . '/'; } unless( exists $targets{$dir . $tgt} ) { if( $opt ne 'directory' ) { $dir = ''; } $targets{$dir . $tgt}{name} = $dir . $tgt; $targets{$dir . $tgt}{directory} = $dir; $targets{$dir . $tgt}{order} = ++$$order; $targets{$dir . $tgt}{config} = $cfgref; } if( exists $targets{$dir . $tgt}{$opt} ) { # duplicate found, so inform user if( $opt ne 'directory' ) { if( exists $targets{$tgt}{$opt} ) { print_error("Parse error in

$file

", "near

$_

", "Duplicate target entry found ($tgt ", "exists already as a target). Either change ", "the target name or provide a ", "

Directory[$tgt]: some_new_dir

", "directive before specifying this line."); } else { $dir = ''; $targets{$dir . $tgt}{name} = $dir . $tgt; $targets{$dir . $tgt}{directory} = $dir; $targets{$dir . $tgt}{order} = ++$$order; $targets{$dir . $tgt}{config} = $cfgref; } } } $targets{$dir . $tgt}{$opt} = $val; next; } elsif (/^([\w\d]+)\s*:\s*(\S.*)$/) { # reading a configuration line (e.g., Imagedir, Logdir, etc) my ($opt, $val) = (lc($1), $2); $cfgref->{$opt} = $val; next; } print_error("Parse error in $file near $_"); } } sub parse_directories { %directories = (); # sorted names using the Schwartzian Transform (read comments backwards) my @names = map { $_->[0] } # restore original values sort { $a->[1] <=> $b->[1] } # sort map { [ $_, $targets{$_}{order} ] } # transform: value, sortkey keys %targets; my %is_in_subdir_list = (); for my $name (@names) { my $dir = $targets{$name}{directory} if defined $targets{$name}{directory}; $dir = '' unless defined $dir; my $prefix = ''; for my $component (split /\/+/, $dir) { unless (defined $directories{$prefix.$component} or $is_in_subdir_list{$prefix.$component}) { push (@{$directories{$prefix}{subdir}}, $component); $is_in_subdir_list{$prefix.$component} = 1; } if( $prefix eq '' ) { # with an empty prefix, use the component itself as the # next prefix $prefix = $component; } else { $prefix .= '/' . $component; } } unless (defined $directories{$dir}) { $directories{$dir}{config} = $targets{$name}{config}; } push (@{$directories{$dir}{target}}, $name); } } sub find_resource_dir($); sub find_resource_dir($) { # find resource directory by descending into subdirectories # recursively until found my $dir = shift; my $resource_dir; my $subdirs = $directories{$dir}{subdir}; my $first_subdir; if( defined $subdirs ) { $first_subdir = @{$subdirs}[0]; $first_subdir = $dir . '/' . $first_subdir unless $dir eq ''; $resource_dir = $directories{$first_subdir}{config}{resourcedir}; # recurse deeper into next directory level $resource_dir = find_resource_dir($first_subdir) unless defined $resource_dir; } return $resource_dir; } sub print_dir($$) { my ($dir, $q) = @_; my $dir1 = $dir . '/'; my( $summary ) = {graphs => 0, suppress => 0, subdir => 0}; # run over all the targets in this directory for summary stats if (defined @{$directories{$dir}{target}}) { for my $item (@{$directories{$dir}{target}}) { $summary->{graphs}++; # see if item is suppressed? if( defined $targets{$item}{suppress} ) { if( ($targets{$item}{suppress} =~ /d/ && $targets{$item}{config}{interval} ne '1') || ($targets{$item}{suppress} =~ /h/ && $targets{$item}{config}{interval} eq '1') ) { $summary->{suppress}++; } } } } # run over all the targets in this directory to see if any of them # has interval as 1 meaning a refresh of 60 if (defined @{$directories{$dir}{target}}) { for my $item (@{$directories{$dir}{target}}) { common_args($item, $targets{$item}, $q); if( $targets{$item}{config}{interval} eq '1' && $targets{$item}{suppress} !~ /h/ ) { $directories{$dir}{config}{refresh} = 60; last; } } } http_headers('text/html', $directories{$dir}{config}); my $resource_dir = $directories{$dir}{config}{resourcedir}; $resource_dir = find_resource_dir($dir) unless defined $resource_dir; $resource_dir = "/resources"; my $is_set_no_auto_refresh = ($q->param('autorefresh') and $q->param('autorefresh') eq 'no') ? 1 : 0; my $is_set_no_preview = ($q->param('preview') and $q->param('preview') eq 'no') ? 1 : 0; my $modified_href; if( $is_set_no_auto_refresh or $is_set_no_preview ) { if( $is_set_no_auto_refresh and $is_set_no_preview ) { $modified_href = '?autorefresh=no&preview=no'; } elsif( $is_set_no_auto_refresh ) { $modified_href = '?autorefresh=no'; } else { $modified_href = '?preview=no'; } } else { $modified_href = ''; } print < RRD: Directory $dir1 EOT print < #graphs { padding-top: 0; clear: left; margin-left: 5px; } #nav { width: 30%; } EOT print < EOT print < EOT my( @graphs, @graph_text, @nav_text, @subdir_text ); if (defined @{$directories{$dir}{subdir}}) { push @subdir_text, <Subdirectories in $dir1

More graphs are available in the following subdirectories

» $item/ EOT $summary->{subdir}++; } push @subdir_text, <

EOT } print <

EOT if ( $dir ne '' ) { my $link_toggle_auto_refresh; my $link_toggle_preview; if( $is_set_no_auto_refresh and $is_set_no_preview ) { # both autorefresh and preview say "no" $link_toggle_auto_refresh = 'Θ Enable Autorefresh'; $link_toggle_preview = 'Θ Enable Preview'; } elsif( $is_set_no_auto_refresh and !$is_set_no_preview ) { # autorefresh says "no" $link_toggle_auto_refresh = 'Θ Enable Autorefresh'; $link_toggle_preview = 'Φ Disable Preview'; } elsif( !$is_set_no_auto_refresh and $is_set_no_preview ) { # preview says "no" $link_toggle_preview = 'Θ Enable Preview'; $link_toggle_auto_refresh = 'Φ Disable Autorefresh'; } else { # none of them say "no" $link_toggle_auto_refresh = 'Φ Disable Autorefresh'; $link_toggle_preview = 'Φ Disable Preview'; } push @nav_text, <↑ Up to parent level (..) EOT push @nav_text, <Title

RRD graphs in:

$dir1

EOT push @nav_text, <Available Graphs

EOT push @graph_text, <Click on a graphic to go to a deeper level. EOT push @graph_text, <Mouseover for individual zoom. preview enabled EOT push @graph_text, <autorefresh enabled EOT push @graph_text, <(disable using navigation). EOT push @graph_text, < EOT for my $item (@{$directories{$dir}{target}}) { my $itemname = $item; common_args($item, $targets{$item}, $q); my( $freq, $freqtext ); if( !$is_set_no_preview ) { $freq = 'preview'; $freqtext = 'Preview'; } elsif( $targets{$item}{config}{interval} eq '1' ) { $freq = 'hour'; $freqtext = 'Hourly'; } else { $freq = 'day'; $freqtext = 'Daily'; } my( undef, $xsize, $ysize ) = do_image($targets{$item}, $freq, 0, 0); $itemname = $targets{$item}{title} if defined $targets{$item}{title}; # for each graph store its item and name in an # anonymous hash and push onto the array @graphs my $item_relative = $item; # strip any directories from $item (first occurrence) $item_relative =~ s/$targets{$item}{directory}\/?//; push @graphs, {item => $item_relative, name => $itemname}; if( (exists $targets{$item}{suppress} && $targets{$item}{suppress} =~ /p/) || (exists $targets{$item}{suppress} && $targets{$item}{suppress} =~ /d/ && $is_set_no_preview && $targets{$item}{config}{interval} ne '1') || (exists $targets{$item}{suppress} && $targets{$item}{suppress} =~ /h/ && $is_set_no_preview && $targets{$item}{config}{interval} eq '1') ) { push @graph_text, < $itemname $freqtext Graphic suppressed. More data is available here.

EOT next; }; if( $is_set_no_preview ) { push @graph_text, < $itemname

EOT } my $detailed_freq = ($targets{$item}{config}{interval} eq '1') ? 'hour' : 'day'; push @graph_text, <

EOT } if( $is_set_no_preview ) { push @nav_text, < EOT foreach my $graph( @graphs ) { push @nav_text, <» $graph->{name} EOT } push @nav_text, <

Navigation

Title

Timestamp

', $total_graphs-length($suppressed_graphs), ' Graphs(s)

Navigation

', $summary->{graphs}-$summary->{suppress}, ' Graph(s)

', $summary->{subdir}, $summary->{subdir} > 1 ? ' Subdirectories' : ' Subdirectory', '