├── TODO.txt ├── README.txt └── bin └── perl_call_graph /TODO.txt: -------------------------------------------------------------------------------- 1 | TODO: Riehm 2011-10-19 include recursive directory walking 2 | eg: if no source provided - take everything under the current directory 3 | -------------------------------------------------------------------------------- /README.txt: -------------------------------------------------------------------------------- 1 | Perl Call Graph Generator 2 | ========================= 3 | 4 | This project provides a simple static analysis tool for examining the 5 | interactions between subroutines in one or more perl scripts. 6 | 7 | After scanning your code (including modules), a .dot file is generated, which 8 | you can then turn into pretty (?) diagrams using a wonderful free peice of 9 | software called GraphViz (http://www.graphviz.org) 10 | 11 | The analysis is quite simplistic, but having a graphic diagram of the call 12 | graph of your entire program, or just a selection of it, can be a great help, 13 | even if it just helps you find the most likely places to look for whatever it 14 | is you're looking for :-) 15 | 16 | Installation: 17 | ============= 18 | 19 | The script in this directory can be used as-is, there is no need to "install" 20 | it anywhere special. 21 | 22 | Documentation: 23 | ============== 24 | 25 | The documentation for perl_call_graph.pl is embedded in the script as POD documentation. 26 | 27 | Use your favourite pod2* script to convert it into your desired format. For example: 28 | 29 | pod2man perl_call_graph.pl | nroff -man | less 30 | 31 | Workflow: 32 | ========= 33 | 34 | Normally it is enough to specifiy which functions you're interested in 35 | (via --start) and the files in question (ie: all .pm files) 36 | 37 | perl_call_graph.pl [--cluster] [--start ] [--jpg|--png] 38 | 39 | 40 | Stephen Riehm 41 | 2011-10-19 42 | -------------------------------------------------------------------------------- /bin/perl_call_graph: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | 3 | # DESCRIPTION: Perl call graph generator 4 | # 5 | # This script analyzes one or more perl scripts or modules and 6 | # produces a GraphViz description file (in dot format) 7 | # Use GraphViz to convert the output file into a "pretty" 8 | # graphical representation of your code. 9 | # 10 | # AUTHOR: Stephen Riehm 11 | # Date: 2009-01-16 12 | 13 | my $VERSION = '1.0'; 14 | 15 | use strict; 16 | use warnings; 17 | use 5.8.8; 18 | use Getopt::Long; # command line processing 19 | use Pod::Usage; 20 | use GraphViz; # for generating the actual call graph images 21 | use POSIX qw( strftime ); 22 | 23 | my $start_node_regex = undef; 24 | my @ignore_patterns = (); 25 | 26 | my $parameters = { 27 | 'ignore' => [], # may be specified multiple times 28 | }; 29 | my $got_opts = GetOptions( $parameters, 30 | 'cluster!', 31 | 'help|?', 32 | 'man', 33 | 'ignore=s', 34 | 'output=s', 35 | 'start=s', 36 | # output formats 37 | 'dot', 38 | 'svg', 39 | 'jpg', 40 | 'png', 41 | ); 42 | 43 | pod2usage( -verbose => 0, -exit => 0 ) if $parameters->{'help'} or ! $got_opts; 44 | pod2usage( -verbose => 2, -exit => 0 ) if $parameters->{'man'}; 45 | 46 | if( $parameters->{'start'} ) 47 | { 48 | $start_node_regex = qr/$parameters->{'start'}/i; 49 | } 50 | 51 | foreach my $ignore_pattern ( @{$parameters->{'ignore'}} ) 52 | { 53 | push( @ignore_patterns, qr/$ignore_pattern/i ); 54 | } 55 | 56 | $parameters->{'output'} ||= '.'; 57 | if( -d $parameters->{'output'} ) 58 | { 59 | my $base_name = 'call_graph_'; 60 | if( $parameters->{'start'} ) 61 | { 62 | $base_name .= $parameters->{'start'}; 63 | $base_name =~ s/\\.//g; 64 | $base_name =~ s/[^-\w]//g; 65 | } 66 | else 67 | { 68 | $base_name .= strftime( "%Y%m%d-%H%M%S", localtime() ); 69 | } 70 | $parameters->{'output'} =~ s:/*$:/$base_name:; 71 | } 72 | 73 | if( not -e $parameters->{'output'} and $parameters->{'output'} =~ s/\.(dot|svg|jpg|png)$// ) 74 | { 75 | $parameters->{$1} = 1; 76 | } 77 | 78 | # generate dot files by default 79 | $parameters->{'dot'} = 1 unless grep( defined, @{$parameters}{qw( dot svg jpg png )} ); 80 | 81 | # 82 | # scan all input files for anything that "looks like" a function definition or a function call. 83 | # Function calls are recorded with their caller function, 84 | # 85 | 86 | my $current_file = undef; 87 | my $current_sub = undef; 88 | my $sub_definition = {}; 89 | my $sub_call = {}; 90 | my $call_graph = {}; 91 | my $in_pod = 0; 92 | 93 | die "Please specify some files to parse!\n" unless @ARGV; 94 | 95 | # TODO: replace this with a real perl parser (ha!) which properly handles 96 | # matching curlies, pod documentation etc. 97 | LINE: 98 | while( my $line = <> ) 99 | { 100 | unless( defined $current_file ) 101 | { 102 | $current_file = $ARGV; 103 | # $current_file =~ s:.*[\\/]::; # only want the file name without path info 104 | $current_sub = 'main'; 105 | } 106 | 107 | $line =~ s/[\n\r]*$//; # platform independent chomp 108 | 109 | next LINE if $line =~ /^\s*(#.*)?$/; # skip empty lines and comments 110 | 111 | # skip pod documentation 112 | if( $line =~ /^=(\w+)/ ) 113 | { 114 | $in_pod = ( $1 eq 'cut' ) ? 0 : 1; 115 | next LINE; 116 | } 117 | 118 | next LINE if $in_pod; 119 | 120 | # look for sub <...> 121 | # but ignore lines which don't look like a real sub (ie: 'sub blah foo') 122 | if( $line =~ /^\s*sub\s+(\w+)(?:\s*?(?:[#{].*)?)$/ ) 123 | { 124 | $current_sub = $1; 125 | $sub_definition->{$current_sub}{$current_file}{'line'} = $.; 126 | next LINE; 127 | } 128 | 129 | # TODO: reliably recognise the end of a sub 130 | # how about 'everything between the last closing curly and the current sub'? (re-evaluate calls) 131 | if( $line =~ /^}/ ) 132 | { 133 | $current_sub = 'main'; 134 | next LINE; 135 | } 136 | 137 | # TODO: extend to do clever things with method calls 138 | # for example: 139 | # CLASS::SUBCLASS->foo() file can be derived 140 | # $var->foo() may match multiple classes 141 | # $var->foo 142 | # {$var->{method}}->foo 143 | # currently - this is deliberatly very lenient - because we don't care 144 | # about calls which don't match to a subroutine in one of the files that 145 | # were provided 146 | while( $line =~ s/^.*?(?{$current_sub}{$current_file}{$1}++; 149 | } 150 | } 151 | continue 152 | { 153 | if( eof ) 154 | { 155 | close( ARGV ); # reset line numbers 156 | $current_file = undef; # indicate that we've changed to a different file 157 | } 158 | } 159 | 160 | # 161 | # try to match callers with callees 162 | # first: try to find a match within the same file. 163 | # second: see if the function is defined in ONE other file 164 | # third: complain about an ambiguous call if the callee has multiple definitions 165 | # 166 | foreach my $caller_sub ( keys %{$sub_call} ) 167 | { 168 | foreach my $caller_file ( keys %{$sub_call->{$caller_sub}} ) 169 | { 170 | foreach my $referenced_sub ( keys %{$sub_call->{$caller_sub}{$caller_file}} ) 171 | { 172 | # skip while(), for() and module calls 173 | next unless( exists $sub_definition->{$referenced_sub} ); 174 | next if( grep $referenced_sub =~ /$_/, @ignore_patterns ); 175 | 176 | if( exists $sub_definition->{$referenced_sub}{$caller_file} ) 177 | { 178 | $call_graph->{"$caller_file:$caller_sub"}{'invokes'}{"$caller_file:$referenced_sub"}++; 179 | $call_graph->{"$caller_file:$referenced_sub"}{'invoked_by'}{"$caller_file:$caller_sub"}++; 180 | next; 181 | } 182 | my ( @matching_definitions ) = sort keys %{$sub_definition->{$referenced_sub}}; 183 | 184 | if( @matching_definitions == 1 ) 185 | { 186 | my $referenced_file = shift @matching_definitions; 187 | $call_graph->{"$caller_file:$caller_sub"}{'invokes'}{"$referenced_file:$referenced_sub"}++; 188 | $call_graph->{"$referenced_file:$referenced_sub"}{'invoked_by'}{"$caller_file:$caller_sub"}++; 189 | } 190 | else 191 | { 192 | # print( "AMBIGUOS: $caller_file:$caller_sub() -> $referenced_sub() defined in @matching_definitions\n" ); 193 | } 194 | } 195 | } 196 | } 197 | 198 | # 199 | # determine which nodes to start graphing from 200 | # 201 | my @initial_nodes = (); 202 | if( defined $start_node_regex ) 203 | { 204 | @initial_nodes = sort grep( /$start_node_regex/, keys %{$call_graph} ); 205 | } 206 | else 207 | { 208 | FILE_SUB: 209 | foreach my $file_sub ( sort keys %{$call_graph} ) 210 | { 211 | unless( $call_graph->{$file_sub}{'invoked_by'} ) 212 | { 213 | push( @initial_nodes, $file_sub ); 214 | next FILE_SUB; 215 | } 216 | } 217 | } 218 | 219 | # 220 | # Actually produce the graph 221 | # 222 | my $graph = graph->new( 223 | 'call_graph' => $call_graph, 224 | 'output_base_name' => $parameters->{'output'}, 225 | 'cluster_files' => $parameters->{'cluster'}, 226 | 'generate_dot' => $parameters->{'dot'}, 227 | 'generate_svg' => $parameters->{'svg'}, 228 | 'generate_jpg' => $parameters->{'jpg'}, 229 | 'generate_png' => $parameters->{'png'}, 230 | ); 231 | 232 | foreach my $file_sub ( @initial_nodes ) 233 | { 234 | $graph->plot( $file_sub ); 235 | } 236 | 237 | $graph->generate(); 238 | 239 | exit( 0 ); 240 | 241 | package graph; 242 | 243 | sub new 244 | { 245 | my $class = shift; 246 | my $self = bless { @_ }, $class; 247 | 248 | return $self; 249 | } 250 | 251 | sub plot 252 | { 253 | my $self = shift; 254 | my $from_file_sub = shift; 255 | my $direction = shift || undef; # up, down or undefined 256 | 257 | $self->{'node'}{$from_file_sub}++; 258 | unless( defined $direction ) 259 | { 260 | $self->{'initial_node'}{$from_file_sub}++; 261 | $direction = "up down"; 262 | } 263 | 264 | if( $direction =~ /up/ ) 265 | { 266 | foreach my $parent_file_sub ( sort keys %{$self->{'call_graph'}{$from_file_sub}{'invoked_by'}} ) 267 | { 268 | $self->{'edge'}{$parent_file_sub}{$from_file_sub}++; 269 | $self->plot( $parent_file_sub, 'up' ) unless $self->{'node'}{$parent_file_sub}++; 270 | } 271 | } 272 | 273 | if( $direction =~ /down/ ) 274 | { 275 | foreach my $to_file_sub ( sort keys %{$self->{'call_graph'}{$from_file_sub}{'invokes'}} ) 276 | { 277 | $self->{'edge'}{$from_file_sub}{$to_file_sub}++; 278 | $self->plot( $to_file_sub, 'down' ) unless $self->{'node'}{$to_file_sub}++; 279 | } 280 | } 281 | } 282 | 283 | sub generate 284 | { 285 | my $self = shift; 286 | 287 | my $graph = GraphViz->new( 288 | rankdir => 1, # 1 = left to right, 0 = top to bottom 289 | concentrate => 1, # concentrate overlapping lines 290 | ratio => 0.7, # make the image 20% wider 291 | fontsize => 24, # was 24 292 | node => { shape => 'Mrecord', }, 293 | ); 294 | 295 | foreach my $file_sub ( sort keys %{$self->{'node'}} ) 296 | { 297 | my ( $file, $sub ) = split( /:/, $file_sub ); 298 | my $cluster_id = "cluster_$file"; 299 | 300 | if( $self->{'cluster_files'} and not $self->{'clusters'}{$cluster_id} ) 301 | { 302 | $self->{'clusters'}{$cluster_id} = { 303 | label => $file, 304 | style => "bold", 305 | fontname => "Times-Bold", 306 | fontsize => 48, # was 48 307 | fontcolor => "red", 308 | }; 309 | } 310 | 311 | my %node_attributes = (); 312 | 313 | $node_attributes{'label'} = $self->{'cluster_files'} 314 | ? sprintf( "%s", $sub ) 315 | : sprintf( "%s\n%s", $file, $sub ) 316 | ; 317 | 318 | # highlight the start node(s) 319 | if( exists $self->{'initial_node'}{$file_sub} ) 320 | { 321 | $node_attributes{'style'} = 'filled'; 322 | $node_attributes{'fillcolor'} = '/greens3/2'; # background, first green in greens3 colorscheme 323 | $node_attributes{'color'} = '/greens3/3'; # border, last green in greens3 colorscheme 324 | } 325 | $node_attributes{'cluster'} = $self->{'clusters'}{$cluster_id} if $self->{'cluster_files'}; 326 | 327 | $graph->add_node( $file_sub, %node_attributes ); 328 | } 329 | 330 | foreach my $from_file_sub ( keys %{$self->{'edge'}} ) 331 | { 332 | foreach my $to_file_sub ( keys %{$self->{'edge'}{$from_file_sub}} ) 333 | { 334 | $graph->add_edge( $from_file_sub, $to_file_sub ); 335 | } 336 | } 337 | 338 | if( $self->{'generate_png'} ) 339 | { 340 | if( $graph->can( 'as_png' ) ) 341 | { 342 | printf "Generating: %s\n", $self->{'output_base_name'} . '.png'; 343 | $graph->as_png( $self->{'output_base_name'}.'.png' ) 344 | } 345 | else 346 | { 347 | printf "The installed GraphViz doesn't support PNG\n"; 348 | $self->{generate_jpg} = 1; 349 | } 350 | } 351 | if( $self->{'generate_jpg'} ) 352 | { 353 | if( $graph->can( 'as_jpg' ) ) 354 | { 355 | printf "Generating: %s\n", $self->{'output_base_name'} . '.jpg'; 356 | $graph->as_jpg( $self->{'output_base_name'}.'.jpg' ) 357 | } 358 | else 359 | { 360 | printf "The installed GraphViz doesn't support JPG\n"; 361 | $self->{generate_dot} = 1; 362 | } 363 | } 364 | if( $self->{'generate_svg'} ) 365 | { 366 | if( $graph->can( 'as_svg' ) ) 367 | { 368 | printf "Generating: %s\n", $self->{'output_base_name'} . '.svg'; 369 | $graph->as_svg( $self->{'output_base_name'}.'.svg' ) 370 | } 371 | else 372 | { 373 | printf "The installed GraphViz doesn't support svg\n"; 374 | $self->{generate_dot} = 1; 375 | } 376 | } 377 | if( $self->{'generate_dot'} ) 378 | { 379 | printf "Generating: %s\n", $self->{'output_base_name'} . '.dot'; 380 | $graph->as_text( $self->{'output_base_name'}.'.dot' ) 381 | } 382 | } 383 | 384 | =head1 NAME 385 | 386 | perl_call_graph.pl - generate a call graph in GraphViz' DOT format for a group of perl scripts or modules. 387 | 388 | =head1 SYNOPSIS 389 | 390 | =head2 Graph as image: 391 | 392 | % perl_call_graph [--[no]cluster] [--start ] [--ignore ...] [--output ] [--[png|jpg|svg]] *.pm 393 | 394 | =head2 Graph as DOT file (manual image creation via GraphViz): 395 | 396 | % perl_call_graph [--[no]cluster] [--start=regex] [--ignore ] [--output ] *.pm 397 | % dot -Tjpg -o graph.jpg 398 | 399 | =head2 Full help: 400 | 401 | % perl_call_graph --man 402 | 403 | =head1 DESCRIPTION 404 | 405 | This script scans all named perl scripts or modules for function definitions and calls. 406 | 407 | If a starting point is defined, then any subroutines whose names match the 408 | provided regular expression will be used as entry-points in the 409 | resulting hierarchical graph. Additionally, the call graphs I each starting 410 | point are included in the digram. 411 | 412 | If no starting point regex is defined, then any subroutine which is not called 413 | from another subrountine in any of the files is considered to be an entry point. 414 | 415 | Subroutines which are un-reachable from one of 416 | the starting points are not included in the resulting graph. 417 | 418 | Subroutines which are not defined in the files being parsed are NOT included in 419 | the resulting graph. 420 | 421 | Interactions between multiple files are automatically tracked also. 422 | 423 | After generating the dot file, use one of the many graphviz tools to render a 424 | nice graphical image of the filtered data. 425 | 426 | =head1 WARNING 427 | 428 | This script does not perform full-blown static code analysis. Rather, it scans 429 | the provided source code for function definitions and calls. 430 | 431 | As a result, it can be confused by sample code in comments and it is not able 432 | to accurately model object-oriented interactions. 433 | 434 | =head1 OPTIONS 435 | 436 | =over 437 | 438 | =item --start 439 | 440 | Any function names that match are marked as entry-points. (Nodes with a green border.) 441 | 442 | B if other functions call the entry-points, they will also be displayed 443 | (so they won't necessarily be on the left-hand edge of the resulting diagram). 444 | 445 | B don't use C<^> or C<$> in your regular expressions. The I that 446 | takes place internally covers both the file name and the function name. 447 | Use C<\b> instead, ie: C<--start '\bstart\b'> 448 | 449 | By default, any functions which are not called by some other function are marked as entry points. 450 | 451 | =item --ignore 452 | 453 | Ignore functions which match . 454 | 455 | C<--ignore> may be specified multiple times to ignore multiple sub-graphs 456 | 457 | =item --[no]cluster 458 | 459 | Specifies that functions should be clustered on a file-by-file basis. 460 | 461 | =item --output 462 | 463 | =item --output 464 | 465 | Specify where the output should be written. 466 | 467 | If a directory is specified, then the --start specification will be used to 468 | derive a file name. In these cases the file name will have the following structure: 469 | 470 | 'call_graph_' '.' 471 | 472 | Note that all non-alphanumeric characters will be replaces by a single 473 | underscore, so C<--start '\w*create\w*view' -jpg> would generate the file name: 474 | C 475 | 476 | If a filename is specified then the file will be created or overwritten as necessary. 477 | 478 | Default: 479 | 480 | =item --dot 481 | 482 | Generate a DOT file which can be given to GraphViz for formatting into any graphical format. 483 | 484 | This is the default output format. 485 | 486 | =item --svg 487 | 488 | Generate a svg image of the resulting call graph. 489 | 490 | =item --jpg 491 | 492 | Generate a jpg image of the resulting call graph. 493 | 494 | Only available if the graphviz and jpg libraries have been installed 495 | 496 | =item --png 497 | 498 | Generate a png image of the resulting call graph. 499 | 500 | Only available if the graphviz and png libraries have been installed 501 | 502 | =back 503 | 504 | =head1 EXAMPLES 505 | 506 | To get an overview of YAML.pm, you might like to try some of the following: 507 | 508 | perl_call_graph.pl -png /usr/lib/site_perl/5.10.0/YAML.pm 509 | 510 | perl_call_graph.pl -png /usr/lib/site_perl/5.10.0/YAML.pm /usr/lib/site_perl/5.10.0/YAML/*.pm 511 | 512 | perl_call_graph.pl -png --cluster /usr/lib/site_perl/5.10.0/YAML.pm /usr/lib/site_perl/5.10.0/YAML/*.pm 513 | 514 | perl_call_graph.pl -png --cluster --start dump /usr/lib/site_perl/5.10.0/YAML.pm /usr/lib/site_perl/5.10.0/YAML/*.pm 515 | 516 | perl_call_graph.pl -png --cluster --start '\bdump\b' /usr/lib/site_perl/5.10.0/YAML.pm /usr/lib/site_perl/5.10.0/YAML/*.pm 517 | 518 | =head1 AUTHOR 519 | 520 | Stephen Riehm 521 | 522 | =head1 FEEDBACK 523 | 524 | Please send bug reports or enhancemets: perl-feedback@opensauce.de 525 | 526 | --------------------------------------------------------------------------------