#!/usr/bin/perl -w

# A basic perl port of the bootchart renderer, SVG only
# (c) 2005 Vincent Caron <v.caron@zerodeux.net>

# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

# BUGS
# - ignore number of CPUs (disk util.)

# 2005-06-29 - fixes
# - process name is latest sample argv value
# - sibling processes are properly PID-sorted from top to bottom
# - process start is now parsed from proc_ps
# - hiding bootchartd-related processes
#
# 2005-06-28
# - initial release

use strict;

my %headers;
my @disk_samples;
my @cpu_samples;
my %ps_info;
my %ps_by_parent;

my $chart_svg_template   = `cat svg/bootchart.svg.template` || die;
my $process_svg_template = `cat svg/process.svg.template` || die;
my $svg_css_file         = `cat svg/style.css` || die;
$svg_css_file =~ s/^/\t\t\t/mg;
$svg_css_file =~ s/^\s+//g;

my $HZ        = 100;
my $min_img_w = 800;
my $sec_w     = 25;
my $proc_h    = 16;
my $header_h  = 300;
my $img_w;
my $img_h;
my $t_begin;
my $t_end;
my $t_dur;


sub parse_logs {
  my $logfile = shift;
  my $tmp = "/tmp/bootchart-$$";

  mkdir $tmp or die;
  system "cd $tmp && tar xzf $logfile";

  parse_log_header($tmp);
  parse_log_cpu($tmp);
  parse_log_disk($tmp);
  parse_log_ps($tmp);

  system('rm', '-rf', $tmp);
  print STDERR "Disk samples: ".scalar(@disk_samples)."\n";
  print STDERR "CPU samples : ".scalar(@cpu_samples)."\n";
  print STDERR "Processes   : ".scalar(keys %ps_info)."\n";
}

sub parse_log_header {
  my $tmp = shift;

  open(HEADER, "<$tmp/header");
  while (<HEADER>) {
    chomp;
    my ($key, $val) = split /\s*=\s*/, $_, 2;
    $headers{$key} = $val;
  }
  close HEADER;
}

sub parse_log_cpu {
  my $tmp = shift;

  # Reads in: time, user, system, iowait
  my ($time, $ltime);
  my (@timings, @ltimings);

  open(PROC_STAT, "<$tmp/proc_stat.log");
  while (<PROC_STAT>) {
    chomp;
    $time = $1, next if /^(\d+)$/;

    if (/^$/) {
      if (defined $ltime) {
        my $dtime  = ($time - $ltime) / $HZ; # in seconds
        my $user   = ($timings[0] + $timings[1]) - ($ltimings[0] + $ltimings[1]);
        my $system = ($timings[2] + $timings[5] + $timings[6]) - ($ltimings[2] + $ltimings[5] + $ltimings[6]);
        my $idle   = $timings[3] - $ltimings[3];
        my $iowait = $timings[4] - $ltimings[4];
        my $sum    = $user + $system + $idle + $iowait;
        my %sample;
        $sample{time}   = $time;
        $sample{user}   = $user / $sum;
        $sample{system} = $system / $sum;
        $sample{iowait} = $iowait / $sum;
        push @cpu_samples, \%sample;
      }

      $ltime = $time;
      @ltimings = @timings;
      next;
    }

    @timings = split /\s+/ if s/^cpu\s+//;
  }
  close(PROC_STAT);
}

