BACKGROUND
I am using File::Tail to tail a log file symbolic link. The symbolic link gets updated after midnight to include a new date stamp, which unfortunately my script does not tail the new file after the symbolic link is updated. Otherwise, my script works as intended.
#!/usr/bin/env perl
use strict;
use warnings;
use utf8;
use Data::Dumper;
use charnames':full';
use Cwd 'abs_path';
use File::Tail;
my $symlink = sub {
my($log) = '/home/user/log';
};
my $file=File::Tail->new(
name=>&$symlink,
ignore_nonexistant=>1,
tail=>0,
interval=>0,
maxinterval=>1,
name_changes=>\&$symlink
) || warn $!;
print Dumper $file;
while (defined($_=$file->read)) {
# do a bunch of stuff;
}
QUESTION
How do I get perl to follow the updated symbolic link?
From the File::Tail documentation:
name_changes
Some logging systems change the name of the file they are writing to, sometimes to include a date, sometimes a sequence number,
sometimes other, even more bizarre changes.
Instead of trying to implement various clever detection methods, File::Tail will call the code reference defined in name_changes. The
code reference should return the string which is the new name of the
file to try opening.
Note that if the file does not exist, File::Tail will report a fatal error (unless ignore_nonexistant has also been specified).
So your code reference should return the name of the new file, which according to your question has a datestring in it. Perhaps something like this would work:
use Path::Tiny; # file system agnostic path utilty
use Time::Piece; # data utilties
my $symlink = sub {
my $time = localtime; # a Time::Piece object
return path(
'/home/user/log',
join('', $time->year, $time->mon, $time->mday),
)->canonpath;
};
For today this sub would return: /home/user/log20151112
I was missing a return from the sub
my $symlink = sub {
my($log) = '/home/user/log';
return $log;
};
Works perfectly now!
Related
I'm trying to create a module with a method that receives a subroutine and redefines it. I had no problem redefining a subroutine inside the main script but the same syntax doesn't seem to work inside the method:
main.pl
use strict;
use warnings;
use ReDef;
sub orig{
print "Original!\n";
}
orig;
*orig=sub{print "not Original!\n";};
orig;
ReDef::redef(\&orig);
orig;
ReDef.pm
package ReDef;
use strict;
use warnings;
sub redef {
my $ref=shift;
*ref = sub {print "Redefined!";}
}
1;
Test output:
perl main.pl
Original!
Subroutine main::orig redefined at main.pl line 9.
not Original!
not Original!
ReDef::redef() doesn't redefine. The way I see it, the *ref is a coderef and assigning to it another subroutine should change main::orig();
What is the correct syntax?
Your redef function should be like this:
package ReDef;
use strict;
use warnings;
sub redef {
my $ref = shift;
no warnings qw(redefine);
*$ref = sub { print "Redefined!" };
}
And you should NOT call it like this:
ReDef::redef(\&orig);
Instead, you must call it like this:
ReDef::redef(\*orig);
Why? When you call orig, you're looking up the name "orig" via the symbol table, so the redef function needs to be altering the symbol table, so that it can point that name to a different bit of code. Globrefs are basically pointers to little bits of symbol table, so that's what you need to pass to ReDef::redef.
As an analogy, imagine that when you want to know the date of the Battle of Lewes, your procedure is to go to the library, look in the catalogue for the shelf address of a book on 13th century English battles, go to that shelf, and look up the date... voila 14 May 1264! Now, imagine I want to feed you altered information. Simply defining a new coderef would be like putting a new book on the shelf: it won't trick you because the catalogue is still pointing you at the old book. We need to alter the catalogue too.
UPDATE
You can make this a little prettier using prototypes. Prototypes are not usually recommended, but this seems to be a non-evil use for them...
use strict;
use warnings;
sub ReDef::redef (*) {
my $ref = shift;
no warnings qw(redefine);
*$ref = sub { print "Redefined!\n" };
}
sub orig { print "Original!\n" }
orig;
ReDef::redef *orig; # don't need the backslash any more
orig;
This works for me:
use v5.16;
use strict;
use warnings;
package Redef;
sub redef {
my $ref = shift;
${$ref} = sub { say "Redefined!"; }
}
package main;
my $orig = sub { say "Original!"; };
Redef::redef(\$orig);
$orig->(); # Redefined!
Although it’s just a result of trial and error, I’d be happy to see better answers.
What maybe got you confused is the typeglob operator, *. In Perl you dereference using a sigil (${$scalar_ref}, #{$array_ref}) and the * operator is used for symbol table tricks – which could also be used in your case, see the answer by #tobyink.
I am trying to make a library of functions for my oscilloscope, but I can't seem to get other module files to play nice.
What I have is here, except the Oscope.pm file. If it's needed I can upload it too.
test.pl
# Includes
use 5.012;
use Oscope;
use Oscope::Acquire;
use warnings;
# From Oscope.pm
my $scope = Oscope->new('port', 'COM3');
# From Oscope::Acquire.pm
$scope->QueryAcquire();
Oscope/Acquire.pm
package Oscope::Acquire;
use Oscope;
use parent 'Oscope';
sub QueryAcquire
{
my ($self) = #_;
# Oscope.pm
my $message = $self->Send('ACQUIRE?');
return();
}
1;
Output
Can't locate object method "QueryAcquire" via package "Oscope" at C:\Documents and Settings\ericfoss\My Documents\Slick\Perl\tests\Test.pl line 11.
Oscope->new('port', 'COM3')
should be
Oscope::Acquire->new('port', 'COM3')
I'm not going to say this is a good idea. You apparently want Oscope::Aquire to monkey patch Oscope. That is possible, but I would recommend having Oscope::Acquire export a function that takes an Oscope parameter (more information on exporting):
Oscope/Acquire.pm
package Oscope::Acquire;
require Exporter 'import';
#EXPORT_OK = qw{QueryAcquire};
use Oscope;
sub QueryAcquire
{
my ($oscope) = #_;
my $message = $oscope->Send('ACQUIRE?');
return $message;
}
1;
Which you would use:
use Oscope;
use Oscope::Acquire 'QueryAcquire';
my $oscope = Oscope->new();
print QueryAquire($oscope);
However, if you really want the $oscope->QueryAcquire() syntax, and you don't want to put it in Oscope itself, you can monkey patch the module. Perl documentation refers to this as modifying the module's symbol table through a typeglob and it's apparently deprecated ("The results of creating new symbol table entries directly ... are undefined and subject to change between releases of perl"):
Oscope/Acquire.pm
package Oscope::Acquire;
use Oscope;
*Oscope::QueryAcquire = sub {
my ($self) = #_;
my $message = $self->Send('ACQUIRE?');
return $message;
}
1;
I should have read my own link more closely. It appears that the approved way of doing this is to simply add methods to the Oscope package inside the Oscope/Acquire.pm file ("You can define a subroutine outside its package by explicitly qualifying the name of the subroutine"):
package Oscope::Acquire;
use Oscope;
...
sub Oscope::QueryAcquire {
my ($self) = #_;
my $message = $self->Send('ACQUIRE?');
return $message;
}
1;
That is, there's no need to the typeglob.
Where are your lib packages, place your code there. You could also use
use lib "path"
Another explanation can be found here which answers require over lib.
Your area message says it all in that it can't find the function.
As the code stands you could just say $scope->Oscope::Acquire::QueryAcquire();, but to get the desired effect, you need to make it part of the package.
package Oscope;
sub QueryAcquire
{
# Code here
}
1;
I am getting
$VAR1 = bless( \*{'Fh::fh00001Screenshot.png'}, 'Fh' );
in a variable. But I need to retrieve fh00001Screenshot.png from it. How can I get it?
The Fh package is used internally by the CGI module to handle temporary files used for building multipart data. You shouldn't be using it directly.
Check carefully to make sure there is no better way before using this code which comes from the CGI code for Fh::asString
(my $name = $$VAR1) =~ s/^\*(\w+::fh\d{5})+//;
print $name;
output
Screenshot.png
Update
Rather than picking bits out of the CGI code, it looks like this package - which should really be a private one - is accessible from calling code. Use just $var->asString instead, like this
use strict;
use warnings;
use CGI;
my $var = do {
no strict 'refs';
my $var = bless( \*{'Fh::fh00001Screenshot.png'}, 'Fh' );
};
print $var->asString;
I am trying to create some scripts for web testing and I use the following piece of code to set up variables from a config file:
package setVariables;
sub readConfig{
open(FH, "workflows.config") or die $!;
while(<FH>)
{
($s_var, $s_val) = split("=", $_);
chomp($s_var);
chomp($s_val);
$args{$s_var} = $s_val;
print "set $s_var = $s_val\n";
}
close(FH);
}
for example: var1=val1
var2=val2
var3=val3
etc...
I want to be able to pass the values set by this subroutine to a subroutine in another package. This is what I have for the package I want it passed into.
package startTest;
use setVariables;
sub startTest{
my %args = %setVariables::args;
my $s_var = $setVariables::s_var;
my $s_val = $setVariables::s_var;
setVariables::readConfig(); #runs the readConfig sub to set variables
my $sel = Test::WWW::Selenium->new( host => "localhost",
port => 4444,
browser => $args{"browser"},
browser_url => $args{"url"} );
$sel->open_ok("/index.aspx");
$sel->set_speed($args{"speed"});
$sel->type_ok("userid", $args{"usrname"});
$sel->type_ok("password", $args{"passwd"});
$sel->click_ok("//button[\#value='Submit']");
$sel->wait_for_page_to_load_ok("30000");
sleep($args{"sleep"});
}
Unfortunately its not holding on to the variables as is and I don't know how to reference them.
Thank you for any help.
Your code has some problems. Let's fix those first.
# Package names should start with upper case unless they are pragmas.
package SetVariables;
# Do this EVERYWHERE. It will save you hours of debugging.
use strict;
use warnings;
sub readConfig{
# Use the three argument form of open()
open( my $fh, '<', "workflows.config")
or die "Error opening config file: $!\n";
my %config;
# Use an explicit variable rather than $_
while( my $line = <$fh> )
{
chomp $line; # One chomp of the line is sufficient.
($s_var, $s_val) = split "=", $line;
$config{$s_var} = $s_val;
print "set $s_var = $s_val\n";
}
close $fh;
return \%config;
}
Then use like so:
use SetVariables;
my $config = SetVariables::readConfig();
print "$_ is $config->{$_}\n"
for keys %$config;
But rather than do all this yourself, check out the many, many config file modules on CPAN. Consider Config::Any, Config::IniFiles, Config::JSON.
You note in your comment that you are trying to work with multiple files, your main code and a couple of packages.
One pattern that is common is to load your config in your main code and pass it (or select elements of it) to consuming code:
package LoadConfig;
sub read_config {
my $file = shift;
my $config;
# Do stuff to read a file into your config object;
return $config;
}
1;
Meanwhile in another file:
package DoStuff;
sub run_some_tests {
my $foo = shift;
my $bar = shift;
# Do stuff here
return;
}
sub do_junk {
my $config;
my $foo = $config->{foo};
# Do junk
return;
}
1;
And in your main script:
use DoStuff;
use LoadConfig;
my $config = LoadConfig::read_config('my_config_file.cfg');
run_some_tests( $config->{foo}, $config->{bar} );
do_junk( $config );
So in run_some_tests() I extract a couple elements from the config and pass them in individually. In do_junk() I just pass in the whole config variable.
Are your users going to see the configuration file or just programmers? If it's just programmers, put your configuration in a Perl module, then use use to import it.
The only reason to use a configuration file for only programmers if you are compiling the program. Since Perl programs are scripts, don't bother with the overhead of parsing a configuration file; just do it as Perl.
Unless it's for your users and its format is simpler than Perl.
PS: There's already a module called Config. Call yours My_config and load it like this:
use FindBin '$RealBin';
use lib $RealBin;
use My_config;
See:
perldoc FindBin
perldoc Config
I would suggest using a regular format, such as YAML, to store the configuration data. You can then use YAML::LoadFile to read back a hash reference of the configuration data and then use it.
Alternatively, if you don't want to use YAML or some other configuration format with pre-written modules, you'll need for your reading routine to actually return either a hash or a a hashref.
If you need some more background information, check out perlref, perlreftut and perlintro.
all you need to do is collect the variable in a hash and return a reference to it in readConfig:
my %vars = ( var1 => val1,
var2 => val2,
var3 => val3,
);
return \%vars;
and in startTest:
my $set_vars = setVariables::readConfig();
Requirement is to pass module name and function name from the command-line argument.
I need to get the command-line argument in the program and I need to call that function from that module
For example, calling a try.pl program with 2 arguments: MODULE1(Module name) Display(Function name)
perl try.pl MODULE1 Display
I want to some thing like this, but its not working, please guide me:
use $ARGV[0];
& $ARGV[0]::$ARGV[1]();
Assuming the function is not a class method, try this:
#!/usr/bin/perl
use strict;
use warnings;
my ( $package, $function ) = #ARGV;
eval "use $package (); ${package}::$function()";
die $# if $#;
Keep in mind that this technique is wide open to code injection. (The arguments could easily contain any Perl code instead of a module name.)
There's many ways to do this. One of them is:
#!/usr/bin/perl
use strict;
use warnings;
my ( $package, $function ) = #ARGV;
eval "use $package; 1" or die $#;
$package->$function();
Note the the first argument of the function will be $package.
Assuming the module exports the function, this should do:
perl -Mmodule -e function
If you want to make sure your perl script is secure (or at least, prevent yourself from accidentally doing something stupid), I'd avoid doing any kind of eval on data passed in to the script without at least some kind of checking. But, if you're doing some kind of checking anyway, and you end up explicitly checking the input, you might as well explicitly spell out witch methods you want to call. You could set up a hash with 'known good' methods, thus documenting everything that you want callable and protecting yourself at the same time.
my %routines = (
Module => {
Routine1 => \&Module::Method,
Routine2 => \&Module::Method2,
},
Module2 => {
# and so on
},
);
my $module = shift #ARGV;
my $routine = shift #ARGV;
if (defined $module
&& defined $routine
&& exists $routines{$module} # use `exists` to prevent
&& exists $routines{$module}{$routine}) # unnecessary autovivication
{
$routines{$module}{$routine}->(#ARGV); # with remaining command line args
}
else { } # error handling
As a neat side effect of this method, you can simply iterate through the methods available for any kind of help output:
print "Available commands:\n";
foreach my $module (keys %routines)
{
foreach my $routine (keys %$module)
{
print "$module::$routine\n";
}
}
As per Leon's, if the perl module doesn't export it, you can call it like so
perl -MMyModule -e 'MyModule::doit()'
provided that the sub is in that package.
If it exports the sub all the time (in #EXPORT), then Leon's will work:
perl -MMyModule -e doit
If it is an optional export (in #EXPORT_OK), then you can do it like this.
perl -MMyModule=doit -e doit
But the first will work in any case where the sub is defined to the package, and I'd probably use that one over the last one.
Always start your Perl like this:
use strict;
use warnings 'all';
Then do this:
no strict 'refs';
my ($class, $method) = #_;
(my $file = "$class.pm") =~ s/::/\//g;
require $file;
&{"$class\::$method"}();
Whatever you do, try not to eval "$string" ever.
Well, for your revised question, you can do this:
use strict;
use warnings;
{
no strict;
use Symbol qw<qualify>;
my $symb = qualify( $ARGV[1], $ARGV[0] );
unless ( defined &{$symb} ) {
die "&$ARGV[1] not defined to package $ARGV[0]\::";
}
&{$symb};
}
And because you're specifying it on the command line, the easiest way to include from the command line is the -M flag.
perl -MMyModule try.pl MyModule a_subroutine_which_does_something_cool
But you can always
eval "use $ARGV[0];";
But that's highly susceptible to injection:
perl try.pl "Carp; `do something disastrous`;" no_op
I'd use UNIVERSAL::require. It allows you to require or use a module from a variable. So your code would change to something like this:
use UNIVERSAL::require;
$ARGV[0]->use or die $UNIVERSAL::require::ERROR;
$ARGV[0]::$ARGV[1]();
Disclaimer: I did not test that code and I agree Robert P's comment about there probably being a better solution than passing these as command line arguments.