Perl Export Suggestions - perl

I am working with a new program that needs to interface with perl.
The example code suggests that all of the methods will be exported to the global namespace like below:
use BGPmon::Fetch;
my $ret = init_bgpdata();
my $ret = connect_bgpdata();
my $xml_msg = read_xml_message();
...
However using any of the methods like that causes "Undefined subroutine &Fetch::init_bgpdata." I know the module works but doesn't seem to be exporting correctly because I can still use the long names: BGPmon::Fetch::init_bgpdata();.
Any reason why the module isn't exporting correctly?
Note: I would love to share the method code but I know its not a problem with the module. It is part of a codeset I can't share and I know it works because the tests manage to pass.
Exporter Section
require Exporter;
our $AUTOLOAD;
our #ISA = qw(Exporter);
our %EXPORT_TAGS = ( 'all' => [ qw(connect_bgpdata read_xml_message
close_connection is_connected messages_read uptime connection_endtime
get_error_code get_error_message get_error_msg) ] );
our #EXPORT_OK = ( #{ $EXPORT_TAGS{'all'} } );
Public source code (mine is the dev)

In the code you have given, you are defining a tag :all
So you calling code can do
use BGPmon::Fetch ':all' ;
Alternatively you can import them individually
use BGPmon::Fetch qw(init_bgpdata connect_bgpdata); # and so on
It is worth having a look at Exporter - apologies if already done so

Related

Using a variable in a library name when trying to use a library perl

