Perl: How to detect which file exists among foo.(txt|abc) - perl

My perl script needs to detect the extension of an existing file and print out the filename. The input that specifies the filename with a vague extension would be in this format:
foo.(txt|abc)
and the script would print "foo.txt" if it exists. If foo.txt does not exist and foo.abc exists, then it would print "foo.abc."
How can I do this detection and printing of the correct existing file in a neat and clean way?
Thanks!

Actually, you've almost got the regular expression right there: the only thing you need to do is escape the . with a backslash (since . means "any character except the newline character" in regular expressions), and it would also help to put a ?: inside of the parentheses (since you don't need to capture the file extension). Also, ^ and $ denote markers for the beginning and the end of the string (so we're matching the entire string, not just part of a string...that way we don't get a match for the file name "thisisnotfoo.txt")
Something like this should work:
use strict;
use warnings;
my $file1="foo.txt";
my $file2="foo.abc";
my $file3="some_other_file";
foreach ($file1,$file2,$file3)
{
if(/^foo\.(?:txt|abc)$/)
{
print "$_\n";
}
}
When the above code is run, the output is:
foo.txt
foo.abc
Take a look at perldoc perlretut for more stuff about regular expressions.

You may want to look at glob, but you'd have to use a different syntax. The equivalent would be:
foo.{txt,abc}
See File::Glob for more information. Also note that this will return a list of all of the matches, so you'll have to do your own rules if it should prefer one when multiple exist.

sub text_to_glob {
my ($s) = #_;
$s =~ s/([\\\[\]{}*?~\s])/\\$1/g;
return $s;
}
my $pat = 'foo.(txt|abc)';
my #possibilities;
if (my ($base, $alt) = $pat =~ /^(.*\.)\(([^()]*)\)\z/s) {
#possibilities = glob(
text_to_glob($base) .
'{' . join(',', split(/\|/, $alt)) . '}'
);
} else {
#possibilities = $pat;
}
for my $possibility (#possibilities) {
say "$possibility: ", -e $possibility ? "exists" : "doesn't exist";
}
glob, but also see File::Glob
-e

use strict;
use warnings;
FILE:
for (glob "file.{txt,abc}") {
if (-f $_) {
print $_, "\n";
last FILE;
}
}

Related

Find words in string