sub parse_log_disk {
  my $tmp = shift;

  # Reads in: time, read, write, use
  my ($time, $ltime);
  my ($read, $write, $util) = (0, 0, 0);
  my ($lread, $lwrite, $lutil);

  open(DISK_STAT, "<$tmp/proc_diskstats.log");
  while (<DISK_STAT>) {
    chomp;
    $time = $1, next if /^(\d+)$/;

    if (/^$/) {
      if (defined $ltime) {
        my $dtime = ($time - $ltime) / $HZ; # in seconds
        my $dutil = ($util - $lutil) / (1000 * $dtime);

        my %sample;
        $sample{time}  = $time;
        $sample{read}  = ($read - $lread) / 2 / $dtime; # in KB/s
        $sample{write} = ($write - $lwrite) / 2 / $dtime; # in KB/s
        $sample{util}  = ($dutil > 1 ? 1 : $dutil);
        push @disk_samples, \%sample;
      }

      $ltime  = $time;
      $lread  = $read, $read = 0;
      $lwrite = $write, $write = 0;
      $lutil  = $util, $util = 0;
      next;
    }

    s/\s+//;
    my @tokens = split /\s+/;
    next if scalar(@tokens) != 14 || not $tokens[2] =~ /hd|sd/;

    $read  += $tokens[5];
    $write += $tokens[9];
    $util  += $tokens[12];
  }
  close(DISK_STAT);
}

sub parse_log_ps {
  my $tmp = shift;

  my $time;

  open(PS_STAT, "<$tmp/proc_ps.log");
  while (<PS_STAT>) {
    chomp;
    next if /^$/;
    $time = $1, next if /^(\d+)$/;

    my @tokens = split /\s+/;
    my $pid    = $tokens[0];

    if (!defined $ps_info{$pid}) {
      my %info;
      my @empty;
      my $ppid  = $tokens[3];
      my $start = $tokens[21]; 
      $t_begin = $start if !defined $t_begin || $t_begin > $start;

      $info{ppid}    = $ppid;
      $info{start}   = $start;
      $info{samples} = \@empty;
      $ps_info{$pid} = \%info;

      if (!defined $ps_by_parent{$ppid}) {
        my @pidlist = ($pid);
        $ps_by_parent{$ppid} = \@pidlist;
      } else {
        push @{$ps_by_parent{$ppid}}, $pid;
      }
    }

    # argv may change, we'll store here the last sampled value
    my $comm = $tokens[1];
    $comm =~ s/[()]//g;
    $ps_info{$pid}->{comm} = $comm;

    my %sample;
    $sample{time}  = $time;
    $sample{state} = $tokens[2];
    $sample{sys}   = $tokens[13];
    $sample{user}  = $tokens[14];
    push @{$ps_info{$pid}->{samples}}, \%sample;
  }
  close PS_STAT;
}

sub unxml {
  my $x = shift;
  $x =~ s/</&lt;/g;
  $x =~ s/>/&gt;/g;

  return $x;
}

