I am new to PERL and even newer to ExifTool—and am therefore likely missing something quite basic.
The goal is to read XMP fields from a photo file. Looking at the exiftool documentation on both the ExifTool site and CPAN, I was able to read tagged jpeg and the XMP sidecar files, both without issues.
The problem is when I read from a raw file—which obviously doesn't have custom fields—I would get an error with an uninitialized value. That is to be expected.
So, I want to have code that says "if you read a field/tag from the raw file and it isn't there, look at the associated XMP file, and if that fails, return a blank string."
I therefore tried to open a second instance of ExifTool, such as:
my $exifInfo = ImageInfo($filePath);
goes to
my $exifInfoXMP = ImageInfo($filePathXMP);
But that keeps failing. If I read the XMP directly from the get-go, it works just fine, so I am getting the impression that I cannot read two ExifTool structures at the same time (which can't be right; I have to be the error here). The code below works, but I cannot "interleave" the conditionals on the two files. I have to process the raw first, then run a second pass with a new handler for the XMP. Knowing how efficient PERL is, my approach cannot possibly be a good one (even though it does the job).
In particular, there is one line that puzzles me. If I remove it, nothing works. (it should be well marked).
$filePath =~ s/$photoExtensions$/.XMP/i;
That line essential does the same as reading the XMP from the get-go (not my ideal solution).
Anyone have an idea as to where I am messing up?
Thanks,
Paul
header [EDITED TO SHOW ALL OPTIONS; HAD SHOWN ALL USED IN QUESTION]
#!/usr/bin/perl
# load standard packages
use strict;
use warnings;
use Data::Dumper;
use File::Find;
no warnings 'File::Find';
use Image::ExifTool ':Public';
# define proxy for ExifTool
my $exifTool = new Image::ExifTool;
my $exifToolXMP = new Image::ExifTool;
# turn on immediate updates
$|=1;
# common extensions that I want to recognize
my $photoExtensions = "\.(jpg|crw|cr2|cr3|rw2|orf|raw|nef|arw|dng)";
my $imageExtensions = "\.(tiff|tif|psd|png|eps|hdr|exr|svg|gif|afphoto|pdf)";
my $videoExtensions = "\.(flv|vob|ogv|avi|mts|m2ts|mov|qt|wmv|mp4|m4p|m4v|svi|3gp|3g2)";
my $audioExtensions = "\.(aiff|aac|wav|mp3|m4a|m4p|ogg|wma)";
my $appFileExtensions = "\.(on1|cos|cof)";
my $GPSFileExtensions = "\.(gpx|kml|kmz|log)";
# start main program
main();
routine in question
sub listKeywords {
print "Reads and displays file information from certain tags (typically set in Photomechanic):\n";
print "\t1. Subject\n";
print "\t2. Hierarchical Subject\n";
print "\t3. Supplemental Categories\n";
print "\t4. Label Name 1\n";
print "\t5. Label Name 2\n";
print "\t6. Label Name 3\n";
print "\t7. Label Name 4\n\n";
print "List Keywords ---\n\tEnter file name (with path) --> ";
my $filePath = <STDIN>;
chomp $filePath;
$filePath =~ s/\\//g;
$filePath =~ s/\s+$//;
########################################################
# COMMENT OUT THE FOLLOWING LINE AND NOTHING WORKS;
# $filePathXMP should be defined anyway, which suggests to
# me that the second invocation of ImageInfo doesn't actually occur.
# But I don't understand why.
$filePath =~ s/$photoExtensions$/.XMP/i;
print "\n\n";
my $filePathXMP = $filePath;
$filePathXMP =~ s/$photoExtensions$/.XMP/i; # TO FIX: filename may not have uppercase extension
# Get Exif information from image file
my $exifInfo = $exifTool->ImageInfo($filePath);
# my $exifInfoXMP = $exifToolXMP->ImageInfo($filePath =~ s/$photoExtensions$/.XMP/gi);
print "XMP Sidecar: \[$filePathXMP\]\n\n";
########################################################
# Get Specific Tag Value
my $hierarchicalSubject = $exifTool->GetValue('HierarchicalSubject');
my $subject = $exifTool->GetValue('Subject');
my $supplementalCategories = $exifTool->GetValue('SupplementalCategories');
my $labelName1 = $exifTool->GetValue('LabelName1');
my $labelName2 = $exifTool->GetValue('LabelName2');
my $labelName3 = $exifTool->GetValue('LabelName3');
my $labelName4 = $exifTool->GetValue('LabelName4');
my $exifInfo = ImageInfo($filePathXMP);
if (not defined $hierarchicalSubject) {$hierarchicalSubject = $exifTool->GetValue('HierarchicalSubject');}
if (not defined $hierarchicalSubject) {$hierarchicalSubject = "";}
if (not defined $subject) {$subject = $exifTool->GetValue('Subject');}
if (not defined $subject) {$subject = "";}
if (not defined $supplementalCategories) {$supplementalCategories = $exifTool->GetValue('SupplementalCategories');}
if (not defined $supplementalCategories) {$supplementalCategories = "";}
if (not defined $labelName1) {$labelName1 = $exifTool->GetValue('LabelName1');}
if (not defined $labelName1) {$labelName1 = "";}
if (not defined $labelName2) {$labelName2 = $exifTool->GetValue('LabelName2');}
if (not defined $labelName2) {$labelName2 = "";}
if (not defined $labelName3) {$labelName3 = $exifTool->GetValue('LabelName3');}
if (not defined $labelName3) {$labelName3 = "";}
if (not defined $labelName4) {$labelName4 = $exifTool->GetValue('LabelName4');}
if (not defined $labelName4) {$labelName4 = "";}
print "Subject:\n------------------------------\n$subject\n\n";
print "Hierarchical Subject:\n------------------------------\n$hierarchicalSubject\n\n";
print "Supplemental Categories:\n------------------------------\n$supplementalCategories\n\n";
print "Label Name 1:\n------------------------------\n$labelName1\n\n";
print "Label Name 2:\n------------------------------\n$labelName2\n\n";
print "Label Name 3:\n------------------------------\n$labelName3\n\n";
print "Label Name 4:\n------------------------------\n$labelName4\n\n";
}
As your code is incomplete, I have to ask: did you make sure to start your script with the following lines?
use strict;
use warnings;
Those two lines are not there to annoy you, they will protect you from simple mistakes you might have made in your code.
IMHO the real problem with your sub listKeywords() is the following line:
my $exifInfo = ImageInfo($filePathXMP);
There are two problems here:
you redefine the variable $exifInfo from a few lines before.
you are not using the OO approach for the 2nd image info.
I think what you intended to write was the following line:
my $exifInfoXMP = $exifToolXMP->ImageInfo($filePathXMP);
Related
Below is the Perl code in .pm file which is supposed to replace the specified strings (that are in "quotes") with some values. But its not happening. Can anyone explain what is happening in this code?
package SomePackage;
require Exporter;
#ISA = qw(Exporter);
#EXPORT = qw(send_request, create_mmd_and_transfer, update_mmd_file);
sub send_request {
my ( $service, $action, $torole ) = #_;
my ( $seller_request_mmd );
my $replace_contents = ();
$replace_contents{"REPLACE_Service"} = $service;
$replace_contents{"REPLACE_RequestAction"} = $action;
$replace_contents{"REPLACE_TradingPartner"} = $torole;
$replace_contents{"REPLACE_Requestxml"} = "Request.xml";
create_mmd_and_transfer( \%replace_contents, $seller_request_mmd, "/MMD.xml" );
}
sub create_mmd_and_transfer {
my $local_replace_contents = shift;
my $input_mmd = shift;
my $local_output_mmd = shift;
my $output_mmd = shift;
update_mmd_file( "$input_mmd", "temp_mmd_file.xml", $local_replace_contents );
}
sub update_mmd_file {
my $input_file = shift;
my $output_file = shift;
my $contents = shift;
open( MMD_FILE, "<$input_file" )
or main::error_exit(" Cannot open MMD file template $input_file \n $input_file not found int the Templates folder \n Please place the same and then run the script ");
open( TEMP_MMD_FILE, ">$output_file" );
while ( <MMD_FILE> ) {
s/^M//g; # Getrid of the ^Ms
foreach my $content ( keys( %$contents ) ) {
my $exact_value = ${%$contents}{$content};
if ( $main::test_scenario =~ /^Invalid Request Action \a\n\d Service/
and ( $content =~ /REPLACE_Service|REPLACE_RequestAction/i ) ) {
}
else {
if ( $exact_value ne "" ) {
s/$content/$exact_value/g;
}
}
}
print TEMP_MMD_FILE;
}
close MMD_FILE;
close TEMP_MMD_FILE;
}
The following will not make your script work, just create the better base for some future questions.
Before you even thinking about posting a perl question here:
1.) add to the top of your script:
use strict;
use warnings;
Posting a code here without these two lines, nobody will bother even trying to read the code.
2.) use perl -c SomePackage.pm for the check. If it will tell you: SomePackage.pm syntax OK - you can start thinking about posting a question here. ;)
Some basic problems with your script:
package SomePackage;
use strict; # see the above
use warnings;
require Exporter;
# these variables are defined outside of this package, so, tell perl this fact. use the `our`
our #ISA = qw(Exporter);
#the use warnings will warn you about the following line
# #EXPORT = qw(send_request, create_mmd_and_transfer, update_mmd_file);
#the correct one is without commas
our #EXPORT = qw(send_request create_mmd_and_transfer update_mmd_file); #not saying anything about the #EXPORT rudeness. :)
#my $replace_contents = ();
#the $replace_contents is a scalar. Bellow you using a hash. So,
my %replace_contents;
#or use the scalar but the lines bellow should use the hashref notation, e.g.
# $replace_contents->{"REPLACE_Service"} = $service;
# you decide. :)
# the seller_request_mmd contains undef here.
create_mmd_and_transfer( \%replace_contents, $seller_request_mmd, "/MMD.xml");
# also bellow, in the subroutine definition it wants 4 arguments.
# indicates a problem...
# using 2-arg open is not the best practice.
# Also, you should to use lexical filehandles
# open (MMD_FILE, "<$input_file")
# better
open (my $mmd_file, '<', $input_file)
# of course, you need change every MMD_FILE to $mmd_file
# check the result of the open and die if not successful
# or you can use the
use autodie;
# instead of $exact_value = ${%$contents}{$content};
# you probably want
my $exact_value = $contents->{$content};
Indent your code!
All the above are just about the syntactic problems and not solving anything about the "logic" of your code.
Ps: And me is still an beginner, so, others sure will find much more problems with the above code.
Ok. Here's what I've done to test this.
Firstly, you didn't give us an input file or the code that you use to call the module. So I invented them. I made the simplest possible input file:
REPLACE_Service
REPLACE_RequestAction
REPLACE_TradingPartner
REPLACE_Requestxml
And this driver program:
#!/usr/bin/perl
use strict;
use warnings;
use SomePackage;
send_request('foo', 'bar', 'baz');
sub error_exit {
die #_;
}
The first time, I ran it, I got this error:
Undefined subroutine &main::send_request called at test line 8.
That was because your #EXPORT line was wrong. You had:
#EXPORT = qw(send_request, create_mmd_and_transfer, update_mmd_file);
But the point of qw(...) is that you don't need the commas. So I corrected it to:
#EXPORT = qw(send_request create_mmd_and_transfer update_mmd_file);
Then I re-ran the program and got this error:
Cannot open MMD file template
not found int the Templates folder
Please place the same and then run the script at test line 11.
That looked like there was something missing. I changed the error message, adding indicators of where the variable interpolation was supposed to happen:
open( MMD_FILE, "<$input_file" )
or main::error_exit(" Cannot open MMD file template <$input_file> \n <$input_file> not found int the Templates folder \n Please place the same and then run the script ");
Then the error message looked like this:
Cannot open MMD file template <>
<> not found int the Templates folder
Please place the same and then run the script at test line 11.
So it seems clear that the $input_file variable isn't set in the update_mmd_file() subroutine. Tracing that variable back, we see that this value is originally the $seller_request_mmd variable in send_request(). But in send_request() you declare $seller_request_mmd but you never give it a value. So let's do that:
my ( $seller_request_mmd ) = 'test_input.txt';
Now, when I run your program, it runs to completion without any errors. And I find a new temp_mmd_file.xml is generated. But it is exactly the same as the input file. So more investigation is needed.
Digging into the update_mmd_file() subroutine, we find this interesting line:
my $exact_value = ${%$contents}{$content};
I think you're trying to extract a value from $contents, which is a hash reference. But your syntax is wrong. You were probably aiming at:
my $exact_value = ${$contents}{$content};
But most Perl programmers prefer the arrow notation for working with reference look-ups.
my $exact_value = $contents->{$content};
Making that change and re-running the program, I get an output file that contains:
foo
bar
baz
Request.xml
Which is exactly what I expected. So the program now works.
But there is still a lot of work to do. As you have been told repeatedly, you should always add:
use strict;
use warnings;
to your code. That will find a lot of potential problems in your code - which you should fix.
To be honest, this feels to me like you were trying to run before you could walk. I'd recommend spending some time to work through a good Perl introductory book before taking on my more Perl work.
And there was a lot of useful information missing from your question. It wouldn't have taken as long to get to the solution if you had shown us your driver program and your input data.
I have a Perl CGI script for online concordance application that searches for an instance of word in a text and prints the sorted output.
#!/usr/bin/perl -wT
# middle.pl - a simple concordance
# require
use strict;
use diagnostics;
use CGI;
# ensure all fatals go to browser during debugging and set-up
# comment this BEGIN block out on production code for security
BEGIN {
$|=1;
print "Content-type: text/html\n\n";
use CGI::Carp('fatalsToBrowser');
}
# sanity check
my $q = new CGI;
my $target = $q->param("keyword");
my $radius = $q->param("span");
my $ordinal = $q->param("ord");
my $width = 2*$radius;
my $file = 'concordanceText.txt';
if ( ! $file or ! $target ) {
print "Usage: $0 <file> <target>\n";
exit;
}
# initialize
my $count = 0;
my #lines = ();
$/ = ""; # Paragraph read mode
# open the file, and process each line in it
open(FILE, " < $file") or die("Can not open $file ($!).\n");
while(<FILE>){
# re-initialize
my $extract = '';
# normalize the data
chomp;
s/\n/ /g; # Replace new lines with spaces
s/\b--\b/ -- /g; # Add spaces around dashes
# process each item if the target is found
while ( $_ =~ /\b$target\b/gi ){
# find start position
my $match = $1;
my $pos = pos;
my $start = $pos - $radius - length($match);
# extract the snippets
if ($start < 0){
$extract = substr($_, 0, $width+$start+length($match));
$extract = (" " x -$start) . $extract;
}else{
$extract = substr($_, $start, $width+length($match));
my $deficit = $width+length($match) - length($extract);
if ($deficit > 0) {
$extract .= (" " x $deficit);
}
}
# add the extracted text to the list of lines, and increment
$lines[$count] = $extract;
++$count;
}
}
sub removePunctuation {
my $string = $_[0];
$string = lc($string); # Convert to lowercase
$string =~ s/[^-a-z ]//g; # Remove non-aplhabetic characters
$string =~ s/--+/ /g; #Remove 2+ hyphens with a space
$string =~s/-//g; # Remove hyphens
$string =~ s/\s=/ /g;
return($string);
}
sub onLeft {
#USAGE: $word = onLeft($string, $radius, $ordinal);
my $left = substr($_[0], 0, $_[1]);
$left = removePunctuation($left);
my #word = split(/\s+/, $left);
return($word[-$_[2]]);
}
sub byLeftWords {
my $left_a = onLeft($a, $radius, $ordinal);
my $left_b = onLeft($b, $radius, $ordinal);
lc($left_a) cmp lc($left_b);
}
# process each line in the list of lines
print "Content-type: text/plain\n\n";
my $line_number = 0;
foreach my $x (sort byLeftWords #lines){
++$line_number;
printf "%5d",$line_number;
print " $x\n\n";
}
# done
exit;
The perl script produces expected result in terminal (command line). But the CGI script for online application produces unexpected output. I cannot figure out what mistake I am making in the CGI script. The CGI script should ideally produce the same output as the command line script. Any suggestion would be very helpful.
Command Line Output
CGI Output
The BEGIN block executes before anything else and thus before
my $q = new CGI;
The output goes to the server process' stdout and not to the HTTP stream, so the default is text/plain as you can see in the CGI output.
After you solve that problem you'll find that the output still looks like a big ugly block because you need to format and send a valid HTML page, not just a big block of text. You cannot just dump a bunch of text to the browser and expect it to do anything intelligent with it. You must create a complete HTML page with tags to layout your content, probably with CSS as well.
In other words, the output required will be completely different from the output when writing only to the terminal. How to structure it is up to you, and explaining how to do that is out of scope for StackOverflow.
As the other answers state, the BEGIN block is executed at the very start of your program.
BEGIN {
$|=1;
print "Content-type: text/html\n\n";
use CGI::Carp('fatalsToBrowser');
}
There, you output an HTTP header Content-type: text/html\n\n. The browser sees that first, and treats all your output as HTML. But you only have text. Whitespace in an HTML page is collapsed into single spaces, so all your \n line breaks disappear.
Later, you print another header, the browser cannot see that as a header any more, because you already had one and finished it off with two newlines \n\n. It's now too late to switch back to text/plain.
It is perfectly fine to have a CGI program return text/plain and just have text without markup be displayed in a browser when all you want is text, and no colors or links or tables. For certain use cases this makes a lot of sense, even if it doesn't have the hyper in Hypertext any more. But you're not really doing that.
Your BEGIN block serves a purpose, but you are overdoing it. You're trying to make sure that when an error occurs, it gets nicely printed in the browser, so you don't need to deal with the server log while developing.
The CGI::Carp module and it's functionality fatalsToBrowser bring their own mechanism for that. You don't have to do it yourself.
You can safely remove the BEGIN block and just put your use CGI::CARP at the top of the script with all the other use statements. They all get run first anyway, because use gets run at compile time, while the rest of your code gets run at run time.
If you want, you can keep the $|++, which turns off the buffering for your STDOUT handle. It gets flushed immediately and every time you print something, that output goes directly to the browser instead of collecting until it's enough or there is a newline. If your process runs for a long time, this makes it easier for the user to see that stuff is happening, which is also useful in production.
The top of your program should look like this now.
#!/usr/bin/perl -T
# middle.pl - a simple concordance
use strict;
use warnigns;
use diagnostics;
use CGI;
use CGI::Carp('fatalsToBrowser');
$|=1;
my $q = CGI->new;
Finally, a a few quick words on the other parts I deleted from there.
Your comment requires over the use statements is misleading. Those are use, not require. As I said above, use gets run at compile time. require on the other hand gets run at run time and can be done conditionally. Misleading comments will make it harder for others (or you) to maintain your code later on.
I removed the -w flag from the shebang (#!/usr/bin/perl) and put the use warnings pragma in. That's a more modern way to turn on warnings, because sometimes the shebang can be ignored.
The use diagnostics pragma gives you extra long explanations when things go wrong. That's useful, but also extra slow. You can use it during development, but please remove it for production.
The comment sanity check should be moved down under the CGI instantiation.
Please use the invocation form of new to instantiate CGI, and any other classes. The -> syntax will take care of inheritance properly, while the old new CGI cannot do that.
I ran your cgi. The BEGIN block is run regardless and you print a content-type header here - you have explicitly asked for HTML here. Then later you attemp to print another header for PLAIN. This is why you can see the header text (that hasn't taken effect) at the beginning of the text in the browser window.
I'm experiencing a rather odd problem while using Data::Dumper to try and check on my importing of a large list of data into a hash.
My Data looks like this in another file.
##Product ID => Market for product
ABC => Euro
XYZ => USA
PQR => India
Then in my script, I'm trying to read in my list of data into a hash like so:
open(CONFIG_DAT_H, "<", $config_data);
while(my $line = <CONFIG_DAT_H>) {
if($line !~ /^\#/) {
chomp($line);
my #words = split(/\s*\=\>\s/, $line);
%product_names->{$words[0]} = $words[1];
}
}
close(CONFIG_DAT_H);
print Dumper (%product_names);
My parsing is working for the most part that I can find all of my data in the hash, but when I print it using the Data::Dumper it doesn't print it properly. This is my output.
$VAR1 = 'ABC';
';AR2 = 'Euro
$VAR3 = 'XYZ';
';AR4 = 'USA
$VAR5 = 'PQR';
';AR6 = 'India
Does anybody know why the Dumper is printing the '; characters over the first two letters on my second column of data?
There is one unclear thing in the code: is *product_names a hash or a hashref?
If it is a hash, you should use %product_names{key} syntax, not %product_names->{key}, and need to pass a reference to Data::Dumper, so Dumper(\%product_names).
If it is a hashref then it should be labelled with a correct sigil, so $product_names->{key} and Dumper($product_names}.
As noted by mob if your input has anything other than \n it need be cleaned up more explicitly, say with s/\s*$// per comment. See the answer by ikegami.
I'd also like to add, the loop can be simplified by loosing the if branch
open my $config_dat_h, "<", $config_data or die "Can't open $config_data: $!";
while (my $line = <$config_dat_h>)
{
next if $line =~ /^\#/; # or /^\s*\#/ to account for possible spaces
# ...
}
I have changed to the lexical filehandle, the recommended practice with many advantages. I have also added a check for open, which should always be in place.
Humm... this appears wrong to me, even you're using Perl6:
%product_names->{$words[0]} = $words[1];
I don't know Perl6 very well, but in Perl5 the reference should be like bellow considering that %product_names exists and is declared:
$product_names{...} = ... ;
If you could expose the full code, I can help to solve this problem.
The file uses CR LF as line endings. This would become evident by adding the following to your code:
local $Data::Dumper::Useqq = 1;
You could convert the file to use unix line endings (seeing as you are on a unix system). This can be achieved using the dos2unix utility.
dos2unix config.dat
Alternatively, replace
chomp($line);
with the more flexible
$line =~ s/\s+\z//;
Note: %product_names->{$words[0]} makes no sense. It happens to do what you want in old versions of Perl, but it rightfully throws an error in newer versions. $product_names{$words[0]} is the proper syntax for accessing the value of an element of a hash.
Tip: You should be using print Dumper(\%product_names); instead of print Dumper(%product_names);.
Tip: You might also find local $Data::Dumper::Sortkeys = 1; useful. Data::Dumper has such bad defaults :(
Tip: Using split(/\s*=>\s*/, $line, 2) instead of split(/\s*=>\s*/, $line) would permit the value to contain =>.
Tip: You shouldn't use global variable without reason. Use open(my $CONFIG_DAT_H, ...) instead of open(CONFIG_DAT_H, ...), and replace other instances of CONFIG_DAT_H with $CONFIG_DAT_H.
Tip: Using next if $line =~ /^#/; would avoid a lot of indenting.
I am new to perl. My motive is to read some value from a txt file and use it in my perl script.
The text file is something like this ::
Servers ::
(local)
Tomas-Server1
Tomas-Server2
.........**
What i need to do is to get the 3rd line value (Tomas-Server2) and use it in my perl script. basically its calling the 3rd value to the perl script.
I have written a basic code for it ::
my($ServName1,$ServName,$ServName3) = getservername($servername);
my ($filenam) = 'data.txt';
my #Param = ();
open(INFILE,"<$filenam") or die "Couldn't open $filenam for reading\n";
while(<INFILE>) {
chop($_);
push(#Param,$_);
}
close(INFILE);
return #Param;
}
But when i try to use the "$ServName2" value , it does not return anything. I guess the value contained should be "(local)" for it.
There a few problems with you example data, but I think I understand what you are trying to do. Assuming that you want the third server value (and not just line #3) you would probably want to have code that looks something like this...
#!perl
#some includes
use strict;
use warnings;
use Data::Dumper;
#set some vars
my $TargetFileName="data_file.txt";
my $TargetServerNumber=3;
#call the sub
my #ServerArray=GetServerName($TargetFileName);
#did we get anything back?
if(#ServerArray) {
#yep, we got some content
print "Server number ".$TargetServerNumber."/".($#ServerArray+1)." is \"".$ServerArray[$TargetServerNumber-1]."\"\n"; #array numbers are 0-based
} else {
#nope, we read the file but didn't any matching content
print "No servers found in file \"".$TargetFileName."\".\n";
} #end if
print "\n";
print "Here's what was loaded into \#ServerArray...\n";
print Data::Dumper::Dumper(#ServerArray); #so you can see the full content of #ServerArray
print "All Done\n";
exit;
#----- subs go here -----
sub GetServerName {
my $DataFileName=shift; #pull in the first arg - this alters #_ for the rest of the sub, so take care when doing this
my #ReturnArray;
#do some QA
if(!$DataFileName) {die "You need to provide a file name to use this sub.\n"} #do we have a file name?
if(!stat($DataFileName)) {die "The requested file name of \"".$DataFileName."\" does not exist.\n";} #does the file exist?
open(INFILE, "<".$DataFileName) or die "Unable to open \"".$DataFileName."\" - ".$!;
#ok, read the file content
while(my $Line=<INFILE>) {
chop($Line);
$Line=~s/^\s+//g; #remove leading white spaces
$Line=~s/\s+$//g; #remove trailing white spaces
if(!$Line) {next;} #blank line, skip it
#check for the headers
if($Line=~m/^Servers/) {next;} #skip lines beginning with "Servers"
if($Line=~m/^\(local\)/) {next;} #skip lines beginning with "(local)"
#if we get here, we must want the line content, so add it to the array
push(#ReturnArray, $Line);
} #end while
close(INFILE);
#send the array data back, if any
return #ReturnArray
} #end GetServerName sub
__END__
stuff below here does not need to be commented
I admit this is not the best way to approach the problem, but like most Perl hacks, it works. You'll notice the code is a bit overkill and does validation checks before passing data to some operations - get into the habit of doing this in any language you work in. This will help you return more meaningful errors when things go wrong and will also catch data related problems. The sample code also does a bit of data cleanup because leading and trailing will likely cause you problems later on. Blank lines (after cleaning) are also removed.
BTW, the data file I used as an example look like this...
Servers ::
(local)
Tomas-Server1
Tomas-Server2
Tomas-Server3
Tomas-Server4
Tomas-Server5
Tomas-ServerLast
You never define a $ServName2 variable. The variable between $ServName1 and $ServName3 is just named $ServName, with no number.
I've got a perl script and a .config file and want to store some hashes in the config file with some variables as its value, then dynamically change them from my perl script.
Config File:
$hash{"hello"} = ["$blah", "$blah2"];
And my perl script:
if (-e ".config")
{
$blah = "hello";
$blah2 = "world!";
eval ('require(".config")');
$val1 = $hash{"hello"}[0];
$val2 = $hash{"hello"}[1];
print "$val1 $val2\n";
# Now I want to CHANGE blah and blah2
$blah = "world!";
$blah2 = "hello";
$val1 = $hash{"hello"}[0];
$val2 = $hash{"hello"}[1];
print "$val1 $val2\n";
}
But both prints show hello world! as if the change didn't happen.. Am I missing something?
Thanks.
(Strange... I've never seen a question of this sort previously, and then variations on it (which are different enough to clearly not be just a cross-post) appeared both here and on PerlMonks in the same day.)
The point you're missing is that
$hash{"hello"} = ["$blah", "$blah2"];
just copies the values of $blah and $blah2 into (an anonymous array referenced by) $hash{hello}. It does not create any lasting connection between the hash and $blah/$blah2.
As a side note, none of the quotes in that line serve any purpose. It would more commonly be written as:
$hash{hello} = [$blah, $blah2];
Or, if you want to create references so that $blah and $hash{hello}[0] are forever linked and changing one will also change the other:
$hash{hello} = [\$blah, \$blah2];
Note that in this case, you must not use quotes. Although "$blah" and $blah are equivalent, "\$blah" and \$blah are not - \$blah gives you a reference to $blah, but "\$blah" gives you the literal string "$blah" with no variables involved at all.