#!/usr/local/bin/perl # # pull_quotes -- tom christiansen, tchrist@convex.com # ################################################################################ sub show_quotes { local($string, $qchars) = @_; local($i) = $[; local($_); local(@list) = &pull_quotes($string,$qchars); $qchars =~ s/(.)(.)/`$1'...`$2'/; print "Extracted ", 0+@list, " ", $qchars, " quote", (@list != 1)?'s':'', "\n"; #print "Extracted ", 0+@list, " ", $qchars, " quote", #(@list != 1)?'s':'', " from:<<", $_[0]. ">>\n"; for (@list) { print "Quote #$i is <<", $_, ">>\n"; $i++; } print "\n"; } ################################################################################ sub pull_quotes { # pull_quotes($string, $quotchars) => @quotestrings local($_, $qchars) = @_; local($xlate); if ($qchars =~ tr/\173\175/\373\375/) { $xlate++; tr/\173\175/\373\375/; } local($qL, $qR); # left and right quote chars, like `' or () local($quote_level); # current quote level local($max_quote); # deepest we've gotten local($qstring); # tmp space for quote local(@quotes); # list of quotes to return local($d) = '\$'; # not sure why this must be here local($b) = '\\'; # nor this local(@done); # which quotes we've finished so far die "need two just quote chars" if length($qchars) != 2; $qL = substr($qchars, 0, 1); $qR = substr($qchars, 1, 1); s/\\(.)/"\201".ord($1)."\202"/eg; # protect from backslashes $max_quote = $quote_level = $[-1; while ( /[$qchars]/ ) { if ($& eq $qL) { do { ++$quote_level; } while $done[$quote_level]; s/$b$qL/\${QL${quote_level}}/; $max_quote = $quote_level if $max_quote < $quote_level; } elsif ($& eq $qR) { s/$b$qR/\${QR${quote_level}}/; $done[$quote_level]++; do { --$quote_level; } while $done[$quote_level]; } else { die "unexpected quot char: $&"; } } for ($quote_level = $[; $quote_level <= $max_quote; $quote_level++) { ($qstring) = /${d}\{QL$quote_level\}([^\000]*)${d}\{QR$quote_level}/; $qstring =~ s/\${QL\d+\}/$qL/g; $qstring =~ s/\${QR\d+\}/$qR/g; $qstring =~ s/\201(\d+)\202/pack('C',$1)/eg; $quotes[$quote_level] = $qstring; } grep (tr/\373\375/\173\175/, @quotes) if $xlate; @quotes; } ################################################################################ ################################################################################ ################################################################################ ################################################################################ ################################################################################ # MAIN STARTS HERE &show_quotes(<<__END__, '()'); param(zzz = (var0)); param(yyy = ((var1=xx), var2(xx), (var3 = xx), var4=xx, var5=xx, etc. etc.)) ; param(yyy = ((var1=xx), var2(xx), (var3 = xx), var4=xx, var5=xx, etc. etc.)) __END__