home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / perl / scripts-convex / pull_quotes < prev    next >
Encoding:
Text File  |  1992-10-31  |  2.9 KB  |  101 lines
  1. #!/usr/local/bin/perl
  2. # 
  3. # pull_quotes -- tom christiansen, tchrist@convex.com
  4. #
  5. ################################################################################
  6. sub show_quotes {
  7.     local($string, $qchars) = @_;
  8.     local($i) = $[;
  9.     local($_);
  10.  
  11.     local(@list) = &pull_quotes($string,$qchars);
  12.  
  13.     $qchars =~ s/(.)(.)/`$1'...`$2'/;
  14.  
  15.     print "Extracted ", 0+@list, " ", $qchars, " quote", 
  16.     (@list != 1)?'s':'', "\n";
  17.     #print "Extracted ", 0+@list, " ", $qchars, " quote", 
  18.     #(@list != 1)?'s':'', " from:<<", $_[0]. ">>\n";
  19.  
  20.     for (@list) {
  21.     print "Quote #$i is <<", $_, ">>\n";
  22.     $i++;
  23.     } 
  24.     print "\n";
  25. } 
  26.  
  27.  
  28. ################################################################################
  29. sub pull_quotes { # pull_quotes($string, $quotchars) => @quotestrings
  30.     local($_, $qchars) = @_;
  31.  
  32.     local($xlate);
  33.  
  34.     if ($qchars =~ tr/\173\175/\373\375/) {
  35.     $xlate++;
  36.     tr/\173\175/\373\375/;
  37.     } 
  38.  
  39.     local($qL, $qR);         # left and right quote chars, like `' or ()
  40.     local($quote_level);    # current quote level
  41.     local($max_quote);        # deepest we've gotten
  42.     local($qstring);        # tmp space for quote
  43.     local(@quotes);        # list of quotes to return
  44.     local($d) = '\$';        # not sure why this must be here
  45.     local($b) = '\\';        # nor this
  46.     local(@done);        # which quotes we've finished so far
  47.  
  48.     die "need two just quote chars" if length($qchars) != 2;
  49.  
  50.     $qL = substr($qchars, 0, 1);
  51.     $qR = substr($qchars, 1, 1);
  52.  
  53.     s/\\(.)/"\201".ord($1)."\202"/eg;   # protect from backslashes
  54.  
  55.     $max_quote = $quote_level = $[-1;
  56.  
  57.     while ( /[$qchars]/ ) {
  58.     if ($& eq $qL) {
  59.         do { ++$quote_level; } while $done[$quote_level];
  60.         s/$b$qL/\${QL${quote_level}}/;
  61.         $max_quote = $quote_level if $max_quote < $quote_level;
  62.     } elsif ($& eq $qR) {
  63.         s/$b$qR/\${QR${quote_level}}/;
  64.         $done[$quote_level]++;
  65.         do { --$quote_level; } while $done[$quote_level];
  66.     } else { 
  67.         die "unexpected quot char: $&";
  68.     }
  69.     } 
  70.     for ($quote_level = $[; $quote_level <= $max_quote; $quote_level++) {
  71.     ($qstring) = /${d}\{QL$quote_level\}([^\000]*)${d}\{QR$quote_level}/;
  72.     $qstring =~ s/\${QL\d+\}/$qL/g;
  73.     $qstring =~ s/\${QR\d+\}/$qR/g;
  74.     $qstring =~ s/\201(\d+)\202/pack('C',$1)/eg;
  75.     $quotes[$quote_level] = $qstring;
  76.     } 
  77.     grep (tr/\373\375/\173\175/, @quotes) if $xlate;
  78.     @quotes;
  79. } 
  80.  
  81. ################################################################################
  82. ################################################################################
  83. ################################################################################
  84. ################################################################################
  85. ################################################################################
  86.  
  87. # MAIN STARTS HERE
  88.  
  89.  
  90. &show_quotes(<<__END__, '()');
  91.  
  92.  param(zzz = (var0));
  93.  
  94.  param(yyy = ((var1=xx), var2(xx), (var3 = xx),
  95.              var4=xx, var5=xx, etc. etc.)) ;
  96.  
  97.  param(yyy = ((var1=xx), var2(xx), (var3 = xx),
  98.              var4=xx, var5=xx, etc. etc.))
  99.  
  100. __END__
  101.