diff options
author | Sverker Eriksson <sverker@erlang.org> | 2021-04-26 13:48:49 +0200 |
---|---|---|
committer | Sverker Eriksson <sverker@erlang.org> | 2021-04-27 13:26:55 +0200 |
commit | 910bd0453056dd584ad60e08f1028b479152869e (patch) | |
tree | 59b078872b4aa61cbd9fcefb1feb0af4808fbd1b /scripts | |
parent | cceb8e4f2b292c19b90f613be46f2fd0e24e2d06 (diff) | |
download | erlang-910bd0453056dd584ad60e08f1028b479152869e.tar.gz |
Add check_doc_since script
Diffstat (limited to 'scripts')
-rwxr-xr-x | scripts/check_doc_since | 852 |
1 files changed, 852 insertions, 0 deletions
diff --git a/scripts/check_doc_since b/scripts/check_doc_since new file mode 100755 index 0000000000..ed13bb8e93 --- /dev/null +++ b/scripts/check_doc_since @@ -0,0 +1,852 @@ +#!/usr/bin/perl -w + +# Compare the documentation of different OTP versions +# and detect missing or incorrect "since" attributes. +# +# The script checks out the supplied git tags one at time and reads +# all xml files searching for documented modules and their functions. +# +# The script is not perfect. For example some function docs use an old +# ambiguous way of declaring default arguments, like foo(Arg1 [,Arg2]). + +#use strict; +use File::Basename; + +my $progname = basename($0); +#my $tagfile = shift @ARGV; +my $skip_branches = 0; +my $verbose = 0; +my $single_module; +my $read_stdin = 1; +my @tag_list; + +while (@ARGV >= 1 and $ARGV[0] =~ /^-/) { + if ($ARGV[0] eq "-s") { + $skip_branches = 1; + } + elsif ($ARGV[0] eq "-v") { + $verbose = 1; + } + elsif ($ARGV[0] eq "-m" && @ARGV >= 2) { + $single_module = $ARGV[1]; + shift @ARGV; + } + elsif ($ARGV[0] eq "-t" && @ARGV >= 3) { + @tag_list = ($ARGV[1], $ARGV[2]); + shift @ARGV; + shift @ARGV; + $read_stdin = 0; + } + else { + die "Syntax: $progname [-h] [-s] [-v] [-m <module>] [-t <new-tag> <old-tag>]\n" . + "-s\tSkip unordered tags\n" . + "-h\tThis help\n" . + "-v\tVerbose\n" . + "-m <module>\tAnalyze only one module\n" . + "-t <new-tag> <old-tag>\tTags to compare\n\n" . + "Without -t reads git tags from STDIN, one per line, sorted from newest to oldest\n"; + } + shift @ARGV; +} + +0 == @ARGV or die "Too many arguments\n"; + +my %facc; # Function accumulator +my %mods; # Modules +my %mods_since; # Since attribute seen for modules + +my %skip_files = ( + 'lib/kernel/doc/src/packages.xml' => 1 + ); + +# foo([Bar]) +# 1: foo has arities 1 and 0 (one optional argument Bar). +# 0: foo has one argument (a list of Bar's). +my %ambiguous_0args = ( + 'io:columns' => 1, + 'io:nl' => 1, + 'io:getopts' => 1, + 'io:rows' => 1, + 'eldap:open' => 0, + "eldap:'and'" => 0, + "eldap:'or'" => 0, + 'net_kernel:start' => 0, + 'fprof:trace' => 0, + 'fprof:profile' => 0, + 'fprof:analyse' => 0, + 'lcnt:conflicts' => 0, + 'lcnt:locations' => 0, + 'tags:root' => 1, + 'ts:cross_cover_analyse' => 0, + 'gen_sctp:open' => 0, + 'c:memory' => 0, + 'supervisor:check_childspecs' => 0 + + ); + +# List of arities. +my %complex_arglist = ( + 'mnesia:sync_transaction' => [1,2,3], + 'mnesia:table' => [1,2], + 'mnesia:transaction' => [1,2,3], + 'mnesia:traverse_backup' => [4,6], + 'public_key:pem_entry_encode' => [2,3], + 'qlc:string_to_handle' => [1,2,3], + 'ttb:tp' => [2,3,4], + 'ttb:tpl' => [2,3,4], + 'ttb:ctp' => [1,2,3], + 'ttb:ctpl' => [1,2,3], + 'ttb:ctpg' => [1,2,3] + ); + +my %suppressions = ( + 'beam_lib:strip/2' => 'OTP 22.0', + 'beam_lib:strip_files/2' => 'OTP 22.0', + 'beam_lib:strip_release/2' => 'OTP 22.0', + 'crypto:crypto_final/1' => 'OTP 23.0', + 'crypto:crypto_get_data/1' => 'OTP 23.0', + 'ct_property_test:present_result/4' => 'OTP 22.3', + 'ct_property_test:present_result/5' => 'OTP 22.3', + 'dialyzer:format_warning/2' => 'R14B02', + 'ei_global:ei_global_names/C' => 'OTP 23.0', + 'ei_global:ei_global_register/C' => 'OTP 23.0', + 'ei_global:ei_global_unregister/C' => 'OTP 23.0', + 'ei_global:ei_global_whereis/C' => 'OTP 23.0', + 'eprof:profile/4' => "", + 'public_key:pkix_hash_type/1' => 'OTP 23.0', + 'public_key:pkix_subject_id/1' => 'OTP 23.1', + 'snmpa:which_transports/0' => 'OTP 23.3', + 'snmpm:restart/1' => 'OTP 22.3', + 'ssh:connection_info/1' => 'OTP 22.1', + 'ssh:daemon_info/2' => 'OTP 22.1', + 'ssh:get_sock_opts/2' => 'OTP 22.3', + 'ssh:set_sock_opts/2' => 'OTP 22.3', + 'ssh:tcpip_tunnel_from_server/5' => 'OTP 23.0', + 'ssh:tcpip_tunnel_from_server/6' => 'OTP 23.0', + 'ssh:tcpip_tunnel_to_server/5' => 'OTP 23.0', + 'ssh:tcpip_tunnel_to_server/6' => 'OTP 23.0', + 'ssh_agent:add_host_key/3' => 'OTP 23.0', + 'ssh_agent:add_host_key/4' => 'OTP 23.0', + 'ssh_agent:is_host_key/4' => 'OTP 23.0', + 'ssh_agent:is_host_key/5' => 'OTP 23.0', + 'ssh_agent:user_key/2' => 'OTP 23.0', + ); + + +my %seen_shas; +my %warnings; +local $tag; +my $prev_tag; + + +# +# First checkout top tag and find all documented modules and functions +# that might have been first introduced in one of the following tags. +# +local $/ = "\n"; +if (next_tag(\$tag)) { + + if ($skip_branches) { + $tag =~ /^(OTP-\d+\.\d+(\.\d+)?)|(OTP_R\d+B(0\d)?(-\d)?)$/ + or die "First tag must be usable\n"; + } + + if ($verbose) { + print STDERR "Check out $tag\n"; + } + my $output = qx(git checkout -f $tag 2>&1); + $? == 0 or fatal("'git checkout -f $tag failed:\n $output"); + + my $xml_files; + if ($single_module) { + $xml_files = qx(git ls-files '*/$single_module.xml' 2>&1); + $? == 0 or fatal("'git ls-files '*.xml' failed:\n $xml_files"); + } + else { + $xml_files = qx(git ls-files '*.xml' 2>&1); + $? == 0 or fatal("'git ls-files '*.xml' failed:\n $xml_files"); + } + + while ($xml_files =~ m/\n*([^\n]+)/g) { + local $filename = $1; + + #if (seen_it()) { + # next; + #} + + my $module; + my $module_since; + my %funcs = read_xml_functions($tag, \$module, \$module_since); + + if (keys %funcs) { + if (!$module) { + die "No <module> tag in $filename\n"; + } + if (exists($mods{$module})) { + die "Duplicate module $mods{$module} and $filename\n"; + } + $mods{$module} = $filename; + $mods_since{$module} = $module_since; + + foreach my $f (keys %funcs) { + !exists($facc{$f}) + or die "Duplicate function $f???\n"; + $facc{$f} = $funcs{$f}; + } + } + elsif ($single_module) { + die "File $filename has no functions\n"; + } + } +} +else { + die "No tags read on STDIN\n"; +} + +# +# Now go through the older tags in reverse time order +# and detect when documented modules or functions "disappear", +# in which case they must have been introduced in the previous +# inspected tag. +# +$prev_tag = $tag; +while (next_tag(\$tag)) { + + if ($skip_branches) { + if ($tag !~ /^((OTP-\d+\.\d+(\.\d+)?)|(OTP_R\d+B(0\d)?(-\d)?))$/) { + print STDERR "Skip tag $tag\n"; + next; + } + #print STDERR "Keep tag $tag 1='$1' 2='$2' 3='$3' 4='$4' 5='$5'\n"; + } + + if ($verbose) { + print STDERR "Check out $tag\n"; + } + my $output = qx(git checkout -f $tag 2>&1); + $? == 0 or fatal("'git checkout -f $tag failed:\n $output"); + + my $xml_files; + if ($single_module) { + $xml_files = qx(git ls-files '*/$single_module.xml' 2>&1); + $? == 0 or fatal("'git ls-files '*.xml' failed:\n $xml_files"); + } + else { + $xml_files = qx(git ls-files '*.xml' 2>&1); + $? == 0 or fatal("'git ls-files '*.xml' failed:\n $xml_files"); + } + + my %prev_facc = %facc; + %facc = (); + my %prev_mods = %mods; + %mods = (); + + while ($xml_files =~ m/\n*([^\n]+)/g) { + local $filename = $1; + + #if (seen_it()) { + # next; + #} + + my $module; + my $module_since; + my %funcs = read_xml_functions($tag, \$module, \$module_since); + + if (keys %funcs) { + if (!$module) { + die "No <module> tag in $filename\n"; + } + if (exists($mods{$module})) { + die "Duplicate module in $mods{$module} and $filename\n"; + } + + if (exists($prev_mods{$module})) { + foreach my $f (keys %funcs) { + if (exists($prev_facc{$f})) { + $facc{$f} = $funcs{$f}; + #print "prev_facc{$f} = $prev_facc{$f}\n"; + #print "prev_facc{$f} = @{$prev_facc{$f}}\n"; + if (delete_versions(\@{$facc{$f}}, \@{$prev_facc{$f}})) { + delete $prev_facc{$f}; + } + } + else { + #print "Ignoring removed function $f\n"; + } + } + $mods{$module} = $filename; + delete $prev_mods{$module}; + } + else { + #print "Ignoring removed module $module\n"; + } + } + elsif ($single_module) { + die "File $filename has no functions\n"; + } + } + + my $erl_file; + foreach my $mod (keys %prev_mods) { + if ($single_module and $single_module ne $mod) { + next; + } + $erl_file = qx(git ls-files '*/src*/$mod.erl' 2>&1); + $? == 0 or fatal("'git ls-files '$mod.erl' failed:\n $erl_file"); + if ($erl_file) { + local $filename = trim($erl_file); + my %funcs = read_edoc_functions($tag, $mod); + if (keys %funcs) { + foreach my $f (keys %funcs) { + if (exists($prev_facc{$f})) { + $facc{$f} = $funcs{$f}[0]; + delete $prev_facc{$f}; + } + } + $mods{$mod} = $filename; + delete $prev_mods{$mod}; + } + else { + #warning("No \@spec functions in $filename\n"); + } + } + } + if ($single_module and !$xml_files and !$erl_file) { + warning("No $single_module.xml or .erl found\n"); + } + + my $headline = "\nTAG: $prev_tag\n"; + + foreach my $mod (sort keys %prev_mods) { + print "${headline}MODULE: $mod since=$mods_since{$mod}\n"; + $headline = ""; + } + foreach my $f (sort keys %prev_facc) { + filter_newer_versions($tag, \@{$prev_facc{$f}}); + if (@{$prev_facc{$f}} != 0) { + if (@{$prev_facc{$f}} != 1 || + !exists($suppressions{$f}) || + $suppressions{$f} ne $prev_facc{$f}->[0]) + { + print "${headline}FUNC: $f since = @{$prev_facc{$f}}\n"; + $headline = ""; + } + } + } + $prev_tag = $tag; +} + +#close TAGFILE; + +if ($verbose) { + # + # Print all stoneage modules and functions, that "always" existed. + # + my $headline = "\nTAG:\n"; + foreach my $mod (sort keys %mods) { + print "${headline}MODULE: $mod\n"; + $headline = ""; + } + foreach my $f (sort keys %facc) { + print "${headline}FUNC: $f\n"; + $headline = ""; + } +} + +# Delete all versions from second array that exists in first array. +# Return true if no versions left in second array. +sub delete_versions { + my ($olds_ref, $news_ref) = @_; + + #print "olds_ref = $olds_ref\n"; + #print "news_ref = $news_ref\n"; + #print "olds = @{$olds_ref}\n"; + #print "news = @{$news_ref}\n"; + + foreach my $old (@{$olds_ref}) { + #print "old = $old\n"; + for (my $i = 0; $i < @{$news_ref}; $i++) { + if (($old eq $news_ref->[$i]) + or (fixver($old) eq $news_ref->[$i])) { + #print "$i: remove $news_ref->[$i]\n"; + splice @{$news_ref}, $i, 1; + last; + } + #print "$i: keep $news_ref->[$i]\n"; + } + } + + # Do a sloppy attempt to detect missing since tags that has + # been corrected in new version. + # For all with "missing" since tag in old, remove one version from new. + foreach my $old (@{$olds_ref}) { + if (@$news_ref == 0) { + last; + } + if ($old eq "missing") { + #print "Remove fixed missing version $news_ref->[0]\n"; + shift @{$news_ref}; + } + } + + my $ret = (@$news_ref == 0); + #print "ret = $ret\n"; + return $ret; +} + + +# Try correct misspelled OTP version +sub fixver { + my ($otp_ver) = @_; + + if ($otp_ver =~ /^OTP \d\d\.\d/) { + # Looks ok + return $otp_ver; + } + + # Try correct any combination of: + # missing OTP + # - instead of space + # missing .0 + if ($otp_ver =~ /^(OTP)?[ -](\d\d)(\.(.+))?/) { + my $major = $2; + my $minor = $3 ? $4 : "0"; + my $fixed = "OTP $major.$minor"; + #print "fixver $otp_ver -> $fixed\n"; + return $fixed; + } + return $otp_ver; +} + +# Remove all versions newer than $ver from @$ver_list_ref +sub filter_newer_versions { + my ($ver, $ver_list_ref) = @_; + + $ver = fixver($ver); + + for (my $i = 0; $i < @{$ver_list_ref}; ) { + if ($ver le fixver($ver_list_ref->[$i])) { + #print "$i: filter $ver_list_ref->[$i]\n"; + splice @{$ver_list_ref}, $i, 1; + } + else { + #print "$i: keep $ver_list_ref->[$i]\n"; + $i++; + } + } +} + +sub read_xml_functions { + my($tag, $module_ref, $module_since_ref) = @_; + + if ($verbose) { + print "XML-file: $filename\n"; + } + + open(FILE, $filename) or die "Cant open xml file \"$filename\"\n"; + local $/ = undef; + my $lines = <FILE>; + close(FILE); + + my %functions; + + if (exists($skip_files{$filename})) { + return %functions; # empty + } + + # Is this a <module> or <lib> reference doc file? + if ($lines =~ /<module(\s*since=\"([^"]*)\")?>([\w]+)<\/module>/) { + if ($1) { + $$module_since_ref = $2; + } + else { + $$module_since_ref = "missing"; + } + $$module_ref = $3; + } + elsif ($lines =~ /<lib>([\w]+)<\/lib>/) { + $$module_ref = $1; + $$module_since_ref = "lib"; + } + else { + #print "XML-file <module> or <lib> not found\n"; + return %functions; # empty + } + + while ($lines =~ /<func>\s*/g) { + my $func_cnt = 0; + + # Find all <name> within <func> (usually only one but may be more, ex io:format,fwrite) + while (1) { + my @farity; + my $fname; + + $lines =~ /(<name|<\/func>)/g + or die "<func> without </func> in $filename\n"; + + if ($1 eq '</func>') { + last; + } + + $func_cnt++; + + # C-lib + # <name since=""><ret>..</ret><nametext>c_function(..)</nametext></name> + if ($lines =~ /\G(\s*since=\"([^"]*)\")?>\s*<ret>.*?<\/ret>\s*<nametext>\*?(\w+)[^<]*?<\/nametext>\s*<\/name>/sgc) { + $fname = $3; + my $since; + if ($1) { + $since = $2; + } + else { + $since = "missing"; + } + push @farity, { arity => 'C', since => $since }; + } + # Old style: <name>... </name> + # or (rare) <name name="foo">... </name> + elsif ($lines =~ /\G(\s*name=\"(\w+)\")?(\s*since=\"([^"]*)\")?>/gc) { + if ($1) { + $fname = $2; + } + my $since; + if ($3) { + $since = $4; + } + else { + $since = "missing"; + } + + # <name>foo(Arg1,Arg2) + # <name>erlang:foo(Arg1,Arg2) + # <name>'Foo'(Arg1,Arg2) + # <name>Module:callback(Arg1,Arg2) + # The cryptic arglist part of the regex below search for end ')' + # while ignoring '()' that might exists for argument types like 'integer()'. + if ($lines =~ /\G\s*((\w+):)?('?\w+'?)\s*\((([^()]*(\(\))?)*)\)/gc) { + my $module = $2; + if ($fname) { + $fname eq $3 + or die "Conflicting function names '$fname' vs '$3' in $filename\n"; + } + else { + $fname = $3; + } + my $arglist = $4; + if ($module) { + if ($module =~ /^[A-Z]/) { + $module = $$module_ref; + $fname = "Callback#$fname"; + } + elsif ($module ne $$module_ref) { + die "Strange module prefix '$module' of function '$fname' in $filename\n"; + } + } + @farity = count_args($arglist, $fname, $$module_ref, $since); + } + elsif ($lines =~ /\G(.*)/gc) { + warning("Strange function prototype '$1' in file $filename\n"); + next; + } + else { + die "WTF in $filename\n"; + } + } + # New style?: + # <name name="foo" arity="2"/> + # <name name="foo" arity="2"></name> + elsif ($lines =~ /(([^\/]*\/)*?[^\/]*)(\/>|>\s*<\/name>)/gc) { + my $name_body = $1; + $name_body =~ m/name=\"\'?(\w+)\'?\"/ + or die "$filename: No function name in \'$name_body\'\n"; + $fname = $1; + + $name_body =~ m/arity=\"(\d+)\"/ + or die "$filename: No function arity in \'$name_body\'\n"; + my $arity = $1; + + my $since; + if ($name_body =~ m/since=\"([^"]*)\"/) { + $since = $1; + #print "$$module_ref:$fname/$arity since = $since\n"; + } + else { + $since = "missing"; + } + + push @farity, { arity => $arity, since => $since }; + } + elsif ($lines =~ /(\G.*)/g) { + warning("Strange name tag '<name$1' in file $filename\n"); + next; + } + else { + die "Very strange <name> tag in $filename\n"; + } + + + #print "$$module_ref:$fname in $filename\n"; + foreach my $fa_since (@farity) { + #while (($key, $value) = each (%$fa_since)) { + # print "$key => $value\n"; + #} + my $fa = $$fa_since{arity}; + my $since = $$fa_since{since}; + #print "$$module_ref:$fname/$fa since=$since\n"; + push @{ $functions{"$$module_ref:$fname/$fa"} }, $since; + } + } + if ($func_cnt < 1) { + die "<func> without <name> in $filename\n"; + } + + } + + return %functions; +} + +sub read_edoc_functions { + my($tag, $module) = @_; + + open(FILE, $filename) or die "Cant open erl file \"$filename\"\n"; + local $/ = undef; + my $lines = <FILE>; + close(FILE); + + my %functions; + + if (exists($skip_files{$filename})) { + return %functions; # empty + } + if ($lines !~ /^\s*-module\(([\w]+)\)\./m) { + die "No -module() found in erl file \"$filename\"\n"; + } + if ($1 ne $module) { + die "Mismatching module name '$1' != '$module' in erl file \"$filename\"\n"; + } + + # % @spec foo(Arg1,Arg2) + # -spec foo(Arg1,Arg2) + while ($lines =~ /\n\s*(%.*\@spec|-spec\s*)/g) { + if ($lines !~ /(\w*)\s*\(/g) { + warning("Strange \@spec function name in $filename"); + } + my $fname = $1; + + if ($fname eq '') { + my $save_pos = pos($lines); + if ($lines !~ /\n\s*(\w+)\s*\(/g) { + warning("No function found after anonymous \@spec in $filename"); + } + $fname = $1; + pos($lines) = $save_pos; + } + + if ($lines !~ /\G(([^()]*(\(\))?)*)\)/gc) { + if ($lines =~ /(\G.*)/g) { + warning("Strange \@spec argument list '$1' for '$fname' in file $filename\n"); + next; + } + else { + die "WTF \@spec for '$fname' in $filename\n"; + } + } + my $arglist = $1; + my @arities = count_args($arglist, $fname, $module, "edoc"); + + foreach my $fa_since (@arities) { + my $fa = $$fa_since{arity}; + push @{ $functions{"$module:$fname/$fa"} }, $tag; + + #print "Found edoc function '$module:$fname/$fa'\n"; + } + } + + return %functions; +} + +sub count_args { + my($arglist,$fname,$module,$since) = @_; + my @arities; + + #print "count_args $module:$fname($arglist)\n"; + + $arglist = trim($arglist); + if ($arglist eq '') { + #print "Empty arg list for $fname\n"; + push @arities, { arity => 0, since => $since}; + return @arities; + } + + if ($arglist =~ /^\s*\[\s*\w+\s*\]\s*$/gc) { + # + # Oh dear! Is "[Foo]" a list of Foo's or an optional Foo???? + # + if (exists($ambiguous_0args{"$module:$fname"})) { + if ($ambiguous_0args{"$module:$fname"}) { + push @arities, { arity => 0, since => $since}; + } + } + else { + warning("Ambigiuous arglist $module:$fname($arglist) in $filename\n"); + } + + push @arities, { arity => 1, since => $since}; + return @arities; + } + + # Starts with [Arg,] ? + my $first_optional = 0; + if ($arglist =~ /^\[\s*\w+\s*,\s*\]/gc) { + $first_optional = 1; + } + + # Ends with [,Arg] ? + my $last_optional = 0; + if ($arglist =~ /(.+)\[\s*,\s*\w+\s*\]$/gc) { + $last_optional = 1; + $arglist = $1; + } + + # Give up if any other "[," or ",]" left? + if ($arglist =~ /(\[\s*,)|(,\s*\])/gc) { + if (!exists($complex_arglist{"$module:$fname"})) { + warning("Complex optional arguments for $module:$fname($arglist)\n"); + } + foreach my $fa (@{$complex_arglist{"$module:$fname"}}) { + #print "complex_arglist: $module:$fname/$fa\n"; + push @arities, { arity => $fa, since => $since }; + } + return @arities; + } + + my $nargs = 0; + my $expect_comma = 'no'; + + while ($arglist =~ /([\w,[{])/g) { + if ($1 eq ',') { + $expect_comma ne 'no' + or die "$filename: Unexpected comma in arglist '$arglist' for '$fname'\n"; + $expect_comma = 'no'; + } + elsif ($1 eq '[' or $1 eq '{') { + $expect_comma ne 'yes' + or die "$filename: Missing comma in arglist '$arglist' for '$fname'\n"; + + my $paren = $1; + skip_term(\$arglist, $paren, 1); + $nargs++; + $expect_comma = 'yes'; + } + else { + $expect_comma ne 'yes' + or die "$filename: Expected comma but found arg in '$arglist' for '$fname'\n"; + if ($expect_comma eq 'no') { + $nargs++; + } + $expect_comma = 'maybe'; + } + } + push @arities, { arity => $nargs, since => $since}; + if ($first_optional) { + $nargs = $nargs + 1; + push @arities, { arity => $nargs, since => $since}; + } + if ($last_optional) { + $nargs = $nargs + 1; + push @arities, { arity => $nargs, since => $since}; + } + + #foreach my $h (@arities) { + # print "count_args: $module:$fname/$$h{arity}\n"; + #} + + return @arities; +} + +sub skip_term { + my($arglist_ref,$paren,$recurs) = @_; + + #my $pp = pos($$arglist_ref); + #print "skip_term($$arglist_ref,$paren) pos=$pp\n"; + + $recurs < 10 or fatal("$filename: Evil recursion\n"); + + while (1) { + my $recurs_paren; + if ($paren eq '[') { + if ($$arglist_ref !~ /([][{])/g) { + my $pp = pos($$arglist_ref); + die "$filename: No matching ']' in '$$arglist_ref' at pos=$pp\n"; + } + if ($1 eq ']') { + last; + } + $recurs_paren = $1; + } + elsif ($paren eq '{') { + $$arglist_ref =~ /([}[{])/g + or die "$filename: No matching '}' in '$$arglist_ref'\n"; + if ($1 eq '}') { + last; + } + $recurs_paren = $1; + } + else { + die "$filename: WTF? in arglist '$$arglist_ref'\n"; + } + skip_term($arglist_ref, $recurs_paren, $recurs+1); + } + #$pp = pos($$arglist_ref); + #print "skip_term($$arglist_ref,$paren) returns pos=$pp\n"; +} + +sub seen_it { + my $sha = qx(git rev-parse :$filename 2>&1); + $? == 0 or fatal("'git rev-parse :$filename failed:\n $sha"); + if (exists($seen_shas{$sha})) { + return 1; + } + $seen_shas{$sha} = 1; + return 0; +} + + +# Trim leading and traling whitespace +sub trim { + my $s = shift; + $s =~ s/^\s+|\s+$//g; + return $s; +} + +sub warning { + my $str = shift; + if (exists($warnings{$str})) { + return; + } + $warnings{$str} = 1; + + print STDERR "WARNING: $tag $str"; +} + +sub fatal { + select()->flush(); + die "$progname: @_\n"; +} + +sub next_tag { + my $tag_ref = shift; + + if ($read_stdin) { + my $line = <STDIN>; + if ($line) { + $$tag_ref = trim($line); + return 1; + } + } + elsif (@tag_list > 0) { + $$tag_ref = shift @tag_list; + return 1; + } + return 0; +} |