I want my library name to change (I have reasons), but when I use a variable in the library path, it can't seem to find it.....Can't locate APOE.pm in #INC
my ($plugin_name) = #ARGV;
use lib("/usr/share/perl/5.10.1/$plugin_name");
use APOE qw(callAPOE);
Is this not possible?
Edit:
$plugin_name = "AIB-TorrentPanel-v2.00";
AND module name is
APOE.pm
You could simply write:
use lib "/usr/share/perl/5.10.1/$ARGV[0]";
or, if you need to do something more complicated to set up the directory name than your example code shows:
my $plugin_name;
BEGIN {
($plugin_name) = #ARGV;
}
use lib "/usr/share/perl/5.10.1/$plugin_name";
Your my ($plugin_name) = #ARGV; will run at run-time, it is too late for lib. According to the manual of lib, use lib LIST; is almost equals
BEGIN { unshift(#INC, LIST) }
but your $plugin_name would not be available at that time.
However, you could replace your use with a require, like this:
my ($plugin_name) = #ARGV;
require "/usr/share/perl/5.10.1/$plugin_name/APOE.pm";

Accessing subs from a require'd perl script

I'm going to import some perl code with the require statement. The code I'd like to import is in mylibA.pl:
#!/usr/bin/perl
package FOO::BAR;
sub routine {
print "A message!\n";
}
and mylibB.pl:
#!/usr/bin/perl
package FOO::BAZ;
sub routine {
print "Another message!\n";
}
Then I'm going to use it like this:
#!/usr/bin/perl
foreach my $lib (qw/ mylibA.pl mylibB.pl /){
require $lib;
print "Make a call to ${lib}'s &routine!\n";
}
Is there a way for my script to figure out the namespace that was pulled in with the require statement?
Wow. I have to say this is the one of the most interesting Perl questions I've seen in a while. On the surface this seems like a very simple request - get an included module's namespace, but there really is no way to do this. You can get it while in the package, but not from outside the package. I tried using EXPORT to send the local package name back to the caller script but that ended up going nowhere given the difference in how "use" and "require" work. A more module type of approach probably would have worked with a "use" statement, but the requirement that the required script be able to run by themselves prevented that approach. The only thing left to do was to directly pollute the caller's namespace and hope for the best (assume that the caller had no package namespace) - something that modules are designed to prevent.
BTW - I can't believe this actually works - in strict mode, no less.
caller.pl
#!/usr/bin/perl
use strict;
#package SomePackageName; #if you enable this then this will fail to work
our $ExportedPackageName;
print "Current package=".__PACKAGE__."\n";
foreach my $lib (qw/ mylibA.pl mylibB.pl /){
require $lib;
print "Make a call to ${lib}'s &routine!\n";
print "Package name exported=".$ExportedPackageName."\n";
$ExportedPackageName->routine;
} #end foreach
print "Normal Exit";
exit;
__END__
mylibA.pl
#!/usr/bin/perl
package FOO::BAR;
use strict;
#better hope the caller does not have a package namespace
$main::ExportedPackageName=__PACKAGE__;
sub routine {
print "A message from ".__PACKAGE__."!\n";
}
1;
mylibB.pl
#!/usr/bin/perl
package FOO::BAZ;
use strict;
#better hope the caller does not have a package namespace
$main::ExportedPackageName=__PACKAGE__;
sub routine {
print "Another message, this time from ".__PACKAGE__."!\n";
}
1;
Result:
c:\Perl>
c:\Perl>perl caller.pl
Current package=main
Make a call to mylibA.pl's &routine!
Package name exported=FOO::BAR
A message from FOO::BAR!
Make a call to mylibB.pl's &routine!
Package name exported=FOO::BAZ
Another message, this time from FOO::BAZ!
Normal Exit
Regarding the mostly academical problem of finding the package(s) in a perl source file:
You can try the CPAN module Module::Extract::Namespaces to get all packages within a perl file. It is using PPI and is thus not 100% perfect, but most of the time good enough:
perl -MModule::Extract::Namespaces -e 'warn join ",", Module::Extract::Namespaces->from_file(shift)' /path/to/foo.pm
But PPI can be slow for large files.
You can try to compare the active packages before and after the require. This is also not perfect, because if your perl library file loads additional modules then you cannot tell which is the package of the prinicipal file and what's loaded later. To get the list of packages you can use for example Devel::Symdump. Here's a sample script:
use Devel::Symdump;
my %before = map { ($_,1) } Devel::Symdump->rnew->packages;
require "/path/to/foo.pm";
my %after = map { ($_,1) } Devel::Symdump->rnew->packages;
delete $after{$_} for keys %before;
print join(",", keys %after), "\n";
You can also just parse the perl file for "package" declarations. Actually, that's what the PAUSE upload daemon is doing, so it's probably "good enough" for most cases. Look at the subroutine packages_per_pmfile in
https://github.com/andk/pause/blob/master/lib/PAUSE/pmfile.pm
There are two problems here:
How do I change the behaviour of a script when executed as a standalone and when used as a module?
How do I discover the package name of a piece of code I just compiled?
The general answer to question 2 is: You don't, as any compilation unit may contain an arbitrary number of packages.
Anyway, here are three possible solutions:
Name your modules so that you already know the name when you load it.
Have each module register itself at a central rendezvous point.
Like #1, but adds autodiscovery of your plugins.
The simplest solution is to put all of the API in an ordinary module, and put the standalone logic in a seperate script:
/the/location/
Module/
A.pm
B.pm
a-standalone.pl
b-standalone.pl
Where each standalone basically looks like
use Module::A;
Module::A->run();
If another script wants to reuse that code, it does
use lib "/the/location";
use Module::A;
...
If the loading happens on runtime, then Module::Runtime helps here:
use Module::Runtime 'use_module';
use lib "/the/location";
my $mod_a = use_module('Module::A');
$mod_a->run();
It isn't strictly necessary to place the contents of a-standalone.pl and Module/A.pm into separate files, although that is clearer. If you want to conditionally run code in a module only if it is used as a script, you can utilize the unless(caller) trick.
Of course all of this is tricksing: Here we determine the file name from the module name, not the other way round – which as I already mentioned we cannot do.
What we can do is have each module register itself at a certain predefined location, e.g. by
Rendezvous::Point->register(__FILE__ => __PACKAGE__);
Of course the standalone version has to shield against the possibility that there is no Rendezvous::Point, therefore:
if (my $register = Rendezvous::Point->can("register")) {
$register->(__FILE__ => __PACKAGE__);
}
Eh, this is silly and violates DRY. So let's create a Rendezvous::Point module that takes care of this:
In /the/location/Rendezvous/Point.pm:
package Rendezvous::Point;
use strict; use warnings;
my %modules_by_filename;
sub get {
my ($class, $name) = #_;
$modules_by_filename{$name};
}
sub register {
my ($file, $package) = #_;
$modules_by_filename{$file} = $package;
}
sub import {
my ($class) = #_;
$class->register(caller());
}
Now, use Rendezvous::Point; registers the calling package, and the module name can be retrived by the absolute path.
The script that wants to use the various modules now does:
use "/the/location";
use Rendezvous::Point (); # avoid registering ourself
my $prefix = "/the/location";
for my $filename (map "$prefix/$_", qw(Module/A.pm Module/B.pm)) {
require $filename;
my $module = Rendezvous::Point->get($filename)
// die "$filename didn't register itself at the Rendezvous::Point";
$module->run();
}
Then there are fully featured plugin systems like Module::Pluggable. This system works by looking at all paths were Perl modules may reside, and loads them if they have a certain prefix. A solution with that would look like:
/the/location/
MyClass.pm
MyClass/
Plugin/
A.pm
B.pm
a-standalone.pl
b-standalone.pl
Everything is just like with the first solution: Standalone scripts look like
use lib "/the/location/";
use MyClass::Plugin::A;
MyClass::Plugin::A->run;
But MyClass.pm looks like:
package MyClass;
use Module::Pluggable require => 1; # we can now query plugins like MyClass->plugins
sub run {
# Woo, magic! Works with inner packages as well!
for my $plugin (MyClass->plugins) {
$plugin->run();
}
}
Of course, this still requires a specific naming scheme, but it auto-discovers possible plugins.
As mentioned before it is not possible to look up the namespace of a 'required' package without extra I/O, guessing or assuming.
Like Rick said before, one have to intrude the namespace of the caller or better 'main'. I prefer to inject specific hooks within a BEGIN block of the 'required' package.
#VENDOR/App/SocketServer/Protocol/NTP.pm
package VENDOR::App::SocketServer::Protocol::NTP;
BEGIN {
no warnings;
*main::HANDLE_REQUEST = \&HANDLE_REQUEST;
}
sub HANDLE_REQUEST {
}
#VENDOR/App/SocketServer.pm
my $userPackage= $ARGV[0];
require $userPackage;
main::HANDLE_REQUEST();
Instead of *main:: you can get more specific with *main::HOOKS::HANDLE_REQUESTS i.e. This enables you to resolve all injected hooks easily within the caller by iterating over the HOOK's namespace portion.
foreach my $hooks( keys %main::HOOKS ) {
}

Log4perl: How do I dynamically load appenders at runtime?

I'd like to have modules managing their logging at runtime, but without having everything referring to a single monolithic config file. When dealing with processes running under different permissions, I really don't want to deal with each process needing to be able to access every log on the system when they're only writing to a subset of them.
However, I'm not finding much documentation in the Log4perl manual on how to initialize additional appenders from a configuration file at runtime. http://metacpan.org/pod/Log::Log4perl::Appender references an add_appender method, but that works on instantiated appender objects instead of conf files. It also doesn't define the logger objects and the logger->appender relations.
I tried having each package init from its own conf, but that simply clobbers the existing config each time it's initalized. What I'd like to do is something along the lines of:
my $foo = Foo->new() ## Checks Log::Log4perl::initialized(), sees that it
## hasn't been initalized yet, inits Log4perl from foo.conf
my $bar = Bar->new() ## Checks Log::Log4perl::initialized(), sees that it
## has been initalized. Adds appenders and loggers defined
## in bar.conf into the initialized configuration
How can I parse and add the configuration into the current config?
Edit: Probalem with using a package variable is that this is just a Moose role being consumed by various classes, pretty much just a MooseX::Role::Parameterized version of Ether's answer in Making self-logging modules with Log::Log4perl. Thus, my logger is getting composed into the library consuming it, and I don't have a global variable I can work on each time I use it.
Though..
If I declare a global variable outside of the MooseX::Role::Parameterized role block, would each and every class that consumes the role be using that same conf variable?
You can remember what config files was already loaded (%log_configs hash in code below). When new class arrives, you can reread all configs, merge it together and init Log::Log4perl again using string reference parameter to init.
I generally prefer having a single log configuration per application, because of easier maintenance and reload capability.
package Logger;
use Moose::Role;
use Log::Log4perl;
our %log_configs = ();
around BUILDARGS => sub {
my $orig = shift;
my $class = shift;
my $config_name = lc($class) . '.conf';
# if the config is not integrated yet
if(! defined $log_configs{$config_name}) {
$log_configs{$config_name} = 1;
# reload all configs including new one
my $config_text = '';
for my $file (sort keys %log_configs) {
$config_text .= "\n" . do {
local $/; # slurp
unless(open my $fh, "<", $file) {
warn "$file could not be open\n";
'';
}
else {
<$fh>
}
};
}
# refresh config
Log::Log4perl::init(\$config_text);
}
return $class->$orig(#_);
};
package Foo;
use Moose;
with 'Logger';
use Log::Log4perl ':easy';
sub BUILD {
ERROR 'Foo reporting';
}
package Bar;
use Moose;
with 'Logger';
use Log::Log4perl ':easy';
sub BUILD {
INFO 'Bar reporting';
}
package main;
my $foo = Foo->new;
my $bar = Bar->new;
While I was hoping to avoid it, if I parse the config files myself I can then access the configuration in perl via the API documented in http://search.cpan.org/perldoc?Log::Log4perl. Namely,
########################
# Initialization section
########################
use Log::Log4perl;
use Log::Log4perl::Layout;
use Log::Log4perl::Level;
# Define a category logger
my $log = Log::Log4perl->get_logger("Foo::Bar");
# Define a layout
my $layout = Log::Log4perl::Layout::PatternLayout->new("[%r] %F %L %m%n");
# Define a file appender
my $file_appender = Log::Log4perl::Appender->new(
"Log::Log4perl::Appender::File",
name => "filelog",
filename => "/tmp/my.log");
# Define a stdout appender
my $stdout_appender = Log::Log4perl::Appender->new(
"Log::Log4perl::Appender::Screen",
name => "screenlog",
stderr => 0);
# Have both appenders use the same layout (could be different)
$stdout_appender->layout($layout);
$file_appender->layout($layout);
$log->add_appender($stdout_appender);
$log->add_appender($file_appender);
$log->level($INFO);
While the other method works, there's too many caveats for me to be comfortable using it (Gee I used this library, why'd my logging stop?) -- it's just too surprising for my tastes.
Instead, I think I'm going to see if I can't get from config file to Log::Log4perl state by looking through how to use Log::Log4perl::Config::PropertyConfigurator, which is delegated to by ->init when parsing a config file is needed. If I go over the data structure that returns, i can compare changes to the initialization on a logger-by-logger and appender-by-appender basis and modify the initialized state appropriately, handle namespace collisions properly, etc.

Is there a tool for extracting all variable, module, and function names from a Perl module file?

My apologies if this is a duplicate; I may not know the proper terms to search for.
I am tasked with analyzing a Perl module file (.pm) that is a fragment of a larger application. Is there a tool, app, or script that will simply go through the code and pull out all the variable names, module names, and function calls? Even better would be something that would identify whether it was declared within this file or is something external.
Does such a tool exist? I only get the one file, so this isn't something I can execute -- just some basic static analysis I guess.
Check out the new, but well recommended Class::Sniff.
From the docs:
use Class::Sniff;
my $sniff = Class::Sniff->new({class => 'Some::class'});
my $num_methods = $sniff->methods;
my $num_classes = $sniff->classes;
my #methods = $sniff->methods;
my #classes = $sniff->classes;
{
my $graph = $sniff->graph; # Graph::Easy
my $graphviz = $graph->as_graphviz();
open my $DOT, '|dot -Tpng -o graph.png' or die("Cannot open pipe to dot: $!");
print $DOT $graphviz;
}
print $sniff->to_string;
my #unreachable = $sniff->unreachable;
foreach my $method (#unreachable) {
print "$method\n";
}
This will get you most of the way there. Some variables, depending on scope, may not be available.
If I understand correctly, you are looking for a tool to go through Perl source code. I am going to suggest PPI.
Here is an example cobbled up from the docs:
#!/usr/bin/perl
use strict;
use warnings;
use PPI::Document;
use HTML::Template;
my $Module = PPI::Document->new( $INC{'HTML/Template.pm'} );
my $sub_nodes = $Module->find(
sub { $_[1]->isa('PPI::Statement::Sub') and $_[1]->name }
);
my #sub_names = map { $_->name } #$sub_nodes;
use Data::Dumper;
print Dumper \#sub_names;
Note that, this will output:
...
'new',
'new',
'new',
'output',
'new',
'new',
'new',
'new',
'new',
...
because multiple classes are defined in HTML/Template.pm. Clearly, a less naive approach would work with the PDOM tree in a hierarchical way.
Another CPAN tools available is Class::Inspector
use Class::Inspector;
# Is a class installed and/or loaded
Class::Inspector->installed( 'Foo::Class' );
Class::Inspector->loaded( 'Foo::Class' );
# Filename related information
Class::Inspector->filename( 'Foo::Class' );
Class::Inspector->resolved_filename( 'Foo::Class' );
# Get subroutine related information
Class::Inspector->functions( 'Foo::Class' );
Class::Inspector->function_refs( 'Foo::Class' );
Class::Inspector->function_exists( 'Foo::Class', 'bar' );
Class::Inspector->methods( 'Foo::Class', 'full', 'public' );
# Find all loaded subclasses or something
Class::Inspector->subclasses( 'Foo::Class' );
This will give you similar results to Class::Sniff; you may still have to do some processing on your own.
There are better answers to this question, but they aren't getting posted, so I'll claim the fastest gun in the West and go ahead and post a 'quick-fix'.
Such a tool exists, in fact, and is built into Perl. You can access the symbol table for any namespace by using a special hash variable. To access the main namespace (the default one):
for(keys %main::) { # alternatively %::
print "$_\n";
}
If your package is named My/Package.pm, and is thus in the namespace My::Package, you would change %main:: to %My::Package:: to achieve the same effect. See the perldoc perlmod entry on symbol tables - they explain it, and they list a few alternatives that may be better, or at least get you started on finding the right module for the job (that's the Perl motto - There's More Than One Module To Do It).
If you want to do it without executing any code that you are analyzing, it's fairly easy to do this with PPI. Check out my Module::Use::Extract; it's a short bit of code shows you how to extract any sort of element you want from PPI's PerlDOM.
If you want to do it with code that you have already compiled, the other suggestions in the answers are better.
I found a pretty good answer to what I was looking for in this column by Randal Schwartz. He demonstrated using the B::Xref module to extract exactly the information I was looking for. Just replacing the evaluated one-liner he used with the module's filename worked like a champ, and apparently B::Xref comes with ActiveState Perl, so I didn't need any additional modules.
perl -MO=Xref module.pm

How can I access the Apache server configuration in a BEGIN block in mod_perl?

I've been trying to switch from using PerlSetEnv to using custom configuration directives. I have my configuration module with a copy of set_val from the docs:
sub set_val
{
local our ($key, $self, $parms, $arg) = #_;
$self->{$key} = $arg;
unless ($parms->path)
{
local our $srv_cfg = Apache2::Module::get_config($self, $parms->server);
$srv_cfg->{$key} = $arg;
}
}
...which is called by every custom directive sub. Then I have in my .conf:
PerlLoadModule MyModule::ServerConfig
MyCustomDirective 'hello'
This works fine in that httpd -t okays the file's syntax. The problem is that I can't seem to get at the value from the config file from within a BEGIN block, which I need to do.
I've tried tinkering with all sorts of things:
BEGIN
{
use Apache2::CmdParms ();
# use Apache2::Directive ();
use Apache2::Module ();
# use Apache2::ServerUtil ();
# use Apache2::RequestUtil ();
use Data::Dump;
warn ddx(Apache2::Module::get_config('MyModule::ServerConfig', Apache2::CmdParms->server));
# warn ddx(Apache2::Directive->as_hash);
# warn Apache2::ServerUtil->dir_config('MyCustomDirective);
# warn Apache2::CmdParms->server->server_hostname();
}
...but to no avail. Most of my efforts (trying to access CmdParms->server for instance) result in Parent: child process exited with status 3221225477 -- Restarting and an automatic restart of Apache as it says. If I pass ServerUtil->server to get_config(), the server stays alive but the warning only prints out '1'.
I read somewhere that this is because you can't get at anything request-related within a BEGIN block, because requests vary. It kind of makes sense, except that with PerlOptions +GlobalRequest I have been able to see $ENV within a BEGIN block, so why wouldn't I be able to see my own directives, just as dependent as they are on how the request happens? Especially confusing is that if I try to pass Apache2::RequestUtil->request->per\_dir\_config() to get_config(), it says Global $r object is not available. If that's true in a BEGIN block, how is it I can get at $ENV?
Try add what you want to import function to other module and use this module in code where you usually put BEGIN block. It should work same. May be it helps.
Partly, Dump isn't being used correctly. This works better:
use Data::Dump qw(pp);
warn pp(Apache2::Module::get_config('MyModule::ServerConfig', Apache2::ServerUtil->server));
However, it doesn't show any directives that appear within <Directory> blocks.
In my particular case, though, I don't need that functionality, on second thought; that just happens to be where I had stuck them.