How to use gdbm in Perl - perl

I'm new to gdbm and I would like to use it in Perl. I know that Perl ships by default with a module for that (GDBM_File). Now, when I try the simplest example possible, namely:
#!/usr/bin/perl
use strict;
use warnings;
use GDBM_File;
my $dbfile = '/tmp/test.gdbm';
my $ok = tie(my %db, 'GDBM_File', $dbfile, &GDBM_WRCREAT, 0664);
die "can't tie to $dbfile for WRCREAT access: $!" unless $ok;
$db{test} = 1;
untie %db;
and execute it I get the following warning:
untie attempted while 1 inner references still exist at ./gdbm-test line 13.
I read the perl documentation (see the "untie gotcha" in the provided link) but that explanation does not seem to apply here since it is clear that %db has no references anywhere in the code pointing to it.
Nonetheless the code seems to work since when I inspect the database file I get the correct result:
bash$ echo list | gdbmtool /tmp/test.gdbm
test 1
Why does this warning appear and how can I get rid of it?

I think that this is, in fact, a manifestation of the gotcha that you point to. The documentation for tie() says this:
The object returned by the constructor is also returned by the tie function
So your $ok contains a reference to the object, and you should undefine that before calling untie().
undef $ok;
untie %db;

Related

Perl wrongly complaining about Name "main::FILE" used only once

I simplified my program to the following trivial snippet and I'm still getting the message
Name "main::FILE" used only once: possible typo...
#!/usr/bin/perl -w
use strict;
use autodie qw(open close);
foreach my $f (#ARGV) {
local $/;
open FILE, "<", $f;
local $_ = <FILE>; # <--- HERE
close FILE;
print $_;
}
which obviously isn't true as it gets used three times. For whatever reason, only the marked occurrence counts.
I am aware about nicer ways to open a file (using a $filehandle), but it doesn't pay for short script, does it? So how can I get rid of the wrong warning?
According to the documentation for autodie:
BUGS
"Used only once" warnings can be generated when autodie or Fatal is used with package filehandles (eg, FILE ). Scalar filehandles are strongly recommended instead.
I get the warning on Perl 5.10.1, but not 5.16.3, so there may be something else going on as well.

Perl Global symbol requires explicit package name

