trunk/scripts/SkelEdit.pl

#!/bin/sh
# The following line is for platform independence.
PERL=`type perl | cut -f3 -d\ `
#
# see whether perl was found
RESP=`echo $PERL | grep perl` 
if [ $? -eq 1 ] ; then
#
#   perl wasn't found
  echo "Couldn't find perl in your path. Please add perl to your path"
  echo "and try again."
  exit 1;
fi
$PERL -x $0 "$@" ; exit $?
#!perl
#------------------------------------------------------------------------------
#
# Author Ed.Rice & J.Gerschwitz
# COPYRIGHT Ed Rice & J.Gerschwitz  2004- All Rights Reserved.
# This software is the property of Ed.Rice & J.Gerschwitz.
# No part of this code may be copied in any form or by any means without the
# expressed written consent of Ed.Rice & J.Gerschwitz.
#
# Perl script to perform skeleton driven file creation
# Based on a skeleton configuration file this script will 
# edit a skeleton file replacing "placekeeper" text with user specified
# text generating updated files
#
# This script expects the name of the skeleton file as its first
# argument - additional arguments depend on the skeleton
#-----------------------------------------------------------------------------
use strict 'vars';

#
# some global variables because I don't know how to make perl pass 
# array variables around to subroutines
#
my $nReplacements = 0;
my @originalText;
my @replacementText;

{
   # There must be at least one command-line argument was provided - the
   # name of the skeleton file
   # Additional arguments may be required by the Skeleton file
   if ($#ARGV < 0) {
      print("Program Usage: SkelEdit <SkeletonFile> <possible skeleton ",
            "file arguments>\n\n",
        "  where SkeletonFile - is the name of the skeleton file to ",
        "process\n\n");

      exit(-1);
   }

   my $skeletonFile = $ARGV[0];

   #
   # Open the skeleton file and process it
   #
   if (!open(SKELH, "$skeletonFile")) {
       print("SkelEdit: Unable to open skeleton file ($skeletonFile).\n");
       exit(-1);
   }

   my $currentBlock = "none";
   my $nArgs = 0;
   my $maxArgs = $#ARGV; 
   my $nLineUsage = 0;
   my @usageText;
   my $nFiles;
   my @filesToCheck;
   while(<SKELH>) {
       if($currentBlock eq "none") {
       if(/^\s*BeginMessage/) {
           $currentBlock="message";
       }
       elsif(/^\s*BeginUsage/) {
           $currentBlock="usage";
               $nLineUsage = 0;
           if(/^\s*BeginUsage\s+(\d*)/) {
           $nArgs = $1;
           }
       }
       elsif(/^\s*BeginReplacements/) {
           $currentBlock="replacements";
           $nReplacements = 0;
       }
       elsif(/^\s*BeginFileCheck/) {
           $currentBlock="filecheck";
           $nFiles = 0;
       }
       elsif(/^\s*BeginFile\s*/) {
           $currentBlock="file";
           if(/^\s*BeginFile\s+(\S*)/) {
           my $file = doReplacements($1);
           if(-f $file) {
               print "Error in File block - output file exists\n";
               print "Attempting to output file $file\n";
               exit(-1);
           }
           if (!open(OUTPUTH, ">$file")) {
               print("Unable to open output file ($file)\n");
               exit(-1);
           }
           print "Processing $file";
           }
           else {
           print "Error in File block - no output file specified\n";
           print "$_\n";
           exit(-1);
           }
       }
       }
       elsif($currentBlock eq "message") {
       if(/^\s*EndMessage/) {
           $currentBlock="none";
       }
       else {
           print doReplacements($_);
       }
       }
      elsif($currentBlock eq "usage") {
       if(/^\s*EndUsage/) {
               if($nArgs>$maxArgs) {
           print "Error - too few arguments specified\n";
           for(my $i = 0; $i<$nLineUsage; $i++) {
               print $usageText[$i];
           }
                   exit(-1);
           }
           $currentBlock="none";
       }
       else {
           $usageText[$nLineUsage] = $_;
               $nLineUsage++;
       }
       }
      elsif($currentBlock eq "replacements") {
      if(/^\s*EndReplacements/) {
          $currentBlock="none";
      }
      else {
          if(/^\s*(<[^>]*>)\s*(\S.*)/) {
          my $orig = $1;
          my $repl = $2;
          my $newText;
                  if($repl =~ /arg:(\d*)/) {
              my $argNum = $1;
                      if($argNum >= $nArgs) {
              print("Problem with replacement block\n",
                $_,
                "Argument number exceeds maximum specified",
                "in usage block\n",
                "Required argument index : $argNum\n",
                "Number of arguments in usage : $nArgs\n",
                "Remember argument indices are zero-based\n");
              exit(-1);
              }
              $newText = $ARGV[$argNum+1];
          }
          elsif($repl =~ /date:(\S*)/) {
              my $dateFormat = $1;
              if($dateFormat eq "yyyymmdd") {
              my ($sec,$min,$hour,$mday,$mon,
                  $year,$wday,$yday,$isdst) = localtime(time);
              $mon++;
              if($mon<10) {
                  $mon = "0".$mon;
              }
              $year+=1900;
              if($mday<10) {
                  $mday = "0".$mday;
              }
              $newText = $year.$mon.$mday;
              }
              else {
              print("Problem with replacement block\n",
                $_,
                "date format ($dateFormat) unknown\n");
              exit(-1);
              }
          }
          else {
              print("Problem with replacement block\n",
                $_,
                "unknown replacement format ($repl)\n");
              exit(-1);
          }
          $originalText[$nReplacements] = $orig;
          $replacementText[$nReplacements] = $newText;
                  $nReplacements++;
          }
      }
      }
      elsif($currentBlock eq "filecheck") {
       if(/^\s*EndFileCheck/) {
           my $nFailed=0;
           my @failedFiles;
           for(my $k=0; $k<$nFiles; $k++) {
           if(-f $filesToCheck[$k]) {
               $failedFiles[$nFailed]=$filesToCheck[$k];
               $nFailed++;
           }
           }
           if($nFailed>0) {
           print("Error processing FileCheck block\n",
             "The following files already exist - \n");
           for(my $i=0; $i<$nFailed; $i++) {
               print "$failedFiles[$i]\n";
           }
           exit(-1);
           }
           $currentBlock="none";
       }
       else {
           # chomp not working cleanly, remove \n and \r
           s/\n//;
           s/\r//;
           $filesToCheck[$nFiles] = doReplacements($_);
               $nFiles++;
       }
       }
      elsif($currentBlock eq "file") {
       if(/^\s*EndFile\s+$/) {
           close(OUTPUTH);
           $currentBlock="none";
           print " .....ok\n";
       }
       else {
           print OUTPUTH doReplacements($_);
       }
       }

   }
   if($currentBlock ne "none") {
       print "Error - end of skeleton file <$skeletonFile> reached\n";
       print "But still in $currentBlock block\n";
       print "Missing End keyword ???\n";
       exit(-1);
   }
   close(SKELH);
}


sub doReplacements {
  my $text=$_[0];
  for(my $j=0; $j<$nReplacements; $j++) {
      $text =~ s/$originalText[$j]/$replacementText[$j]/g;
  }
  return $text;
}
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(/^\sBeginUsage\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(/^\sBeginFile\s/) {
93			$currentBlock="file";
94			if(/^\sBeginFile\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			}
Name	Value
svn:eol-style	native
svn:executable	*
svn:keywords	Author Date Id Revision