sub render_svg {
  my $t_init = $cpu_samples[0]->{time};
  $t_end    = $cpu_samples[-1]->{time};
  $t_dur    = $t_end - $t_begin;
  $img_w    = $t_dur / $HZ * $sec_w;

  my @subst;
  $subst[1] = $svg_css_file;

  #
  # Headers
  #

  my $cpu = $headers{'system.cpu'};
  $cpu =~ s/model name\s*:\s*//;
  $subst[2] = unxml($headers{title});
  $subst[3] = "uname: ".unxml($headers{'system.uname'});
  $subst[4] = "release: ".unxml($headers{'system.release'});
  $subst[5] = "CPU: ".unxml($cpu);
  $subst[6] = "kernel options: ".unxml($headers{'system.kernel.options'});
  $subst[7] = "boot time: ".int($t_end / $HZ)." seconds";

  #
  # CPU I/O chart
  #

  my $bar_h = 50;
  my $cpu_ticks = '';
  for (my $i = 0; $i < $t_dur / $HZ; $i++) {
    my $x = $i * $sec_w;
    $cpu_ticks .= "<line ".($i % 5 ? "" : "class=\"Bold\" ")."x1=\"$x\" y1=\"0\" x2=\"$x\" y2=\"$bar_h\"/>\n";
  }
  $cpu_ticks =~ s/^/\t\t\t/mg; $cpu_ticks =~ s/^\s+//g;

  my $io_points = '';
  my $cpu_points = '';

  if (@cpu_samples) {
    my $last_x = 0;

    for (@cpu_samples) {
      my $time    = $_->{time};
      my $iowait  = $_->{iowait};
      my $usersys = $_->{user} + $_->{system};

      my $pos_x = int(($time - $t_begin) * $img_w / $t_dur);
      my $pos_y = int($bar_h - ($usersys + $iowait) * $bar_h);
      $io_points .= "$pos_x,$bar_h" if $io_points eq '';
      $io_points .= " $pos_x,$pos_y";

      $pos_y = int($bar_h - $usersys * $bar_h);
      $cpu_points .= "$pos_x,$bar_h" if $cpu_points eq '';
      $cpu_points .= " $pos_x,$pos_y";

      $last_x = $pos_x;
    }
    $io_points  .= " $last_x,$bar_h";
    $cpu_points .= " $last_x,$bar_h";
  }

  $subst[8] = $cpu_ticks;
  $subst[9] = $io_points;
  $subst[10] = $cpu_points;

  #
  # Disk usage chart
  #

  my $util_points = '';
  my $read_points = '';

  if (@disk_samples) {
    my $max_tput  = 0;
    my $max_tput_label = '';
    for (@disk_samples) {
      my $put = $_->{read} + $_->{write};
      $max_tput = $put if $put > $max_tput;
    }

    my $last_x = 0;
    my $last_y = 0;

    for (@disk_samples) {
      my $time  = $_->{time};
      my $read  = $_->{read};
      my $write = $_->{write};
      my $util  = $_->{util};

      my $pos_x = int(($time - $t_begin) * $img_w / $t_dur);
      my $pos_y = int($bar_h - $util * $bar_h);
      $util_points .= "$pos_x,$bar_h" if $util_points eq '';
      $util_points .= " $pos_x,$pos_y";

      $pos_y = int($bar_h - ($read + $write) / $max_tput * $bar_h);
      if ($read_points ne '') {
        $read_points .= "\t\t\t<line x1=\"$last_x\" y1=\"$last_y\" x2=\"$pos_x\" y2=\"$pos_y\"/>";
      }
      $read_points .= "\n";

      if ($max_tput_label eq '' && $read + $write == $max_tput) {
        my $label = int($max_tput / 1024)." MB/s";
        $max_tput_label = "\t\t\t<text class=\"DiskLabel\" x=\"$pos_x\" y=\"0\" dx=\"-".(length($label) / 3)."em\" dy=\"-2px\">$label</text>\n";
      }

      $last_x = $pos_x;
      $last_y = $pos_y;
    }
    $util_points .= " $last_x,$bar_h";
    $read_points .= $max_tput_label;
  }

  $subst[11] = $cpu_ticks;
  $subst[12] = $util_points;
  $subst[13] = $read_points;
  $subst[14] = ''; # open_points, no openfile parser implemented

  #
  # Process tree
  #

  my $tree_h     = scalar(@cpu_samples) * $proc_h;
  my $axis       = '';
  my $proc_ticks = '';
  for (my $i = 0; $i < $t_dur / $HZ; $i++) {
    my $x = $i * $sec_w;
    $proc_ticks .= "<line ".($i % 5 ? "" : "class=\"Bold\" ")."x1=\"$x\" y1=\"0\" x2=\"$x\" y2=\"$tree_h\"/>\n";
    if ($i > 0 && $i % 5 == 0) {
      my $label = $i.'s';
      $axis .= "<text class=\"AxisLabel\" x=\"$x\" y=\"0\" dx=\"-".(length($label) / 4)."\" dy=\"-3\">$label</text>\n";
    }
  }
  $proc_ticks =~ s/^/\t\t\t/mg; $proc_ticks =~ s/^\s+//g;
  $axis       =~ s/^/\t\t\t/mg; $axis       =~ s/^\s+//g;

  my $proc_tree = '';
  my @init      = (1);
  my $ps_count  = 0;
  $proc_tree    = render_proc_tree(\@init, \$ps_count);

  $subst[15] = $axis;
  $subst[16] = $proc_ticks;
  $subst[17] = $proc_tree;

  $img_h     = $proc_h * $ps_count + $header_h;
  $subst[0]  = 'width="'.($img_w > $min_img_w ? $img_w : $min_img_w).'px" height="'.($img_h + 1).'px"';

  print template_subst($chart_svg_template, @subst);
}

