view release on metacpan or  search on metacpan

call-anal.pl  view on Meta::CPAN

Usage: ./call-anal.pl [opts] */*.c */*.cc >graph.dot
        -n  perform simulation, do not alter the source

dot -Tps graph.dot -o graph.ps && gv graph.ps
http://www.research.att.com/sw/tools/graphviz/download.html
USAGE
    ;

$project = 'ZXID';

$dot_header = <<DOT;
// Generated graph. Do not edit. Any changes will be lost.
// dot -Tps graph.dot -o graph.ps && gv graph.ps
// http://www.research.att.com/sw/tools/graphviz/download.html
DOT
    ;

$write = 1;
if ($ARGV[0] eq '-n') {
    shift;
    $write = 0;
}
die $USAGE if $ARGV[0] =~ /^-/;
undef $/;

# Function at origin of graph => call depth from the function
#%local_graphs = ( main => 6,     # the start
#		  yyparse => 3,  # center of compiler
#		  );
%local_graphs = ( hi_shuffle => 10,
		  zxbus_listen_msg => 4,
		  zxid_simple_cf => 4);

# N.B. names in all upper case, i.e. macros, are always ignored
@ignore_callee = qw(for if return sizeof switch while);
push @ignore_callee,
    qw(accept atoi close fclose fcntl fprintf fputs ftruncate free
       getpid getuid getegid htons htonl getenv gmtime_r inetaton
       lseek dlsym dlopen
       malloc memchr memcpy memcmp memmove memset mmap munmap
       new open printf poll
       closedir opendir rewinddir pow
       perror pthread_mutex_init pthread_mutex_lock pthread_mutex_unlock
       pthread_cancel pthread_detach pthread_setcanceltype pthread_setspecific
       read sleep sort sprintf strcat strchr strcmp strcpy strdup strerror
       sscanf strlen strncmp strncpy strspn strtok toupper tolower
       va_end va_start vprintf vsnprintf vsprintf vsyslog
       write writev);

push @ignore_callee,
    qw(name_from_path vname_from_path open_fd_from_path vopen_fd_from_path close_file
       zx_CreateFile write_all_fd write_all_fd_fmt
       write_all_path_fmt write2_or_append_lock_c_path
       read_all_fd read_all hexdump read_all_alloc get_file_size
       sha1_safe_base64 zxid_nice_sha1
       zx_strf zx_ref_str zx_ref_len_str zx_dup_str zx_dup_len_str zx_dup_cstr
       zx_new_len_str zx_str_to_c
       zx_ref_attr zx_ref_len_attr zx_attrf zx_dup_attr zx_dup_len_attr
       zx_new_str_elem zx_ref_elem zx_ref_len_elem
       zx_url_encode zx_url_encode_len zx_url_encode_raw unbase64_raw
       zx_rand zx_report_openssl_err zx_memmem zxid_mk_self_sig_cert zxid_extract_private_key );

push @ignore_callee,
    qw(hi_pdu_alloc hi_dump nonblock setkernelbufsizes zxid_get_ent_ss zx_pw_authn
       xmtp_decode_resp test_ping http_decode smtp_decode_req smtp_decode_resp );

push @ignore_callee, qw(new_zx_ei);

select STDERR; $|=1; select STDOUT;

sub process_func {
    my ($fn, $func, $body) = @_;
    #warn "process_func($fn,$func,".length($body).")";
    $func =~ s/^~/D_/;
    push @{$def{$func}}, $fn;     # where is function defined
    push @{$funcs_in_file{$fn}}, $func;
      
    ### Analyze body to detect function calls: first eliminate confusing junk
    
    $body =~ s{/\*.*?\*/}{}gs;    # strip comments
    $body =~ s{"[^\n\"]+?"}{}gs;  # strip strings (debug output)
    $body =~ s{if\s*\(}{}gs;
    $body =~ s{while\s*\(}{}gs;
    $body =~ s{for\s*\(}{}gs;
    $body =~ s{switch\s*\(}{}gs;
    
    #                        01     1     0
    @func_calls = $body =~ m%((~?\w+)\s*\()%sg;
    while (@func_calls) {
	$callee = $func_calls[1];
	next if $callee =~ /^[A-Z0-9_]+$/;   # Ignore macros
	next if $callee =~ /^[A-Z0-9_]{3,}/; # Ignore all caps starts
	next if grep $callee eq $_, @ignore_callee;
	$callee =~ s/^~/D_/;
	#warn "zxlex2() body: >$callee< >>$func_calls[0]<<" if $func eq 'zxlex2';
	$called_by{$callee}{$func}++;
	$calls{$func}{$callee}++;
	#warn "zx_scan_identifier x zxlex2: `$called_by{$callee}{$func}' `$calls{$func}{$callee}'" if ($func eq 'zxlex2') && ($callee eq 'zx_scan_identifier');
	$fnf{$fn}{$func}{$callee}++;
	#warn "fn=$fn func=$func callee=$callee: $fnf{$fn}{$func}{$callee}";
    } continue {
	splice @func_calls, 0, 2;
    }
}

#$watch1 = 'zxid_extract_issuer';        # zxiddec.c
#$watch2 = 'zxid_decode_redir_or_post';  # zxiddec.c

sub process_doc {
    my ($fn, $func, $doc_flag, $doc, $params) = @_;
    return if $doc_flag =~ /-/;   # (-) suppresses function from documentation
    warn "DOC1 FUNC($func) ($doc)" if $func eq $watch1 || $func eq $watch2;
    #$doc =~ s/\n\/\*\sCalled\sby:[^\*\/]*?\*\/)?//;
    $doc =~ s/\n\/\*\sCalled\sby:.*$//s;
    warn "DOC2($doc)" if $func eq $watch1 || $func eq $watch2;
    $doc =~ s/\*\/$//gs;
    warn "DOC3($doc)" if $func eq $watch1 || $func eq $watch2;
    $doc =~ s/\n ?\* ?/\n/gs;
    warn "DOC4($doc)" if $func eq $watch1 || $func eq $watch2;
    $local_graphs{$func} = 1;  # Cause call graph (2 deep) to be generated for this function
    ++$n_fn;