Beefy Boxes and Bandwidth Generously Provided by pair Networks
There's more than one way to do things
 
PerlMonks  

Registration Error

by sulfericacid (Deacon)
on Mar 06, 2003 at 19:10 UTC ( [id://240968]=perlquestion: print w/replies, xml ) Need Help??

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

For those who have been following along with my past few nodes I'm still working on the same script and running into the same problems. No matter how many times I rewrite the script from the ground up I still run into the same mixup while everything else runs fine.

In this revision I am using two databases instead of one thinking it would be easier to have one database for their email address and ID and the other database for just their email address. That was the major update so instead of thinking it's the database itself that's having problems I'm thinking it my method of checking the url params to the database to see if their identical.

The entire script is below, I noted the part where I think the problem might be. I've rewritten this so many times and I'm not getting any closer to getting it done, what in the heck am I doing wrong??

#!/usr/bin/perl -w use strict; use CGI::Carp qw(fatalsToBrowser); use CGI; use POSIX; require SDBM_File; # # Define our constants # my $sendmail = "/usr/lib/sendmail"; my $adminmail = "test\@test.com"; my($verified, $unverified, $ID); my @chars = ( "A" .. "Z", "a" .. "z", 0 .. 9, qw(! @ $ % ^ & * ) ); # # Define our dynamic input # my $query = CGI->new; print $query->header; my %form = %{$query->Vars}; my $accountID = $query->url_param('accountID'); my $accountAD = $query->url_param('accountAD'); my (%dbm1, %dbm2); my $dbm1 = "unverified.dbm"; my $dbm2 = "verified.dbm"; tie (%dbm1, 'SDBM_File', $dbm1, O_CREAT|O_RDWR, 0644) || die "Died tying database\nReason: $!\n"; tie (%dbm2, 'SDBM_File', $dbm2, O_CREAT|O_RDWR, 0644) || die "Died tying database\nReason: $!\n"; # # If form was completed generate an ID, store them to database, email +user # if ($form{'usermail'}) { &generate_id; &email; print "An email has been sent to $form{'usermail'} for verification. +<br><br>\n"; $dbm1{$form{'usermail'}} = "$ID"; } # # Or if url param's are present and checked add them to other DB and r +emove them from $unverified # ***************The error is probably in this segment*** else { my $unverified = $accountID; my $verified = "$accountAD"; if ($dbm1{"$accountAD"} && $dbm1{"$accountAD"} =~ /^$accountAD$/) { $dbm2{"$verified"} = "$accountAD"; print "You have been added to the mailing list successfully!\n"; } else { print "Registration failed!<br><br>\n"; print "\$accountID: $accountID .<br>\n"; print "\$accountAD: $accountAD .<br>\n"; } } ***** error probably above this line sub email { $accountAD = "$form{'usermail'}"; open (MAIL, "|$sendmail -t") or die "Cannot access mail"; print MAIL "To: $form{'usermail'}\n"; print MAIL "From: $adminmail\n"; print MAIL "Subject: Verify your Email Address\n\n"; print MAIL "http://sulfericacid.perlmonk.org/evs/revised.pl?accountI +D=$accountID&accountAD=$accountAD\n"; close (MAIL); } sub generate_id { do { $accountID = join '', map { $chars[ rand @chars ] } 1..17; } while grep {$_ eq $ID} my @used; print $ID; # my @unverified_emails=($form{'usermail'}, $accountID); # $unverified = join "::",@unverified_emails; #$dbm{"$unverified"}= join "::",@unverified_emails; #foreach my $mail (split /::/, $dbm{'notverified'}) { # print "$mail is not verified!\n"; #} } untie(%dbm1); untie(%dbm2);


"Age is nothing more than an inaccurate number bestowed upon us at birth as just another means for others to judge and classify us"

sulfericacid

Replies are listed 'Best First'.
Re: Registration Error
by sulfericacid (Deacon) on Mar 06, 2003 at 19:14 UTC
    Incase you are confused and wonder what the script does this is an email verification script which I may possibly tie into a mailing list script someday. I take an email address from a form, email that address a verification link (a unique ID and their email address is stored into db1), when they click the link the script verifies that their credentials exist in the database, and if the check passes they are removed from db1 and their email addy is placed in db2.

    "Age is nothing more than an inaccurate number bestowed upon us at birth as just another means for others to judge and classify us"

    sulfericacid
Re: Registration Error
by sutch (Curate) on Mar 06, 2003 at 19:41 UTC
    What type of error is being experienced?

    One thing that stands out to me is:
    if ($dbm1{"$accountAD"} && $dbm1{"$accountAD"} =~ /^$accountAD$/) {
    The hash key, $accountAD, is being compared against the value of the hash, $dbm1{"$accountAD"}. Shouldn't $accountID be used somewhere in here?

    A reply falls below the community's threshold of quality. You may see it by logging in.
Re: Registration Error
by poj (Abbot) on Mar 06, 2003 at 19:45 UTC
    What's confusing me is this code
    sub generate_id { do { $accountID = join '', map { $chars[ rand @chars ] } 1..17; } while grep {$_ eq $ID} my @used; print $ID;
    which generates the $accountID and then this
    $dbm1{$form{'usermail'}} = "$ID";
    Should $ID be $accountID
    poj
      I think you're right and I changed $ID to $accountID but that wasn't the problem. $ID actually contained their registration number, I just had to rename ID to accountID to get the variables to work.

      "Age is nothing more than an inaccurate number bestowed upon us at birth as just another means for others to judge and classify us"

      sulfericacid
Re: Registration Error
by sulfericacid (Deacon) on Mar 07, 2003 at 01:00 UTC
    This is an update of the changes I've made based on your suggestions. Still no change in output however :(

    #!/usr/bin/perl -w use strict; use CGI::Carp qw(fatalsToBrowser); use CGI; use POSIX; require SDBM_File; # # Define our constants # my $sendmail = "/usr/lib/sendmail"; my $adminmail = "test\@test.com"; my($verified, $unverified, $ID); my @chars = ( "A" .. "Z", "a" .. "z", 0 .. 9, qw(! @ $ % ^ & * ) ); # # Define our dynamic input # my $query = CGI->new; print $query->header; my %form = %{$query->Vars}; my $accountID = $query->url_param('accountID'); my $accountAD = $query->url_param('accountAD'); my (%dbm1, %dbm2); my $dbm1 = "unverified.dbm"; my $dbm2 = "verified.dbm"; tie (%dbm1, 'SDBM_File', $dbm1, O_CREAT|O_RDWR, 0644) || die "Died tying database\nReason: $!\n"; tie (%dbm2, 'SDBM_File', $dbm2, O_CREAT|O_RDWR, 0644) || die "Died tying database\nReason: $!\n"; # # If form was completed generate an ID, store them to database, email +user # if ($form{'usermail'}) { &generate_id; &email; print "An email has been sent to $form{'usermail'} for verification. +<br><br>\n"; $dbm1{$form{'usermail'}} = "$accountID"; } # # Or if url param's are present and checked add them to other DB and r +emove them from $unverified # else { my $unverified = $accountID; my $verified = "$accountAD"; if ($dbm1{"$accountAD"} && $dbm1{"$accountID"} =~ /^$accountAD$/) { $dbm2{"$verified"} = "$accountAD"; print "You have been added to the mailing list successfully!\n"; } else { print "Registration failed!<br><br>\n"; print "\$accountID: $accountID .<br>\n"; print "\$accountAD: $accountAD .<br>\n"; } } sub email { $accountAD = "$form{'usermail'}"; open (MAIL, "|$sendmail -t") or die "Cannot access mail"; print MAIL "To: $form{'usermail'}\n"; print MAIL "From: $adminmail\n"; print MAIL "Subject: Verify your Email Address\n\n"; print MAIL "http://sulfericacid.perlmonk.org/evs/revised.pl?accountI +D=$accountID&accountAD=$accountAD\n"; close (MAIL); } sub generate_id { do { $accountID = join '', map { $chars[ rand @chars ] } 1..17; } while grep {$_ eq $ID} my @used; print $ID; # my @unverified_emails=($form{'usermail'}, $accountID); # $unverified = join "::",@unverified_emails; #$dbm{"$unverified"}= join "::",@unverified_emails; #foreach my $mail (split /::/, $dbm{'notverified'}) { # print "$mail is not verified!\n"; #} } untie(%dbm1); untie(%dbm2);


    "Age is nothing more than an inaccurate number bestowed upon us at birth as just another means for others to judge and classify us"

    sulfericacid
      I think the problem is here
      # if ($dbm1{"$accountAD"} # && $dbm1{"$accountID"} =~ /^$accountAD$/) { # key values reversed if ($dbm1{"$accountAD"} && $dbm1{"$accountAD"} =~ /^$accountID$/) { # corrected
      If it helps, here's code I used to debug your script, paste it in after the ties
      # debug sub showdata { my ($head,$data) = @_; print qq(<table border=1><tr><td> key </td><td> $head </td></tr>\n); foreach (sort keys %$data){ print qq(<tr><td> $_ </td><td> $$data{$_} </td></tr>\n); } print q(</table>); } showdata("Unverified",\%dbm1); showdata("Verified",\%dbm2);
      poj
      update ; Another way to fix it is to change these round
      # $dbm1{$form{'usermail'}} = "$accountID"; $dbm1{"$accountID"} = $form{'usermail'};
        I've tried all the suggestions you proposed, Poj, but the results aren't changing. I actually have been doing database prints to verify things are actually stored so they can be compared to. Things are storing as I expected them to so the only possible problem is with the verification which we concluded earlier.

        Maybe what's confusing you is what's going on so I'll try to explain that small section.

        AccountID is their generated $ID number which is a 17 character string. AccountAD is their email address collected from the form. Both of these are stored in the DB1 just fine. I'm trying to verify the url_params (accountID=xxx&accountAD=xxx) to what's being stored so I can add them to DB2.

        That's what I am after anyways, is this what the code is actually doing or am I confusing that entire process? Thanks so much. sulfericacid

        "Age is nothing more than an inaccurate number bestowed upon us at birth as just another means for others to judge and classify us"

        sulfericacid
Re: Registration Error
by sulfericacid (Deacon) on Mar 06, 2003 at 20:12 UTC
    I will see what I can do with the checking itself using your suggestions. Thanks everyone.

    "Age is nothing more than an inaccurate number bestowed upon us at birth as just another means for others to judge and classify us"

    sulfericacid

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlquestion [id://240968]
Approved by rozallin
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others studying the Monastery: (2)
As of 2024-04-19 18:16 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found