scripts/gearman2dot.pl

   1 #!/usr/bin/perl
   2 use warnings;
   3 use strict;
   4
   5 use autodie;
   6 use File::Find;
   7 use File::Slurp;
   8 use Data::Dump qw(dump);
   9
  10 my $dot;
  11 sub dot {
  12         $dot .= join("\n",@_) . "\n";
  13         warn "DOT ",@_,$/;
  14 }
  15
  16 sub print_job {
  17         my ( $name, $job ) = @_;
  18         warn "JOB $name ",dump($job),$/;
  19
  20         return unless exists $job->{task};
  21
  22         $name = $job->{name};
  23
  24         foreach my $taskset ( keys %{ $job->{task} } ) {
  25                 dot "subgraph ${name}_$taskset {";
  26                 my @t = @{ $job->{task}->{$taskset} };
  27                 my $wait = $t[$#t] eq 'wait' && pop @t;
  28                 foreach my $f ( @t ) {
  29                         dot qq|"$name" -> "$f"|;
  30                         dot qq|"$f" -> "${name}_wait"| if $wait;
  31                 }
  32                 dot "} //subgraph";
  33         }
  34 }
  35
  36 find(sub {
  37         my $name = $_;
  38         return if ! m/\.pm$/;
  39         open(my $fh, '<', $name);
  40         my $job;
  41         while(<$fh>) {
  42                 chomp;
  43                 if (/sub\s+(\w+)\s*:\s*Job/) {
  44                         print_job $name => $job;
  45                         $job = { name => $1 };
  46                 } elsif ( m/\$(\w+)->add_task\(\s*'(\w+)'/ ) {
  47                         push @{ $job->{task}->{$1} }, $2;
  48                 } elsif ( m/\$(\w+)->wait/ ) {
  49                         if ( exists $job->{task}->{$1} ) {
  50                                 push @{ $job->{task}->{$1} }, 'wait';
  51                         }
  52                 } elsif ( m/\$self->(do\w*)\(\s*'(\w+)'/ ) {
  53                         push @{ $job->{$1} }, $2;
  54                         dot qq|"$job->{name}" -> "$2" [ label="$1" ]|;
  55                 }
  56         }
  57         print_job $name => $job;
  58 }, 'lib');
  59
  60 print $dot;
  61
  62 open(my $d, '|-', 'dot -Tpng -o public/gearman.png');
  63 print $d "digraph {\n$dot\n}\n";
  64 close($d);