[interchange-cvs] interchange - jon modified 2 files
interchange-cvs at icdevgroup.org
interchange-cvs at icdevgroup.org
Mon Apr 28 19:31:35 UTC 2008
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;
+}
More information about the interchange-cvs
mailing list