Solved

How to get the return values of a subroutine in Perl from another subroutine?

Posted on 2011-09-16
23
358 Views
Last Modified: 2012-05-12
Hi,
I have a follow up question to ID: 27285438


This is the code I use to parse the text file:
sub submitFileParser{
my $filename = shift;
my @paragraphs;
{
#   local($/) = '';
    open( FILE, "< $filename" ) or die "Can't open $filename : $!";
    @paragraphs = <FILE>;
    close FILE;
}
our @HEADERS = ("Files", "Comments", "Related Records", "Code Reviewers");

sub read_paragraphs (@) {
	# read lines as parameters
	my @rippedParagraphs = @_;

	# Storage for all sections
	my (@CRS, @RRS, @CSS, @ALLFiles, @Options);
	# Temporary storages for single section of each type
	my (@Files, @CR, @RR, @CS);
	# Flags for file traversal logic
	my ($opt_flag, $file_flag);

	my $submit_file = 0;
	#read the file
	for ( @rippedParagraphs ) {
			if (/^\s*Submit\s+file\s*$/) {
				$submit_file = 1;
			next;
			}
			if ($submit_file == 1) {
				if(/^\s*\=+\s*$/) {
				$submit_file++;
			}
			else {
				$submit_file = 0; # two-line grammar didn't hold
			}
			next;
			}
			if ($submit_file == 2) {
				# Match the login name in the submit file
				if(m|^#\s*Sandbox\s+location\s*\:\s*/sandbox/(.*?)/|) {
				   $geckLogin = $1;
				}
			}
		# If we encounter a comment or empty string
		if (/^\#/ || !/\S/) {
			# we haven't encountered an option to start doing anything
			next unless $opt_flag || $file_flag;
			# If we're in file reading stage
			if ($file_flag) {
				# Means section reading is over, let's append to the general
				# storage arrays
				push(@ALLFiles, [@Files]) if @Files;
				push(@CRS, [@CR]) if @CR;
				push(@CSS, [@CS]) if @CS;
				push(@RRS, [@RR]) if @RR;
				# and reset temporary storages
				@Files = @CR = @CS = @RR = ();
			}
			# If we're done with options, let's start reading file sections
			if ($opt_flag == 1) {
				$opt_flag = 0;
				$file_flag = 1;
			}
			elsif ($opt_flag > 1) {
				# Addresses the empty line within Options:
				$opt_flag--;
			}
			next;
		} #/^\#/ || !/\S/
		if (/^Options/) {
			# We start reading options
			$opt_flag = 2;
			next;
		} #Options
		# Matching beginning of the line to determine the type of the string
		# and placing it in temporary storage
                /^R(R|elated\sRecords):\s*(.*\n)/ && push(@RR, $_) && next;
                /^C(R|ode\sReviewer):\s*(.*\n)/ && push(@CR, $_) && next;
                /^C(S|omments):\s*(.*\n)/ && push(@CS, $_) && next;

		# General text is either files or options info, depending on the
		# value of the option flag
		$opt_flag ? push(@Options, $_) : push(@Files, $_);		
	} #@rippedParagraphs 
	
	# Let's put the last read section into storages
	push(@ALLFiles, [@Files]);
	push(@CRS, [@CR]);
	push(@CSS, [@CS]);
	push(@RRS, [@RR]);
	# And we return the full datastructure - hashref of populated storage
	return {
		"Options"              => [@Options],
		"Files"                => [@ALLFiles],
		"Comments"             => [@CSS],
		"Related Records"      => [@RRS],
		"Code Reviewers"       => [@CRS],
	};
} #read_paragraphs
} # submitFileParser

Open in new window


This is how I call this function within another subroutine ($cache is the text file I parse):

my $cache_data = submitFileParser($cache);

Open in new window


When I check $cache_data by typing

x $cache_data

Open in new window


I get this

0  4

Open in new window


What I expect to get is the access to these return values:
@Options
@ALLFiles
@CSS
@RRS
@CRS

Open in new window


How can I do that?

0
Comment
Question by:Tolgar
  • 12
  • 11
23 Comments
 
LVL 9

Expert Comment

by:parparov
ID: 36550173
You're not using the code you received in your previous question, are you?
Because the one that you're trying to use is based on nested subroutines and is broken completely.

0
 

Author Comment

by:Tolgar
ID: 36550491
I assume I am using it but maybe I am confused. If you don't mind can you please attach the right one in here?

Thanks,

0
 
LVL 9

Expert Comment

by:parparov
ID: 36550528
The code you're using is the code you tried to write yourself in a previous question. That code is broken, and returns not the values you intended to.