sub render_proc_tree {
  my $ps_list  = shift;
  my $ps_count = shift;
  my $level    = shift || 0;

  my $proc_tree = '';
  for (sort {$a <=> $b} @{$ps_list}) {
    # Hide bootchartd and its children processes
    next if $ps_info{$_}->{comm} eq 'bootchartd';

    my $children = $ps_by_parent{$_};
    $proc_tree  .= render_proc($_, $ps_count, $level);
    $proc_tree  .= render_proc_tree($children, $ps_count, $level + 1) if defined $children;
  }
  return $proc_tree;
}

sub render_proc {
  my $pid      = shift;
  my $ps_count = shift;
  my $level    = shift;

  my $info    = $ps_info{$pid};
  return '' if defined $info->{done};  # Draw once

  my @samples = @{$info->{samples}};
  return '' if scalar(@samples) < 2; # Skip processes with only 1 sample

  my $p_begin  = ($pid == 1) ? $samples[0]->{time} : $info->{start};
  my $p_period = $samples[1]->{time} - $p_begin;
  my $p_end    = $samples[-1]->{time};
  my $p_dur    = $p_end - $p_begin + $p_period;

  my $x = ($p_begin - $t_begin) * $sec_w / $HZ;
  my $y = ${$ps_count} * $proc_h;
  my $w = $p_dur * $sec_w / $HZ;

  my $position = "$x,$y";
  my $border   = "width=\"$w\" height=\"$proc_h\"";
  my $timeline = "<rect class=\"Sleeping\" x=\"0\" y=\"0\" $border/>\n";

  my ($last_tx, $last_sample);
  for my $sample (@samples) {
    my $time  = $sample->{time};
    my $state = $sample->{state};
    my $tx = ($time - $p_begin) * $sec_w / $HZ;
    $tx = 0 if $tx < 0;

    if (defined $last_sample) {
      my $tw = $tx - $last_tx;

      if ($state ne 'S') {
        my $sys  = ($sample->{sys} - $last_sample->{sys}) / $HZ;
        my $user = ($sample->{user} - $last_sample->{user}) / $HZ;

        my %class   = ('D' => 'UnintSleep', 'R' => 'Running', 'T' => 'Traced', 'Z' => 'Zombie');
        my $opacity = ($state eq 'R') ? ' fill-opacity="'.($sys + $user).'"' : '';
        $timeline  .= "<rect class=\"$class{$state}\"$opacity x=\"$last_tx\" y=\"0\" width=\"$tw\" height=\"$proc_h\"/>\n";
      }
    }

    $last_tx = $tx;
    $last_sample = $sample;
  }
  $timeline =~ s/^/\t\t/mg; $timeline =~ s/^\s+//g;

  my $label = $info->{comm};
  my $label_pos = ($w < 200 && ($x + $w + 200) < $img_w) ?
    "dx=\"2\" dy=\"".($proc_h - 1)."\" x=\"".($w + 1)."\" y=\"0\"" :
    "dx=\"".($w / 2)."\" dy=\"".($proc_h - 1)."\" x=\"0\" y=\"0\"";

  my @subst = ($position, $timeline, $border, '', $label_pos, $label, '');

  $info->{done} = 1;
  ${$ps_count}++;
  return template_subst($process_svg_template, @subst);
}

sub template_subst {
  my $template = shift;

  my $i = 0;
  for(@_) {
    $template =~ s/\Q{$i}\E/$_[$i]/g;
    $i++;
  }
  return $template;
}


parse_logs('/var/log/bootchart.tgz');
render_svg();