I have problem with logging some messages in perl. I created simple log package. I still get just first row to the file. Seems like there is appending to file not working. Any ideas?
even when i run that script more times, there arent any changes in output log file. There is always just written "something". I need to append that "somethingElse" to the output file. Do I have some mistake in log?
package Logger;
sub new {
my $package = shift;
my $self = {};
bless $self , $package;
$self->initialize(#_);
return $self;
}
sub initialize {
my $self = shift;
$self->{logfile} = shift;
return;
}
sub logger {
my $self = shift;
my $message = shift;
my (undef,$script, $line) = caller;
open(LOG, ">>$self->{logfile}");
print LOG substr(scalar localtime(),4,15), " ", $message, "\n";
close(LOG);
return;
}
my $log = Logger->new('/usr/local/logs/test.log');
$log->logger("something");
$log->logger("somethingElse");
Thank you
This code works fine for me, so I can't be sure this is the correct solution, but often when some code doesn't print what you want it to, it's because of an autoflush problem. You could try adding this:
$| = 1
or if you prefer:
use English qw( -no_match_vars );
$OUTPUT_AUTOFLUSH = 1;
to the beginning of your program and see if that helps.
Related
This question is based on the observed behavior of patch running with a certain version of perl. When running a command like:
$ patch -N -p0 -u -b .bak < my.patch
I occasionally got output like:
print() on unopened filehandle NULL at patch line 715, <IN> line 12330.
When looking into the code, I see that the NULL filehandle is localized and saved in the object hash:
sub new {
# ....
local *NULL;
tie *NULL, 'Dev::Null';
$self->{o_fh} = \*NULL; # output filehandle
# ....
}
Since this behavior (the output of the message print() on unopened filehandle NULL) only occured for certain versions of perl and (maybe certain version of the patch program) I wondered if this is a bug? To me it looks like one should not localize NULL since we are saving a reference to it and the value of reference (*NULL) will be restored to its previous value when returning from new().
Here is a minimal example:
use feature qw(say);
use strict;
use warnings;
my $p = Patch->new();
$p->apply();
package Patch;
sub new {
my ( $class ) = #_;
my $self = bless {}, $class;
local *NULL;
tie *NULL, 'Dev::Null';
$self->{null} = \*NULL;
local *OUT;
my $out = 'out.txt';
open OUT, ">$out" or die "Couldn't open '$out': $!\n";
$self->{out} = \*OUT;
return $self;
}
sub apply {
my ( $self ) = #_;
my $null = $self->{null};
say $null "This should be discarded..";
my $out = $self->{out};
say $out "This is output to the file..";
}
package Dev::Null;
sub TIEHANDLE { bless \my $null }
sub PRINT {}
sub PRINTF {}
sub WRITE {}
sub READLINE {''}
sub READ {''}
sub GETC {''}
The output when I run this is:
say() on unopened filehandle NULL at ./p.pl line 34.
say() on unopened filehandle OUT at ./p.pl line 36.
It's a bug in patch.
$self->{...} = \*NULL;
should be
$self->{...} = *NULL;
Let's look at these four snippets:
my $r; $s = "abc"; $r = \$s; say $$r;
my $r; { local $s; $s = "abc"; $r = \$s; } say $$r;
my $r; *F = \*STDOUT; $r = \*F; say $r "abc";
my $r; { local *F; *F = \*STDOUT; $r = \*F; } say $r "abc";
Given that the first three work, we would expect the fourth to work too, but it doesn't.
We can't really talk in terms of variables and values in Perl. Perl's model is far more complex than C's where a variable is just a name that represents a location. Globs are even more complex because they're both a variable type (*FOO) something that can be found in a scalar ($foo = *FOO;). The above difference is related to this.
The following does work while still properly localizing *F:
my $r; { local *F; *F = \*STDOUT; $r = *F; } say $r "abc";
patch already uses this approach for *OUT, but it needs to use it for *NULL too. It probably went unnoticed because *NULL is used as a sink, and using an undefined handle also acts as a sink (if you disregard the warning and the error returned by print).
I came to appreciate Log4perl and I would like to make use of it across the main Perl-script and (several) modules. How do I implement it, preferably in an OO-fashion?
Is it possible to hook up the logger-object (of the main script) with the object of the module in order to fully log events that happen in the main script as well as events of the module('s object)?
Say I've got something like this main-script:
use rotate_action;
use Log::Log4perl;
my $logger = get_logger();
my $appender_log = Log::Log4perl::Appender->new(
"Log::Dispatch::File",
filename => "action.log",
mode => "append"
);
$logger->add_appender($appender_log);
$logger->info("Logger activated");
use rotate_action;
my $ro = Rotation->new; # package in rotate_action.pm
#associate logger-object with ro-object here:
$ro->$logger; # pseudo-code!
my $file "somefile";
$logger->info("processing $file");
$ro->process_file("$file");
$logger->info("finished processing $file);
And a module rotate_action like this:
{
package Rotation;
sub new {
my $class = shift;
my $self = {};
bless $self, $class;
return $self;
}
sub process_file {
my $self = shift;
my $file = shift;
my $exec_string = "identify -format \"orientation: %[orientation]\ngeometry: %g\n\"";
$exec_string .= " $file";
my $exec_result = `$exec_string 2>&1`;
my $err_lvl = $?;
if ($err_lvl != 0) {
#put same logger-object from main script here:
$self->$logger->warn("$file is not an image"); # pseudo-code!
} else {
#put same logger-object from main script here:
$self->$logger->info("rotate $file"); # pseudo-code!
`rotate.sh $file`;
}
}
}
How do I pass the logger-object on to the module in order to write to the same logfile (as configured in the main-script)?
You can add a logger field to the object and store the logger there:
sub add_logger {
my ($self, $logger) = #_;
$self->{logger} = $logger;
}
Which would be called like
$ro->add_logger($logger);
And you can then
$self->{logger}->warn("$file is not an image");
Or you can provide the logger directly to the constructor.
This question was born out of another (Completely destroy all traces of an object in Perl). After seeing some of the comments I believe I have narrowed the problem down to the "real" issue.
I'm looking for a simple way to link a variable to a class attribute in Perl so that whenever the attribute is modified, the variable will be automatically updated.
ex (some pseudo code):
# Create a file object
my $file = File->new();
# Get the text
my $text = $file->text();
# prints 'hello'
print $text;
# Set the text
$file->text('goodbye');
# prints 'goodbye'
print $text;
Also I want the $text variable to be read only so that you cannot inadvertently modify the text attribute of the file.
Use tie:
#!/usr/bin/perl
use warnings;
use strict;
use feature qw{ say };
{ package File;
sub new {
bless ['hello'], shift
}
sub text {
my $self = shift;
if (#_) {
$self->[0] = shift;
} else {
return $self->[0]
}
}
}
{ package FileVar;
use Tie::Scalar;
use parent qw( -norequire Tie::StdScalar );
sub TIESCALAR {
my ($class, $obj) = #_;
bless \$obj, $class
}
sub FETCH {
my $self = shift;
${$self}->text()
}
sub STORE {
die 'Read only!';
# Or, do you want to change the object by changing the var, too?
my ($self, $value) = #_;
${$self}->text($value);
}
}
my $file = 'File'->new();
tie my $text, 'FileVar', $file;
say $text;
$file->text('goodbye');
say $text;
# Die or change the object:
$text = 'Magic!';
say $file->text;
I recently started playing around with writing Perl (v5.8.8) extensions using XS. One of the methods I am writing collects a bunch of data and splats it to the client. I want to write some unit tests that make assertions against the output, but I'm running in to a problem: It doesn't appear that the PerlIO methods are passing data through the same channels as a print call in Perl does. Normally, you can tie in to the STDOUT file handler and intercept the result, but the PerlIO methods seem to be bypassing this completely.
I've pasted an example below, but the basic jist of my test is this: Tie in to STDOUT, run code, untie, return collected string. Doing this, I'm able to capture print statements, but not the PerlIO_* calls from my module. I've tried using PerlIO_write, PerlIO_puts, PerlIO_printf, and more. No dice.
From scratch, here is a minimal repro of what I'm doing:
h2xs -A -n IOTest
cd IOTest
Put this in to IOTest.xs:
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#include "ppport.h"
MODULE = IOTest PACKAGE = IOTest
void
oink ()
CODE:
PerlIO_puts(PerlIO_stdout(), "oink!\n");
And this goes in to a file called test.pl (The interesting part is near the bottom, everything else is just for capturing stdout):
# Set up the include path to match the build directories
BEGIN {
push #INC, './blib/lib/';
push #INC, './blib/arch/auto/IOTest';
}
use IOTest;
# This package is just a set of hooks for tieing in to stdout
{
# Lifted from the Test::Output module found here:
# http://search.cpan.org/~bdfoy/Test-Output-1.01/lib/Test/Output.pm
package OutputTie;
sub TIEHANDLE {
my $class = shift;
my $scalar = '';
my $obj = shift || \$scalar;
bless( $obj, $class);
}
sub PRINT {
my $self = shift;
$$self .= join(defined $, ? $, : '', #_);
$$self .= defined $\ ? $\ : '';
}
sub PRINTF {
my $self = shift;
my $fmt = shift;
$$self .= sprintf $fmt, #_;
}
sub read {
my $self = shift;
my $data = $$self;
$$self = '';
return $data;
}
}
# Runs a sub, intercepts stdout and returns it as a string
sub getStdOut (&) {
my $callback = shift;
select( ( select(STDOUT), $| = 1 )[0] );
my $out = tie *STDOUT, 'OutputTie';
$callback->();
my $stdout = $out->read;
undef $out;
untie *STDOUT;
return $stdout;
}
# This is the interesting part, the actual test:
print "Pre-capture\n";
my $output = getStdOut(sub {
print "before";
IOTest::oink();
print "after";
});
print "Captured StdOut:\n" . $output . "\nend\n";
Building and testing is then just a matter of:
perl Makefile.PL
make
perl test.pl
The output I'm seeing is:
Pre-capture
oink!
Captured StdOut:
beforeafter
end
Obviously, I'm expecting "oink!" to be sandwiched between "before" and "after", but that doesn't appear to be happening.
Any ideas?
I think the capturing is faulty. Compare:
use IOTest;
use Capture::Tiny qw(capture);
print "Pre-capture\n";
my $output = capture {
print "before";
IOTest::oink();
print "after";
};
print "Captured StdOut:\n" . $output . "\nend\n";
Pre-capture
Captured StdOut:
beforeoink!
after
end
please look at the following code first.
#! /usr/bin/perl
package foo;
sub new {
my $pkg = shift;
my $self = {};
my $self->{_fd} = undef;
bless $self, $pkg;
return $self;
}
sub Setfd {
my $self = shift;
my $fd = shift;
$self_->{_fd} = $fd;
}
sub write {
my $self = shift;
print $self->{_fd} "hello word";
}
my $foo = new foo;
My intention is to store a file handle within a class using hash. the file handle is undefined at first, but can be initilized afterwards by calling Setfd function. then
write can be called to actually write string "hello word" to a file indicated by the file handle, supposed that the file handle is the result of a success "write" open.
but, perl compiler just complains that there are syntax error in the "print" line. can anyone of you tells me what's wrong here? thanks in advance.
You will need to put the $self->{_fd} expression in a block or assign it to a simpler expression:
print { $self->{_fd} } "hello word";
my $fd = $self->{_fd};
print $fd "hello word";
From perldoc -f print:
Note that if you're storing FILEHANDLEs in an array, or if you're using any other expression more complex than a scalar variable to retrieve it, you will have to use a block returning the filehandle value instead:
print { $files[$i] } "stuff\n";
print { $OK ? STDOUT : STDERR } "stuff\n";
Alternately:
use IO::Handle;
# ... later ...
$self->{_fd}->print('hello world');