The code that you should be using is this:
our @HEADERS = ("Files", "Comments", "Related Records", "Code Reviewers");
sub processFile ($) {
  my $cache = shift;
  my $cache_data = submitFileParser($cache);
  # then use $cache_data like I used it in printing.

}
sub submitFileParser ($) {
  my $filename = shift;
  my @paragraphs;
  local($/) = '';
  open( FILE, "< $filename" ) or die "Can't open $filename : $!";
  @paragraphs = <FILE>;
  close FILE;
  return read_paragraphs (@paragraphs);
}
sub read_paragraphs (@) {
        # read lines as parameters
        my @rippedParagraphs = @_;

        # Storage for all sections
        my (@CRS, @RRS, @CSS, @ALLFiles, @Options);
        # Temporary storages for single section of each type
        my (@Files, @CR, @RR, @CS);
        # Flags for file traversal logic
        my ($opt_flag, $file_flag);

        #read the file
        for ( @rippedParagraphs ) {
                # If we encounter a comment or empty string
                if (/^\#/ || !/\S/) {
                        # we haven't encountered an option to start doing anything
                        next unless $opt_flag || $file_flag;
                        # If we're in file reading stage
                        if ($file_flag) {
                                # Means section reading is over, let's append to the general
                                # storage arrays
                                push(@ALLFiles, [@Files]) if @Files;
                                push(@CRS, [@CR]) if @CR;
                                push(@CSS, [@CS]) if @CS;
                                push(@RRS, [@RR]) if @RR;
                                # and reset temporary storages
                                @Files = @CR = @CS = @RR = ();
                        }
                        # If we're done with options, let's start reading file sections
                        if ($opt_flag == 1) {
                                $opt_flag = 0;
                                $file_flag = 1;
                        }
                        elsif ($opt_flag > 1) {
                                # Addresses the empty line within Options:
                                $opt_flag--;
                        }
                        next;
                }
                if (/^Options/) {
                        # We start reading options
                        $opt_flag = 2;
                        next;
                }
                # Matching beginning of the line to determine the type of the string
                # and placing it in temporary storage
                /^R(R|elated\sRecords):\s*(.*\n)/ && push(@RR, $_) && next;
                /^C(R|ode\sReviewer):\s*(.*\n)/ && push(@CR, $_) && next;
                /^C(S|omments):\s*(.*\n)/ && push(@CS, $_) && next;

#               /^CR:/ && push(@CR, $_) && next;
#               /^CS:/ && push(@CS, $_) && next;
#               /^RR:/ && push(@RR, $_) && next;
                # General text is either files or options info, depending on the
                # value of the option flag
                $opt_flag ? push(@Options, $_) : push(@Files, $_);
        }
        # Let's put the last read section into storages
        push(@ALLFiles, [@Files]);
        push(@CRS, [@CR]);
        push(@CSS, [@CS]);
        push(@RRS, [@RR]);
        # And we return the full datastructure - hashref of populated storage
        return {
                "Options"              => [@Options],
                "Files"                => [@ALLFiles],
                "Comments"             => [@CSS],
                "Related Records"      => [@RRS],
                "Code Reviewers"       => [@CRS],
        };
}

Open in new window


The returned value is a complex data structure - a hash where the keys are field names, and the values are arrays.
0
 

Author Comment

by:Tolgar
ID: 36551091
@parparov: This is the code I use. It is the code you mentioned with some editions to it. Eventhough I kow that keyword1 and keyword2 exists in this file, Line10 and Line11 does not return true.

Can you please take a look at it?

Thanks,

our @HEADERS = ("Files", "Comments", "Related Records", "Code Reviewers", "Geck Login");
sub process_cache_file {
    my $cache = "PATH_TO_THE_TEXT_FILE";		
    my $cache_data = submitFileParser($cache);
}


SOME OTHER CODE IN HERE  

my $optionLogFiles = grep {/KEYWORD1/} @Options;
my $optionSbcheck = grep {/KEYWORD2/} @Options;
my @javaCmd = ('java', '-jar', "$mydir/myTools/myTool-1.0.jar", $geckLogin, @RRS, $optionLogFiles, $optionSbcheck, $soapEndpointURL);

print "Running: @javaCmd\n";
system( @javaCmd );

if ($?) {
	$? >>= 8;
	if ($? > 255){
	print "Error:\n Exit code=$?";
			 }
	}
	else {
		  print "Success\n";
		}
	}
	alarm 0;
	}; # eval
			
	if ($@) {
	die $@
	if $@ ne "alarm\n"; # propagate unexpected errors timed out
	# log error message
	print "Error: $@";
	}

SOME OTHER CODE IN HERE  

    return;
} # process_cache_file


