[interchange-cvs] interchange - jon modified 2 files

[interchange-cvs at icdevgroup.org]

User:      jon
Date:      2008-04-28 19:31:34 GMT
Modified:  .        WHATSNEW-5.5
Modified:  eg       check_perl_itl
Log:
Ok, now check_perl_itl supports both calc and perl.

Revision  Changes    Path
1.114                interchange/WHATSNEW-5.5


rev 1.114, prev_rev 1.113
Index: WHATSNEW-5.5
===================================================================
RCS file: /var/cvs/interchange/WHATSNEW-5.5,v
retrieving revision 1.113
retrieving revision 1.114
diff -u -u -r1.113 -r1.114
--- WHATSNEW-5.5	28 Apr 2008 19:00:25 -0000	1.113
+++ WHATSNEW-5.5	28 Apr 2008 19:31:34 -0000	1.114
@@ -396,8 +396,8 @@
 * Added eg/merge-tab-files, helpful for merging tab-delimited files on
   matching keys.
 
-* Added eg/check_perl_itl, a helper for syntax-checking [calc] blocks in
-  ITL pages from within an editor.
+* Added eg/check_perl_itl, a helper for syntax-checking [perl] and [calc]
+  blocks in ITL pages from within an editor.
 
 
 ------------------------------------------------------------------------------



1.2                  interchange/eg/check_perl_itl


rev 1.2, prev_rev 1.1
Index: check_perl_itl
===================================================================
RCS file: /var/cvs/interchange/eg/check_perl_itl,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -u -r1.1 -r1.2
--- check_perl_itl	28 Apr 2008 17:38:19 -0000	1.1
+++ check_perl_itl	28 Apr 2008 19:31:34 -0000	1.2
@@ -1,13 +1,13 @@
 #!/usr/bin/perl -- -*-cperl-*-
 
-## Check all the perl blocks embedded in ITL tags in one or more files
+## Check all the perl and calc blocks embedded in ITL tags in one or more files
 ## Greg Sabino Mullane <greg at endpoint.com>
 
 use strict;
 use warnings;
 use Getopt::Long;
 
-our $VERSION = '1.0.1';
+our $VERSION = '1.1.1';
 
 @ARGV or show_help();
 
@@ -31,7 +31,7 @@
 
     print qq{
 Usage: $0 [Options] filename(s)
-Description: Checks that perl blocks in ITL code is valid
+Description: Checks that perl and calc blocks in ITL code are valid
 Options:
   --help          Show this help message
   --verbose       Verbose output
@@ -72,7 +72,7 @@
     $opt->{verbose} >= 2 and print qq{** Wrote "$tempfile"\n};
     my $top = qq{#!perl
 
-## Temporary file created by extracting perl blocks from the file "$file"
+## Temporary file created by extracting perl and calc blocks from the file "$file"
 
 use strict;
 use warnings;
@@ -102,20 +102,26 @@
     my $inperl = 0;
     my $subnum = 0;
     my %mapline;
+    my $tagstart = qr{\s*(?:perl|calcn?)\s*};
+    my $tagend   = qr{\[\s*/\s*(?:perl|calcn?)\s*\]};
+    my $subtext  = '';
+
     while (<$rh>) {
 
         if (!$inperl) {
-            next unless m{\[perl\s*([^\]]*)\](.*?)(\[/perl\])?$};
-            my ($attr,$extra, $closetag) = ($1,$2,$3);
+            next unless m{\[$tagstart\s*([^\]]*)\](.*?)($tagend)?$};
+            my ($attr,$extra,$closetag) = ($1,$2,$3);
             $inperl = 1;
             $subnum++;
             print $wh "sub perl_itl_$subnum {\n";
             $templines++;
             if (length $extra and $extra =~ /\S/) {
-                print $wh "$extra\n";
+                $subtext .= "$extra\n";
                 $mapline{++$templines} = $.;
             }
             if ($closetag) {
+                print $wh itl_escape($subtext);
+                $subtext = '';
                 print $wh "\n} ## end of perl_itl_$subnum\n\n";
                 $templines += 3;
                 $inperl = 0;
@@ -123,15 +129,17 @@
             next;
         }
 
-        if (m{(.*)\Q[/perl]}o) {
+        if (m{(.*)$tagend}o) {
             my $pre = $1;
-            print $wh "$pre\n} ## end of perl_itl_$subnum\n\n";
+            $subtext .= $1;
+            printf $wh "%s\n} ## end of perl_itl_$subnum\n\n", itl_escape($subtext);
+            $subtext = '';
             $templines += 3;
             $inperl = 0;
             next;
         }
 
-        print $wh "$_";
+        $subtext .= $_;
         $mapline{++$templines} = $.;
     }
 	close $wh or die qq{Could not close "$tempfile": $!\n};
@@ -156,7 +164,6 @@
     for my $line (split /\n/ => $errors) {
         next if $line =~ /had compilation errors/o;
         chomp $line;
-
         $line =~ s/at $tempfile line (\d+)\.?/exists $mapline{$1} ? "(line $mapline{$1})" : "(original line $1)"/e;
         print "--> $line\n";
     }
@@ -164,3 +171,21 @@
     return;
 }
 
+
+sub itl_escape {
+    my $text = shift;
+
+    ## Filter out pragmas
+    $text =~ s{\[pragma(.*?)\]}{ }gso;
+
+    ## Filter out macros
+    my $AZ = qr{[A-Za-z0-9]};
+    $text =~ s/\@\@$AZ\w+$AZ\@\@/11111/go;
+    $text =~ s/\@_$AZ\w+${AZ}_\@/22222/go;
+    $text =~ s/__$AZ\w*?${AZ}__/33333/go;
+
+    ## Filter out comment tags
+    $text =~ s{\[comment\].*?\[/comment\]}{ }gs;
+
+    return $text;
+}