Adam Jimerson wrote:
On Dec 7, 12:43 pm, g...@lazymountain.com (Greg Jetter) wrote:
On Sunday 06 December 2009 10:24:31 am Adam Jimerson wrote:

I am working on a registration page and there for want it to show the
user errors it has found with their input.  I have two subroutines in
my code, the first one prints out the form, also takes an array with
error descriptions that is passed by the other subroutine.  The other
subroutine takes the user input and verifies it, any errors that it
finds it pushes into an array called @errors and passes that back to
the first subroutine.   The problem is it doesn't work right when I
run it from the command line this is what I get:
vend...@seserver:~/public_html/AmeriVista> perl -cT register.cgi
[Sun Dec  6 14:12:12 2009] register.cgi: Illegal character in
prototype for main::form_verify : @user at register.cgi line 43.
[Sun Dec  6 14:12:12 2009] register.cgi: Scalar found where operator
expected at register.cgi line 93, near "$user"
[Sun Dec  6 14:12:12 2009] register.cgi:        (Missing semicolon on
previous line?)
[Sun Dec  6 14:12:12 2009] register.cgi: main::form_verify() called
too early to check prototype at register.cgi line 36.
Content-type: text/html
<h1>Software error:</h1>
<pre>syntax error at register.cgi line 93, near &quot;$user&quot;
Global symbol &quot;$GoodMail&quot; requires explicit package name at
register.cgi line 93.
register.cgi had compilation errors.
</pre>
<p>
For help, please send mail to this site's webmaster, giving this error
message
and the time and date of the error.
</p>
[Sun Dec  6 14:12:12 2009] register.cgi: syntax error at register.cgi
line 93, near "$user"
[Sun Dec  6 14:12:12 2009] register.cgi: Global symbol "$GoodMail"
requires explicit package name at register.cgi line 93.
[Sun Dec  6 14:12:12 2009] register.cgi: register.cgi had compilation
errors.
I have attached my code for the script, if someone could look at it
and give some ideas as to how to make this work or a better way then
please do

You are trying to use a local scoped var as a global , line 93 $GoodMail is
used out of its scope ,
if ( $user[5] =~ /^([...@\w.]+)$/ ) {
                $user[5] = $1;
                eval {
                        my $GoodMail = Email::Valid->address( -address => 
"$user[5]", -mxcheck =>
1);
                        return;
                }
                #push @errors, "<p>Error: Double check your email address</p>" 
if $@;
                $user[5] = $GoodMail;
             }

it should read

if ( $user[5] =~ /^([...@\w.]+)$/ ) {
                my $GoodMail ;
                $user[5] = $1;
                eval {
                         $GoodMail = Email::Valid->address( -address => 
"$user[5]", -mxcheck => 1);
                        return;
                }
                #push @errors, "<p>Error: Double check your email address</p>" 
if $@;
                $user[5] = $GoodMail;
             }

or even declare it  up with the other globals  if you want , but the way you
have it  now it is out of scope after that eval { } block completes.

there may be other errors , fix that one first and try it again  and see what
else pops up.

Ok well I have corrected a couple more errors with the script and it
now has no errors during compile and runs until it goes to report
problems it has found back to the user:

