Solved

breaking out of a subroutine

Posted on 2004-04-05
4
441 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 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

VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

Question has a verified solution.

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

I have been pestered over the years to produce and distribute regular data extracts, and often the request have explicitly requested the data be emailed as an Excel attachement; specifically Excel, as it appears: CSV files confuse (no Red or Green h…
Checking the Alert Log in AWS RDS Oracle can be a pain through their user interface.  I made a script to download the Alert Log, look for errors, and email me the trace files.  In this article I'll describe what I did and share my script.
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…
Six Sigma Control Plans

632 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