Hello and welcome to our community! Is this your first visit?
Register
Enjoy an ad free experience by logging in. Not a member yet? Register.
Results 1 to 2 of 2
  1. #1
    New Coder
    Join Date
    Aug 2005
    Posts
    71
    Thanks
    9
    Thanked 3 Times in 3 Posts

    Need help identifing Perl method

    Alright, i came across a script I modified many years ago and noticed that it will work (with a little tweaking) for something I am currently doing. Since I know I didn't fully understand what it was I was doing at the time and I probably was going from another script sample I found on the internet, I need to now identify what method(s) of Perl I am using in this script. Particularly the parts where I output html code tags. It seems to be an abbreviated form of some sort and that is what I need to identify. Here is the code.

    Code:
    #!/usr/bin/perl -w
    use strict;
    
    use CGI qw/:standard/;
    use CGI::Carp qw/fatalsToBrowser/;
    
    $CGI::POST_MAX = 350;
    
    $ENV{PATH} = "/cgi-bin";
    
    # declare/define variable names
    my $lines;
    my $status = 0;
    my $elim = 35;
    my $plim = 50;
    my $clim = 199;
    
    open(LOGFILE, "../logs/error_log") or die "Could not open log file: $!\n";
    my @lines = <LOGFILE>;
    close(LOGFILE);
    
    my $last_line = "$lines[$#lines]";
    
    # strip out html file name from error log string
    if ($last_line =~ /^[\[]{1}([\w\s\:\[\]\.]+)(\/httpd\/htdocs\/{1})(.+)/)
    {
      $last_line = $3;
    }else {
      $last_line = "";
    }
    
    # sub for checking data and untainiting
    sub stat_check {
    $status = 1;
    my $info1 = $ENV{'HTTP_REFERER'};
    my $info2 = $ENV{'REMOTE_ADDR'};
    my $_email = param('email');
    my $_page = param('page');
    my $_comments = param('comments');
    my @vars;
    
    if (!$_email) {
       my $gemail = "No email address provided";
       push(@vars,$gemail);
       return @vars;
    }elsif (length ($_email) > $elim) {
       print 'The email address you entered is too long.&nbsp; Please recheck your address';
       $status = 0;
    }elsif ($_email !~ /[\%\$\^\!\*\(\)\[\]\\\|\{\}\;\<\>]/ && $_email =~ /^(\w{1}[\w\-\.]+\@{1}[\w\-\.]+\.{1}\w{2,4})$/i) {
       my $gemail = "$1";
       push(@vars,$gemail);
       return @vars;
    }else {
       print 'Please use only alphanumeric characters, dashes, &quot;@&quot;, periods or underscores in your email address';
       $status = 0;
    }
    
    if (!$_page) {
       my $gpage = "No page info given";
       push (@vars,$gpage);
       return @vars;
    }elsif (length ($_page) > $plim) {
       print 'The page length is too long.&nbsp; Be sure too leave off the &quot;http://www.&quot;';
       $status = 0;
    }elsif ($_page !~ /[\%\&\$\^\!\*\(\)\[\]\\\|\{\}\;\<\>]+/ && $_page =~ /^([\w\.\/\-]+)(\.{1}\w{2,5})$/i) {
       my $gpage = "$1$2";
       push (@vars,$gpage);
       return @vars;
    }else {
       print 'Please use only alphanumeric characters, dashes, &quot;@&quot;, periods or underscores in your email address';
       $status = 0;
    }
    
    if (!$_comments) {
       my $gcomments = "No comments entered";
       push (@vars,$gcomments);
       return @vars;
    }elsif (length ($_comments) > $clim) {
       print 'Please keep your comments to 200 characters or less (spaces count as a character)';
       $status = 0;
    }elsif ($_comments !~ /[\%\$\^\!\*\(\)\[\]\\\|\{\}\;\<\>\&]+/ && $_comments =~ /^([\w\s\.\,]+)/i) {
       my $gcomments = $1;
       push (@vars,$gcomments);
       return @vars;
    }else {
       print 'Please use only alphanumeric characters, dashes, &quot;@&quot;, periods or underscores in your email address';
       $status = 0;
    }
    
    if (!$info1) {
      my $info1 = "No URL available";
      push (@vars,$info1);
      return @vars;
    }elsif ($info1 !~ /[%\$\^\!\*\(\)\[\]\\\|\{\}\;\<\>]+/ && $info1 =~ /^(http{1}.+)/) {
       my $info1 = "$1";
       push (@vars,$info1);
       return @vars;
    }else {
       my $info1 = "Bad URL submitted";
       push (@vars,$info1);
       return @vars;
    }
    
    if (!$info2) {
      my $info2 = "No IP address available";
      push (@vars,$info2);
      return @vars;
    }elsif ($info2 !~ /[\%]+/ && $info2 =~ /^(\d{1,3}\.{1})(\d{1,3}\.{1})(\d{1,3}\.{1})(\d{1,3})$/) {
       my $info2 = "$1$2$3$4";
       push (@vars,$info2);
       return @vars;
    }else {
       my $info2 = "Bad IP address submitted";
       push (@vars,$info2);
       return @vars;
    }
    }
    
    # Begin second page
    print header;
    
    if (param()) {
      my $_email = param('email');
      my $_page = param('page');
      my $_comments = param('comments');
          if (stat_check()) {
          &mailoff;
          exit; }
    }
    
    # Begin intro page
    print start_form,
    h1({style=>'color: #06C;'},'Error - Page Not Found!'),
    p({style=>'font: 1em Arial, sans-serif;'},'We're sorry, but the page
    you were looking for has either been changed, moved, or has been
    deleted.&nbsp;  Please return to our ',a({href=>'http://www.memco.us'},'homepage'),' to locate the proper
    page.&nbsp; You may also fill out the form below to help us better understand why you arrived at this error page.'),
    p({style=>'font: 1em Arial, sans-serif;'},'If you arrived at this page via a &quot;bookmark&quot;, please delete the link as it no longer works.'),
    br,hr,br,
    'Email address &lt;optional&gt;:&nbsp; ',br,
    textfield('email','',35),
    br,br,
    'This is the page you were trying to access.',br,
    textfield('page',$last_line,50),
    br,br,
    'Additional information:',br,
    textarea('comments','',4,40),
    br,br,
    submit,
    end_form;
    
    # Begin subs
    sub mailoff {
    
    my $mailprog = '/usr/sbin/sendmail';
    my $recipient = 'me@here.com';
    my @vars = &stat_check('vars');
    
    open (MAIL, "|$mailprog -t") or diemail ("Can't access $mailprog!\n");
    
    print MAIL "To: $recipient\n";
    print MAIL "Subject: Error 404\n\n";
    
    print MAIL "The following information has been supplied due to an Error 404.\n";
    print MAIL "\n";
    print MAIL "Message sender: $vars[0] $vars[4]\n\n";
    print MAIL "Tried to access $vars[1]\n\n";
    print MAIL "Comments:\n";
    print MAIL "$vars[2]\n\n";
    print MAIL "Refering page: $vars[3]\n";
    
    close(MAIL);
    
          print start_html(title=>'Thank You');
          h1('Thank You!'),
          p('Your information has been submitted&nbsp; This information will enable us to locate your particular problem and fix it.'),
          end_html;
    }
    
    sub diemail {
            my $msg = shift;
            print start_html,
              p ($msg),
              end_html;
              }
    If you look the "#begin intro page" section, there are a bunch of html tags that seem to be coded in a short form sort of way. What I want to do is make the "page" textfield read only. I think it goes like this

    Code:
    textfield('page', $last_line,50,readonly)'
    but without any way to check documentation, I can't be sure. I know this is a particular method of the CGI.PM module, but I can't find anything on it now. Please help. Thanks.
    Last edited by Budreaux; 03-16-2010 at 08:47 PM. Reason: Clarify things
    It's OK to pee against the wind if your standing in a lake.

  • #2
    New Coder
    Join Date
    Aug 2005
    Posts
    71
    Thanks
    9
    Thanked 3 Times in 3 Posts
    OK, I found my answer. What I was looking at was the old style of using CGI.PM. I should be using the named parameter style which will allow me to use the read only parameter.
    It's OK to pee against the wind if your standing in a lake.


  •  

    Posting Permissions

    • You may not post new threads
    • You may not post replies
    • You may not post attachments
    • You may not edit your posts
    •