/[escript]/branches/arrexp_trunk2098/scripts/SkelEdit.pl
ViewVC logotype

Annotation of /branches/arrexp_trunk2098/scripts/SkelEdit.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 155 - (hide annotations)
Wed Nov 9 02:02:19 2005 UTC (13 years, 6 months ago) by jgs
Original Path: trunk/scripts/SkelEdit.pl
File MIME type: text/plain
File size: 6629 byte(s)
move all directories from trunk/esys2 into trunk and remove esys2

1 jgs 82 #!/bin/sh
2     # The following line is for platform independence.
3     PERL=`type perl | cut -f3 -d\ `
4     #
5     # see whether perl was found
6     RESP=`echo $PERL | grep perl`
7     if [ $? -eq 1 ] ; then
8     #
9     # perl wasn't found
10     echo "Couldn't find perl in your path. Please add perl to your path"
11     echo "and try again."
12     exit 1;
13     fi
14     $PERL -x $0 "$@" ; exit $?
15     #!perl
16     #------------------------------------------------------------------------------
17     #
18     # Author Ed.Rice & J.Gerschwitz
19     # COPYRIGHT Ed Rice & J.Gerschwitz 2004- All Rights Reserved.
20     # This software is the property of Ed.Rice & J.Gerschwitz.
21     # No part of this code may be copied in any form or by any means without the
22     # expressed written consent of Ed.Rice & J.Gerschwitz.
23     #
24     # Perl script to perform skeleton driven file creation
25     # Based on a skeleton configuration file this script will
26     # edit a skeleton file replacing "placekeeper" text with user specified
27     # text generating updated files
28     #
29     # This script expects the name of the skeleton file as its first
30     # argument - additional arguments depend on the skeleton
31     #-----------------------------------------------------------------------------
32     use strict 'vars';
33    
34     #
35     # some global variables because I don't know how to make perl pass
36     # array variables around to subroutines
37     #
38     my $nReplacements = 0;
39     my @originalText;
40     my @replacementText;
41    
42     {
43     # There must be at least one command-line argument was provided - the
44     # name of the skeleton file
45     # Additional arguments may be required by the Skeleton file
46     if ($#ARGV < 0) {
47     print("Program Usage: SkelEdit <SkeletonFile> <possible skeleton ",
48     "file arguments>\n\n",
49     " where SkeletonFile - is the name of the skeleton file to ",
50     "process\n\n");
51    
52     exit(-1);
53     }
54    
55     my $skeletonFile = $ARGV[0];
56    
57     #
58     # Open the skeleton file and process it
59     #
60     if (!open(SKELH, "$skeletonFile")) {
61     print("SkelEdit: Unable to open skeleton file ($skeletonFile).\n");
62     exit(-1);
63     }
64    
65     my $currentBlock = "none";
66     my $nArgs = 0;
67     my $maxArgs = $#ARGV;
68     my $nLineUsage = 0;
69     my @usageText;
70     my $nFiles;
71     my @filesToCheck;
72     while(<SKELH>) {
73     if($currentBlock eq "none") {
74     if(/^\s*BeginMessage/) {
75     $currentBlock="message";
76     }
77     elsif(/^\s*BeginUsage/) {
78     $currentBlock="usage";
79     $nLineUsage = 0;
80     if(/^\s*BeginUsage\s+(\d*)/) {
81     $nArgs = $1;
82     }
83     }
84     elsif(/^\s*BeginReplacements/) {
85     $currentBlock="replacements";
86     $nReplacements = 0;
87     }
88     elsif(/^\s*BeginFileCheck/) {
89     $currentBlock="filecheck";
90     $nFiles = 0;
91     }
92     elsif(/^\s*BeginFile\s*/) {
93     $currentBlock="file";
94     if(/^\s*BeginFile\s+(\S*)/) {
95     my $file = doReplacements($1);
96     if(-f $file) {
97     print "Error in File block - output file exists\n";
98     print "Attempting to output file $file\n";
99     exit(-1);
100     }
101     if (!open(OUTPUTH, ">$file")) {
102     print("Unable to open output file ($file)\n");
103     exit(-1);
104     }
105     print "Processing $file";
106     }
107     else {
108     print "Error in File block - no output file specified\n";
109     print "$_\n";
110     exit(-1);
111     }
112     }
113     }
114     elsif($currentBlock eq "message") {
115     if(/^\s*EndMessage/) {
116     $currentBlock="none";
117     }
118     else {
119     print doReplacements($_);
120     }
121     }
122     elsif($currentBlock eq "usage") {
123     if(/^\s*EndUsage/) {
124     if($nArgs>$maxArgs) {
125     print "Error - too few arguments specified\n";
126     for(my $i = 0; $i<$nLineUsage; $i++) {
127     print $usageText[$i];
128     }
129     exit(-1);
130     }
131     $currentBlock="none";
132     }
133     else {
134     $usageText[$nLineUsage] = $_;
135     $nLineUsage++;
136     }
137     }
138     elsif($currentBlock eq "replacements") {
139     if(/^\s*EndReplacements/) {
140     $currentBlock="none";
141     }
142     else {
143     if(/^\s*(<[^>]*>)\s*(\S.*)/) {
144     my $orig = $1;
145     my $repl = $2;
146     my $newText;
147     if($repl =~ /arg:(\d*)/) {
148     my $argNum = $1;
149     if($argNum >= $nArgs) {
150     print("Problem with replacement block\n",
151     $_,
152     "Argument number exceeds maximum specified",
153     "in usage block\n",
154     "Required argument index : $argNum\n",
155     "Number of arguments in usage : $nArgs\n",
156     "Remember argument indices are zero-based\n");
157     exit(-1);
158     }
159     $newText = $ARGV[$argNum+1];
160     }
161     elsif($repl =~ /date:(\S*)/) {
162     my $dateFormat = $1;
163     if($dateFormat eq "yyyymmdd") {
164     my ($sec,$min,$hour,$mday,$mon,
165     $year,$wday,$yday,$isdst) = localtime(time);
166     $mon++;
167     if($mon<10) {
168     $mon = "0".$mon;
169     }
170     $year+=1900;
171     if($mday<10) {
172     $mday = "0".$mday;
173     }
174     $newText = $year.$mon.$mday;
175     }
176     else {
177     print("Problem with replacement block\n",
178     $_,
179     "date format ($dateFormat) unknown\n");
180     exit(-1);
181     }
182     }
183     else {
184     print("Problem with replacement block\n",
185     $_,
186     "unknown replacement format ($repl)\n");
187     exit(-1);
188     }
189     $originalText[$nReplacements] = $orig;
190     $replacementText[$nReplacements] = $newText;
191     $nReplacements++;
192     }
193     }
194     }
195     elsif($currentBlock eq "filecheck") {
196     if(/^\s*EndFileCheck/) {
197     my $nFailed=0;
198     my @failedFiles;
199     for(my $k=0; $k<$nFiles; $k++) {
200     if(-f $filesToCheck[$k]) {
201     $failedFiles[$nFailed]=$filesToCheck[$k];
202     $nFailed++;
203     }
204     }
205     if($nFailed>0) {
206     print("Error processing FileCheck block\n",
207     "The following files already exist - \n");
208     for(my $i=0; $i<$nFailed; $i++) {
209     print "$failedFiles[$i]\n";
210     }
211     exit(-1);
212     }
213     $currentBlock="none";
214     }
215     else {
216     # chomp not working cleanly, remove \n and \r
217     s/\n//;
218     s/\r//;
219     $filesToCheck[$nFiles] = doReplacements($_);
220     $nFiles++;
221     }
222     }
223     elsif($currentBlock eq "file") {
224     if(/^\s*EndFile\s+$/) {
225     close(OUTPUTH);
226     $currentBlock="none";
227     print " .....ok\n";
228     }
229     else {
230     print OUTPUTH doReplacements($_);
231     }
232     }
233    
234     }
235     if($currentBlock ne "none") {
236     print "Error - end of skeleton file <$skeletonFile> reached\n";
237     print "But still in $currentBlock block\n";
238     print "Missing End keyword ???\n";
239     exit(-1);
240     }
241     close(SKELH);
242     }
243    
244    
245     sub doReplacements {
246     my $text=$_[0];
247     for(my $j=0; $j<$nReplacements; $j++) {
248     $text =~ s/$originalText[$j]/$replacementText[$j]/g;
249     }
250     return $text;
251     }

Properties

Name Value
svn:eol-style native
svn:executable *
svn:keywords Author Date Id Revision

  ViewVC Help
Powered by ViewVC 1.1.26