Broad Network


HTML Form Validation Project with Perl

Perl Validation of HTML Form Data – Part 2

Web Development with Perl and MySQL

Foreword: In this part of the series I present a project that uses Perl to validate the field values of an HTML Form.

By: Chrysanthus Date Published: 5 Sep 2016

Introduction

This is part 2 of my series, Perl Validation of HTML Form Data. In this part of the series I present a project that uses Perl to validate the field values of an HTML Form. You should have read the previous part of the series before reaching here, as this is a continuation.

Project Description
There is an HTML Form in a web page (from localhost) in a browser. The Perl file to do the validation is in a localhost (personal web server) in the home directory. When the Perl file receives the form dataset, it checks if each value of each field has been typed according to the syntax of the data type. If any of the field value is wrongly typed, an error message is sent back to the browser. If all the values are properly typed, a feedback message is sent to the browser indicating so.

Remember, you are using the new PurePerl MySQL API that is becoming more and more famous. The second part of the first series of this volume, tells you how to download and install it, free.

The HTML Form
The code for the HTML Form page is:

<!DOCTYPE HTML>
<html>
<head>
    <title>Code Sample</title>
</head>
<body>


    <form method="post" action="valid.pl">
        <h3>Supplier Info</h3>
        <p>
            <label>Company Name: <input type="text" name="company" id="company"></label>
        </p>
        <p>
            <label>URL: <input type="text" name="url" id="url"></label>
        </p>
        <p>
            <label>Internet IP: <input type="text" name="ip" id="ip"></label>
        </p>
        <p>
            <label>No. of Workers: <input type="text" name="noW" id="noW"></label>
        </p>
        <p>
            <label>Years in Business: <input type="text" name="years" id="years"></label>
        </p>
        <p>
            Service Company? <label>Yes: <input type="radio" name="cType" value=1></label> <label>No: <input type="radio" name="cType" value=0>
        </p>
        <strong>Contact Person</strong><br>
        <p>
            <label>First Name: <input type="text" name="firstname" id="firstname"></label>
        </p>
        <p>
            <label>Last Name: <input type="text" name="lastname" id="lastname"></label>
        </p>
        <p>
            <label>Email: <input type="text" name="email" id="email"></label>
        </p>

        <p>
            <button type="submit">Submit</button>
        </p>

    </form>


</body>
</html>

You should display the page to see what the Form looks like.
The HTTP POST method has been used and the name of the Perl file is, valid.pl in the Form action URL of http://localhost/valid.pl .

The Data Types Involved
The fields for Company, First name and Last name are of data type text. The field for URL is of data type, URL. The field for Internet IP is of data type IP. The field for Number of Workers is of data type, int. The field for number of Years in Business, is of data type, float. The field for Service Company (is it a service or a product company) is of data type Boolean. The field for Email is of data type, Email.

Perl Validation Technique
Validation is done using the functions indicated in the previous part of the series. The function may be modified a bit. The text type is validated using Perl regular expression. You use regular expression techniques to validate the text type (company, first name, last name, etc) in Perl.

Coding the Perl Script
The first code segment of the Perl script is:

#!C:/Perl/bin/perl5.18.2.exe
use Mysql;
use CGI;
use strict;

print "Content-Type: text/html\n\n";

    my $obj = CGI->new();

    my $company  = $obj->param('company');
    my $url = $obj->param('url');
    my $ip = $obj->param('ip');
    my $noW = $obj->param('noW');
    my $years = $obj->param('years');
    my $cType = $obj->param('cType');
    my $firstname = $obj->param('firstname');
    my $lastname = $obj->param('lastname');
    my $email = $obj->param('email');

    my $allFine = 1;

The CGI object collects all the Form name/value pairs. The values are assigned to Perl variables.

For the company, firstname and lastname fields, it is assumed that the value consists of just one word, for simplicity. So the regex will be, "/\w*/".

The code segment to test the Boolean variable is,

    #Test the Service Company radio field for yes or no.
    $cType =~ s/^\s*|\s*$//g;  #remove leading and trailing whitespaces

    sub isBoolean
        {

            my $bool = 0;

            if (($_[0] eq "0"))
                {
                    $bool = 1;
                }
            if (($_[0] == 1)||($_[0]<0)||($_[0]>0))
                {
                    $bool = 1;
                }
            if ($bool == 1)
                {
                    return 1;
                }
            else
                {
                    return 0;
                }
        }

    if (isBoolean($cType) == 0)
        {
            print "You have to answer Yes or No for Service Company!";
        }

When no radio button is checked, the Perl value is equivalent to undef or "". So the isBoolean() function has been modified a bit (at the first if condition).

If at the end of the script, there is no error, that is all the fields are validated correctly, a feedback is sent to the browser to indicate so. The feedback code is executed in a conditional block (based on the $allFine variable – see below).

Note: an error message or the feedback (positive) message goes to a new page at the browser.
The complete Perl script is:

use Mysql;
use CGI;
use strict;

