Remove Part of String Perl - string

I have this in perl
return "$file->{srv_cgi_url}/dl.cgi/$hash/$fname";
where
$file->{srv_cgi_url}
returns
http://s1.site.com/cgi-bin/
how can I remove the trailing /cgi-bin/ from the string? :)
Thanks!

Like this:
my $new = $file->{srv_cgi_url};
$new =~ s{/cgi-bin/}{};
That is all. See perldoc perlre for details.

While substitution can work, it’s fragile and difficult to extend and maintain. I strenuously recommend learng to use URI, URI::QueryParam, and Path::Class instead (the last is not used in this example but important and related).
use warnings;
use strict;
use URI;
my $file;
$file->{srv_cgi_url} = "http://s1.site.com/cgi-bin/";
my $srv_cgi_uri = URI->new( $file->{srv_cgi_url} );
my $hash = "some";
my $fname = "path.ext";
$srv_cgi_uri->path("/dl.cgi/$hash/$fname");
print $srv_cgi_uri, "\n";
__END__
http://s1.site.com/dl.cgi/some/path.ext

Related

how to combine directory path in perl

I am having a perl script in which i am giving path to directory as input.
Directory has xml files inside it.
In my code i am iterating through all the xml files and creating absolute path for all xml files. Code is working fine.
#!/usr/bin/perl
use File::Spec;
$num_args = $#ARGV + 1;
if ($num_args != 1) {
print "\nUsage: $0 <input directory>\n";
exit;
}
my $dirPath = $ARGV[0];
opendir(DIR, $dirPath);
my #docs = grep(/\.xml$/,readdir(DIR));
foreach my $file (#docs)
{
my $abs_path = join("",$dir,$file);
print "absolute path is $abs_path";
}
Question i have here is,
joining $dirPath and $file with no separator which means that $dirPath must end in a "/". So is there any way or built in function in perl which take cares of this condition and replaces the join method.
All i want is not to worry about the separator "/". Even if script is called with path as "/test/dir_to_process" or "/test/dir_to_process/", i should be able to produce the correct absolute path to all xml files present without worrying about the separator.
Let me know if anyone has any suggestions.
Please take heed of the advice you are given. It is ridiculous to keep asking questions when comments and answers to previous posts are being ignored.
You must always use strict and use warnings at the top of every Perl program you write, and declare every variable using my. It isn't hard to do, and you will be reprimanded if you post code that doesn't have these measures in place.
You use the File::Spec module in your program but never make use of it. It is often easier to use File::Spec::Functions instead, which exports the methods provided by File::Spec so that there is no need to use the object-oriented call style.
catfile will correctly join a file (or directory) name to a path, doing the right thing if path separators are incorrect. This rewrite of your program works fine.
#!/usr/bin/perl
use strict;
use warnings;
use File::Spec::Functions 'catfile';
if (#ARGV != 1) {
print "\nUsage: $0 <input directory>\n";
exit;
}
my ($dir_path) = #ARGV;
my $xml_pattern = catfile($dir_path, '*.xml');
while ( my $xml_file = glob($xml_pattern) ) {
print "Absolute path is $xml_file\n";
}
The answer is in the documentation for File::Spec, e.g., catfile:
$path = File::Spec->catfile( #directories, $filename );
or catpath:
$full_path = File::Spec->catpath( $volume, $directory, $file );
This will add the trailing slash if not there:
$dirPath =~ s!/*$!/!;

Perl if condition parameters

I have a log file which looks like below:
4680 p4exp/v68 PJIANG-015394 25:34:19 IDLE none
8869 unnamed p4-python R integration semiconductor-project-trunktip-turbolinuxclient 01:33:52 IDLE none
8870 unnamed p4-python R integration remote-trunktip-osxclient 01:33:52
There are many such entries in the same log file such that some contains IDLE none at the end while some does not. I would like to retain the ones having "R integration" and "IDLE none" in a hash and ignore the rest. I have tried the following code but not getting the desired results.
#!/usr/bin/perl
open (FH,'/root/log.txt');
my %stat;
my ($killid, $killid_details);
while ($line = <FH>) {
if ($line =~ m/(\d+)/){
$killid = $1;
}
if ($line =~ /R integration/ and $line =~ /IDLE none/){
$killid_details = $line;
}
$stat{$killid} = {
killid => $killid_details
};
}
close (FH);
I am getting all the lines with R integration (for example I get 8869, 8870 lines) which should not be the case as 8870 should be ignored.
Please inform me if any mistake. I am still learning perl. Thank you.
I made a few changes in your program:
Always put in use strict; and use warnings;. These will catch 90% of your errors. (Although not this time).
When you open a file, you need to either use or die as in open my $fh, "<", $file or die qq(blah, blah, blah); or use use autodie; (which is now preferred). In your case, if the file didn't open, your program would have continued merrily along. You need to test whether or not the open statement worked.
Note my open statement. I use a variable for the file handle. This is preferred because it's not global, and it's easier to pass into subroutines. Also note I use the three parameter open. This way, you don't run into trouble if your file name begins with some strange character.
When you declare a variable, it's best to do it in scope. This way, variables go out of scope when you no longer need them. I moved where $killid and $killid_details to be declared inside the loop. That way, they no longer exist outside the loop.
You need to be more careful with your regular expressions. What if the phrase IDLE none appears elsewhere in your line? You only want it if its on the end of the line.
Now, for the issues you had:
You need to chomp lines when you read them. In Perl, the NL at the end of the line is read in. The chomp command removes it.
Your logic was a bit strange. You set $killid if your line had a digit in it (I modified it to look only for digits at the beginning of the line). However, you simply went on your merry way even if killid was not set. In your version, because you declared $killid outside of the loop, it had a value in each loop. Here I go to the next statement if $killid isn't defined.
You had a weird definition for your hash. You were defining a reference hash within a hash. No need for that. I made it a simple hash.
Here it is:
#! /usr/bin/env perl
use strict;
use warnings;
use feature qw(say);
use autodie;
use Data::Dumper;
open my $log_fh, '<', '/root/log.txt';
my %stat;
while (my $line = <$log_fh>) {
chomp $line;
next if not $line =~ /^(\d+)\s+/;
my $killid = $1;
if ($line =~ /R\s+integration/ and $line =~ /IDLE\s+none$/){
my $killid_details = $line;
$stat{$killid} = $killid_details;
}
}
close $log_fh;
say Dumper \%stat;
I think this is probably what you want:
while (<FH>) {
next unless /^(\d+).*R integration.*IDLE none/;
$stat{$1} = $_;
}
The regexp should be anchored to the beginning of the line, so you don't match a number anywhere on the line. There's no need to do multiple regexp matches, assuming the order of R integration and IDLE none are always as in the example. You need to use next when there's no match, so you don't process non-matching lines.
And I suspect that you just want to set the value of the hash entry to the string, not a reference to another hash.

How explicitly resolve variables in a perl string?

In my perl script I want to have both versions of $config directory:
my $config='$home/client/config';
and
my $config_resolved="$home/client/config";
But I want to get $config_resolved from $config, i.e. something like this:
my $config_resolved=resolve_vars($config);
How can I do such thing in perl?
From the Perl FAQ (which every Perl programmer should read at least once):
How can I expand variables in text strings?
(contributed by brian d foy)
If you can avoid it, don't, or if you can
use a templating system, such as Text::Template or Template Toolkit,
do that instead. You might even be able to get the job done with
sprintf or printf:
my $string = sprintf 'Say hello to %s and %s', $foo, $bar;
However, for the one-off simple case where I don't want to pull out a
full templating system, I'll use a string that has two Perl scalar
variables in it. In this example, I want to expand $foo and $bar to
their variable's values:
my $foo = 'Fred';
my $bar = 'Barney';
$string = 'Say hello to $foo and $bar';
One way I can do this involves the substitution operator and a double /e flag. The
first /e evaluates $1 on the replacement side and turns it into $foo. The
second /e starts with $foo and replaces it with its value. $foo,
then, turns into 'Fred', and that's finally what's left in the string:
$string =~ s/(\$\w+)/$1/eeg; # 'Say hello to Fred and Barney'
The /e will also silently ignore violations of strict, replacing undefined
variable names with the empty string. Since I'm using the /e flag
(twice even!), I have all of the same security problems I have with
eval in its string form. If there's something odd in $foo, perhaps
something like #{[ system "rm -rf /" ]}, then I could get myself in
trouble.
To get around the security problem, I could also pull the
values from a hash instead of evaluating variable names. Using a
single /e, I can check the hash to ensure the value exists, and if it
doesn't, I can replace the missing value with a marker, in this case
??? to signal that I missed something:
my $string = 'This has $foo and $bar';
my %Replacements = (
foo => 'Fred',
);
# $string =~ s/\$(\w+)/$Replacements{$1}/g;
$string =~ s/\$(\w+)/
exists $Replacements{$1} ? $Replacements{$1} : '???'
/eg;
print $string;
I use eval for this.
So, you must replace all scalars (their names) with their values.
$config = 'stringone';
$boo = '$config/any/string';
$boo =~ s/(\$\w+)/eval($1)/eg;
print $boo;
Because you are using my to declare it as private variable, you might as well use a /ee modifier. This can find variables declared to be in local scope:
$boo =~ s/(\$\w+)/$1/eeg;
This is most tidily and safely done by the double-eval modifier on s///.
In the program below, the first /e evaluates the string $1 to get $home, while the second evaluates $home to get the variable's value HOME.
use strict;
my $home = 'HOME';
my $config = '$home/client/config';
my $config_resolved = resolve_vars($config);
print $config_resolved, "\n";
sub resolve_vars {
(my $str = shift) =~ s/(\$\w+)/$1/eeg;
return $str;
}
output
HOME/client/config

Perl: Removing characters up to certain point.

I've tried searching through questions already asked, but can't seem to find anything. I'm sure its incredibly simple to do, but I am completely new to Perl.
What I am trying to do is remove characters in an string up to a certain point. For example, I have:
Parameter1 : 0xFFFF
and what I would like to do is remove the "Parameter1:" and be left with just the "0xFFFF". If anyone can help and give a simple explanation of the operators used, that'd be great.
Sounds like you need the substr function.
#!/usr/bin/perl
use strict;
use warnings;
my $string = 'Parameter1 : 0xFFFF';
my $fragment = substr $string, 12;
print " string: <$string>\n";
print "fragment: <$fragment>\n";
s/.*:\s*//;
or
$s =~ s/.*:\s*//;
This deletes everything up to and including the first occurrence of : followed by zero or more whitespace characters. With $s =~ it's applied to $s; without it, it's applied to $_.
Have you considered using something like Config::Std?
Here is how to parse a configuration file like that by hand:
#!/usr/bin/perl
use strict; use warnings;
my %params;
while ( my $line = <DATA> ) {
if ($line =~ m{
^
(?<param> Parameter[0-9]+)
\s*? : \s*?
(?<value> 0x[[:xdigit:]]+)
}x ) {
$params{ $+{param} } = $+{value};
}
}
use YAML;
print Dump \%params;
__DATA__
Parameter1 : 0xFFFF
Parameter3 : 0xFAFF
Parameter4 : 0xCAFE
With Config::Std:
#!/usr/bin/perl
use strict; use warnings;
use Config::Std;
my $config = do { local $/; <DATA> };
read_config \$config, my %params;
use YAML;
print Dump \%params;
__DATA__
Parameter1 : 0xFFFF
Parameter3 : 0xFAFF
Parameter4 : 0xCAFE
Of course, in real life, you'd pass a file name to read_config instead of slurping it.
I like split for these parameter/value pairs.
my $str = "Parameter1 : 0xFFFF";
my ($param, $value) = split /\s*:\s*/, $str, 2;
Note the use of LIMIT in the split, which limits the split to two fields (in case of additional colons in the value).

How can I parse people's full names into user names in Perl?

I need to convert a name in the format Parisi, Kenneth into the format kparisi.
Does anyone know how to do this in Perl?
Here is some sample data that is abnormal:
Zelleb, Charles F.,,IV
Eilt, John,, IV
Wods, Charles R.,,III
Welkt, Craig P.,,Jr.
These specific names should end up as czelleb, jeilt, cwoods, cwelkt, etc.
I have one more condition that is ruining my name builder
O'Neil, Paulso far, Vinko Vrsalovic's answer is working the best when weird/corrupt names are in the mix, but this example above would come out as "pneil"... id be damned below judas if i cant get that o between the p and the n
vinko#parrot:~$ cat genlogname.pl
use strict;
use warnings;
my #list;
push #list, "Zelleb, Charles F.,,IV";
push #list, "Eilt, John,, IV";
push #list, "Woods, Charles R.,,III";
push #list, "Welkt, Craig P.,,Jr.";
for my $name (#list) {
print gen_logname($name)."\n";
}
sub gen_logname {
my $n = shift;
#Filter out unneeded characters
$n =~ s/['-]//g;
#This regex will grab the lastname a comma, optionally a space (the
#optional space is my addition) and the first char of the name,
#which seems to satisfy your condition
$n =~ m/(\w+), ?(.)/;
return lc($2.$1);
}
vinko#parrot:~$ perl genlogname.pl
czelleb
jeilt
cwoods
cwelkt
I would start by filtering the abnormal data so you only have regular names. Then something like this should do the trick
$t = "Parisi, Kenneth";
$t =~ s/(.+),\s*(.).*/\l$2\l$1/;
Try:
$name =~ s/(\w+),\s(\w)/$2$1/;
$name = lc $name;
\w here matches an alphanumerical character. If you want to be more specific, you could also use [a-z] instead, and pass the i flag (case insensitive):
$name =~ s/([a-z]+)\s([a-z])/$2$1/i;
Here's a one line solution, assuming you store all the names in a file called "names" (one per line) and you will do duplicated name detection somehow later.
cat names | perl -e 'while(<>) {/^\s*(\S*)?,\s*(\S)/; print lc "$2$1\n";}' | sed s/\'//g
It looks like your input data is comma-separated. To me, the clearest way to do this would be split into components, and then generate the login names from that:
while (<>) {
chomp;
my ($last, $first) = split /,/, lc $_;
$last =~ s/[^a-z]//g; # strip out nonletters
$first =~ s/[^a-z]//g; # strip out nonletters
my $logname = substr($first, 0, 1) . $last;
print $logname, "\n";
}
$rowfetch =~ s/['-]//g; #All chars inside the [ ] will be filtered out.
$rowfetch =~ m/(\w+), ?(.)/;
$rowfetch = lc($2.$1);
this is how I ended up using Vinko Vrsalovic's solution... its inside a while loop that goes through a sql query result ... thanks again vinko
This should do what you need
use strict;
use warnings;
use 5.010;
while ( <DATA> ) {
say abbreviate($_);
}
sub abbreviate {
for ( #_ ) {
s/[-']+//g;
tr/A-Z/a-z/;
tr/a-z/ /c;
return "$2$1" if /([a-z]+)\s+([a-z])/;
}
}
__DATA__
Zelleb, Charles F.,,IV
Eilt, John,, IV
Woods, Charles R.,,III
Welkt, Craig P.,,Jr.
O'Neil, Paul
output
czelleb
jeilt
cwoods
cwelkt
poneil

Resources