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 sub print_job {
  11         return unless @_;
  12         print "JOB ",dump(@_),$/;
  13 }
  14
  15 find(sub {
  16         my $name = $_;
  17         return if ! m/\.pm$/;
  18         open(my $fh, '<', $name);
  19         my $job;
  20         while(<$fh>) {
  21                 chomp;
  22                 if (/sub\s+(\w+)\s*:\s*Job/) {
  23                         print_job $name => $job;
  24                         $job = { name => $1 };
  25                 } elsif ( m/\$(\w+)->add_task\(\s*'(\w+)'/ ) {
  26                         push @{ $job->{task}->{$1} }, $2;
  27                 } elsif ( m/\$(\w+)->wait/ ) {
  28                         if ( exists $job->{task}->{$1} ) {
  29                                 push @{ $job->{task}->{$1} }, 'wait';
  30                         }
  31                 } elsif ( m/\$self->(do\w*)\(\s*'(\w+)'/ ) {
  32                         push @{ $job->{$1} }, $2;
  33                 }
  34         }
  35         print_job $name => $job;
  36 }, 'lib');