I am trying to write a function that can take all of its arguments and print them as a string exactly as they were entered.
For example using the following function:
test('arg1' => $arg1, 'arg2' => $arg2);
I would like to get the following string inside of the function formatted EXACTLY as seen below:
"'arg1' => $arg1, 'arg2' => $arg2"
I want to do this so I can print all of the arguments the same way that they were entered for debugging/testing purposes.
Perl provides special debugging hooks that let you see the raw lines of compiled source files. You can write a custom debugger that prints the original line every time a subroutine is invoked.
The following lets you specify one or more subroutines you want to match; every time a matching subroutine is invoked, the corresponding line is printed.
package Devel::ShowCalls;
our %targets;
sub import {
my $self = shift;
for (#_) {
# Prepend 'main::' for names without a package specifier
$_ = "main::$_" unless /::/;
$targets{$_} = 1;
}
}
package DB;
sub DB {
($package, $file, $line) = caller;
}
sub sub {
print ">> $file:$line: ",
${ $main::{"_<$file"} }[$line] if $Devel::ShowCalls::targets{$sub};
&$sub;
}
1;
To trace invocations of functions foo and Baz::qux in the following program:
sub foo {}
sub bar {}
sub Baz::qux {}
foo(now => time);
bar rand;
Baz::qux( qw/unicorn pony waffles/ );
Run:
$ perl -d:ShowCalls=foo,Baz::qux myscript.pl
>> myscript.pl:5: foo(now => time);
>> myscript.pl:7: Baz::qux( qw/unicorn pony waffles/ );
Note that this will only print the first line of the invocation, so it won't work for calls like
foo( bar,
baz );
I know this is probably not the best solution, but it works:
sub test {
my (undef, $file_name, $line_number) = caller;
open my $fh, '<', $file_name or die $!;
my #lines = <$fh>;
close $fh;
my $line = $lines[$line_number - 1];
trim($line);
print $line."\n";
}
sub trim {
return map { $_ =~ s/^\s+|\s+$//g } #_;
}
Now when you run this:
test(time);
You will get this as the output:
test(time);
Related
I have a really big xml file. It has certain incrementing numbers inside, which i would like to replace with a different incrementing number. I've looked and here is what someone suggested here before. Unfortunately i cant get it to work :(
In the code below all instances of 40960 should be replaced with 41984, all instances of 40961 with 41985 etc. Nothing happens. What am i doing wrong?
use strict;
use warnings;
my $old = 40960;
my $new = 41984;
my $string;
my $file = 'file.txt';
rename($file, $file.'.bak');
open(IN, '<'.$file.'.bak') or die $!;
open(OUT, '>'.$file) or die $!;
$old++;
$new++;
for (my $i = 0; $i < 42; $i++) {
while(<IN>) {
$_ =~ s/$old/$new/g;
print OUT $_;
}
}
close(IN);
close(OUT);
Other answers give you better solutions to your problem. Mine concentrates on explaining why your code didn't work.
The core of your code is here:
$old++;
$new++;
for (my $i = 0; $i < 42; $i++) {
while(<IN>) {
$_ =~ s/$old/$new/g;
print OUT $_;
}
}
You increment the values of $old and $new outside of your loops. And you never change those values again. So you're only making the same substitution (changing 40961 to 41985) 42 times. You never try to change any other numbers.
Also, look at the while loop that reads from IN. On your first iteration (when $i is 0) you read all of the data from IN and the file pointer is left at the end of the file. So when you go into the while loop again on your second iteration (and all subsequent iterations) you read no data at all from the file. You need to reset the file pointer to the start of your file at the end of each iteration.
Oh, and the basic logic is wrong. If you think about it, you'll end up writing each line to the output file 42 times. You need to do all possible substitutions before writing the line. So your inner loop needs to be the outer loop (and vice versa).
Putting those suggestions together, you need something like this:
my $old = 40960;
my $change = 1024;
while (<IN>) {
# Easier way to write your loop
for my $i ( 1 .. 42 ) {
my $new = $old + $change;
# Use \b to mark word boundaries
s/\b$old\b/$new/g;
$old++;
}
# Print each output line only once
print OUT $_;
}
Here's an example that works line by line, so the size of file is immaterial. The example assumes you want to replace things like "45678", but not "fred45678". The example also assumes that there is a range of numbers, and you want them replaced with a new range offset by a constant.
#!/usr/bin/perl
use strict;
use warnings;
use constant MIN => 40000;
use constant MAX => 90000;
use constant DIFF => +1024;
sub repl { $_[0] >= MIN && $_[0] <= MAX ? $_[0] + DIFF : $_[0] }
while (<>) {
s/\b(\d+)\b/repl($1)/eg;
print;
}
exit(0);
Invoked with the file you want to transform as an argument, it produces altered output on stdout. With the following input ...
foo bar 123
40000 50000 60000 99999
fred60000
fred 60000 fred
... it produces this output.
foo bar 123
41024 51024 61024 99999
fred60000
fred 61024 fred
There are a couple of classic Perlisms here, but the example shouldn't be hard to follow if you RTFM appropriately.
Here is an alternative way which reads the input file into a string and does all the substitutions at once:
use strict;
use warnings;
{
my $old = 40960;
my $new = 41984;
my ($regexp) = map { qr/$_/ } join '|', map { $old + $_ } 0..41;
my $file = 'file.txt';
rename($file, $file.'.bak');
open(IN, '<'.$file.'.bak') or die $!;
my $str = do {local $/; <IN>};
close IN;
$str =~ s/($regexp)/do_subst($1, $old, $new)/ge;
open(OUT, '>'.$file) or die $!;
print OUT $str;
close OUT;
}
sub do_subst {
my ( $old, $old_base, $new_base ) = #_;
my $i = $old - $old_base;
my $new = $new_base + $i;
return $new;
}
Note: Can probably be made more efficient by using Regexp::Assemble
Here is an example of what i'm trying to do:
I want to "defined" a name for the input and then when it's taken into a function, only then it will substitute all the 3 variables.
$place_holder = 'f${file_case}_lalal_${subcase}_${test}';
.... somewhere else in another function:
read file containing 3 set of numbers on each line that represents the $file_case, $subcase, $test
while(<IN>){
($file_case, $subcase, $tset) = split;
$input = $place_holder #### line #3 here needs to fix
print " $input \n";
}
Unfortunately, it prints out f${file_case}lalal${subcase}_${test} for every single line. I want those variables to be substituted. How do I do that, how
do I change line #3 to be able to output as i wanted ? I don't want to defined the input name in the subroutine, it has to be in the main.
You can do it using subroutines for example, if that satisfies your criteria
use warnings;
use strict;
my $place_holder = sub {
my ($file_case, $subcase, $test) = #_;
return "f${file_case}_lalal_${subcase}_${test}";
}
# ...
while (<IN>) {
my ($file_case, $subcase, $tset) = split;
#
# Code to validate input
#
my $input = $place_holder->($file_case, $subcase, $tset);
print "$input\n";
}
I've used code reference with an anonymous subroutine in anticipation of uses that may benefit from it, but for the specified task alone you can use a normal subroutine as well.
Note that you have $test and $tset, which doesn't affect the above but may be typos.
You may use the String::Interpolate module, like this
use String::Interpolate 'interpolate';
my $place_holder = 'f${file_case}_lalal_${subcase}_${test}';
while ( <IN> ) {
my ($file_case, $subcase, $test) = split;
my $input = interpolate($place_holder);
print "$input\n";
}
The module gives access to Perl's built-in C code that performs double-quote interpolation, so it is generally fast and accurate
A while after I posted, I found a way to do it.
in the ## line 3, do this:
($input = $place_holder) =~ s/(\${w+})/$1/eeg;
and everything works. Yes the above tset is a typo, meant to be test. Thank for everybody's response.
Try eval while(<IN>){ ($file_case, $subcase, $tset) = split; $input = eval $place_holder #### line #3 here needs to fix print " $input \n"; }
I have the below program for checking the file availability in a Unix directory.
my $numbera = "c://";
my $numberb = "test1.txt";
check_file_exist($numbera, $numberb);
sub check_file_exist {
my $download_filename;
my ($numbera,$numberb) = #_;
$download_filename = $numbera.$numberb;
print "*** $download_filename ****";
my $mtime = (stat $download_filename)[9];
my $filedatetime = scalar localtime $mtime;
if (-e $download_filename) {
print "Data File Exist which is created on $filedatetime";
}
unless (-e $download_filename) {
print "File not exists";
}
}
while running the program I am getting the below error:
*** data_file=HASH(0xa912f0)/home1/saravanan/ ****
Use of uninitialized value in localtime at /home1/saravanan/data_file.pl
First, always put these in your program:
use strict;
use warnings;
When you use strict, you will have to declare your variables with either my or our (HINT: You use my about 99.99% of the time).
These will catch all sorts of errors in your script:
Also, use indentations. It makes your script easier to read. It is also bad form to output inside of your subroutine (unless that is the purpose of your subroutine. Instead, have your subroutine return (or not return a value), and then display that.
Your problem is that you were attempting to stat a file before you knew whether it exists or not. You need to put your stat inside your if statement where you check for the file's existence.
I've made a few changes besides what I stated above:
I use say instead of print. If you use print, you have to put in a terminating \n. The say command does this for you.
I pull in my parameters as soon as I get the subroutine (and use better variable names than $numbera and $numberb.
I use if/then/else instead of doing an if and then an unless with the same test. I no longer use unless in most circumstances. It's simply clearer to say if ( not ... ).
The subroutine either returns a datestamp or returns nothing. I check for the return value of the subroutine with my if statement.
Here's your program updated a bit:
use warnings;
use strict;
use autodie;
use feature qw(say);
use Data::Dumper;
my $numbera = "/Users/david";
my $numberb = ".profile";
if ( my $timestamp = check_file_exist( $numbera, $numberb ) ) {
say "The file was downloaded at $timestamp";
}
else {
say "The file does not exist";
}
sub check_file_exist {
my $directory = shift;
my $file_name = shift;
my $download_filename = "$directory/$file_name";
my #stat = stat($download_filename);
if (not #stat) {
return;
}
my $mtime = $stat[9];
return scalar localtime $mtime;
}
My Expectation:
I have to use the following command to send the value of first argument to all the files calling perl.pl file.
./perl.pl 1
The one is read using the following file: (perl.pl)
#!/usr/bin/perl
package Black;
use strict;
use warnings;
#subroutines
sub get_x();
#variables
our $XE = -1;
my ($param1, $param2, $param3) = #ARGV;
my $x = get_x();
sub get_x()
{
$XE = $param1;
return $XE;
}
exit;
Then I wrote another script which performs some code base on the input to perl.pl (0 or 1).
The file is ./per.pl and I invoke in from linux terminal like this: ./per.pl
Here is the code I wrote for it:
#!/usr/bin/perl
require "perl.pl";
my $xd = Black::get_x();
if ($xd ==1){
print $xd;}
else {
print "5";
}
exit;
But this is what I get when I write these commands:
./perl.pl 1
I tried to print it and it prints 1...removed the print like from the code in this case
./per.pl
And now I get nothing. I would like the 1 getting printed out but no it doesn't
Thanks in Advance
Before we get started, you cannot possibly get the output you say you get because you tell the process to exit when the module is executed by require, so Black::get_x() is never reached. Change exit; to 1;.
Now on to your question. If I understand correctly, you want to pass a value to one process via its command line, and fetch that value by executing the same script without the parameter.
You did not even attempt to pass the variable from one process to another, so it shouldn't be a surprise that it doesn't work. Since the two processes don't even exist at the same time, you'll need to store the value somewhere such as the file system.
#!/usr/bin/perl
use strict;
use warnings;
my $conf_file = "$ENV{HOME}/.black";
my $default = -1;
sub store {
my ($val) = #_;
open(my $fh, '>', $conf_file) or die $!;
print $fh "$val\n";
return $val;
}
sub retrieve {
open(my $fh, '<', $conf_file)
or do {
return $default if $!{ENOENT};
die $!;
};
my $val = <$fh>;
chomp($val);
return $val;
}
my $xd = #ARGV ? store($ARGV[0]) : retrieve();
print("$xd\n");
I wrote a super simple script:
#!/usr/bin/perl -w
use strict;
open (F, "<ids.txt") || die "fail: $!\n";
my #ids = <F>;
foreach my $string (#ids) {
chomp($string);
print "$string\n";
}
close F;
This is producing an expected output of all the contents of ids.txt:
hello
world
these
annoying
sourcecode
lines
Now I want to add a file-extension: .txt for every line. This line should do the trick:
#!/usr/bin/perl -w
use strict;
open (F, "<ids.txt") || die "fail: $!\n";
my #ids = <F>;
foreach my $string (#ids) {
chomp($string);
$string .= ".txt";
print "$string\n";
}
close F;
But the result is as follows:
.txto
.txtd
.txte
.txtying
.txtcecode
Instead of appending ".txt" to my lines, the first 4 letters of my string will be replaced by ".txt" Since I want to check if some files exist, I need the full filename with extension.
I have tried to chop, chomp, to substitute (s/\n//), joins and whatever. But the result is still a replacement instead of an append.
Where is the mistake?
Chomp does not remove BOTH \r and \n if the file has DOS line endings and you are running on Linux/Unix.
What you are seeing is actually the original string, a carriage return, and the extension, which overwrites the first 4 characters on the display.
If the incoming file has DOS/Windows line endings you must remove both:
s/\R+$//
A useful debugging technique when you are not quite sure why your data is getting set to what it is is to dump it with Data::Dumper:
#!/usr/bin/perl -w
use strict;
use Data::Dumper ();
$Data::Dumper::Useqq = 1; # important to be able to actually see differences in whitespace, etc
open (F, "<ids.txt") || die "fail: $!\n";
my #ids = <F>;
foreach my $string (#ids) {
chomp($string);
print "$string\n";
print Data::Dumper::Dumper( { 'string' => $string } );
}
close F;
have you tried this?
foreach my $string (#ids) {
chomp($string);
print $string.".txt\n";
}
I'm not sure what's wrong with your code though. these results are strange