8 use Data::Dump qw(dump);
12 $dot .= join("\n",@_) . "\n";
17 my ( $name, $job ) = @_;
18 warn "JOB $name ",dump($job),$/;
20 return unless exists $job->{task};
24 foreach my $taskset ( keys %{ $job->{task} } ) {
25 dot qq|subgraph cluster_${name}_$taskset {
26 style = filled; color=lightgray; label="$name"
27 node [style=filled,color=white];
29 my @t = @{ $job->{task}->{$taskset} };
30 my $wait = $t[$#t] eq 'wait' && pop @t;
31 foreach my $f ( @t ) {
32 dot qq|"$name" -> "$f";|;
33 dot qq|"$f" -> "${name}";| if $wait;
42 open(my $fh, '<', $name);
46 if (/sub\s+(\w+)\s*:\s*Job/) {
47 print_job $name => $job;
48 $job = { name => $1 };
49 } elsif ( m/\$(\w+)->add_task\(\s*'(\w+)'/ ) {
50 push @{ $job->{task}->{$1} }, $2;
51 } elsif ( m/\$(\w+)->wait/ ) {
52 if ( exists $job->{task}->{$1} ) {
53 push @{ $job->{task}->{$1} }, 'wait';
55 } elsif ( m/\$self->(do\w*)\(\s*'(\w+)'/ ) {
56 my ( $do, $what ) = ( $1, $2 );
57 push @{ $job->{$do} }, $what;
59 $style = ' style=dotted ' if $do =~ s/_background.*//;
60 dot qq|"$job->{name}" -> "$what" [ $style ];|;
63 print_job $name => $job;
68 open(my $d, '|-', 'dot -Tpng -o public/gearman.png');
69 print $d "digraph {\n$dot\n}\n";