sub submitFileParser ($) {
  my $filename = shift;
  my @paragraphs;
  local($/) = '';
  open( FILE, "< $filename" ) or die "Can't open $filename : $!";
  @paragraphs = <FILE>;
  close FILE;
  return read_paragraphs (@paragraphs);
}
sub read_paragraphs (@) {
        # read lines as parameters
        my @rippedParagraphs = @_;

        # Storage for all sections
        my (@CRS, @RRS, @CSS, @ALLFiles, @Options);
        # Temporary storages for single section of each type
        my (@Files, @CR, @RR, @CS);
        # Flags for file traversal logic
        my ($opt_flag, $file_flag);

		my $submit_file = 0;
        #read the file
        for ( @rippedParagraphs ) {
			if (/^\s*Submit\s+file\s*$/) {
				$submit_file = 1;
			next;
			}
			if ($submit_file == 1) {
				if(/^\s*\=+\s*$/) {
				$submit_file++;
			}
			else {
				$submit_file = 0; # two-line grammar didn't hold
			}
			next;
			}
			if ($submit_file == 2) {
				# Match the login name in the submit file
				if(m|^#\s*Sandbox\s+location\s*\:\s*/sandbox/(.*?)/|) {
				   $geckLogin = $1;
				}
			}
                # If we encounter a comment or empty string
                if (/^\#/ || !/\S/) {
                        # we haven't encountered an option to start doing anything
                        next unless $opt_flag || $file_flag;
                        # If we're in file reading stage
                        if ($file_flag) {
                                # Means section reading is over, let's append to the general
                                # storage arrays
                                push(@ALLFiles, [@Files]) if @Files;
                                push(@CRS, [@CR]) if @CR;
                                push(@CSS, [@CS]) if @CS;
                                push(@RRS, [@RR]) if @RR;
                                # and reset temporary storages
                                @Files = @CR = @CS = @RR = ();
                        }
                        # If we're done with options, let's start reading file sections
                        if ($opt_flag == 1) {
                                $opt_flag = 0;
                                $file_flag = 1;
                        }
                        elsif ($opt_flag > 1) {
                                # Addresses the empty line within Options:
                                $opt_flag--;
                        }
                        next;
                }
                if (/^Options/) {
                        # We start reading options
                        $opt_flag = 2;
                        next;
                }
                # Matching beginning of the line to determine the type of the string
                # and placing it in temporary storage
                /^R(R|elated\sRecords):\s*(.*\n)/ && push(@RR, $_) && next;
                /^C(R|ode\sReviewer):\s*(.*\n)/ && push(@CR, $_) && next;
                /^C(S|omments):\s*(.*\n)/ && push(@CS, $_) && next;

                /^CR:/ && push(@CR, $_) && next;
                /^CS:/ && push(@CS, $_) && next;
                /^RR:/ && push(@RR, $_) && next;
                # General text is either files or options info, depending on the
                # value of the option flag
                $opt_flag ? push(@Options, $_) : push(@Files, $_);
        }
        # Let's put the last read section into storages
        push(@ALLFiles, [@Files]);
        push(@CRS, [@CR]);
        push(@CSS, [@CS]);
        push(@RRS, [@RR]);
        # And we return the full datastructure - hashref of populated storage
        return {
                "Options"              => [@Options],
                "Files"                => [@ALLFiles],
                "Comments"             => [@CSS],
                "Related Records"      => [@RRS],
                "Code Reviewers"       => [@CRS],
		"Geck Login" 		   => [$geckLogin],
        };
}

Open in new window

0
 
LVL 9

Expert Comment

by:parparov
ID: 36551456
where are you trying to obtain @Options from?

The code you provided here is not a valid perl, because you seem to have two } terminations for process_cache_file.

If the greps are within process_cache_file, then you need to grep @{$cache_data->{Options}}, not @Options.
0
 

Author Comment

by:Tolgar
ID: 36551682
The termination can be my mistake in inserting the code in here.

I try to obtain the followings from process_cache_file

@Options
@ALLFiles
@CSS
@RRS
@CRS
$geckLogin

Open in new window


So my current code is this:

my $optionLogFiles = grep {/KEYWORD1/} @Options;

Open in new window


Should change change it like this?

my $optionLogFiles = grep {/KEYWORD1/} @{$cache_data->{Options}};

Open in new window


So in this case my $cache_data does not make sense.

What about the others that I need to obtain later? Like this:

my @javaCmd = ('java', '-jar', "$mydir/myTools/myTool-1.0.jar", $geckLogin, , @ALLFiles, 

Open in new window

@CSS, @RRS, @CRS, $optionLogFiles, $optionSbcheck, $soapEndpointURL);

Open in new window



Thanks,




0
 
LVL 9

Expert Comment

by:parparov
ID: 36551744
You still don't make sense, sorry.
I asked you if the grep happens within process_cache_file or not.
Because if it doesn't, the $cache_data that has all your data is not returned and gets lost.

In that case, add return $cache_data; after line 4. However, you need to call process_cache_file from somewhere to obtain it, something like:
my $cache_data = process_cache_file();

Open in new window

just before the usage of the $cache_data, for instance, before the grep.

In both cases you change you grep as I told you.
You'll need to change every other list occurrence from @xxx to @{$cache_data->{xxx}}

You don't need to encapsulate $geckLogin like you did in line 141.
change this line to:
"Geck Login" => $geckLogin

Open in new window