I would like to show in result three words "hidden". I don't know how to do this. Right now, when I start the program, I don't have effect. I see only my text. How to repair it ? I want to create simple program. I have my string and I want to show words which I want to find in my result.
use strict;
my $text='Try to find the hidden string here! Hidden or hidden';
my $a = m/\bhidden\b/;
if ($text=~ $a) {
print "I found word: $a";
}
else {
print "No match, sorry.\n";
}
Let's see how we could debug this problem.
Your first step should be to add use warnings to your code. You should always include both use strict and use warnings. They are like Perl's safety nets and only a foolhardy programmer codes without them.
#!/usr/bin/perl
use strict;
use warnings; # ADDED THIS
my $text='Try to find the hidden string here! Hidden or hidden';
my $a = m/\bhidden\b/;
if ($text=~ $a) {
print "I found word: $a";
}
else {
print "No match, sorry.\n";
}
Now we get a warning:
Use of uninitialized value $_ in pattern match (m//) at test_re line 8.
Line 8 is this:
if ($text=~ $a) {
So let's see what is in $a (as an aside - please don't use $a as a variable name. Firstly, it's a terrible, generic name; and, secondly, Perl uses it as a special variable in the sort function):
#!/usr/bin/perl
use strict;
use warnings;
use feature 'say'; # ADDED THIS
my $text='Try to find the hidden string here! Hidden or hidden';
my $a = m/\bhidden\b/;
say "\$a is [$a]"; # ADDED THIS
if ($text=~ $a) {
print "I found word: $a";
}
else {
print "No match, sorry.\n";
}
Now, as well as our warning, we get this output:
$a is []
I don't think you're expecting $a to be empty at that point, are you? We can go further and determine whether it's an empty string or an undefined value.
#!/usr/bin/perl
use strict;
use warnings;
use feature 'say';
my $text='Try to find the hidden string here! Hidden or hidden';
my $a = m/\bhidden\b/;
say "\$a is [$a]";
say "\$a is ", (defined $a ? 'defined' : 'undefined'); # ADDED THIS
if ($text=~ $a) {
print "I found word: $a";
}
else {
print "No match, sorry.\n";
}
And we see:
$a is defined
So it's an empty string. What do you expect it to be?
Here's where is it set?
my $a = m/\bhidden\b/;
I'm not sure what you expected this to do, but it actually means "match \bhidden\b and assign the result of the match to $a". And what does it match against that regex? Well, m/.../ matches the contents of$` by default. (That, incidentally, explains our original "uninitialized value $" warning - Perl just got the line number wrong by one.)
So what actually happens on that line is that Perl tries to match \bhidden\b against $_. This fails (as $_ is undefined) and the match returns a false value (the empty string) that gets assigned to $a.
Then your code goes on to run this:
if ($text=~ $a) {
And, as $a is the empty string, it matches (any string will match against an empty string and Perl tells you it has matched $a (which still contains the empty string).
I'm not sure what you were trying to do with this line:
my $a = m/\bhidden\b/;
Perhaps you were trying "pre-compile" the regex in some way. In which case, you were looking for qr/.../, not m/.../.
So maybe you wanted this:
#!/usr/bin/perl
use strict;
use warnings;
use feature 'say';
my $text = 'Try to find the hidden string here! Hidden or hidden';
my $a = qr/\bhidden\b/; # CHANGED THIS
say "\$a is [$a]";
say "\$a is ", (defined $a ? 'defined' : 'undefined');
if ($text =~ $a) {
print "I found word: $a";
}
else {
print "No match, sorry.\n";
}
Which gives this output:
$a is [(?^:\bhidden\b)]
$a is defined
I found word: (?^:\bhidden\b)
Or, if you want to show what has been matched, rather than the regex that you are matching, then you need to "capture" that text:
#!/usr/bin/perl
use strict;
use warnings;
use feature 'say';
my $text = 'Try to find the hidden string here! Hidden or hidden';
my $a = qr/\b(hidden)\b/; # CHANGED THIS
say "\$a is [$a]";
say "\$a is ", (defined $a ? 'defined' : 'undefined');
if (my ($matched) = $text =~ $a) { # CHANGED THIS
print "I found word: $matched"; # CHANGED THIS
}
else {
print "No match, sorry.\n";
}
Which gives us:
$a is [(?^:\b(hidden)\b)]
$a is defined
I found word: hidden
Ah, but you want to see all of the words. So capture the matches in an array and use the /g option to match multiple times:
#!/usr/bin/perl
use strict;
use warnings;
use feature 'say';
my $text = 'Try to find the hidden string here! Hidden or hidden';
my $a = qr/\b(hidden)\b/;
say "\$a is [$a]";
say "\$a is ", (defined $a ? 'defined' : 'undefined');
if (my (#matched) = $text =~ /$a/g) { # CHANGED THIS
print "I found word: #matched"; # CHANGED THIS
}
else {
print "No match, sorry.\n";
}
We now get this:
$a is [(?^:\b(hidden)\b)]
$a is defined
I found word: hidden hidden
That only matches two instances of "hidden" as the match is case-sensitive. So turn off the case sensitivity with /i.
#!/usr/bin/perl
use strict;
use warnings;
use feature 'say';
my $text = 'Try to find the hidden string here! Hidden or hidden';
my $a = qr/\b(hidden)\b/i; # CHANGED THIS
say "\$a is [$a]";
say "\$a is ", (defined $a ? 'defined' : 'undefined');
if (my (#matched) = $text =~ /$a/g) {
print "I found word: #matched";
}
else {
print "No match, sorry.\n";
}
Which gives us:
$a is [(?^i:\b(hidden)\b)]
$a is defined
I found word: hidden Hidden hidden
But, honestly, I think pre-compiling the regex here is just over-complicating things. I'd write this code like this (removing the $a variable completely):
#!/usr/bin/perl
use strict;
use warnings;
use feature 'say';
my $text = 'Try to find the hidden string here! Hidden or hidden';
if (my (#matched) = $text =~ /\b(hidden)\b/gi) {
print "I found word: #matched";
}
else {
print "No match, sorry.\n";
}
Perhaps you are looking for this piece of code
use strict;
use warnings;
use feature 'say';
my $text='Try to find the hidden string here! Hidden or hidden';
my $re = qr/(hidden)/i; # () capture found ignoring case
my #match = $text =~ /$re/g; # g specifies to look for all accurances
say for #match; # output each element of #match
Output
hidden
Hidden
hidden

Regular expression to validate an email in perl

I am new in Perl and trying to catch hold of the scripting language where I come across regular expression to validate a email address. I am sharing the perl script. I am not sure where I am making mistake in it. The \# part is omitted always following which the correct email id is also showing as invalid.
Here is the code :
#!/usrs/bin/perl/
$string = "XYZ#yahoo.com";
if ( $string =~ /([a-zA-Z]+)\#([a-zA-Z]+)\.(com|net|org)/)
{
print "TRUE";
print $string;
}
else
{
print "FALSE";
print $string;
}
Thanks for your help.
The regex for validating an email address is included in the source code for Email::Valid. I've copied it below:
$RFC822PAT = <<'EOF';
[\040\t]*(?:\([^\\\x80-\xff\n\015()]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-\
xff\n\015()]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015()]*)*\))[^\\\x80-\xf
f\n\015()]*)*\)[\040\t]*)*(?:(?:[^(\040)<>#,;:".\\\[\]\000-\037\x80-\x
ff]+(?![^(\040)<>#,;:".\\\[\]\000-\037\x80-\xff])|"[^\\\x80-\xff\n\015
"]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015"]*)*")[\040\t]*(?:\([^\\\x80-\
xff\n\015()]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\n\015()]*(?:\\[^\x80
-\xff][^\\\x80-\xff\n\015()]*)*\))[^\\\x80-\xff\n\015()]*)*\)[\040\t]*
)*(?:\.[\040\t]*(?:\([^\\\x80-\xff\n\015()]*(?:(?:\\[^\x80-\xff]|\([^\
\\x80-\xff\n\015()]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015()]*)*\))[^\\\
x80-\xff\n\015()]*)*\)[\040\t]*)*(?:[^(\040)<>#,;:".\\\[\]\000-\037\x8
0-\xff]+(?![^(\040)<>#,;:".\\\[\]\000-\037\x80-\xff])|"[^\\\x80-\xff\n
\015"]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015"]*)*")[\040\t]*(?:\([^\\\x
80-\xff\n\015()]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\n\015()]*(?:\\[^
\x80-\xff][^\\\x80-\xff\n\015()]*)*\))[^\\\x80-\xff\n\015()]*)*\)[\040
\t]*)*)*#[\040\t]*(?:\([^\\\x80-\xff\n\015()]*(?:(?:\\[^\x80-\xff]|\([
^\\\x80-\xff\n\015()]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015()]*)*\))[^\
\\x80-\xff\n\015()]*)*\)[\040\t]*)*(?:[^(\040)<>#,;:".\\\[\]\000-\037\
x80-\xff]+(?![^(\040)<>#,;:".\\\[\]\000-\037\x80-\xff])|\[(?:[^\\\x80-
\xff\n\015\[\]]|\\[^\x80-\xff])*\])[\040\t]*(?:\([^\\\x80-\xff\n\015()
]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\n\015()]*(?:\\[^\x80-\xff][^\\\
x80-\xff\n\015()]*)*\))[^\\\x80-\xff\n\015()]*)*\)[\040\t]*)*(?:\.[\04
0\t]*(?:\([^\\\x80-\xff\n\015()]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\
n\015()]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015()]*)*\))[^\\\x80-\xff\n\
015()]*)*\)[\040\t]*)*(?:[^(\040)<>#,;:".\\\[\]\000-\037\x80-\xff]+(?!
[^(\040)<>#,;:".\\\[\]\000-\037\x80-\xff])|\[(?:[^\\\x80-\xff\n\015\[\
]]|\\[^\x80-\xff])*\])[\040\t]*(?:\([^\\\x80-\xff\n\015()]*(?:(?:\\[^\
x80-\xff]|\([^\\\x80-\xff\n\015()]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\01
5()]*)*\))[^\\\x80-\xff\n\015()]*)*\)[\040\t]*)*)*|(?:[^(\040)<>#,;:".
\\\[\]\000-\037\x80-\xff]+(?![^(\040)<>#,;:".\\\[\]\000-\037\x80-\xff]
)|"[^\\\x80-\xff\n\015"]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015"]*)*")[^
()<>#,;:".\\\[\]\x80-\xff\000-\010\012-\037]*(?:(?:\([^\\\x80-\xff\n\0
15()]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\n\015()]*(?:\\[^\x80-\xff][
^\\\x80-\xff\n\015()]*)*\))[^\\\x80-\xff\n\015()]*)*\)|"[^\\\x80-\xff\
n\015"]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015"]*)*")[^()<>#,;:".\\\[\]\
x80-\xff\000-\010\012-\037]*)*<[\040\t]*(?:\([^\\\x80-\xff\n\015()]*(?
:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\n\015()]*(?:\\[^\x80-\xff][^\\\x80-
\xff\n\015()]*)*\))[^\\\x80-\xff\n\015()]*)*\)[\040\t]*)*(?:#[\040\t]*
(?:\([^\\\x80-\xff\n\015()]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\n\015
()]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015()]*)*\))[^\\\x80-\xff\n\015()
]*)*\)[\040\t]*)*(?:[^(\040)<>#,;:".\\\[\]\000-\037\x80-\xff]+(?![^(\0
40)<>#,;:".\\\[\]\000-\037\x80-\xff])|\[(?:[^\\\x80-\xff\n\015\[\]]|\\
[^\x80-\xff])*\])[\040\t]*(?:\([^\\\x80-\xff\n\015()]*(?:(?:\\[^\x80-\
xff]|\([^\\\x80-\xff\n\015()]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015()]*
)*\))[^\\\x80-\xff\n\015()]*)*\)[\040\t]*)*(?:\.[\040\t]*(?:\([^\\\x80
-\xff\n\015()]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\n\015()]*(?:\\[^\x
80-\xff][^\\\x80-\xff\n\015()]*)*\))[^\\\x80-\xff\n\015()]*)*\)[\040\t
]*)*(?:[^(\040)<>#,;:".\\\[\]\000-\037\x80-\xff]+(?![^(\040)<>#,;:".\\
\[\]\000-\037\x80-\xff])|\[(?:[^\\\x80-\xff\n\015\[\]]|\\[^\x80-\xff])
*\])[\040\t]*(?:\([^\\\x80-\xff\n\015()]*(?:(?:\\[^\x80-\xff]|\([^\\\x
80-\xff\n\015()]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015()]*)*\))[^\\\x80
-\xff\n\015()]*)*\)[\040\t]*)*)*(?:,[\040\t]*(?:\([^\\\x80-\xff\n\015(
)]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\n\015()]*(?:\\[^\x80-\xff][^\\
\x80-\xff\n\015()]*)*\))[^\\\x80-\xff\n\015()]*)*\)[\040\t]*)*#[\040\t
]*(?:\([^\\\x80-\xff\n\015()]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\n\0
15()]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015()]*)*\))[^\\\x80-\xff\n\015
()]*)*\)[\040\t]*)*(?:[^(\040)<>#,;:".\\\[\]\000-\037\x80-\xff]+(?![^(
\040)<>#,;:".\\\[\]\000-\037\x80-\xff])|\[(?:[^\\\x80-\xff\n\015\[\]]|
\\[^\x80-\xff])*\])[\040\t]*(?:\([^\\\x80-\xff\n\015()]*(?:(?:\\[^\x80
-\xff]|\([^\\\x80-\xff\n\015()]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015()
]*)*\))[^\\\x80-\xff\n\015()]*)*\)[\040\t]*)*(?:\.[\040\t]*(?:\([^\\\x
80-\xff\n\015()]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\n\015()]*(?:\\[^
\x80-\xff][^\\\x80-\xff\n\015()]*)*\))[^\\\x80-\xff\n\015()]*)*\)[\040
\t]*)*(?:[^(\040)<>#,;:".\\\[\]\000-\037\x80-\xff]+(?![^(\040)<>#,;:".
\\\[\]\000-\037\x80-\xff])|\[(?:[^\\\x80-\xff\n\015\[\]]|\\[^\x80-\xff
])*\])[\040\t]*(?:\([^\\\x80-\xff\n\015()]*(?:(?:\\[^\x80-\xff]|\([^\\
\x80-\xff\n\015()]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015()]*)*\))[^\\\x
80-\xff\n\015()]*)*\)[\040\t]*)*)*)*:[\040\t]*(?:\([^\\\x80-\xff\n\015
()]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\n\015()]*(?:\\[^\x80-\xff][^\
\\x80-\xff\n\015()]*)*\))[^\\\x80-\xff\n\015()]*)*\)[\040\t]*)*)?(?:[^
(\040)<>#,;:".\\\[\]\000-\037\x80-\xff]+(?![^(\040)<>#,;:".\\\[\]\000-
\037\x80-\xff])|"[^\\\x80-\xff\n\015"]*(?:\\[^\x80-\xff][^\\\x80-\xff\
n\015"]*)*")[\040\t]*(?:\([^\\\x80-\xff\n\015()]*(?:(?:\\[^\x80-\xff]|
\([^\\\x80-\xff\n\015()]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015()]*)*\))
[^\\\x80-\xff\n\015()]*)*\)[\040\t]*)*(?:\.[\040\t]*(?:\([^\\\x80-\xff
\n\015()]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\n\015()]*(?:\\[^\x80-\x
ff][^\\\x80-\xff\n\015()]*)*\))[^\\\x80-\xff\n\015()]*)*\)[\040\t]*)*(
?:[^(\040)<>#,;:".\\\[\]\000-\037\x80-\xff]+(?![^(\040)<>#,;:".\\\[\]\
000-\037\x80-\xff])|"[^\\\x80-\xff\n\015"]*(?:\\[^\x80-\xff][^\\\x80-\
xff\n\015"]*)*")[\040\t]*(?:\([^\\\x80-\xff\n\015()]*(?:(?:\\[^\x80-\x
ff]|\([^\\\x80-\xff\n\015()]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015()]*)
*\))[^\\\x80-\xff\n\015()]*)*\)[\040\t]*)*)*#[\040\t]*(?:\([^\\\x80-\x
ff\n\015()]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\n\015()]*(?:\\[^\x80-
\xff][^\\\x80-\xff\n\015()]*)*\))[^\\\x80-\xff\n\015()]*)*\)[\040\t]*)
*(?:[^(\040)<>#,;:".\\\[\]\000-\037\x80-\xff]+(?![^(\040)<>#,;:".\\\[\
]\000-\037\x80-\xff])|\[(?:[^\\\x80-\xff\n\015\[\]]|\\[^\x80-\xff])*\]
)[\040\t]*(?:\([^\\\x80-\xff\n\015()]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-
\xff\n\015()]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015()]*)*\))[^\\\x80-\x
ff\n\015()]*)*\)[\040\t]*)*(?:\.[\040\t]*(?:\([^\\\x80-\xff\n\015()]*(
?:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\n\015()]*(?:\\[^\x80-\xff][^\\\x80
-\xff\n\015()]*)*\))[^\\\x80-\xff\n\015()]*)*\)[\040\t]*)*(?:[^(\040)<
>#,;:".\\\[\]\000-\037\x80-\xff]+(?![^(\040)<>#,;:".\\\[\]\000-\037\x8
0-\xff])|\[(?:[^\\\x80-\xff\n\015\[\]]|\\[^\x80-\xff])*\])[\040\t]*(?:
\([^\\\x80-\xff\n\015()]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\n\015()]
*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015()]*)*\))[^\\\x80-\xff\n\015()]*)
*\)[\040\t]*)*)*>)
EOF
But your actual problem is this line:
$string = "XYZ#yahoo.com";
The #yahoo looks like an array variable to Perl, and and you don't have an array called #yahoo it gets replaced with an empty string. Try printing the value of $string to see what you get.
The solution is either to use single quotes (so the array variable isn't expanded):
$string = 'XYZ#yahoo.com';
Or to escape the # with a \:
$string = "XYZ\#yahoo.com";
Alway add use strict and use warnings to your Perl programs. They would have told you what the problem is.
#!/usr/bin/perl
use strict;
use warnings;
use Email::Valid;
my $email_address = 'a.n#example.com';
unless( Email::Valid->address($email_address) ) {
print "Sorry, that email address is not valid!";
}
Reference Site: http://learn.perl.org/examples/email_valid.html
For Regex Pattern try this:
my $pattern= '^([a-zA-Z][\w\_\.]{6,15})\#([a-zA-Z0-9.-]+)\.([a-zA-Z]{2,4})$';
Reference Site: https://www.experts-exchange.com/articles/8652/Email-validation-using-Regular-Expression-in-Perl.html
Change your if condition to
if ($string =~ /^[a-z0-9A-Z][A-Za-z0-9.]+[A-Za-z0-9]\#[A-Za-z0-9.-]+$/)
and change
$string = "XYZ#yahoo.com"; to
$string = 'XYZ#yahoo.com';
Refference : http://perlmaven.com/email-validation-using-regular-expression-in-perl
for details.
Try
if ($email =~ /^[a-z0-9]([a-z0-9.]+[a-z0-9])?\#[a-z0-9.-]+$/)
And some test code:
#!/usr/bin/perl
my $email = "john.doe\#acme.org";
if ($email =~ /^[a-z0-9]([a-z0-9.]+[a-z0-9])?\#[a-z0-9.-]+$/) {
print "Valid email\n";
} else {
print "Not valid email\n";
}
exit;
Output:
Valid email

How to extract directory names from a path in Perl

I have a path like this
/home/user/doc/loc
I want to extract home, user, doc, loc separately. I tried split (////) and also split("/")
but none of them worked. Please give me sample script:
while (<EXPORT>) {
if (/^di/) {
($key, $curdir) = split(/\t/);
printf "the current dir is %s\n", $curdir;
printf("---------------------------------\n");
($home_dir, $user_dir, $doc_dir, $loc_dir) = split("/");
}
}
But it didn't work; hence please help me.
Given $curdir containing a path, you'd probably use:
my(#names) = split m%/%, $curdir;
on a Unix-ish system. Or you would use File::Spec and splitdir. For example:
#!/usr/bin/env perl
use strict;
use warnings;
use File::Spec;
my $curdir = "/home/user/doc/loc";
my(#names) = split m%/%, $curdir;
foreach my $part (#names)
{
print "$part\n";
}
print "File::Spec->splitdir()\n";
my(#dirs) = File::Spec->splitdir($curdir);
foreach my $part (#dirs)
{
print "$part\n";
}
Ouput (includes a leading blank line):
home
user
doc
loc
File::Spec->splitdir()
home
user
doc
loc
split's first result will be the string preceding the first instance of the regular expression passed to it. Since you have a leading "/" here you would get an empty string in $home_dir, 'user' in $user_dir and so on. Add undef to the list assignment's first position or alternatively trim a leading slash first.
Also I'm not sure if you can call split without passing it $curdir here. Try:
(undef, $home_dir, $user_dir, $doc_dir, $loc_dir) = split("/", $curdir);

Regular Expression for # Array in Perl

Actually i m using one perl script to prepare Readme txt for my builds. in that script i used
foreach $line (<LOG>)
{
if(length(trim($line))>0)
{
$line=trim($line);
$line=~ s/[\r]//gs;
if(rindex($line,'#')!=-1)
{
$icut=substr($line,0,index($line,']'));
$icut2=substr($icut,index($icut,'#')+1,length($icut));
}
push(#issue,$icut2);
it's fetching correct issue no but when the situation comes like
[I#1303350], [I#1270918],[I#1312521] Updated Physical Confirmation Template based on CO
then it's fetching only one issue no not all issue i that same line. so i modified my code like
foreach $revno(<REV>)
{
if(length(trim($revno))>0)
{
$revno=trim($revno);
$revno=~ s/[\r]//gs;
if(rindex($revno,'#')!=-1)
{
$revcut=substr($revno,0,rindex($revno,']'));
print "$revcut\n";
$revcut1=substr($revcut,index($revcut,'#')+1,length($revcut));
}
}
push(#issue,$revcut1);
now it's fetch it all revision no but output is like 1312588,1303350], [I#1270918],[I#1312521 but i want to remove the # [ ] I only but not , so pls tell me how can i parse this through regex.
This can be done without regular expressions: Transliterate: tr///
use warnings;
use strict;
my $s = '1312588,1303350], [I#1270918],[I#1312521';
$s =~ tr/ ][#I//d;
print "$s\n";
__END__
1312588,1303350,1270918,1312521
You can do it like this:
echo "[I#1303350], [I#1270918],[I#1312521]" | perl -lnwe "print for m/#(\d+)/g"
This works for me:
my #issues = $line_of_data =~ m/#(\d+)/g;
And if you want commas, it's far easier to do this:
my $with_commas = join( ', ', #issues );
And you still have the individual issues numbers as "atoms" of data.

Perl: How to pass and use a lexical file handle to a subroutine as a named argument?

I want to pass a lexical file handle to a subroutine using a named argument, but the following does not compile:
#!/usr/bin/perl -w
use strict;
my $log_fh;
my $logname = "my.log";
sub primitive {
my ($fh, $m) = #_;
print $fh $m;
}
sub sophisticated {
my ($args) = #_;
print $args->{m};
print $args->{fh} $args->{m} ;
}
open $log_fh, ">", $logname;
print $log_fh "Today I learned ...\n";
primitive($log_fh,"... the old way works ...\n");
sophisticated({
fh=>$log_fh,
m=>"... and the new way requires an intervention by SO.",
});
close $log_fh;
The complaint is:
Scalar found where operator expected at ./lexical.file.handle.pl line 15, near
} $args"
(Missing operator before $args?)
$ perl --version
This is perl, v5.10.1
It works O.K. when I use the primitive technique of passing arguments, and the named-argument hash technique works for the message portion, just not for the file handle portion. Do I need a new version of print ?
When you've got a complex expression that returns a filehandle (like $args->{fh}) you'll need to disambiguate the syntax a bit by adding some extra curlies:
print { $args->{fh} } $args->{m};
This is due to the weird way the print operator is designed, with no comma between the filehandle and the list of stuff to print.
Alternatively, you could grab the filehandle out of your arguments hashref first, e.g.
my $fh = $args->{fh};
print $fh $args->{m};
friedo's answer covers your problem, but there's a stylistic issue I'd like to point out. You don't need to wrap everything in an anonymous hash to emulate named arguments. A hash initializer is just a list interpreted as key/value pairs. Passing such a list to a sub provides a cleaner syntax for the caller:
sub sophisticated {
my %arg = #_;
print $arg{m};
print {$arg{fh}} $arg{m};
}
sophisticated(fh => $log_fh, m => "Hello, world!\n");