keiusui has asked for the wisdom of the Perl Monks concerning the following question:

I run a forum which has been running smoothly until recently. I use DB_File and the tie function like this: tie(%database, DB_File, "/path/to/database");

And to add a new key I use this:

$database{$some_key} = $some_value

This has worked wonderfully in the past. But now, seemingly randomly, some new keys are not being added.

My database file is 632kb with about 5,000 keys.

Is there a glitch associated with DB_File as the database grows bigger and bigger?

Replies are listed 'Best First'.
Re: perl db_file
by perrin (Chancellor) on Nov 12, 2005 at 05:37 UTC
    Your script appear to have no locking at all. That will lead to lost data. Try using MLDBM::Sync to wrap DB_File for you.
[reply]
Re: perl db_file
by keiusui (Monk) on Nov 12, 2005 at 04:54 UTC
    Here is the "boiled down" source of the entire post.cgi script which is supposed to add the new key. However, sometimes it fails and sometimes it succeeds, seemingly randomly.
[reply]
      I don't know why the script is dying where you show. Use warnings and strict, and errorcheck/die for tie and file opens. Those may help you find the problem. Once you've found the problem, I also strongly advise replacing the CONTENT_LENGTH stuff with CGI.pm. Good luck!
[reply]
      
#!/usr/bin/perl
print "Content-type:text/html\n\n";
use CGI::Carp qw(fatalsToBrowser);
use DB_File;
my $x = tie(%data, DB_File, "data.db");
die unless $x;
$data{"1131764522.1131769129"} = "1131764522.1131769129\tJiskha Webmas
+ter\t\tMt Tarawera\t\t70.228.93.58" || die "$!";
untie(%data);
print "success!";
1;

      [download]
[reply]
[d/l]
        This script works for me: 
        #!/usr/local/bin/perl
use warnings;
use strict;
use DB_File;
my %data;
tie(%data, 'DB_File', "data.db") or die $!;
$data{"1131764522.1131769129"} = "1131764522.1131769129\tJiskha Webmas
+ter\t\tMt Tarawera\t\t70.228.93.58" || die "$!";
untie(%data) or die $!;
%data=();
print "success!\n";
tie(%data, 'DB_File', "data.db") or die $!;
print $data{"1131764522.1131769129"};

        [download]
[reply]
[d/l]
Re: perl db_file
by Anonymous Monk on Aug 09, 2006 at 10:02 UTC
    Among many other problems your use of the $answer_to variable seems most dangerous. That variable is defined by whatever your users put in a form, and you use it without enough checking in 3 different ways:
    1. It becomes part of a hash key in your database.
    2. It becomes part of the value of that key.
    3. It becomes part of the filename used to save the message.
    Aside from that the unlocked database is the most likely culprit. This (untested) code demonstrates the kind of changes you need to make: 
    #!/usr/bin/perl -w

use strict;
use CGI ':standard';
use Fcntl qw(:DEFAULT);
use MLDBM qw(DB_File Storable);
use MLDBM::Sync;

my $name      = param('field1') || 'Anonymous';
my $email     = param('field2');
my $subject   = param('field3');
my $message   = param('field4');
my $notify    = param('notify');
my $subscribe = param('subscribe');
my $level     = param('level');
my $answer_to = param('answer_to');

my $notify_checked    = $notify    ? 'checked' : '';
my $subscribe_checked = $subscribe ? 'checked' : '';
my @errors = ();
my $data_id;

print header;

unless ($subject) { push @errors, "You did not provide a subject." }
unless ($message) { push @errors, "$post_no_message" } # where does th
+at come from?

if (
($message =~ /(http|www|\.co|\.net|\.org| co | org |co\.)/gi  || 
 $subject =~ /(http|www|\.co|\.net|\.org| co | org |co\.)/gi) && 
 $name !~ /^(Jiskha Webmaster|Lance|bobpursley|drwls|Ms\. Sue|Writeach
+er|PsyDAG|TchrWill)$/){
  push @errors, "You are not allowed to post internet addresses."
}

if (@errors) {
  print 'Message could not post because: ';
  print "$_ " for @errors;
}
else {
  if ($answer_to) { 
    $answer_to =~ s/\W//g; # UNTAINT!
    $data_id = $answer_to . time()
  }
  else{
    $data_id = time()
  }

# make sure no tabs go into the tab delimited file!
$_ =~ tr/\t// for ($name,$email,$subject,$notify);

my $db = tie (my %data, 'MLDBM::Sync', 'data.db', O_CREAT|O_RDWR, 0666
+) or die "Could not tie: $!";

$data{$data_id} = "$data_id\t$name\t$email\t$subject\t$notify\t$ENV{'R
+EMOTE_ADDR'}" 
or die "could not post, THIS IS A GLITCH THAT I AM TRYING TO SOLVE RIG
+HT NOW, hit refresh to try again";

undef $db;
untie %data;

open my $fh, "> data/$data_id.txt" or die "Can't open data/$data_id.tx
+t: $!";
print $fh $message;
close $fh or die "$!";

print <<OUTPUT;
post successfully posted!  (you got lucky this time; but next time, by
+ seemlingly random acts, you may not get as lucky)
OUTPUT
}

1;

    [download]
[reply]
[d/l]

Back to Seekers of Perl Wisdom