because it is a single scalar value, and not a list value like all others.
Then replace $geckLogin occurrences with $cache_data->{Geck Login}
0
 

Author Comment

by:Tolgar
ID: 36551844
Oh yes, grep is in process_cache_file.

The } on line 5 was a mistake.

Most of the process is in process_cache_file subroutine. So if I didn't misunderstand, I can reach any variable from submitFileParser subroutine by this way within process_cache_file:

sub process_cache_file {

my $cache = "/opt/folder1/myText.txt";

my $cache_data = submitFileParser($cache);

my $Options = @{$cache_data->{Options}};
my $Files =@{$cache_data->{Files}};
my $Comments =@{$cache_data->{Comments}};
my $Related_Records =@{$cache_data->{Related Records}};
my $Code_Reviewers =@{$cache_data->{Code Reviewers}};
my $Geck_Login =${$cache_data->{Geck Login}};
}

sub submitFileParser ($) {
my $filename = shift;
.
.
.
.
return {
                "Options"                  => [@Options],
                "Files"                       => [@ALLFiles],
                "Comments"              => [@CSS],
                "Related Records"    => [@RRS],
                "Code Reviewers"    => [@CRS],
	        "Geck Login" 		  => $geckLogin,
           };
}

Open in new window


Is it right now?
0
 
LVL 9

Expert Comment

by:parparov
ID: 36551898
You can reach. You can do that.
It just takes up a bit more memory that way.
But you need to pertain the data types, which means:
my @Options = @{$cache_data->{Options}};
my @Files =@{$cache_data->{Files}};
my @Comments =@{$cache_data->{Comments}};
my @Related_Records =@{$cache_data->{Related Records}};
my @Code_Reviewers =@{$cache_data->{Code Reviewers}};
my $Geck_Login = $cache_data->{Geck Login};

Open in new window

The lists must take additional dereferencing via @{} since they are stored as references ([ ])
The scalar Geck_Login doesn't need the additional dereferencing since it is stored as its value and not a reference to it.
0
 

Author Comment

by:Tolgar
ID: 36551960
Ok. So;

1- How can I make it without taking up more memory?

2- How can I do the additional dereferencing?

Thanks,
0
 
LVL 9

Expert Comment

by:parparov
ID: 36552035
1) By using direct accessors like the ones.

2) The correct dereferencing is in my code above, in answer 36551898

The extra consumption is not large, you can use the code because it is more understandable. Especially now I think you'll have to dereference for grep anyways.

0
What Is Threat Intelligence?

Threat intelligence is often discussed, but rarely understood. Starting with a precise definition, along with clear business goals, is essential.

 

Author Comment

by:Tolgar
ID: 36552673
Hi,
There is still a problem.

When I debug the code up to the beginning of readParagraphs subroutine everything is as expected.  
However, when we get into the for loop of "for ( @rippedParagraphs )", the code cannot detect "Submit File", "equal signs" and so on.


