I have a very simple script which mocks time using Test::MockTime, but the output of time call is different in two parts of the code.
Here is the script:
package mocker;
use strict;
use warnings;
sub abcd {
print "in abcd, time is " . time . "\n";
}
BEGIN {
use Test::MockTime qw(set_absolute_time restore_time);
set_absolute_time(0);
};
sub do_mock {
print "Current epoch in do_mock is: " . time . "\n";
abcd;
restore_time();
}
1;
I call mocker::do_mock in my script:
use strict;
use warnings;
use mocker;
mocker::do_mock;
I expect output to have "0" as current time in both print statements but strangely I have this output:
Current epoch in do_mock is: 0
in abcd, time is 1450343385
So, WHY in abcd time is restored to current time?
The documentation for Test::MockTime explains that "it overrides localtime, gmtime and time at compile time." So:
print "Before: " . time; # Uses CORE::time()
use Test::MockTime; # Override time()
print "After: " . time; # Uses overridden time()
You can see this using B::Deparse:
$ perl -MO=Deparse foo
print 'Before: ' . time;
use Test::MockTime;
print 'After: ' . &CORE::GLOBAL::time();
foo syntax OK
The second call to time() actually uses CORE::GLOBAL::time(), which is the overridden version.
To fix, make sure Test::MockTime is compiled before you call time():
package mocker;
use strict;
use warnings;
use Test::MockTime qw(set_absolute_time restore_time);
sub abcd {
print "in abcd, time is " . time . "\n";
}
BEGIN {
set_absolute_time(0);
};
sub do_mock {
print "Current epoch in do_mock is: " . time . "\n";
abcd;
restore_time();
}
1;
You can see this answer to better understand how a BEGIN block woks.
The point here is that it's executed before the main body, but it also has to be compiled. This means that the order in which you put your declarations and your BEGIN block is relevant.
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 had this little script:
#!/usr/bin/perl
use strict;
use warnings;
my #a = `history`;
print #a;
here is the question I asked about the error in this script: Can't exec "history": No such file or directory at gatherinformation.pl line 7
As I mentioned in the question: I was messing around with the HISTFILESIZE and HISTFILE variable to get the output as I desired.
Since I can't perform that script, is there anyway I can get the same result directly from the /.bash_history file with the desired format?
is there a way to get the history directly from the file
./bash_history with date and time?
Sure, we can read the file and convert the timestamps:
use POSIX qw(strftime);
my $histfile = "$ENV{'HOME'}/.bash_history";
open HIST, "<$histfile" or die "$histfile: $!";
while (<HIST>)
{
if (/^#(\d+)$/) { print strftime("%h/%d -- %H:%M:%S ", localtime $1); next }
print $_
}
According to my research the '\b' character used in perl print statements should act like a "backspace", that is, moving the cursor one character back, and deleting the current character. For this reason, I had planned to use this operation to print operational status on a single line, updating as it progressed. However, I noticed that while the cursor does indeed move back, the characters underfoot are not deleted, and therefore, longer messages remain after shorter print statements. I have compiled the following sample code to explain my findings:
#!/usr/bin/perl
use strict;
use warnings;
my $m;
#set to nonzero so that the screen will update before \n
local $| = 1;
print "Current number shown: ";
$m = "LONG MESSAGE TEMP";
print $m;
print "\b" x length($m);
foreach(1..22) {
$m = $_;
print $m;
print "\b" x length($m);
#sleep 1; #Uncomment to see updates
}
print "\n";
And this was the output:
Current number shown: 22NG MESSAGE TEMP
If this is indeed the correct operation of '\b', is there another escape that deletes the character as well as moving the cursor back? I would like to avoid using '\r' which starts at the beginning of the current line. Otherwise, how am I using the escapes incorrectly?
"\b" is just a fancy way of writing chr(0x08). Your terminal will likely move the cursor rather than display anything, but that's entirely up to it.
If you can rely on it, then you can achieve what you want by overwriting with spaces.
my $last_length = 0;
sub update {
my ($s) = #_;
print("\b" x $last_length);
print(" " x $last_length);
print("\b" x $last_length);
print($s);
$last_length = length($s);
}
Or with less flicker:
my $last_length = 0;
sub update {
my ($s) = #_;
my $diff = $last_length - length($s);
print("\b" x $last_length);
print($s);
print(" " x $diff);
print("\b" x $diff);
$last_length = length($s);
}
Just output some extra space characters to overwrite what you need to overwrite.
#!/usr/bin/env perl
use strict;
use warnings;
use Time::HiRes qw(sleep);
sub backspace {
print "\b" x $_[0];
print " " x $_[0];
print "\b" x $_[0];
}
local $| = 1;
my $m = "LONG MESSAGE TEMP";
print "Current number shown: ", $m;
sleep 1;
for (1..22) {
backspace( length($m) );
$m = $_;
print $m;
sleep 0.2;
}
print "\n";
Depending on how it is used, \b can have a special meaning within a Perl command:
\b is the backspace character only inside a character class. Outside a character class, \b alone is a word-character/non-word-character boundary.
To substitute "def" for each occurrence of the word "ABC" within a file, use the Perl command:
perl -pi -e 's/\bABC\b/def/g' file
which will leave strings such as "ZABCD" unchanged.
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;
}