I am trying to create a Perl class LogManager that is to be used to write logs to a file. For that I have written a Class::Std class with following specifications
package LogManager;
use strict;
use warnings;
use Class::Std;
use FileHandle;
my %fName : ATTR( :name<fName> :default<"log">);
my %fLocation : ATTR( :name<fLocation> :default<"./">);
my %fHandle : ATTR( :name<fHandle> :default<undef>);
sub START {
my ($self, $ident, $args_ref) = #_;
my $logfile = $self->get_fLocation(). '/' . $self->get_fName();
$self->set_fHandle(FileHandle->new("> $logfile"));
}
sub log {
my ($self, $msg) = #_;
print $self->get_fHandle(), $msg;
}
1;
What I know of Class::Std is that one can use get and set functions (eg. get_fName(), set_fName()) to read and write values of the attributes.
So, I have defined a START() function as above.
I have used this object as follows
my $fh = LogManager->new();
LogManager::log($fh, "This is my log");
However, instead of writing to the file, following is being printed on the terminal
FileHandle=GLOB(0x5dcdd0)This is my log
I could think of a reason for this. In the START() function third line - there is something else happening than what I intend of - (might be it is copying address of the file handle object - this is a guess).
I'm new to Perl, and can't think of a different way to set the file handle. What I could think of now is creating a normal class instead of a Class::Std class and write something like
my $fHandle = FileHandle->new("> $logfile");
But, what I wanted to know - is there a way I can achieve the same using Class::Std, by some modifications to the above code ?
The syntax for print to a file handle is different: there's no comma. Also, for complex structures, you need curly braces:
print { $self->get_fHandle } $msg;
Related
If I pass it as an argument I get the error:
'Can't locate object method "getline" via package "Bad" at Bad.pm line 27.'
But if I insert it in the module it works.
This is the boiled down code. bad.pl uses the module Bad.pm. Set $CAUSE_ERROR to see the problem.
#!/usr/bin/env perl
# This is bad.pl
use strict;
use warnings;
use IO::File;
use Bad; # use the bad module "Bad.pm"
&Main();
sub Main {
my $filename = "bad.pl";
warn "About to parse '$filename'\n";
my $MyWord = Bad->new(); # Create a new object.
my $io = IO::File->new($filename, "r");
#####################
my $CAUSE_ERROR = 1; # Set to 0 it does NOT cause an error. Set to 1 it DOES.
#####################
if($CAUSE_ERROR ) {
$MyWord->Parse($MyWord, $io);
} else {
$MyWord->{fd} = $io;
$MyWord->Parse($MyWord);
}
}
This is Bad.pm
package Bad;
# This is Bad.pm
use warnings;
use strict;
sub new {
my ($class, $args) = #_;
my $self = {
fd => undef,
};
return bless($self, $class); # Changes a function to a class
}
sub Parse {
my ($MyWord, $io) = #_;
if(defined($MyWord->{fd})){
# WORKS
$io = $MyWord->{fd};
while ( defined(my $inputline = $io->getline) ) {
print "${inputline}";
}
} else {
# FAILS
while ( defined(my $inputline = $io->getline) ) {
print "${inputline}";
}
}
}
1;
Using Perl v5.22.3 under Cygwin.
Originally I had Bad.pm in a sub directory but I simplified it.
Thank you for you time.
To summarize:
$MyWord->Parse($MyWord, $io);
Given that $MyWord is a reference blessed into the Bad class (i.e, it's an instance of Bad), this calls Bad::Parse with the arguments ($MyWord, $MyWord, $io). That is, it behaves as if you'd called:
Bad::Parse($MyWord, $MyWord, $io)`.
However, Bad::Parse() is written to expect the arguments ($MyWord, $io), so $io gets set to the second $MyWord, and Bad::Parse() throws an error when it tries to call $io->getline because the Bad module doesn't implement that method.
The fix is simple:
Call the function as $MyWord->Parse($io).
Change the variable name for the first argument in Bad::Parse() from $MyWord to $self. This isn't strictly necessary -- you can technically call this variable whatever you want -- but it's conventional, and will make your code much more readable to other Perl programmers.
To summarize errors in the posted code: The class name is passed to the constructor behind the scenes, as is the object to methods; we do not supply them. We do pass the filehandle to new, so that it is assigned to object's data and it can thus be used by methods in the class.
Here is a basic example. I try to stick to the posted design as much as possible. This does not do much of what is needed with I/O objects, but is rather about writing a class in general.
The class is meant to process a file, having been passed a filehandle for it. We expect to have one filehandle per object. Since we get it open the reponsibility to close it is left to the caller.
script.pl
use strict;
use warnings;
use feature 'say';
use IO::File;
use ProcessFile;
my $filename = shift || $0; # from command line, or this file
say "About to parse '$filename'";
my $io = IO::File->new($filename, "r") or die "Can't open $filename: $!";
my $word = ProcessFile->new($io); # Create a new object, initialize with $io
$word->parse();
# OR, by chaining calls
#my $word = ProcessFile->new($io)->parse();
say "Have ", ProcessFile->num_objects(), " open filehandles";
$io->close;
The package file ProcessFile.pm
package ProcessFile;
use warnings;
use strict;
use Carp qw(croak);
use Scalar::Util qw(openhandle);
# Example of "Class" data and methods: how many objects (open filehandles)
our $NumObjects;
sub num_objects { return $NumObjects }
sub DESTROY { --$NumObjects }
sub new {
my ($class, $fh) = #_; # class name, arguments passed to constructor
# To also check the mode (must be opened for reading) use Fcntl module
croak "No filehandle or not open or invalid " if not openhandle $fh;
my $self = { _fh => $fh }; # add other data that may make sense
bless $self, $class; # now $self is an object of class ProcessFile
++$NumObjects;
return $self;
}
sub parse {
my ($self, #args) = #_; # object, arguments passed to method (if any)
# Filehandle is retrieved from data, $self->{_fh}
while ( defined(my $inputline = $self->{_fh}->getline) ) {
print $inputline;
}
# Rewind before returning $self (or not, depending on design/#args)
# Can do more here, set some data etc, as needed by class design
seek $self->{_fh}, 0, 0;
return $self;
}
1;
A few comments on the above code follow. Let me know if more would be helpful.
Class data and methods don't belong to any one object, and are used for purposes that relate to the class as a whole (for example, to track all objects in play).
The DESTROY method runs when an object is destroyed, for example when it goes out of scope. Here we need it in order to decrease the count of existing objects. Try: place the code creating an object in a block { ... }; and see what count we get after the block.
We use openhandle from Scalar::Util to test whether the filehandle is open. We should really also test whether it is open for reading, since that is the fixed purpose of the class, using Fcntl.
In the sole, example method parse we read out the file and then rewind the filehandle, before returning the object. That is a placeholder for saving and/or setting the state for repeated use. What is done depends on the purpose and design of the class, and can be controlled by arguments.
Documentation: tutorial perlootut and reference perlobj on object-oriented work in Perl, perlmod for modules (a class is firstly a package), and a tutorial perlreftut for references.
There are also many informative SO posts around, please search.
I have a very interesting predicament. I am working on a Perl script interface to the CVS repository and have created Perl Objects to represent Modules,Paths, and Files. Since Modules, Paths, and Files can all have CVS commands issued on them, I set up the AUTOLOAD routine to take any unidentified methods and issue them on the object as if they were CVS commands.
All of these CVS commands are executed exactly the same way, but some of them need special processing done with the output to get the result i desire.
For example, I want to take the output from the diff command and reformat it before I return it.
I am using Moose, so typically this special processing could be done as follows:
after 'diff' => sub {
# Reformat output here
}
The problem is... I never explicitly created the diff method since it is being generated by AUTOLOAD and Perl won't let me create a method modifier for it since it technically doesn't exist!
Is there a way to get this to work how I want?
Apply after to your AUTOLOAD method.
after 'AUTOLOAD' => sub {
my $method = $The::Package::AUTOLOAD;
$method =~ s/.*:://;
if ($method eq 'diff') {
# do after diff stuff
} elsif ($method eq 'foo') {
# do after foo stuff
} else {
# never mind, don't want to do anything after this function
}
};
EDIT:
I found that I may want even more control over the diff command so I have added more detail to your answer. Hopefully someone will find this information useful.
For even more control you can use around!
around 'AUTOLOAD' => sub {
my $orig = shift;
my $self = shift;
(my $command = $AUTOLOAD) =~ s{.+::}{};
# Special processing
if ($command eq 'diff') {
#
# Add "before" special processing here
#
my $output = $self->$orig(#_);
#
# Add "after" special processing here
#
}
else {
return $self->$orig(#_);
}
};
This allows you to do special processing before the function is called AND after.
For more information see: Moose::Manual::MethodModifiers
Depending on how well the AUTOLOAD-using class is implemented, you may find that it respects the can method too, and that simply calling can is enough to create the method.
__PACKAGE__->can( "diff" );
after diff => sub { ... };
I'd suggest that you re-architect your system to use traits, instead of relying on AUTOLOAD behavior. The maintainability and intent will be much more obvious, if you don't have behavior scattered all over the place.
As an example, you can do what you want with something like the following:
package Trait::CVSActions;
use Moose::Role;
sub commit { print 'in commit for ' . shift . "\n" }
sub diff { print 'diffing for ' . shift . "\n" }
package Module;
use Moose;
with 'Trait::CVSActions';
package Path;
use Moose;
with 'Trait::CVSActions';
after commit => sub { print "after commit on Path\n" };
package main;
my $module = new Module;
my $path = new Path;
$module->commit;
$path->commit;
If you're looking to use AUTOLOAD to dispatch to unknown commands, then this is dangerous, since there may be some that you will have to have special handling for that you aren't aware of, so you may be causing yourself future problems.
I am trying to Iterate directories in Perl, getting introspectable objects as result, mostly so I can print fields like mtime when I'm using Dumper on the returns from IO::All.
I have discovered, that it can be done, if in the module IO::All::File (for me, /usr/local/share/perl/5.10.1/IO/All/File.pm), I add the line field mtimef => undef;, and then modify its sub file so it runs $self->mtimef($self->mtime); (note, this field cannot have the same name (mtime) as the corresponding method/property, as those are dynamically assigned in IO::All). So, in essence, I'm not interested in "overloading", as in having the same name for multiple function signatures - I'd want to "replace" or "override" a class with its extended version (not sure how this is properly called), but under the same name; so all other classes that may use it, get on to using the extended version from that point on.
The best approach for me now would be, if I could somehow "replace" the IO::All::File class, from my actual "runnable" Perl script -- if somehow possible, by using the mechanisms for inheritance, so I can just add what is "extra". To show what I mean, here is an example:
use warnings;
use strict;
use Data::Dumper;
my #targetDirsToScan = ("./");
use IO::All -utf8 ; # Turn on utf8 for all io
# try to "replace" the IO::All::File class
{ # recursive inheritance!
package IO::All::File;
use IO::All::File -base;
# hacks work if directly in /usr/local/share/perl/5.10.1/IO/All/File.pm
field mtimef => undef; # hack
sub file {
my $self = shift;
bless $self, __PACKAGE__;
$self->name(shift) if #_;
$self->mtimef($self->mtime); # hack
return $self->_init;
}
1;
}
# main script start
my $io = io(#targetDirsToScan);
my #contents = $io->all(0); # Get all contents of dir
for my $contentry ( #contents ) {
print Dumper \%{*$contentry};
}
... which fails with "Recursive inheritance detected in package 'IO::All::Filesys' at /usr/local/share/perl/5.10.1/IO/All/Base.pm line 13."; if you comment out the "recursive inheritance" section, it all works.
I'm sort of clear on why this happens with this kind of syntax - however, is there a syntax, or a way, that can be used to "replace" a class with its extended version but of the same name, similar to how I've tried it above? Obviously, I want the same name, so that I wouldn't have to change anything in IO::All (or any other files in the package). Also, I would preferably do this in the "runner" Perl script (so that I can have everything in a single script file, and I don't have to maintain multiple files) - but if the only way possible is to have a separate .pm file, I'd like to know about it as well.
So, is there a technique I could use for something like this?
Well, I honestly have no idea what is going on, but I poked around with the code above, and it seems all that is required, is to remove the -base from the use IO::All::File statement; and the code otherwise seems to work as I expect it - that is, the package does get "overriden" - if you change this snippet in the code above:
# ...
{ # no more recursive inheritance!? IO::All::File gets overriden with this?!
package IO::All::File;
use IO::All::File; # -base; # just do not use `-base` here?!
# hacks work if directly in /usr/local/share/perl/5.10.1/IO/All/File.pm
field mtimef => undef; # hack
sub file {
my $self = shift;
bless $self, __PACKAGE__;
$self->name(shift) if #_;
$self->mtimef($self->mtime); # hack
print("!! *haxx0rz'd* file() reporting in\n");
return $self->_init;
}
1;
}
# ...
I found this so unbelievable, I even added the print() there to make sure it is the "overriden" function that runs, and sure enough, it is; this is what I get in output:
...
!! *haxx0rz'd* file() reporting in
$VAR1 = {
'_utf8' => 1,
'mtimef' => 1394828707,
'constructor' => sub { "DUMMY" },
'is_open' => 0,
'io_handle' => undef,
'name' => './test.blg',
'_encoding' => 'utf8',
'package' => 'IO::All'
};
...
... and sure enough,the field is there, as expected, too...
Well - I hope someone eventually puts a more qualified answer here; for the time being, I hope this is as good as a fix to my problems :) ...
I'm a bit messed up with the following:
I have a function that calls subroutines in the following way:
sub someFunction {
my $self = shift;
my $type = $self->{'type'};
if($type eq 'one_subroutine') {
$self->updateOneSubroutine();
}
elsif($type eq 'another_one_sub') {
$self->updateAnotherOneSub();
}
(...)
else {
die "Unsupported '$type'";
}
I have to change this to let each subroutine be coded in its own file, include all available files, and automagically call the subroutine inside.
I did this in a test file with the following code:
# Assume a routines subdir with one_subroutine.pm file with
sub updateOneSubroutine(){
$self = shift;
$self->doSomeThings();
(...) #my code
}
1;
test.pl
# Saves in routines hash_ref a pair of file_name => subRoutineName for each file in routines subdir.
# This will be used later to call subroutine.
opendir(DIR,"lib/routines") or die "routines directory not found";
for my $filename (readdir(DIR)) {
if($filename=~m/\.pm$/){
# includes file
require "lib/routines/$filename";
# get rid of file extension
$filename=~s/(.*)\.pm/$1/g;
my $subroutine = "update_${file}";
# camelizes the subroutine name
$subroutine=~s/_([a-z0-9])/\u$1/g;
$routine->{ $filename } = $subroutine;
}
}
{
no strict "refs";
$routine->{$param}();
}
where param is something like "one_subroutine", that matches with a filename available.
Since each subroutine receives $self in the call, I should call the routine by $self->something();
I've tried $self->$routine->{$param}() , $self->${routine->${param}}() and many other things without success. I've checked chapter 9 "dynamic subroutines" of mastering perl, and a similar question to perl monks, but I can't still figure out how to reference the subroutine in a way that represents $self->updateAnotherOneSub() , or something similar that lets $self be read as a param in those subroutines.
Thanks in advance, Keber.
This seems a bit like an X/Y problem. What exactly are you trying to do? If it is to reduce loading time, then modules like AutoSplit/AutoLoader might be of interest to you.
If it is to create some sort of data structure of subroutines, you should be installing anonymous subs into a hash, rather than giving them all names.
Given a subroutine reference:
my $code = sub {...};
you would call it as:
$self->$code(...);
If instead you have a subroutine name, you can lookup the coderef:
my $code = 'Package::With::The::Subroutines'->can('method_name');
and if that succeeds (check it), then you can use $self->$code(...) to call it.
Given this code:
{
no strict "refs";
$routine->{$param}();
}
You would pass $self to the routine with:
{
no strict "refs";
$routine->{$param}($self);
}
Or you could approach it the way I did above with can:
'package'->can($routine->{$param})->($self)
if you don't want to turn off strict 'refs'
Try to extract the method name first, then it should work. I did a small test script that may do something like you want to, so:
my $method = $routine->{$param};
$self->$method->();
You can and of course should check, if the desired method exists like Eric said:
if ($self->can($method)) {
$self->$method->();
}
The important part here is, that you extract the method name so you have it in a single variable; otherwise perl won't figure that out for you - and as far as I know there is no way of setting parens or braces to do so.
In Perl we can get the name of the current package and current line number Using the predefined variables like __PACKAGE__ and __LINE__.
Like this I want to get the name of the current subroutine:
use strict;
use warnings;
print __PACKAGE__;
sub test()
{
print __LINE__;
}
&test();
In the above code I want to get the name of the subroutine inside the function test.
Use the caller() function:
my $sub_name = (caller(0))[3];
This will give you the name of the current subroutine, including its package (e.g. 'main::test'). Closures return names like 'main::__ANON__'and in eval it will be '(eval)'.
caller is the right way to do at #eugene pointed out if you want to do this inside the subroutine.
If you want another piece of your program to be able to identify the package and name information for a coderef, use Sub::Identify.
Incidentally, looking at
sub test()
{
print __LINE__;
}
&test();
there are a few important points to mention: First, don't use prototypes unless you are trying to mimic builtins. Second, don't use & when invoking a subroutine unless you specifically need the effects it provides.
Therefore, that snippet is better written as:
sub test
{
print __LINE__;
}
test();
I was just looking for an answer to this question as well, I found caller as well, but I was not interested in the fully qualified path, simply the literal current package name of the sub, so I used:
my $current_sub = (split(/::/,(caller(0))[3]))[-1];
Seems to work perfectly, just adding it in for if anyone else trips over this questions :)
There special __SUB__ exists from perl-5.16.
use v5.16;
use Sub::Identify qw/sub_fullname/;
sub foo {
print sub_fullname( __SUB__ ); # main::foo
}
foo();
Actually you can pass to sub_fullname any subroutine reference (even anonymous):
use Sub::Identify qw/sub_fullname/;
sub foo {
print sub_fullname( \&foo ); # main::foo
print sub_fullname( sub{} ); # main::__ANON__
}
foo();