bin/tracedeps-visual-compare.pl

   1 #!/usr/bin/perl
   2
   3 # use 5.010;
   4 use strict;
   5 use warnings;
   6
   7 =head1 NAME
   8
   9
  10
  11 =head1 SYNOPSIS
  12
  13
  14
  15 =head1 OPTIONS
  16
  17 =over 8
  18
  19 =cut
  20
  21 my @opt = <<'=back' =~ /B<--(\S+)>/g;
  22
  23 =item B<--help|h!>
  24
  25 This help
  26
  27 =back
  28
  29 =head1 DESCRIPTION
  30
  31
  32
  33 =cut
  34
  35
  36 use FindBin;
  37 use lib "$FindBin::Bin/../lib";
  38 BEGIN {
  39     push @INC, qw(       );
  40 }
  41
  42 use Dumpvalue;
  43 use File::Basename qw(basename dirname);
  44 use File::Path qw(mkpath);
  45 use File::Spec;
  46 use File::Temp;
  47 use Getopt::Long;
  48 use Pod::Usage;
  49 use Hash::Util qw(lock_keys);
  50
  51 our %Opt;
  52 lock_keys %Opt, map { /([^=|!]+)/ } @opt;
  53 GetOptions(\%Opt,
  54            @opt,
  55           ) or pod2usage(1);
  56 if ($Opt{help}) {
  57     pod2usage(0);
  58 }
  59
  60 use Imager; use YAML::XS; my @yaml = map { YAML::XS::LoadFile $_ or die "cannot load yaml file: $!"; } @ARGV;
  61 my $xsize = 1200;  my $ysize = 800;
  62 my $img    = Imager->new(xsize=>$xsize, ysize=>$ysize, channels=>4);
  63 my $white  = Imager::Color->new( 255, 255, 255 );
  64 my $gray   = Imager::Color->new( 192, 192, 192 );
  65 my $black  = Imager::Color->new(  10,  10,  10 );
  66 $img->flood_fill(x=>50, y=>50, color=>$white);
  67 my $xgridlines = 30; my $ygridlines = 12;
  68 GRIDX: for (my $xgridline = 0; $xgridline <= $xgridlines; $xgridline++) {
  69     my $x = 10 + ($xsize - 20) * ($xgridline/$xgridlines);
  70     $img->line(color=>$gray, x1=>$x, x2=>$x,      y1=>10, y2=>$ysize-10, aa=>1, endp=>1 );
  71 }
  72 GRIDY: for (my $ygridline = 0; $ygridline <= $ygridlines; $ygridline++) {
  73     my $y = 10 + ($ysize - 20) * ($ygridline/$ygridlines);
  74     $img->line(color=>$gray, x1=>10, x2=>$xsize-10,      y1=>$y, y2=>$y, aa=>1, endp=>1 );
  75 }
  76 my($max_total_secs, $max_total_lines);
  77 YAML: for my $yaml_i (0..$#yaml){
  78     my $yaml = $yaml[$yaml_i];
  79     my @k = sort keys %{$yaml->{G}};
  80     $max_total_secs  //= $yaml->{G}{$k[-1]}{T};
  81     $max_total_lines //= $yaml->{G}{$k[-1]}{N};
  82     $max_total_secs  = $yaml->{G}{$k[-1]}{T} if $yaml->{G}{$k[-1]}{T} > $max_total_secs;
  83     $max_total_lines = $yaml->{G}{$k[-1]}{N} if $yaml->{G}{$k[-1]}{N} > $max_total_lines;
  84 }
  85 my $font = Imager::Font->new(file => "/usr/share/fonts/truetype/freefont/FreeSans.ttf");
  86 $img->align_string(
  87     string =>int($max_total_lines),
  88     x      =>10,
  89     y      =>10,
  90     aa     =>1,
  91     halign =>'left',
  92     valign =>'top',
  93     font   =>$font,
  94     size   => 18,
  95     color  => $black,
  96 );
  97 $img->align_string(
  98     string =>int($max_total_secs),
  99     x      =>$xsize-10,
 100     y      =>$ysize-10,
 101     aa     =>1,
 102     halign =>'right',
 103     valign =>'baseline',
 104     font   =>$font,
 105     size   => 18,
 106     color  => $black,
 107 );
 108 DAY: for (my $i = 1;$i < $max_total_secs/86400; $i++) {
 109     my $x = $i*86400*($xsize-20)/$max_total_secs + 10;
 110     $img->line(
 111         color => $black,
 112         x1 => $x,
 113         x2 => $x,
 114         y1 => $ysize-20,
 115         y2 => $ysize-10,
 116         aa => 1,
 117         endp => 1,
 118     );
 119 }
 120
 121 my @hue = map { (360/scalar(@yaml)) * $_ } 0..$#yaml;
 122 $|=1;
 123 for my $yaml_i (0..$#yaml){
 124     printf "\r%d/%d ", 1+$yaml_i, 1+$#yaml;
 125     my $yaml   = $yaml[$yaml_i];
 126     my $curcol = Imager::Color->new( hue => $hue[$yaml_i], s=>0.95, v=>0.9,  );
 127     my @k = sort keys %{$yaml->{G}};
 128     for my $t (@k){
 129         my $e = $yaml->{G}{$t};
 130         $img->circle( color => $curcol, r => 1, aa => 1, filled => 1, x => 10 + ($xsize-20)*$e->{T}/$max_total_secs, y => $ysize - 10 - ($ysize-20)*$e->{N}/$max_total_lines );
 131     }
 132     my $string = sprintf "%s (%s)", basename($ARGV[$yaml_i]), $yaml->{uniq_path_snippet} || $yaml->{hostname};
 133     $img->align_string(
 134         string =>$string,
 135         x      =>10,
 136         y      =>75+25*$yaml_i,
 137         aa     =>1,
 138         halign =>'left',
 139         valign =>'baseline',
 140         font   =>$font,
 141         size   => 18,
 142         color  => $curcol,
 143     );
 144     $img->write(file=>"t.png");
 145 }
 146 print "\n";
 147
 148 # Local Variables:
 149 # mode: cperl
 150 # cperl-indent-level: 4
 151 # End: