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

My perl interpreter won't even look at it. It's that bad.
perl -w user_test.pl User.pm has too many errors. BEGIN failed--compilation aborted at user_test.pl line 4.
I tried debugging and I am not sure what I am doing since this is my first object. As it is quite long I am going to post it at the bottom for now hoping that you can tell me how to force it to read the object and give me errors so I can fix it and not get slammed for asking you to debug this monster. It was giving me syntax errors and then it stopped. Any ideas?
package User; use DBI; use strict; use EmailValid; use Digest::MD5 qw( md5_hex ); # what value the evaulate functions return when the # values is correct. my $no_errors = "validated"; #constructor sub new( $ ) { my $self = {}; $self->{userID} = undef; $self->{userName} = undef; $self->{password} = undef; $self->{passwordHint} = undef; $self->{passwordHintAnswer} = undef; $self->{userActive} = undef; $self->{legalName} = undef; $self->{scaName} = undef; $self->{addressLine1} = undef; $self->{addressLine2} = undef; $self->{state} = undef; $self->{country} = undef; $self->{city} = undef; $self->{zip} = undef; $self->{areaCode} = undef; $self->{firstThree} = undef; $self->{lastFour} = undef; $self->{extension} = undef; $self->{emailAddress} = undef; bless ($self); return $self; } # Loads the user account with information from the database # and returns undefined if not found or user id if found. # # ARGS DB handle, UserID # # RETURNS UserID or undef if not found sub load_user( $ ) { my $self = shift; my $dbh = $_[0]; my $sqlQuery = "SELECT UserID, UserName, Password, PasswordHint, PasswordHintAnswer, UserActive, LegalName, ScaName, AddressLine1, AddressLine2, State, Country, City, Zip, AreaCode, FirstThree, LastFour, Extension, EmailAddress FROM USERINFORMATION WHERE UserID = \'$_[1]\'"; my $query = $dbh->prepare( $sqlQuery ); $query->execute() || die $dbh->errstr; my @userData = $query->fetchrow_array(); $self->{user_id} = $userData[0]; $self->{user_name} = $userData[1]; $self->{password} = $userData[2]; $self->{password_hint} = $userData[3]; $self->{password_hint_answer} = $userData[4]; $self->{user_active} = $userData[5]; $self->{legal_name} = $userData[6]; $self->{sca_name} = $userData[7]; $self->{address_line_1} = $userData[8]; $self->{address_line_2} = $userData[9]; $self->{state} = $userData[10]; $self->{country} = $userData[11]; $self->{city} = $userData[12]; $self->{zip} = $userData[13]; $self->{area_code} = $userData[14]; $self->{first_three} = $userData[15]; $self->{last_four} = $userData[16]; $self->{extension} = $userData[17]; $self->{email_address} = $userData[18]; return( $self->{userID} ); } sub save_user() { } ###################################################################### +######### # VALIDATE AND UPDATE SUBROUTINES # # called by the main system this allows for a standardized # checking of variables for correctness # # ARGS : VALUE TO BE VERIFIED # RETURNS : ARRAY->( "$true_error_value" if error # "$false_error_value" if no error # AND # HTML ERROR STRING # sub update_user_id( $ ) { my $self = shift; if( $_[0] eq "" ) { return( &generate_form_entry_error_string( "blank" ) ); } elsif( length( $_[0] > 11 ) ) { return( &generate_form_entry_error_string( "length" ) ); } elsif( $_[0] !~ /^[0-9]/ ) { return( &generate_form_entry_error_string( "0-9" ) ); } else { $self->{user_id} = $_[0]; return( $no_errors ); } } sub update_user_name( $ ) { my $self = shift; if( $_[0] eq "" ) { return( &generate_form_entry_error_string( "blank" ) ); } elsif( length( $_[0] > 20 ) ) { return( &generate_form_entry_error_string( "length" ) ); } elsif( $_[0] !~ /^[A-Za-z0-9]/ ) + { return( &generate_form_entry_error_string( "A-Z a-z 0-9" ); } else { $self->{user_name} = $_[0]; return( $no_errors ); } } sub update_password( $ ) { my $self = shift; if( $_[0] eq "" ) { return( &generate_form_entry_error_string( "blank" ) ); } elsif( length( $_[0] > 20 ) ) { return( &generate_form_entry_error_string( "length" ) ); } elsif( $_[0] !~ /^[A-Za-z0-9]/ ) + { return( &generate_form_entry_error_string( "A-Z a-z 0-9" ); } else { my $digest = md5_hex( $_[0] ); $self->{password} = $digest; return( $no_errors ); } } sub update_password_hint( $ ) { my $self = shift; if( $_[0] eq "" ) { return( &generate_form_entry_error_string( "blank" ) ); } elsif( length( $_[0] > 100 ) ) { return( &generate_form_entry_error_string( "length" ) ); } elsif( $_[0] !~ /^[A-Za-z0-9\'\.-]/ ) + { return( &generate_form_entry_error_string( "A-Z a-z 0-9 \' . - +" ); } else { $self->{password_hint} = $_[0]; return( $no_errors ); } } sub update_password_hint_answer( $ ) { my $self = shift; if( $_[0] eq "" ) { return( &generate_form_entry_error_string( "blank" ) ); } elsif( length( $_[0] > 100 ) ) { return( &generate_form_entry_error_string( "length" ) ); } elsif( $_[0] !~ /^[A-Za-z0-9\'\.-]/ ) + { return( &generate_form_entry_error_string( "A-Z a-z 0-9 \' . - +" ); } else { $self->{password_hint_answer} = $_[0]; return( $no_errors ); } } sub update_user_active( $ ) { my $self = shift; if( $_[0] eq "" ) { return( &generate_form_entry_error_string( "blank" ) ); } elsif( length( $_[0] > 1 ) ) { return( &generate_form_entry_error_string( "length" ) ); } elsif( $_[0] !~ /^[0|1]/ ) { return( &generate_form_entry_error_string( "0 or 1" ); } else { $self->{user_active} = $_[0]; return( $no_errors ); } } sub update_legal_name( $ ) { my $self = shift; if( $_[0] eq "" ) { return( &generate_form_entry_error_string( "blank" ) ); } elsif( length( $_[0] > 100 ) ) { return( &generate_form_entry_error_string( "length" ) ); } elsif( $_[0] !~ /^[A-Za-z0-9\'\.-]/ ) + { return( &generate_form_entry_error_string( "A-Z a-z 0-9 \' . - +" ); } else { $self->{legal_name} = $_[0]; return( $no_errors ); } } sub update_sca_name( $ ) { my $self = shift; if( $_[0] eq "" ) { return( &generate_form_entry_error_string( "blank" ) ); } elsif( length( $_[0] > 100 ) ) { return( &generate_form_entry_error_string( "length" ) ); } elsif( $_[0] !~ /^[A-Za-z0-9\'\.-]/ ) + { return( &generate_form_entry_error_string( "A-Z a-z 0-9 \' . - +" ); } else { $self->{sca_name} = $_[0]; return( $no_errors ); } } sub update_address_line_1( $ ) { my $self = shift; if( $_[0] eq "" ) { return( &generate_form_entry_error_string( "blank" ) ); } elsif( length( $_[0] > 100 ) ) { return( &generate_form_entry_error_string( "length" ) ); } elsif( $_[0] !~ /^[A-Za-z0-9\'\.-]/ ) + { return( &generate_form_entry_error_string( "A-Z a-z 0-9 \' . - +" ); } else { $self->{address_line_1} = $_[0]; return( $no_errors ); } } sub update_address_line_2( $ ) { my $self = shift; if( $_[0] eq "" ) { return( &generate_form_entry_error_string( "blank" ) ); } elsif( length( $_[0] > 100 ) ) { return( &generate_form_entry_error_string( "length" ) ); } elsif( $_[0] !~ /^[A-Za-z0-9\'\.-]/ ) + { return( &generate_form_entry_error_string( "A-Z a-z 0-9 \' . - +" ); } else { $self->{address_line_2} = $_[0]; return( $no_errors ); } } sub update_state( $ ) { my $self = shift; if( $_[0] eq "" ) { return( &generate_form_entry_error_string( "blank" ) ); } elsif( length( $_[0] > 20 ) ) { return( &generate_form_entry_error_string( "length" ) ); } elsif( $_[0] !~ /^[A-Za-z0-9\.-]/ ) + { return( &generate_form_entry_error_string( "A-Z a-z 0-9. -" ); } else { $self->{state} = $_[0]; return( $no_errors ); } } sub update_country( $ ) { my $self = shift; if( $_[0] eq "" ) { return( &generate_form_entry_error_string( "blank" ) ); } elsif( length( $_[0] > 20 ) ) { return( &generate_form_entry_error_string( "length" ) ); } elsif( $_[0] !~ /^[A-Za-z0-9\.-]/ ) + { return( &generate_form_entry_error_string( "A-Z a-z . -" ); } else { $self->{country} = $_[0]; return( $no_errors ); } } sub update_city( $ ) { my $self = shift; if( $_[0] eq "" ) { return( &generate_form_entry_error_string( "blank" ) ); } elsif( length( $_[0] > 30 ) ) { return( &generate_form_entry_error_string( "length" ) ); } elsif( $_[0] !~ /^[A-Za-z0-9\'\.-]/ ) + { return( &generate_form_entry_error_string( "A-Z a-z 0-9 \' . - +" ); } else { $self->{city} = $_[0]; return( $no_errors ); } } sub update_zip( $ ) { my $self = shift; if( $_[0] eq "" ) { return( &generate_form_entry_error_string( "blank" ) ); } elsif( length( $_[0] > 11 ) ) { return( &generate_form_entry_error_string( "length" ) ); } elsif( $_[0] !~ /^[A-Za-z0-9-]/ ) + { return( &generate_form_entry_error_string( "A-Z a-z 0-9" ); } else { $self->{zip} = $_[0]; return( $no_errors ); } } sub update_area_code( $ ) { my $self = shift; if( $_[0] eq "" ) { return( &generate_form_entry_error_string( "blank" ) ); } elsif( length( $_[0] > 3 ) ) { return( &generate_form_entry_error_string( "length" ) ); } elsif( $_[0] !~ /^[0-9]/ ) { return( &generate_form_entry_error_string( "0-9" ); } else { $self->{area_code} = $_[0]; return( $no_errors ); } } sub update_first_three( $ ) { my $self = shift; if( $_[0] eq "" ) { return( &generate_form_entry_error_string( "blank" ) ); } elsif( length( $_[0] > 3 ) ) { return( &generate_form_entry_error_string( "length" ) ); } elsif( $_[0] !~ /^[0-9]/ ) { return( &generate_form_entry_error_string( "0-9" ); } else { $self->{first_three} = $_[0]; return( $no_errors ); } } sub update_last_four( $ ) { my $self = shift; if( $_[0] eq "" ) { return( &generate_form_entry_error_string( "blank" ) ); } elsif( length( $_[0] > 4 ) ) { return( &generate_form_entry_error_string( "length" ) ); } elsif( $_[0] !~ /^[0-9]/ ) { return( &generate_form_entry_error_string( "0-9" ); } else { $self->{last_four} = $_[0]; return( $no_errors ); } } sub update_extension( $ ) { my $self = shift; if( $_[0] eq "" ) { return( &generate_form_entry_error_string( "blank" ) ); } elsif( $_[0] eq "" ) { $self->{extension} = $_[0]; } elsif( length( $_[0] > 4 ) ) { return( &generate_form_entry_error_string( "length" ) ); } elsif( $_[0] !~ /^[0-9]/ ) { return( &generate_form_entry_error_string( "0-9" ); } else { $self->{extension} = $_[0]; return( $no_errors ); } } sub update_email_address( $ ) { my $self = shift; if( $_[0] eq "" ) { return( &generate_form_entry_error_string( "blank" ) ); } elsif( length( $_[0] > 50 ) ) { return( &generate_form_entry_error_string( "length" ) ); } elsif( $_[0] !~ /^[A-Za-z0-9\.\@]/ ) + { return( &generate_form_entry_error_string( "A-Z a-z 0-9 . \@" +); } elsif( $_[0] =~ /\s/ ) { return( &generate_form_entry_error_string( "A-Z a-z 0-9 . \@ No + Spaces" ); } elseif( !EmailValid->rfc822( $_[0] ) ) { return( &generate_form_entry_error_string( "A-Z a-z 0-9 . \@ No + Spaces" ); } else { $self->{email_address} = $_[0]; return( $no_errors ); } } ###################################################################### +######### # GENERATE SUBROUTINES # # called by the main system this allows for a standardized # production of form elements # form elements should not be generated in main line code # these methods should be called # # ARGS : NONE # RETURNS : HTML FORM FIELD # # sub generate_user_ID { my $self = shift; return( &generate_line_form_element( "text", "user_id" , $self->{ +user_id}, $self->{user_id} , "5" , "10 +" ); } sub generate_user_name { my $self = shift; return( &generate_line_form_element( "text", "user_name" , $self- +>{user_name}, $self->{user_id} , "20" , "2 +0" ); } sub generate_password { my $self = shift; return( "Passwords MD5 hasked for security" ); } sub generate_password_hint { my $self = shift; return( &generate_line_form_element( "text", "password_hint" , $s +elf->{password_hint}, $self->{password_hint} , "50 +" , "100" ); } sub generate_password_hint_answer { my $self = shift; return( &generate_line_form_element( "text", "password_hint_answe +r" , $self->{password_hint_answer}, $self->{password_hint_answer +} , "50" , "100" ); } sub generate_user_active { my $self = shift; return( &generate_line_form_element( "text", "user_active", $self +->{user_active}, $self->{user_active} , "10" +, "1" ); } sub generate_legal_name { my $self = shift; return( &generate_line_form_element( "text", "legal_name" , $self +->{legal_name}, $self->{legal_name} , "50" , + "100" ); } sub generate_sca_name { my $self = shift; return( &generate_line_form_element( "text", "sca_name" , $self-> +{sca_name}, $self->{sca_name} , "50" , " +100" ); } sub generate_address_line_1 { my $self = shift; return( &generate_line_form_element( "text", "address_line_1" , $ +self->{address_line_1}, $self->{address_line_1} , "5 +0" , "100" ); } sub generate_address_line_2 { my $self = shift; return( &generate_line_form_element( "text", "address_line_2" , $ +self->{address_line_2}, $self->{address_line_2} , "5 +0" , "100" ); } sub generate_state { my $self = shift; return( &generate_line_form_element( "text", "state" , $self->{st +ate}, $self->{city} , "20" , "20" +); } sub generate_country { my $self = shift; return( &generate_line_form_element( "text", "country" , $self->{ +country}, $self->{country} , "20" , "2 +0" ); } sub generate_city { my $self = shift; return( &generate_line_form_element( "text", "city" , $self->{cit +y}, $self->{country} , "20" , "3 +0" ); } sub generate_zip { my $self = shift; return( &generate_line_form_element( "text", "zip" , $self->{zip} +, $self->{country} , "10" , "1 +0" ); } sub generate_area_code { my $self = shift; return( &generate_line_form_element( "text", "area_code" , $self- +>{area_code}, $self->{area_code} , "3" , " +3" ); } sub generate_first_three { my $self = shift; return( &generate_line_form_element( "text", "first_three" , $sel +f->{first_three}, $self->{first_three} , "3" , + "3" ); } sub generate_last_four { my $self = shift; return( &generate_line_form_element( "text", "last_four" , $self- +>{last_four}, $self->{last_four} , "4" , " +4" ); } sub generate_extension { my $self = shift; return( &generate_line_form_element( "text", "extension" , $self- +>{extension}, $self->{extension} , "4" , " +4" ); } sub generate_email_address { my $self = shift; return( &generate_line_form_element( "text", "email_address" , $s +elf->{email_address}, $self->{email_address} , "30 +" , "50" ); } # Creates the basic line form elements based on # passed data # ARGS type, name, value, length, maxlength # RETURNS the HTML string for the form sub generate_line_form_element( $ ) { my $form_element = "< INPUT TYPE="; if( $_[0] eq "text" ) { $form_element .= "\"text\""; } elsif( $_[0] eq "password" ) { $form_element .= "\"password\""; } elsif( $_[0] eq "hidden" ) { $form_element .= "\"hidden\""; } $form_element .= "NAME= \"$_[1]\""; $form_element .= "VALUE= \"$_[2]\""; $form_element .= "LENGTH= \"$_[3]\""; $form_element .= "MAXLENGTH= \"$_[4]\" >"; } # creates the error response html codes # # ARGS: allowed char string OR # blank # RETURNS: html string # sub generate_form_entry_error_string( $ ) { if( $_[0] eq "blank" ) { return( "<font face=\"Arial, Helvetica, sans-serif\" size=\"2\" color=\"red\"> This field must be filled in <\/font>" ); } else { return( "<font face=\"Arial, Helvetica, sans-serif\" size=\"2\" color=\"red\"> Values may only contain ( $_[0] )<\/font>"); } } 1;