print "Content-Type: text/html\n\n";

    my $obj = CGI->new();

    my $company  = $obj->param('company');
    my $url = $obj->param('url');
    my $ip = $obj->param('ip');
    my $noW = $obj->param('noW');
    my $years = $obj->param('years');
    my $cType = $obj->param('cType');
    my $firstname = $obj->param('firstname');
    my $lastname = $obj->param('lastname');
    my $email = $obj->param('email');

    my $allFine = 1;


    sub isRT
        {
            if ($_[0] =~ /\w+/)
                {
                    return 1;
                }
            else
                {
                    return 0;
                }
        }


    #test a single word company name
    $company =~ s/^\s*|\s*$//g;  #remove leading and trailing whitespaces

    if (isRT($company) == 0)
        {
            print "The company name has not been typed correctly!", '<br>';
            $allFine = 0;
        }


    #Test the URL
    $url =~ s/^\s*|\s*$//g;  #remove leading and trailing whitespaces

    sub isURL
        {
            if ($_[0] =~ /^http|https:\/\/([0-9a-zA-Z_\-]{1,64}\.)?[0-9a-zA-Z_\-]{1,64}(\.[0-9a-zA-Z_\-]{2,4}){0,2}(:[0-9]{1,5})?(\/[0-9a-zA-Z_\-]{1,64}){0,64}([0-9a-zA-Z_\-]{1,64}(\.[a-zA-Z]{1,4})?)?(#[0-9a-zA-Z_\-]{1,64})?/)
                {
                    return 1;
                }
            else
                {
                    return 0;
                }
        }

    if (isURL($url) == 0)
        {
            print "The URL has not been typed correctly!", '<br>';
            $allFine = 0;
        }


    #Test the IP
    $ip =~ s/^\s*|\s*$//g;  #remove leading and trailing whitespaces

    sub isIP
        {
            if (($_[0] =~ /^[\d]{1,3}\.[\d]{1,3}\.[\d]{1,3}\.[\d]{1,3}$/) || ($_[0] =~ /^[\da-fA-F]{1,4}:[\da-fA-F]{1,4}:[\da-fA-F]{1,4}:[\da-fA-F]{1,4}:[\da-fA-F]{1,4}:[\da-fA-F]{1,4}:[\da-fA-F]{1,4}:[\da-fA-F]{1,4}$/))
                {
                    return 1;
                }
            else
                {
                    return 0;
                }
        }

    if (isIP($ip) == 0)
        {
            print "The IP address has not been typed correctly!", '<br>';
            $allFine = 0;
        }


    #Test the whole number of workers
    $noW =~ s/^\s*|\s*$//g;  #remove leading and trailing whitespaces

    sub isWholeNumber
        {
            if ($_[0] =~ /^\d+\z/)
                {
                    return 1
                }
            else
                {
                    return 0;
                }
        }

    if (isWholeNumber($noW) == 0)
        {
            print "Type a whole number for no. of workers!", '<br>';
            $allFine = 0;
        }


    #Test the float number of Business years
    $years =~ s/^\s*|\s*$//g;  #remove leading and trailing whitespaces

    sub isFloat
        {
            if ($_[0] =~ /^[+-]?(?=\.?\d)\d*\.?\d*(?:e[+-]?\d+)?\z/i)
                {
                    return 1
                }
            else
                {
                    return 0;
                }
        }

    if (isFloat($years) == 0)
        {
            print "Years in Business e.g. 3 or 3.5 has not been typed correctly!", '<br>';
            $allFine = 0;
        }


    #Test the Service Company radio field for 1 or 0.
    $cType =~ s/^\s*|\s*$//g;  #remove leading and trailing whitespaces

    sub isBoolean
        {

            my $bool = 0;

            if (($_[0] eq "0"))
                {
                    $bool = 1;
                }
            if (($_[0] == 1)||($_[0]<0)||($_[0]>0))
                {
                    $bool = 1;
                }
            if ($bool == 1)
                {
                    return 1;
                }
            else
                {
                    return 0;
                }
        }

    if (isBoolean($cType) == 0)
        {
            print "You have to answer Yes or No for Service Company!", '<br>';
            $allFine = 0;
        }


    #test a single word firstname
    $firstname =~ s/^\s*|\s*$//g;  #remove leading and trailing whitespaces

    if (isRT($firstname) == 0)
        {
            print "The First Name has not been typed correctly!", '<br>';
            $allFine = 0;
        }


    #test a single word lastname
    $lastname =~ s/^\s*|\s*$//g;  #remove leading and trailing whitespaces

    if (isRT($lastname) == 0)
        {
            print "The Last Name has not been typed correctly!", '<br>';
            $allFine = 0;
        }


    #test the email
    $email =~ s/^\s*|\s*$//g;  #remove leading and trailing whitespaces

    sub isEmail
        {
            my $temp = 0;
        
            if ($_[0] =~ /^[0-9a-zA-Z_\.-]{1,64}@[0-9a-zA-Z_-]{1,252}(\.[0-9a-zA-Z_\-]{2,4}){0,2}$/)
                {
                    $temp = 1;
                }

            if ($temp == 1)
                {
                    if (length($_[0]) <=254)
                        {
                            return 1;
                        }
                    else
                        {
                            return 0;
                        }                                    
                }
            else
                {
                    return 0;
                }
        }

    if (isEmail($email) == 0)
        {
            print "The Email has not been typed correctly!", '<br>';
            $allFine = 0;
        }


    #All should be well at this point
    #Send feedback
    if ($allFine == 1)
        {
            print $company, '<br>';
            print $url, '<br>';
            print $ip, '<br>';
            print $noW, '<br>';
            print $years, '<br>';
            print $cType, '<br>';
            print $firstname, '<br>';
            print $lastname, '<br>';
            print $email, '<br>';
        }

If all is fine, the feedback data (message) can be sent to an email box or database.

That is it: A project to validate HTML Form data using Perl, at the server.

Chrys

Related Links

Web Development Basics with Perl and MySQL
Perl Validation of HTML Form Data
Page Views with Ajax and Perl and MySQL
Web Live Text Chart Application using Perl and MySQL
Search Within a Site using Perl and MySQL
More Related Links
Perl Mailsend
PurePerl MySQL API
Perl Course - Professional and Advanced
Major in Website Design
Web Development Course
Producing a Pure Perl Library
MySQL Course

BACK

Comments

Become the Writer's Follower
Send the Writer a Message