sub read_paragraphs (@) {
        # read lines as parameters
        my @rippedParagraphs = @_;

        # Storage for all sections
        my (@CRS, @RRS, @CSS, @ALLFiles, @Options);
        # Temporary storages for single section of each type
        my (@Files, @CR, @RR, @CS);
        # Flags for file traversal logic
        my ($opt_flag, $file_flag);

		my $submit_file = 0;
        #read the file
        for ( @rippedParagraphs ) {
			if (/^\s*Submit\s+file\s*$/) {
				$submit_file = 1;
			next;
			}
			if ($submit_file == 1) {
				if(/^\s*\=+\s*$/) {
				$submit_file++;
			}
			else {
				$submit_file = 0; # two-line grammar didn't hold
			}
			next;
			}
			if ($submit_file == 2) {
				# Match the login name in the submit file
				if(m|^#\s*Sandbox\s+location\s*\:\s*/sandbox/(.*?)/|) {
				   $geckLogin = $1;
				}
			}
                # If we encounter a comment or empty string
                if (/^\#/ || !/\S/) {
                        # we haven't encountered an option to start doing anything
                        next unless $opt_flag || $file_flag;
                        # If we're in file reading stage
                        if ($file_flag) {
                                # Means section reading is over, let's append to the general
                                # storage arrays
                                push(@ALLFiles, [@Files]) if @Files;
                                push(@CRS, [@CR]) if @CR;
                                push(@CSS, [@CS]) if @CS;
                                push(@RRS, [@RR]) if @RR;
                                # and reset temporary storages
                                @Files = @CR = @CS = @RR = ();
                        }
                        # If we're done with options, let's start reading file sections
                        if ($opt_flag == 1) {
                                $opt_flag = 0;
                                $file_flag = 1;
                        }
                        elsif ($opt_flag > 1) {
                                # Addresses the empty line within Options:
                                $opt_flag--;
                        }
                        next;
                }
                if (/^Options/) {
                        # We start reading options
                        $opt_flag = 2;
                        next;
                }
                # Matching beginning of the line to determine the type of the string
                # and placing it in temporary storage
                /^R(R|elated\sRecords):\s*(.*\n)/ && push(@RR, $_) && next;
                /^C(R|ode\sReviewer):\s*(.*\n)/ && push(@CR, $_) && next;
                /^C(S|omments):\s*(.*\n)/ && push(@CS, $_) && next;

#                /^CR:/ && push(@CR, $_) && next;
#                /^CS:/ && push(@CS, $_) && next;
#                /^RR:/ && push(@RR, $_) && next;
                # General text is either files or options info, depending on the
                # value of the option flag
                $opt_flag ? push(@Options, $_) : push(@Files, $_);
        }
        # Let's put the last read section into storages
        push(@ALLFiles, [@Files]);
        push(@CRS, [@CR]);
        push(@CSS, [@CS]);
        push(@RRS, [@RR]);
        # And we return the full datastructure - hashref of populated storage
        return {
                "Options"              => [@Options],
                "Files"                => [@ALLFiles],
                "Comments"             => [@CSS],
                "RelatedRecords"      => [@RRS],
                "CodeReviewers"       => [@CRS],
				"GeckLogin" 		   => $geckLogin,
        };

Open in new window


The file that I process is this:

USER=testman, HOST=testman-deb6-64, ARCH=glnxa64
Revisions: /st/hub/share/apps/bat//share/mmit: 07/26-09:48:58; csubmitItem.pm: 2011/07/26-09:48:56
Original arguments:
        -t
        Atk
        -F
        20110914.submit
Currently $_='154551'

        main:/st/hub/share/apps/bat/bat2.15.17/share/../lib/csubmitCache.pm:44 called main::submissionHistory
        main:/st/hub/share/apps/bat/bat2.15.17/share/submit:3871 called main::CreateCacheFile

Current directory ($PWD) = /st/devel/sandbox/testman/Aslrtw
                Submit file
        ===========================
# Component        : Coder
# Sandbox location : /st/devel/sandbox/testman/Atk
# Submission for   : 2000
#
# Description:
#   Unlocking making changes
#
# Documentation impact:
#   None
#
# QE items:
#   None
#
# Type of change:
#   Unlocking making changes
#

# submit file for use with msubmit.  To use run the command
#      submit -F 24.submit
#   or use C-c C-c from emacs to run this command.
# "<a href='http://www-sandbox/testman/Atk/glnxa64'>/sandbox/testman/Atk_ests/glnxa64</a>"
# "No need for sbruntests: Interactive Tests Update"
Options:

-CJ "<a href='http://www-sandbox/testman/Atk_tests/glnxa64'>/sandbox/testman/Atk_tests/glnxa64</a>"
-nowrap
-subject "Unlocking making changes"
-KEYWORD1
-KEYWORD2

st/ert/variants/variants5.c
CR: testman2
RR: 987654
CS: Unlocking before making changes

Mail sent to:
    st.devel.submit: Unlocking making changes
    Files:
    st/ert/variants/variants5.c

	
				Submit file
        ===========================
# Component        : Coder
# Sandbox location : /st/devel/sandbox/testman/Atk
# Submission for   : 2000
#
# Description:
#   Unlocking making changes
#
# Documentation impact:
#   None
#
# QE items:
#   None
#
# Type of change:
#   Unlocking making changes
#

# submit file for use with msubmit.  To use run the command
#      submit -F 14.submit
#   or use C-c C-c from emacs to run this command.
# "<a href='http://www-sandbox/testman/Atk_tests/glnxa64'>/sandbox/testman/Atk_tests/glnxa64</a>"
# "No need for sbruntests: Interactive Tests Update"
Options:

-CJ "<a href='http://www-sandbox/testman/Atk_tests/glnxa64'>/sandbox/testman/Atk_tests/glnxa64</a>"
-nowrap
-subject "Unlocking making changes"
-KEYWORD1
-KEYWORD2

st/ert/variants/variants5.c
CR: testman2
RR: 123456
CS: Unlocking before making changes

Mail sent to:
    st.devel.submit: Unlocking making changes
    Files:
    st/ert/variants/variants5.c

Open in new window


when I run this command

main::read_paragraphs(processBatStatus:319):
319:            my @rippedParagraphs = @_;
DB<2> x @_

Open in new window


@_ at line 3 for this file is this:

0  "USER=testman, HOST=testman-deb6-64, ARCH=glnxa64\cM\cJRevisions: /st/hub/share/apps/bat//share/mmit: 07/26-09:48:58; csubmitItem.pm: 2011/07/26-09:48:56\cM\cJOriginal arguments:\cM\cJ        -t\cM\cJ        Atk\cM\cJ        -F\cM\cJ        20110914.submit\cM\cJCurrently \$_='154551'\cM\cJ\cM\cJ        main:/st/hub/share/apps/bat/bat2.15.17/share/../lib/csubmitCache.pm:44 called main::submissionHistory\cM\cJ        main:/st/hub/share/apps/bat/bat2.15.17/share/submit:3871 called main::CreateCacheFile\cM\cJ\cM\cJCurrent directory (\$PWD) = /st/devel/sandbox/testman/Aslrtw\cM\cJ                Submit file\cM\cJ        ===========================\cM\cJ# Component        : Coder\cM\cJ# Sandbox location : /st/devel/sandbox/testman/Atk\cM\cJ# Submission for   : 2000\cM\cJ#\cM\cJ# Description:\cM\cJ#   Unlocking making changes\cM\cJ#\cM\cJ# Documentation impact:\cM\cJ#   None\cM\cJ#\cM\cJ# QE items:\cM\cJ#   None\cM\cJ#\cM\cJ# Type of change:\cM\cJ#   Unlocking making changes\cM\cJ#\cM\cJ\cM\cJ# submit file for use with msubmit.  To use run the command\cM\cJ#      submit -F 24.submit\cM\cJ#   or use C-c C-c from emacs to run this command.\cM\cJ# \"<a href='http://www-sandbox/testman/Atk/glnxa64'>/sandbox/testman/Atk_ests/glnxa64</a>\"\cM\cJ# \"No need for sbruntests: Interactive Tests Update\"\cM\cJOptions:\cM\cJ\cM\cJ-CJ \"<a href='http://www-sandbox/testman/Atk_tests/glnxa64'>/sandbox/testman/Atk_tests/glnxa64</a>\"\cM\cJ-nowrap\cM\cJ-subject \"Unlocking making changes\"\cM\cJ-KEYWORD1\cM\cJ-KEYWORD2\cM\cJ\cM\cJst/ert/variants/variants5.c\cM\cJCR: testman2\cM\cJRR: 123456\cM\cJCS: Unlocking before making changes\cM\cJ\cM\cJMail sent to:\cM\cJ    st.devel.submit: Unlocking making changes\cM\cJ    Files:\cM\cJ    st/ert/variants/variants5.c\cM\cJ\cM\cJ\cI\cM\cJ\cI\cI\cI\cISubmit file\cM\cJ        ===========================\cM\cJ# Component        : Coder\cM\cJ# Sandbox location : /st/devel/sandbox/testman/Atk\cM\cJ# Submission for   : 2000\cM\cJ#\cM\cJ# Description:\cM\cJ#   Unlocking making changes\cM\cJ#\cM\cJ# Documentation impact:\cM\cJ#   None\cM\cJ#\cM\cJ# QE items:\cM\cJ#   None\cM\cJ#\cM\cJ# Type of change:\cM\cJ#   Unlocking making changes\cM\cJ#\cM\cJ\cM\cJ# submit file for use with msubmit.  To use run the command\cM\cJ#      submit -F 14.submit\cM\cJ#   or use C-c C-c from emacs to run this command.\cM\cJ# \"<a href='http://www-sandbox/testman/Atk_tests/glnxa64'>/sandbox/testman/Atk_tests/glnxa64</a>\"\cM\cJ# \"No need for sbruntests: Interactive Tests Update\"\cM\cJOptions:\cM\cJ\cM\cJ-CJ \"<a href='http://www-sandbox/testman/Atk_tests/glnxa64'>/sandbox/testman/Atk_tests/glnxa64</a>\"\cM\cJ-nowrap\cM\cJ-subject \"Unlocking making changes\"\cM\cJ-KEYWORD1\cM\cJ-KEYWORD2\cM\cJ\cM\cJst/ert/variants/variants5.c\cM\cJCR: testman2\cM\cJRR: 123456\cM\cJCS: Unlocking before making changes\cM\cJ\cM\cJMail sent to:\cM\cJ    st.devel.submit: Unlocking making changes\cM\cJ    Files:\cM\cJ    st/ert/variants/variants5.c\cM\cJ"

Open in new window



Can you please take a look why it does not work?

Thanks,
0
 
LVL 9

Expert Comment

by:parparov
ID: 36552739
I don't see the problem. @rippedParagraphs contain the whole file contents, and both subit file and ===s are there. x @_ just prints you all the members of the list @rippedParagraphs without any delimiter between them. Submit file is around position 500, I think.

You can install debugging prints in all the parsing ifs of the code to see if every important pattern is detected.
0
 

Author Comment

by:Tolgar
ID: 36552751
Ok this is the problem actually. I went through all the parsing ifs and none of them were detected.

Can you please try it by feeding @_ to the third line of read_paragraphs subroutine?

It does not detect anything in this case.

Thanks,
0
 
LVL 9

Accepted Solution

by:
parparov earned 500 total points
ID: 36552781
Ok, I took a deeper look.

First of all, please get rid of line  
local($/) = ''; 

Open in new window

- I think I suggested you did that in earlier discussions. That was the first reason of your problem that clobbered the read file.

Second, the usage of parenthesis/scopes is wrong, the condition
if ($submit_file == 2) { 

Open in new window

should be closed only at line 77, at the end of the loop, as it encompasses the entire parsing.

In addition, the pattern for matching geckLogin is wrong, the correct one should be:
			if (m|^\#\s*Sandbox\s+location\s*\:\s*\S*/sandbox/(.*?)/|) {

Open in new window

(line 30)
Hope this helps.
0
 

Author Comment

by:Tolgar
ID: 36560742
Hi,
I did the changes you recommended but it still does not return any values. When I debug, the geckLogin works fine at line 40. When I go to line 92 and say the following commands:
x @ALLFiles 
x @CRS
x @CSS

Open in new window


they all return something like this:
DB<2> x @CSS
0  ARRAY(0x155b430)
     empty array

Open in new window




This is how I call my subroutine.
my $cache_data = submitFileParser($cache);

Open in new window



This is the subroutine I use.
sub submitFileParser ($) {
  my $filename = shift;
  my @paragraphs;

  open( FILE, "< $filename" ) or die "Can't open $filename : $!";
  @paragraphs = <FILE>;
  close FILE;
  return read_paragraphs (@paragraphs);
}
sub read_paragraphs (@) {
        # read lines as parameters
        my @rippedParagraphs = @_;

        # Storage for all sections
        my (@CRS, @RRS, @CSS, @ALLFiles, @Options);
        # Temporary storages for single section of each type
        my (@Files, @CR, @RR, @CS);
        # Flags for file traversal logic
        my ($opt_flag, $file_flag);

		my $submit_file = 0;
        #read the file
        for ( @rippedParagraphs ) {
			if (/^\s*Submit\s+file\s*$/) {
				$submit_file = 1;
			next;
			}
			if ($submit_file == 1) {
				if(/^\s*\=+\s*$/) {
				$submit_file++;
			}
			else {
				$submit_file = 0; # two-line grammar didn't hold
			}
			next;
			}
			if ($submit_file == 2) {
				# Match the login name in the submit file
				if(m|^\#\s*Sandbox\s+location\s*\:\s*\S*/sandbox/(.*?)/|) {
				   $geckLogin = $1;
				}
			}
                # If we encounter a comment or empty string
                if (/^\#/ || !/\S/) {
                        # we haven't encountered an option to start doing anything
                        next unless $opt_flag || $file_flag;
                        # If we're in file reading stage
                        if ($file_flag) {
                                # Means section reading is over, let's append to the general
                                # storage arrays
                                push(@ALLFiles, [@Files]) if @Files;
                                push(@CRS, [@CR]) if @CR;
                                push(@CSS, [@CS]) if @CS;
                                push(@RRS, [@RR]) if @RR;
                                # and reset temporary storages
                                @Files = @CR = @CS = @RR = ();
                        }
                        # If we're done with options, let's start reading file sections
                        if ($opt_flag == 1) {
                                $opt_flag = 0;
                                $file_flag = 1;
                        }
                        elsif ($opt_flag > 1) {
                                # Addresses the empty line within Options:
                                $opt_flag--;
                        }
                        next;
                }
                if (/^Options/) {
                        # We start reading options
                        $opt_flag = 2;
                        next;
                
                # Matching beginning of the line to determine the type of the string
                # and placing it in temporary storage
                /^R(R|elated\sRecords):\s*(.*\n)/ && push(@RR, $_) && next;
                /^C(R|ode\sReviewer):\s*(.*\n)/ && push(@CR, $_) && next;
                /^C(S|omments):\s*(.*\n)/ && push(@CS, $_) && next;

#                /^CR:/ && push(@CR, $_) && next;
#                /^CS:/ && push(@CS, $_) && next;
#                /^RR:/ && push(@RR, $_) && next;
                # General text is either files or options info, depending on the
                # value of the option flag
                $opt_flag ? push(@Options, $_) : push(@Files, $_);
				}		
		}
        # Let's put the last read section into storages
        push(@ALLFiles, [@Files]);
        push(@CRS, [@CR]);
        push(@CSS, [@CS]);
        push(@RRS, [@RR]);
        # And we return the full datastructure - hashref of populated storage
        return {
                "Options"              => [@Options],
                "Files"                => [@ALLFiles],
                "Comments"             => [@CSS],
                "RelatedRecords"      => [@RRS],
                "CodeReviewers"       => [@CRS],
				"GeckLogin" 		   => $geckLogin,
        };
}

Open in new window


The files I process is same as in the previous post. (ID: 36552673)



Why do you think it still does not work?
0
 
LVL 9

Expert Comment

by:parparov
ID: 36560816
After your call to submitFileParser($cache);
please add two following lines:
use Data::Dumper;
print Dumper $cache_data;

Open in new window

Debug until after the print, study the output, and if it seems to you it lacks something, or you don't understand something, paste it here and I'll look.
0
 

Author Comment

by:Tolgar
ID: 36561153
Hi,
I added these lines and this is the output:

229:                print Dumper $cache_data;
  DB<2> n
$VAR1 = {
          'RelatedRecords' => [
                                []
                              ],
          'Comments' => [
                          []
                        ],
          'GeckLogin' => 'testman',
          'Options' => [],
          'CodeReviewers' => [
                               []
                             ],
          'Files' => [
                       []
                     ]
        };

Open in new window



I think I still cannot catch the data.

What do you think?

thanks,
0
 
LVL 9

Expert Comment

by:parparov
ID: 36561721
You forgot to add the other fix I pointed at a few comments below, about incorrect parenthesis on if $submit_file == 2
0
 

Author Comment

by:Tolgar
ID: 36562347
ok. now it works. But there are a few issues:

1- I cannot distinguish which part is for Submit File 1 and which part is for Submit file 2. they are all flattened. Can we do something to separate them?

2- In the Files array "Mail sent to" is also assumed as a file. But it is not. Why do we catch it?

3- Why do i get empty element in the array for Comments, Related Records and Code reviewers? It may be due to blank line. Is it possible to get rid of it?

Here is the output I am talking about:

 DB<5> x @Options
0  "-CJ \"<a href='http://www-sandbox/testman/Atk_tests/glnxa64'>/sandbox/testman/Atk_tests/glnxa64</a>\"\cM\cJ"
1  "-nowrap\cM\cJ"
2  "-subject \"Unlocking making changes\"\cM\cJ"
3  "-KEYWORD1\cM\cJ"
4  "-KEYWORD2\cM\cJ"
5  "-CJ \"<a href='http://www-sandbox/testman/Atk_tests/glnxa64'>/sandbox/testman/Atk_tests/glnxa64</a>\"\cM\cJ"
6  "-nowrap\cM\cJ"
7  "-subject \"Unlocking making changes\"\cM\cJ"
8  "-KEYWORD1\cM\cJ"
9  "-KEYWORD2\cM\cJ"
  DB<6> x @Files
0  ARRAY(0x161ba00)
   0  "st/ert/variants/variants5.c\cM\cJ"
1  ARRAY(0x161bcc0)
   0  "Mail sent to:\cM\cJ"
   1  "    st.devel.submit: Unlocking making changes\cM\cJ"
   2  "    Files:\cM\cJ"
   3  "    st/ert/variants/variants5.c\cM\cJ"
2  ARRAY(0x161bfc0)
   0  "matlab/test/toolbox/rtw/targets/ert/codevariants/myprequal_1.m\cM\cJ"
3  ARRAY(0x161bf80)
   0  "Mail sent to:\cM\cJ"
   1  "    mw.devel.submit.simulink: Unlocking a library before making changes\cM\cJ"
   2  "    Files:\cM\cJ"
   3  "    matlab/test/toolbox/rtw/targets/ert/codevariants/myprequal_2.m\cM\cJ"
  DB<7> x @Comments
0  ARRAY(0x161bb40)
   0  "CS: Unlocking before making changes\cM\cJ"
1  ARRAY(0x1621160)
   0  "CS: locking a library before making changes\cM\cJ"
2  ARRAY(0x1621220)
     empty array
  DB<8> x @Related_Records
0  ARRAY(0x161bc00)
   0  "RR: 123456\cM\cJ"
1  ARRAY(0x1621190)
   0  "RR: 123456\cM\cJ"
2  ARRAY(0x1621240)
     empty array
  DB<9> x @Code_Reviewers
0  ARRAY(0x161ba80)
   0  "CR: testman2\cM\cJ"
1  ARRAY(0x161c4a0)
   0  "CR: testman2\cM\cJ"
2  ARRAY(0x1621200)
     empty array
  DB<10> x $Geck_Login
0  'testman'

Open in new window


Thanks,
0
 
LVL 9

Expert Comment

by:parparov
ID: 36563141
The problem is that we're trying to sew together various solutions to isolated problems you posted earlier. For example, we never knew that the Options must be broken per entry, and even that overall entries may be several per file.

It looks like once again you need to post an as representative as possible example of input and output, and we'd try to adjust the source code accordingly.
0
 

Author Comment

by:Tolgar
ID: 36563246
you are right. I will post it in a few minutes.

Thanks,
0
 

Author Comment

by:Tolgar
ID: 36563438
Follow up question:

ID: 27316317

Thanks,
0

Featured Post

How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

Join & Write a Comment

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 …
In the distant past (last year) I hacked together a little toy that would allow a couple of Manager types to query, preview, and extract data from a number of MongoDB instances, to their tool of choice: Excel (http://dilbert.com/strips/comic/2007-08…
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…
Access reports are powerful and flexible. Learn how to create a query and then a grouped report using the wizard. Modify the report design after the wizard is done to make it look better. There will be another video to explain how to put the final p…

744 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

Need Help in Real-Time?

Connect with top rated Experts

11 Experts available now in Live!

Get 1:1 Help Now