|
| 1 | +#!/usr/bin/perl |
| 2 | +use strict; |
| 3 | +use warnings; |
| 4 | +use Data::Dumper; |
| 5 | + |
| 6 | +sub mind(@) { |
| 7 | + my ($title, @lines) = @_; |
| 8 | + # [level, content, children] |
| 9 | + my @stk=([0, $title, []]); |
| 10 | + foreach my $ln (@lines) { |
| 11 | + if ($ln =~/^([-]*)\s*(.*)/) { |
| 12 | + my ($dashes, $content) = ($1, $2); |
| 13 | + my $level = length($dashes); |
| 14 | + while (scalar(@stk) > 0 && $stk[-1][0] + 1 != $level) { |
| 15 | + pop @stk; |
| 16 | + } |
| 17 | + die "Ill-formed mind input" if (scalar(@stk) == 0); |
| 18 | + my $top = $stk[-1]; |
| 19 | + my $curr = [$level, $content, []]; |
| 20 | + push @stk, $curr; |
| 21 | + my ($top_level,$parent_content,$top_children) = @$top; |
| 22 | + push @$top_children, $curr; |
| 23 | + } |
| 24 | + } |
| 25 | + return $stk[0]; |
| 26 | +} |
| 27 | + |
| 28 | +my $lines =<<DONE |
| 29 | +calltree.pl |
| 30 | +- prerequisites |
| 31 | +-- perl 5.10+: Most Linux distributions and MacOS have intalled perl 5.10+. |
| 32 | +-- ag(the_silver_searcher): |
| 33 | +--- Must be installed, |
| 34 | +--- Although calltree.pl can leverage official https://github.com/ggreer/the_silver_searcher, but not the best choice. |
| 35 | +--- Suggest to install customized https://github.com/satanson/the_silver_searcher that extract function body precisely. |
| 36 | +-- calltree.pl/java_calltree.pl/cpptree.pl/javatree.pl/deptree.pl are standalone scripts with no others dependencies. |
| 37 | +- |
| 38 | +- format: calltree.pl '<src_regex>' '[[-]<dst_regex>]' <mode(0|1|2|3|4)> <verbose> <[-]depth> [[-]file_name_regex] |
| 39 | +- REGEX in calltree.pl are perl regex, and must be enclosed by quotes. |
| 40 | +- |
| 41 | +- arguments: |
| 42 | +-- <src_regex>: (required) Search since functions match `src_regex`, these functions will be root of subtrees. |
| 43 | +--- demos |
| 44 | +---- calltree.pl '(\\bfsync|fdatasync|sync_file_range\\b)' 'Write' 1 1 3 # rocksdb |
| 45 | +---- calltree.pl '((?i)\\b\\w*compaction\\w*\\b)' '' 1 1 3 # rocksdb |
| 46 | +-- [[-]<dst_regex>]: (required) Search till functions match `dst_regex`, these functions will be leaf of subtrees. |
| 47 | +--- demos |
| 48 | +---- calltree.pl '(\\bfsync|fdatasync|sync_file_range\\b)' '' 1 1 3 # empty '' means match any functions |
| 49 | +---- calltree.pl '(\\bfsync|fdatasync|sync_file_range\\b)' '-Write' 1 1 3 # '-<regex>' means interested in functions not match the regex |
| 50 | +---- calltree.pl '(\\bfsync|fdatasync|sync_file_range\\b)' '(?i)compaction' 1 1 3 # '<regex>' means interested in functions match the regex |
| 51 | +-- |
| 52 | +-- <mode>: (required) |
| 53 | +--- 0: show calling tree(caller is parent node, callee is child node). |
| 54 | +---- demos |
| 55 | +----- calltree.pl 'parsePassPipeline' '(Pass|Analysis|Pipeline)\$' 0 1 2 # llvm |
| 56 | +----- calltree.pl 'main' 'Pipeline' 0 1 3 # llvm |
| 57 | +--- 1: show called tree(callee is parent node, caller is child node). |
| 58 | +---- demos |
| 59 | +----- |
| 60 | +----- |
| 61 | +--- 2: show outermost functions that call others and have no callers. |
| 62 | +--- 3: show intermost functions that are called by others and have no callees. |
| 63 | +--- 4: show called tree and used to find functions/files that enclosing the contents matches <src_regex>. |
| 64 | +-- |
| 65 | +-- <verbose>: (required) |
| 66 | +--- 0: not show file-lineno infos, take effect on all modes. |
| 67 | +--- 1: show file-lineno infos, take effect on all modes. |
| 68 | +--- qhcv or hcv: a four-digit or three-digit number, take effect only on mode 0. |
| 69 | +---- q: quiet, 0 for non-quiet(default) and 1 for quiet, not show common subtrees when quiet. |
| 70 | +---- h: height of common subtrees, >=3(default), subtrees height than `h` will be extracted as common subtrees. |
| 71 | +---- c: repetition count of common subtrees, >=2(default), subtrees ocurrs at least for `c` times will be considered as common subtrees. |
| 72 | +---- v: verbose, 0 for not showing file-lineno infos and 1 for showing file-lineno infos. |
| 73 | +---- motivation: mode 0(show calling tree) leverages qhcv and hcv to speed up searching and collapse duplicate calling patterns. |
| 74 | +---- demos: |
| 75 | +----- a |
| 76 | +----- b |
| 77 | +----- c |
| 78 | +-- |
| 79 | +-- [-]<depth>: (required) the depth of the tree output, a larger depth means cost more times to generate trees. |
| 80 | +--- depth > 0: take effect on all modes. |
| 81 | +--- depth < 0: only take effect on mode 1 (show called tree), |
| 82 | +---- It is quite similar to |depth|, but adjacent functions with the name will be collapsed to only one. |
| 83 | +---- It is very useful when your are reading codes that designed in Visitor or Iterator pattern. |
| 84 | +--- demos: |
| 85 | +---- a |
| 86 | +---- b |
| 87 | +---- c |
| 88 | +-- |
| 89 | +-- [[-]<file_name_regex>]: (optional) Sometimes, your are only interested in functions in files whose names match the regex or not match. |
| 90 | +--- demos |
| 91 | +---- a |
| 92 | +---- b |
| 93 | +- |
| 94 | +- How to reach me: |
| 95 | +-- E-Mail: ranpanf\@gmail.com |
| 96 | +DONE |
| 97 | +; |
| 98 | + |
| 99 | +sub should_prune_subtree($$) { |
| 100 | +} |
| 101 | + |
| 102 | +sub format_tree($$$$\&\&) { |
| 103 | + my ($root, $level, $verbose, $enable_prune, $get_entry, $get_child) = @_; |
| 104 | + $root->{level} = $level; |
| 105 | + unless (defined($root) && %$root) { |
| 106 | + return (); |
| 107 | + } |
| 108 | + |
| 109 | + my ($common_idx) = should_prune_subtree($root, $enable_prune); |
| 110 | + my $entry = $get_entry->($root, $verbose, $common_idx); |
| 111 | + my @result = ($entry); |
| 112 | + |
| 113 | + my @child = $get_child->($root); |
| 114 | + if (!scalar(@child)) { |
| 115 | + return @result; |
| 116 | + } |
| 117 | + |
| 118 | + my $last_child = pop @child; |
| 119 | + |
| 120 | + foreach my $chd (@child) { |
| 121 | + my ($first, @rest) = &format_tree($chd, $level + 1, $verbose, $enable_prune, $get_entry, $get_child); |
| 122 | + if ((!defined($first) || $first =~/^\s*$/) && scalar(@rest)==0) { |
| 123 | + push @result, "│"; |
| 124 | + next; |
| 125 | + } |
| 126 | + push @result, "├── $first"; |
| 127 | + push @result, map {"│ $_"} @rest; |
| 128 | + } |
| 129 | + |
| 130 | + my ($first, @rest) = &format_tree($last_child, $level + 1, $verbose, $enable_prune, $get_entry, $get_child); |
| 131 | + push @result, "└── $first"; |
| 132 | + push @result, map {" $_"} @rest; |
| 133 | + return @result; |
| 134 | +} |
| 135 | +sub format_mind($) { |
| 136 | + my $root = shift; |
| 137 | + my $get_entry = sub($$$) { |
| 138 | + my $root = shift; |
| 139 | + return $root->{name}; |
| 140 | + }; |
| 141 | + my $get_child = sub($) { |
| 142 | + my $root = shift; |
| 143 | + return map {+{level=>$_->[0], name=>$_->[1], child=>$_->[2]}} @{$root->{child}}; |
| 144 | + }; |
| 145 | + my $tree_root = { |
| 146 | + level=>$root->[0], |
| 147 | + name=>$root->[1], |
| 148 | + child=>$root->[2], |
| 149 | + }; |
| 150 | + |
| 151 | + &format_tree($tree_root, 0, 0, 0, $get_entry, $get_child); |
| 152 | +} |
| 153 | + |
| 154 | +my @lines = split /\n/, $lines; |
| 155 | +print join qq//, map{"$_\n"} format_mind(mind(@lines)); |
0 commit comments