#!/usr/bin/perl -T
use warnings;
use strict;
use diagnostics;
use CGI qw(:standard);
use DBI;
use Email::Valid;
BEGIN {
        $|=1;
        use CGI::Carp('fatalsToBrowser');
}
delete @ENV { 'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};

my @user; #Here @user deals with: first name, last name, username,
password, CLSCC Email, and Student Number
my @errors;
my $dbh;

sub db_connect {
        use constant username => 'secret';
        use constant password => 'secret';
        my $database = 'database name';
        my $server = 'localhost';
 my $dsn = "DBI:mysql:database=$database;host=$server;port=3306" ||
die "Couldn't Connect to the Database: $!";

The string you are assigning to $dsn is *always* true so the die() is superfluous, it will *never* execute.


        my $dbh = DBI->connect($dsn, username, password, {RaiseError
=> 1}) || die "couldn't authenticate to the Database: $!";
}

db_connect ();
print header;
print start_html (-title=>"AmeriVista Event Logging",
                        -author=>'vend...@vendion.net');
print "<h1>Registration Form</h1>\n";
print "<hr>\n";

if (param) {
        form_verify (@user);
} else {
        print start_form;
        print_form ();
        print end_form, "\n";
}

sub form_verify {
        $user[0] = param('FirstName');
 if ( $user[0] =~ /^([-\w.]+)$/ )  {
                $user[0] = $1;
        } else {
                push @errors, "<p>First Names should only contain
letters</p>\n";
        }
        $user[1] = param('LastName');
        if ( $user[1] =~ /^([...@\w.]+)$/ ) {
                $user[1] = $1;
        } else {
                push @errors, "<p>Last Name Should Only Contain
Letters</p>\n";
        }
        $user[2] = param('Username');
        if ( $user[2] =~ /^([...@\w.]+)$/ ) {
                $user[2] = $1;
        } else {
                push @errors, "<p>Usernames Should Only Contain
Letters and Numbers</p>\n";
        }
        $user[3] = param('Password1');
        if ( $user[3] =~ /^([...@\w.]+)$/ ) {
                if ( length ( $user[3] ) eq '6' ) {

Why are you using a stringwise comparison on numerical values?


                        $user[3] = $1;
 if ( length ( $user[3] ) eq '6' ) {

Why are you using a stringwise comparison on numerical values?


                        $user[3] = $1;
                } else {
                        push @errors, "<p>The password is to short, it
should be atleast 6 charaters long</p>\n";
                }
        } else {
                push @errors, "<p>The Password Should only Contain
alphanumeric characters!\n";;
        }
        $user[4] = param('Password2');
        if ( $user[4] =~ /^([...@\w.]+)$/ ) {
                if ( length ( $user[4] eq '6' ) ) {

Why are you using a stringwise comparison on numerical values? Why are you testing the length of a true or false value? The length of a true value is always true and the length of a false value is always false so the length function is superfluous.


                                $user[4] = $1;
                        } else {
                                push @errors, "<p>The Password is to
Short, it should be at least 6 charaters long</p>\n";
                        }
        } else {
                push @errors, "<p>The Password Should only Contain
alphanumeric characters!\n";
        }
        if ( $user[3] != $user[4] ) {

If you expect passwords to contain alphanumeric characters why are you using a numerical comparison?


     push @errors, "<p>Error: Passwords do not match!</p>\n";
        }
        $user[5] = param('Email');
        if ( $user[5] =~ /^([...@\w.]+)$/ ) {
                my $GoodMail;
                $user[5] = $1;
                eval {
                        $GoodMail = Email::Valid->address( -address =>
"$user[5]", -mxcheck => 1);
                        return;
                };
                push @errors, "<p>Error: Double check your email
address</p>\n" if $@;
                $user[5] = $GoodMail;
        } else {
                push @errors, "<p>Incorrect Email given</p>\n";
        }
        $user[6] = param('studentid');
        if ( $user[6] =~ /^([...@.]+)$/ ) {

You want param('studentid') to contain *only* the three characters '-', '@' and '.'?

                $user[6] = $1;
        } else {
                push @errors, "<p>Incorrect studentid given</p>\n";
        }
 push @errors, "<p>Incorrect studentid given</p>\n";
        }
        if ( @errors ) {
                print "Errors found, going back to form\n"; #Debugging
                print_form (@errors);
        } else {
                print "No errors found\n";
                return @user;
        }
}

sub print_form {
        my @errors = @_;
        print "<div align='center'>\n";
        print "<table width='25%' border=1 summary='Register'>\n";
        print "<td align='left' valign='middle'>\n";
        if ( @errors ) {
                while ( @errors ) {

You never modify the @errors array inside the loop so the loop will *never* end. You want a foreach loop instead:

                  foreach ( @errors ) {

                        print $_, "\n";
                        print "<br>\n";
                }
        }
        print "<p>Registration</p>\n";
}
        print "<p>Registration</p>\n";
        print "<p>First Name: ", textfield(-name=>'FirstName',
                                        -maxlength=>120), "\n";
        print "<br>\n";
        print "Last Name: ", textfield(-name=>'LastName',
                                -maxlength=>120), "\n";
        print "<br>\n";
        print "Username: ", textfield(-name=>'Username',
                                        -maxlenght=>120), "\n";
        print "<br>\n";
        print "Password: ", password_field(-name=>'Password1',
                                        -maxlength=>120), "\n";
        print "<br>\n";
        print "Repeat Password: ", password_field(-name=>'Password2',
                                                -maxlength=>120),
"\n";
        print "<br>\n";
        print "CLSCC Email: ", textfield(-name=>'Email',
                                        -maxlenght=>120), "\n";
        print "<br>\n";
        print "Student ID #: N", textfield(-name=>'studentid',
                                        -maxlength=>120), "</p>";
        print submit(-name=>'Submit_Form',
                                 -maxlength=>120), "</p>";
        print submit(-name=>'Submit_Form',
                        -value=>'Submit');
        print reset, "\n";
        print "</td>\n";
        print "</table>\n";
        print "</div>\n";
}



John
--
The programmer is fighting against the two most
destructive forces in the universe: entropy and
human stupidity.               -- Damian Conway

--
To unsubscribe, e-mail: beginners-cgi-unsubscr...@perl.org
For additional commands, e-mail: beginners-cgi-h...@perl.org
http://learn.perl.org/


Reply via email to