p5pRT
commented
20 years ago From supraexpress@globaleyes.net
Using perl-5.8.2 NDBM_File\, a new DB entry causes the DB file to be filled with "Perl code fragments".
====== Sample script used =====
#!/usr/bin/perl
use NDBM_File;
use Fcntl;
#tie (%db\, 'NDBM_File'\, 'newspwfile'\, O_RDWR | O_CREAT\, 0640)
my $db = NDBM_File::TIEHASH('NDBM_File'\, 'newspwfile'\, O_RDWR | O_CREAT\, 0640)
or die "Cannot open newspwfile: $!\n";
$| = 1;
print "Username: ";
my $user = \
===== Sample DB contents (via Unix "strings") ===== strings newspwfile.db
IXUSR S_IRWXU S_IRGRP S_IWGRP S_IXGRP S_IRWXG S_IROTH S_IWOTH S_IXOTH S_IRWXO S_IREAD S_IWRITE S_IEXEC S_ISREG S_ISDIR S_ISLNK S_ISSOCK S_ISBLK S_ISCHR S_ISFIFO S_ISWHT S_ISENFMT S_IFMT S_IMODE )]\, sub S_IFMT { @_ ? ( $_[0] & _S_IFMT() ) : _S_IFMT() } sub S_IMODE { $_[0] & 07777 } sub S_ISREG { ( $_[0] & _S_IFMT() ) == S_IFREG() } sub S_ISDIR { ( $_[0] & _S_IFMT() ) == S_IFDIR() } sub S_ISLNK { ( $_[0] & _S_IFMT() ) == S_IFLNK() } sub S_ISSOCK { ( $_[0] & _S_IFMT() ) == S_IFSOCK() } sub S_ISBLK { ( $_[0] & _S_IFMT() ) == S_IFBLK() } sub S_ISCHR { ( $_[0] & _S_IFMT() ) == S_IFCHR() } sub S_ISFIFO { ( $_[0] & _S_IFMT() ) == S_IFIFO() } sub S_ISWHT { ( $_[0] & _S_IFMT() ) == S_IFWHT() } sub S_ISENFMT { ( $_[0] & _S_IFMT() ) == S_IFENFMT() } sub AUTOLOAD { (my $constname = $AUTOLOAD) =~ s/.*:://; die "&Fcntl::constant not defined" if $constname eq 'constant'; my ($error\, $val) = constant($constname); if ($error) { my (undef\,$file\,$line) = caller; die "$error at $file line $line.\n"; } *$AUTOLOAD = sub { $val }; goto &$AUTOLOAD; XSLoader::load 'Fcntl'\, $VERSION; = shift; $pkg->TIEHASH(@_); # Grandfather "new" sub TIEHASH { my $pkg = shift; if (defined &{"${pkg}::new"}) { warnings::warnif("WARNING: calling ${pkg}->new since ${pkg}->TIEHASH is missing"); $pkg->new(@_); } else { croak "$pkg doesn't define a TIEHASH method"; } sub EXISTS { my $pkg = ref $_[0]; croak "$pkg doesn't define an EXISTS method"; sub CLEAR { my $self = shift; my $key = $self->FIRSTKEY(@_); my @keys; while (defined $key) { push @keys\, $key; $key = $self->NEXTKEY(@_\, $key); } foreach $key (@keys) { $self->DELETE(@_\, $key); } # The Tie::StdHash package implements standard perl hash behaviour. # It exists to act as a base class for classes which only wish to # alter some parts of their behaviour. package Tie::StdHash; # @ISA = qw(Tie::Hash); # would inherit new() only sub TIEHASH { bless {}\, $_[0] } sub STORE { $_[0]->{$_[1]} = $_[2] } sub FETCH { $_[0]->{$_[1]} } sub FIRSTKEY { my $a = scalar keys %{$_[0]}; each %{$_[0]} } sub NEXTKEY { each %{$_[0]} } sub EXISTS { exists $_[0]->{$_[1]} } sub DELETE { delete $_[0]->{$_[1]} } sub CLEAR { %{$_[0]} = () } package Tie::ExtraHash; sub TIEHASH { my $p = shift; bless [{}\, @_]\, $p } sub STORE { $_[0][0]{$_[1]} = $_[2] } sub FETCH { $_[0][0]{$_[1]} } sub FIRSTKEY { my $a = scalar keys %{$_[0][0]}; each %{$_[0][0]} } sub NEXTKEY { each %{$_[0][0]} } sub EXISTS { exists $_[0][0]->{$_[1]} } sub DELETE { delete $_[0][0]->{$_[1]} } sub CLEAR { %{$_[0][0]} = () } \ Githubissues.
Migrated from rt.perl.org#28075 (status was 'stalled')
Searchable as RT28075$