Solved

breaking out of a subroutine

Posted on 2004-04-05
4
431 Views
Last Modified: 2011-09-20
This is a continuation of my previous question with my File::Find::name script.  I now have a problem where I need to break out of the find subroutine if my script find a particular pattern:

#!/usr/bin/perl

###############################################################################
# tlgfileconverter.pl                                                         #
#                                                                             #
# Copyright Cirrus Logic Inc. 2004                                            #
#                                                                             #
# Author: Ken Gerdes                                                          #
###############################################################################

use File::Find;
use File::Basename;

$find="test_case";
$rootdir=$ARGV[0];
if(($find eq "") || ($rootdir eq "")) {
   print "Usage: perl tlgfileconverter.pl <search-directory>\n";
   exit;
}
$rootdir =~ s/^.+\\.+\$/^.+\\\\.+\\\$/g;
LOOK:
find(\&wanted_files, "$rootdir");

sub wanted_files {
        # First, we want to find files with tlg extension
        if($File::Find::name=~m!^*.tlg$!) {
           # Break up the input file name and path into usable parts
           ($name,$path,$suffix) = fileparse($File::Find::name,@suffixlist);
           chop($path);
           ($filename,$ext) = $name=~/(.*)\.(.*)/;  
           $outfile = join("",$filename,"out.tlg");
           # Create the output file in the same directory as the input file
           $pathtooutfile = join("\\",$path,$outfile);
           # Open input file for reading and writing
           open(FILE,"$File::Find::name") || die("Can not open file $File::Find::name because $!");
           open(OUTFILE,">$pathtooutfile") || die("Can not open file $pathtooutfile because $!");
           # Line number
           $linenum=0;
           while(<FILE>) {
              $linenum++;
              # If "test_case" is found, change to "project_test_case"
              if(m/\Q$find\E/i) {
                  $newline = $_;
                  if($newline =~ /project_test_case/) {
                     goto LOOK;
                  } else {
                     $newline =~ s/$find/project_test_case/g;
                     print OUTFILE "$newline";
                  }
              # If "test_phase" is found, print that line, then insert the new lines
              } elsif($_ =~ /test_phase/) {
                  print OUTFILE "$_";
                  print OUTFILE "<test_status>Not yet attempted</test_status>\n";
                  print OUTFILE "<test_attempts>0</test_attempts>\n";
                  print OUTFILE "<last_attempt_date>N/A</last_attempt_date>\n";
                  print OUTFILE "<actual_duration></actual_duration>\n";
                  print OUTFILE "<version_tested></version_tested>\n";
                  print OUTFILE "<testers></testers>\n";
                  print OUTFILE "<fault_report_id></fault_report_id>\n";
                  print OUTFILE "<change_req_id></change_req_id>\n";
                  print OUTFILE "<results_obtained></results_obtained>\n";
              } else {
                  print OUTFILE "$_";
              }
           }
           close(FILE);
           # Print the final line
           print OUTFILE "\n<history_entry><time></time><date></date><type></type><old_status></old_status><new_status></new_status><num_tries></num_tries></history_entry>\n";
           close(OUTFILE);
           $pathtoinfile = join("\\",$path,$filename);
           $pathtoinfile = join("\.",$pathtoinfile,"tlg");
           system("move \"$pathtooutfile\" \"$pathtoinfile\"");
        }
}

Notice where the LOOK label is.  I'm trying to force it to break out if the file it finds contains the pattern "project_test_case" already, so that it doesn't even mess with this file, but it is getting stuck in an infinite loop instead this way.  I need it to go on to the next file find instead if it sees project_test_case.  

I've also noticed where my script seems to ignore files with all capital letters.  One of the files it should be changing is called 026. SOME FILE.tlg, but it is not even opening the file, and finding the test_case pattern, then replacing the inputfile with the output file.  Can somebody see where the problem may be with this?
0
Comment
Question by:texasreddog
  • 2
  • 2
4 Comments
 
LVL 84

Accepted Solution

by:
ozo earned 50 total points
ID: 10759268
what was this line
$rootdir =~ s/^.+\\.+\$/^.+\\\\.+\\\$/g;
intended to do?

Instead of
     goto LOOK;
it looks like you just need
     return;
0
 

Author Comment

by:texasreddog
ID: 10759342
The $rootdir =~ s/^.+\\.+\$/^.+\\\\.+\\\$/g; line I believe is for converting backslashes in the path, since it is on a Windows system.  
I think this is to make sure the path is found, otherwise, it reports an error.
0
 

Author Comment

by:texasreddog
ID: 10759471
OK, the return worked, and I figured out the problem with the file with all caps not working.  Thanks ozo!
0
 
LVL 84

Expert Comment

by:ozo
ID: 10759893
If that was the intent of the line, I don't think it works.  But That's ok, since it's also unnecessary
0

Featured Post

U.S. Department of Agriculture and Acronis Access

With the new era of mobile computing, smartphones and tablets, wireless communications and cloud services, the USDA sought to take advantage of a mobilized workforce and the blurring lines between personal and corporate computing resources.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

I've just discovered very important differences between Windows an Unix formats in Perl,at least 5.xx.. MOST IMPORTANT: Use Unix file format while saving Your script. otherwise it will have ^M s or smth likely weird in the EOL, Then DO NOT use m…
A year or so back I was asked to have a play with MongoDB; within half an hour I had downloaded (http://www.mongodb.org/downloads),  installed and started the daemon, and had a console window open. After an hour or two of playing at the command …
Explain concepts important to validation of email addresses with regular expressions. Applies to most languages/tools that uses regular expressions. Consider email address RFCs: Look at HTML5 form input element (with type=email) regex pattern: T…
Email security requires an ever evolving service that stays up to date with counter-evolving threats. The Email Laundry perform Research and Development to ensure their email security service evolves faster than cyber criminals. We apply our Threat…

770 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question