Edit by tye to add READMORE tag

Replies are listed 'Best First'.
Re: My perl interpreter won't even look at it. It's that bad.
by Ovid (Cardinal) on Nov 16, 2002 at 00:55 UTC

    A few issues.

    • It's Email::Valid, not EmailValid
    • Prototypes do not work with object methods. Thus, they are no-ops here
    • Many lines are missing a closing paren.

    This (in line 176):

    return( &generate_form_entry_error_string( "A-Z a-z 0-9" );

    Should be:

    return( &generate_form_entry_error_string( "A-Z a-z 0-9" ) );

    This error is repeated many times. You also have an elseif instead of an elsif.

    Last comment: with this error being duplicated so many times, I suspect that you should look into how you can refactor this code.

    Cheers,
    Ovid

    New address of my CGI Course.
    Silence is Evil

      Just an expansion of Ovid's last comment: refactoring this code would (for example) turn this:
      sub generate_extension { my $self = shift; return( &generate_line_form_element( "text", "extension" , $self- +>{extension}, $self->{extension} , "4" , "4" ); } sub generate_email_address { my $self = shift; return( &generate_line_form_element( "text", "email_address" , $s +elf->{email_address}, $self->{email_address} , "30 +" , "50" ); }

      ... into this:
      sub generate_stuff { my $self = shift; my $what = shift; my @numbers = @_; return( &generate_line_form_element( "text", $stuff , $self->{$st +uff}, $self->{$stuff} , @numbers ) +; }

      ... and calling it would look like this:
      generate_stuff( 'extension', 4, 4 ); # this is what a generate_stuff( 'email_address', 30, 50 ); # call would look like

      If you see a lot of code that looks the same structurally, it's usually better to consolidate it into something smaller and less repetetive. That way, if you have an error (or just a change you want to make), you only have to fix it in one place, and you can be certain that all of your similar functions will work the same way. In a situation of significant redundancy, consolidation can save a lot of space.
      --
      Love justice; desire mercy.
Re: My perl interpreter won't even look at it. It's that bad.
by dws (Chancellor) on Nov 16, 2002 at 01:26 UTC
    My perl interpreter won't even look at it. It's that bad.

    Next time, you'll know not to type that much code before you start syntax checking it (via perl -cw).

    One way to work your way through that body of code is to use POD directives to comment chunks out. Pick a reasonable chunk at the top of the file and add   =for COMPILING below it. Then add   =cut to the bottom of the file. You've commented out everything between these directives. Now perl -cw the file, fix any errors that are reported, and then move the =for COMPILING line down a chunk. Repeat until you've reached the bottom of the file.

Re: My perl interpreter won't even look at it. It's that bad.
by atcroft (Abbot) on Nov 16, 2002 at 01:00 UTC

    My first thought was to suggest 'perl -c filename' to do a syntax check, or to run the code through perltidy to see what it might do.

    Instead, I downloaded the code, removed the first few lines where the download page gave the error message you received, had to comment out the use of EmailValid (which I did not have), named it as "too_many_errors.pl", and got the following with perl 5.6.1:

    # perl -c too_many_errors.pl syntax error at too_many_errors.pl line 176, near ");" syntax error at too_many_errors.pl line 201, near ");" syntax error at too_many_errors.pl line 228, near ");" syntax error at too_many_errors.pl line 253, near ");" syntax error at too_many_errors.pl line 278, near ");" syntax error at too_many_errors.pl line 303, near ");" syntax error at too_many_errors.pl line 327, near ");" syntax error at too_many_errors.pl line 351, near ");" syntax error at too_many_errors.pl line 376, near ");" syntax error at too_many_errors.pl line 401, near ");" too_many_errors.pl has too many errors.

    As best I could tell, these lines are in the else sections for update_* functions, are appear that there may be a closing parenthesis missing on each of those lines before the semi-colon.

    Hope that helps somewhat. I don't do much work with objects personally, but I expect and hope that others will be able to provide you with other hints/tips/observations in that area.

Re: My perl interpreter won't even look at it. It's that bad.
by Zaxo (Archbishop) on Nov 16, 2002 at 01:56 UTC

    A couple more things that aren't exactly errors. Your new() constructor should shift in the class name, which should be used as the second argument of bless. What you have will work, but you can't inherit from User to make Customer or Admin classes. It would be good to let yourself initialize the User in the constructor, too.

    sub new { my $class = shift; my $self = { userID => undef, userName => undef, password => undef, passwordHint => undef, passwordHintAnswer => undef, userActive => undef, legalName => undef, scaName => undef, addressLine1 => undef, addressLine2 => undef, state => undef, country => undef, city => undef, zip => undef, areaCode => undef, firstThree => undef, lastFour => undef, extension => undef, emailAddress => undef, @_ # initializer }; bless $self, $class; }
    I'm not convinced you need to set up all the keys in that, or that undef is the best default initialization.

    The way you've named your class data, cgi fields, and db columns, you could keep a single array of names to use in all those by mapping through lc and ucfirst; but why not use the same names for all three?

    After Compline,
    Zaxo

Re: My perl interpreter won't even look at it. It's that bad.
by dws (Chancellor) on Nov 16, 2002 at 04:09 UTC
    Another problem this code suffers from is a Cargo-cultism from sloppy C programming -- treating return as a function call.

    In Perl, the semantics of slapping parentheses around expressions is not the same as in C et al. What you get (in Perl) is a list. Having a list when you think you're getting a scalar can occassionally cause interesting problems. Even if it doesn't cause problems, it leads to unecessary object creation/destruction, which is kind of like having barnacles on the bottom of your boat.

    So, lose the parentheses when you use return.

Re: My perl interpreter won't even look at it. It's that bad.
by Enlil (Parson) on Nov 16, 2002 at 01:03 UTC
    I just started looking at this, but one of your main problems (that I have seen so far), in it not compiling is that you have a lot of code like:
    return( &generate_line_form_element( DIFFERENT_STUFF );
    All of which seem to be missing the last ) . You also have an elseif not an elsif in there.

    I just had an idea, I am assuming that you are calling user.pm from another script, and have not yet debugged user.pm. You can just run the .pm like a .pl file, and debug that, but here is a start to fixing your problems, now that I realized (I think) what you're probably doing.

    -enlil