I am trying to store my log messages in a hash depending upon message type as shown below:
#!/usr/bin/perl
use strict;
use warnings;
my %log;
opendir (DIR, '.') or die $!;
while (my $file = readdir(DIR)) {
# some code to select TAR filename in $1
if (-e $1.'.tar') {
push(#{$log->{$1}}, $file); /* line 12 */
}
else {
$log{$1} = [];
push(#{$log->{$1}}, $file); /* line 16 */
}
Now this code gives compilation error saying:
Global symbol "$log" requires explicit package name at at lines 12 & 16
where I am actually trying to use the hash "%log". What can be a possible way to get rid of this error ? Why exactly is this happening ?
I did see some explanation on context where people replied saying the variables were created in one context and were being referred in another but I feel this variable should be available inside while loop in this piece of code. This happens only when I have "use strict" and works fine otherwise.
I have started with Perl so I do not fully understand the basics! Please help me understand why this variable is not accessible.
my %log;
defines hash %log, but lines 12 and 16 don't use it. Instead, you're accessing the anonymous hash referenced by the scalar $log which you've never declared. You have two options.
You could continue to use an anonymous hash.
my $log = {}; # The creation of the hash ("{}") is currently being done
# implicitly by "->". This is called autovivification.
... $log->{...} ...
This adds a bit of a extra complexity and an unnoticeable reduction in speed.
You could use use a hash directly.
my %log;
... $log{...} ...
I'm not sure what are you trying to do with $1, but the hash access is not a reference, so change:
$log->{$1}
to
$log{$1}
The error message you got, says: Global symbol "$log" requires explicit package, because $log variable was not defined. Remember that %log and $log are two different variables (hash vs scalar).

File locking with Fcntl: Baffling bug involving 'use' and 'require'

The following Perl script outputs "SUCCESS" as you'd expect:
use Fcntl qw(:DEFAULT :flock);
sysopen(LF, "test.txt", O_RDONLY | O_CREAT) or die "SYSOPEN FAIL: $!";
if(flock(LF, LOCK_EX)) { print "SUCCESS.\n"; }
else { print "FAIL: $!\n"; }
But now, replace that first line with
require "testlib.pl";
where testlib.pl contains
use Fcntl qw(:DEFAULT :flock);
1;
Now, strangely enough, the script fails, like so:
FAIL: Bad file descriptor
The question: Why?
ADDED:
And now that I know why -- thanks! -- I'm wondering what is the best way to deal with this:
Just do the use Fcntl twice, once in the main script and once in the required library (both the main script and the library need it).
Replace O_RDONLY with &O_RDONLY, etc.
Replace O_RDONLY with O_RDONLY(), etc.
Something else?
By foregoing use, you deprive the Perl parser of the knowledge that O_RDONLY et al. are parameterless subroutines. You have to be a bit more verbose in that situation:
sysopen(LF, "test.txt", O_RDONLY() | O_CREAT()) or die "SYSOPEN FAIL: $!";
if(flock(LF, LOCK_EX())) { print "SUCCESS.\n"; }
EDIT: To elaborate a bit further, without the parentheses, the O_RDONLY and O_CREAT were being interpreted as barewords (strings), which don't behave as you'd expect when binary-or'ed together:
$ perl -le 'print O_RDONLY | O_CREAT'
O_SVOO\Y
(The individual characters are being bitwise or'ed togther.)
In this case, the string "O_SVOO\Y" (or whatever it is on your system) was being interpreted as the number 0 to sysopen, which would therefore still work as long as O_RDONLY is 0 (as is typical) and the file already existed (so the O_CREAT was superfluous). But fcntl is apparently not as forgiving with non-numeric arguments:
$ perl -e 'flock STDOUT, "LOCK_EX" or die "Failed: $!"'
Failed: Bad file descriptor at -e line 1.
Similarly:
$ perl -e 'flock STDOUT, LOCK_EX or die "Failed: $!"'
Failed: Bad file descriptor at -e line 1.
However:
$ perl -e 'use Fcntl qw(:flock); flock STDOUT, LOCK_EX or die "Failed: $!"'
(no output)
Finally, note that use strict provides many helpful clues.
The line use Fcntl qw(:DEFAULT :flock); is not just loading the Fcntl library for you, but also exporting some symbols into your script's namespace. If you move that to a different scope, then the constants O_RDONLY, O_CREAT, LF, and LOCK_EX are no longer available to you, and your code won't do the same thing [however you could still reach them, if you know what namespace they ended up in -- since it was a script that did the export, you could call &main::NAME or simply &NAME, but then you have to be aware of what another file is doing with its code, which is not very clean].
This is described in the documentation under EXPORTED SYMBOLS:
By default your system's F_* and O_* constants (eg, F_DUPFD and O_CREAT) and the FD_CLOEXEC constant are exported into your namespace.
You can request that the flock() constants (LOCK_SH, LOCK_EX, LOCK_NB and LOCK_UN) be provided by using the tag ":flock". See Exporter.
If you add the lines
use strict;
use warnings;
to the top of your script, you will get more informative error messages such as "Name "main::O_RDONLY" used only once: possible type at line ...", which would give you a clue that these constants definitions are no longer visible.
Edit: in response to your question, the best practice would be #1, to include
the use statement in every file that needs it. See perldoc -f use -- the Fcntl library is only included once, but the import() call is made every time it is needed, which is what you want.
use is equivalent to:
BEGIN { require Module; Module->import( LIST ); }
guaranteeing that the import functions are available before the code starts executing. Whe you replace use with require, it simply reads the code in at the lexical point in the program where it exists.

How can I dynamically include Perl modules without using eval?

I need to dynamically include a Perl module, but if possible would like to stay away from eval due to work coding standards. This works:
$module = "My::module";
eval("use $module;");
But I need a way to do it without eval if possible. All google searches lead to the eval method, but none in any other way.
Is it possible to do it without eval?
Use require to load modules at runtime. It often a good idea to wrap this in a block (not string) eval in case the module can't be loaded.
eval {
require My::Module;
My::Module->import();
1;
} or do {
my $error = $#;
# Module load failed. You could recover, try loading
# an alternate module, die with $error...
# whatever's appropriate
};
The reason for the eval {...} or do {...} syntax and making a copy of $# is because $# is a global variable that can be set by many different things. You want to grab the value as atomically as possible to avoid a race condition where something else has set it to a different value.
If you don't know the name of the module until runtime you'll have to do the translation between module name (My::Module) and file name (My/Module.pm) manually:
my $module = 'My::Module';
eval {
(my $file = $module) =~ s|::|/|g;
require $file . '.pm';
$module->import();
1;
} or do {
my $error = $#;
# ...
};
How about using the core module Module::Load
With your example:
use Module::Load;
my $module = "My::module";
load $module;
"Module::Load - runtime require of both modules and files"
"load eliminates the need to know whether you are trying to require either a file or a module."
If it fails it will die with something of the like "Can't locate xxx in #INC (#INC contains: ...".
Well, there's always require as in
require 'My/Module.pm';
My::Module->import();
Note that you lose whatever effects you may have gotten from the import being called at compile time instead of runtime.
Edit: The tradeoffs between this and the eval way are: eval lets you use the normal module syntax and gives you a more explicit error if the module name is invalid (as opposed to merely not found). OTOH, the eval way is (potentially) more subject to arbitrary code injection.
No, it's not possible to without eval, as require() needs the bareword module name, as described at perldoc -f require. However, it's not an evil use of eval, as it doesn't allow injection of arbitrary code (assuming you have control over the contents of the file you are requireing, of course).
EDIT: Code amended below, but I'm leaving the first version up for completeness.
I use I used to use this little sugar module to do dynamic loads at runtime:
package MyApp::Util::RequireClass;
use strict;
use warnings;
use Exporter 'import'; # gives you Exporter's import() method directly
our #EXPORT_OK = qw(requireClass);
# Usage: requireClass(moduleName);
# does not do imports (wrong scope) -- you should do this after calling me: $class->import(#imports);
sub requireClass
{
my ($class) = #_;
eval "require $class" or do { die "Ack, can't load $class: $#" };
}
1;
PS. I'm staring at this definition (I wrote it quite a while ago) and I'm pondering adding this:
$class->export_to_level(1, undef, #imports);... it should work, but is not tested.
EDIT: version 2 now, much nicer without an eval (thanks ysth): :)
package MyApp::Util::RequireClass;
use strict;
use warnings;
use Exporter 'import'; # gives you Exporter's import() method directly
our #EXPORT_OK = qw(requireClass);
# Usage: requireClass(moduleName);
# does not do imports (wrong scope) -- you should do this after calling me: $class->import(#imports);
sub requireClass
{
my ($class) = #_;
(my $file = $class) =~ s|::|/|g;
$file .= '.pm';
require $file; # will die if there was an error
}
1;
Class::MOP on CPAN has a load_class method for this:
http://metacpan.org/pod/Class::MOP
i like doing things like..
require Win32::Console::ANSI if ( $^O eq "MSWin32" );

How can I get around a 'die' call in a Perl library I can't modify?

Yes, the problem is with a library I'm using, and no, I cannot modify it. I need a workaround.
Basically, I'm dealing with a badly written Perl library, that exits with 'die' when a certain error condition is encountered reading a file. I call this routine from a program which is looping through thousands of files, a handful of which are bad. Bad files happen; I just want my routine to log an error and move on.
IF I COULD modify the library, I would simply change the
die "error";
to a
print "error";return;
, but I cannot. Is there any way I can couch the routine so that the bad files won't crash the entire process?
FOLLOWUP QUESTION: Using an "eval" to couch the crash-prone call works nicely, but how do I set up handling for catch-able errors within that framework? To describe:
I have a subroutine that calls the library-which-crashes-sometimes many times. Rather than couch each call within this subroutine with an eval{}, I just allow it to die, and use an eval{} on the level that calls my subroutine:
my $status=eval{function($param);};
unless($status){print $#; next;}; # print error and go to next file if function() fails
However, there are error conditions that I can and do catch in function(). What is the most proper/elegant way to design the error-catching in the subroutine and the calling routine so that I get the correct behavior for both caught and uncaught errors?
You could wrap it in an eval. See:
perldoc -f eval
For instance, you could write:
# warn if routine calls die
eval { routine_might_die }; warn $# if $#;
This will turn the fatal error into a warning, which is more or less what you suggested. If die is called, $# contains the string passed to it.
Does it trap $SIG{__DIE__}? If it does, then it's more local than you are. But there are a couple strategies:
You can evoke its package and override die:
package Library::Dumb::Dyer;
use subs 'die';
sub die {
my ( $package, $file, $line ) = caller();
unless ( $decider->decide( $file, $package, $line ) eq 'DUMB' ) {
say "It's a good death.";
die #_;
}
}
If not, can trap it. (look for $SIG on the page, markdown is not handling the full link.)
my $old_die_handler = $SIG{__DIE__};
sub _death_handler {
my ( $package, $file, $line ) = caller();
unless ( $decider->decide( $file, $package, $line ) eq 'DUMB DIE' ) {
say "It's a good death.";
goto &$old_die_handler;
}
}
$SIG{__DIE__} = \&_death_handler;
You might have to scan the library, find a sub that it always calls, and use that to load your $SIG handler by overriding that.
my $dumb_package_do_something_dumb = \&Dumb::do_something_dumb;
*Dumb::do_something_dumb = sub {
$SIG{__DIE__} = ...
goto &$dumb_package_do_something_dumb;
};
Or override a builtin that it always calls...
package Dumb;
use subs 'chdir';
sub chdir {
$SIG{__DIE__} = ...
CORE::chdir #_;
};
If all else fails, you can whip the horse's eyes with this:
package CORE::GLOBAL;
use subs 'die';
sub die {
...
CORE::die #_;
}
This will override die globally, the only way you can get back die is to address it as CORE::die.
Some combination of this will work.
Although changing a die to not die has a specific solution as shown in the other answers, in general you can always override subroutines in other packages. You don't change the original source at all.
First, load the original package so you get all of the original definitions. Once the original is in place, you can redefine the troublesome subroutine:
BEGIN {
use Original::Lib;
no warnings 'redefine';
sub Original::Lib::some_sub { ... }
}
You can even cut and paste the original definition and tweak what you need. It's not a great solution, but if you can't change the original source (or want to try something before you change the original), it can work.
Besides that, you can copy the original source file into a separate directory for your application. Since you control that directory, you can edit the files in it. You modify that copy and load it by adding that directory to Perl's module search path:
use lib qw(/that/new/directory);
use Original::Lib; # should find the one in /that/new/directory
Your copy sticks around even if someone updates the original module (although you might have to merge changes).
I talk about this quite a bit in Mastering Perl, where I show some other techniques to do that sort of thing. The trick is to not break things even more. How you not break things depends on what you are doing.