Beefy Boxes and Bandwidth Generously Provided by pair Networks
Syntactic Confectionery Delight
 
PerlMonks  

Re: Re: A CGI redirect problem

by CharlesClarkson (Curate)
on Jan 29, 2002 at 00:44 UTC ( #142183=note: print w/ replies, xml ) Need Help??


in reply to Re: A CGI redirect problem
in thread A CGI redirect problem

If anyone wants to suggest impovements pelase feel free.

Let's start with an outline of the script:

if ( param ) { } else { } sub start_handler {} sub char_handler {}

Next, we'll add in the subroutines:

sub start_handler { my ($expat, $element, %attributes) =@_; if ($::flag==0 && $element eq "username") { $::flag=1; } if ($::flag==1 && $element eq "password") { $::flag=2; } }

We'll rewrite this to exclude variables we don't use and using conditional statements:

sub start_handler { my $element = $_[1]; $::flag = 1 if $::flag == 0 && $element eq 'username'; $::flag = 2 if $::flag == 1 && $element eq 'password'; }

sub char_handler { my ($expat, $text) =@_; if ($::flag==1 && $text eq (param("username"))) { $::flag=1; } if ($::flag==2 && $text eq (param("password"))) { my($un); $un=param("username"); print redirect("http://www.domain.com/cgi-bin/xml_final/viewdb. +pl?username=$un"); } elsif ($::flag==2 && $text ne (param("password"))) { $::flag=0; print header; print start_html(-title => "Not so much correct with tha login" + ,-style => { -src => "../..//xml_final/db.css"}); print h1("incorrect password"); print p({-align=>'CENTER'},a{-href=>"login.pl"},"Try Agian?"); print end_html; #print a link back to login.pl } }

Let's return immediately if $::flag is not set. Just in case we have a very large file to process.

return unless $::flag;

Let's add some more error checking to that $::flag variable. It will remind us what is going on when we look at this code again in a few months:

warn '$::flag must be 0, 1, or 2 only' if $::flag > 2 or $::flag < + 0;

We're not using $expat, let's not include it.

my $text = $_[1];

This doesn't do anything. Why set $::flag to 1 if it already is 1? Let's remove it.

if ($::flag==1 && $text eq (param("username"))) { $::flag=1; }

Let's outline the rest of the sub:

if ( $::flag==2 && $text eq param('password') ) { } elsif ( $::flag==2 && $text ne param('password') { }

Let's nest this instead:

if ( $::flag==2 ) { if ( $text eq param('password') ) { } else { } }

Same thing a little clearer. But how about:

return unless $::flag == 2; if ( $text eq param('password') ) { } else { }

Now let's fill it in:

if ( $text eq param('password') ) { print redirect( 'http://www.domain.com/cgi-bin/xml_final/viewd +b.pl?username=' . param('username') ); } else { print header, start_html( -title => 'Not so much correct with that login', -style => {-src => '../..//xml_final/db.css'} ), h1('Incorrect password'), p({-align => 'center'}, a({-href => 'login.pl'}, 'Try Agian?') ), end_html; } exit; # no reason to continue processing if the browser is movin +g on

Putting it together:

sub char_handler { return unless $::flag; my $text = $_[1]; warn '$::flag must be 0, 1, or 2 only' if $::flag > 2; return unless $::flag == 2; if ( $text eq param('password') ) { print redirect('http://www.domain.com/cgi-bin/xml_final/viewdb +.pl?username=' . param('username')); } else { $::flag = 0; print header, start_html( -title => 'Not so much correct with that login', -style => { -src => '../..//xml_final/db.css'}), h1('Incorrect password'), p({-align => 'center'}, a({-href => 'login.pl'}, 'Try Agian?') ), end_html; } exit; }

Let's fill in the main if. This is what you presented:

my ($parser, $document, $users); local($::flag); $::flag=0; open(USERS, "../../xml_final/users/users.xml") || die "Could not open users.xml $!"; flock(USERS, LOCK_SH); print header, start_html(-title => "Login" ,-style => { -src => "../../xml_final/db.css"}), title ("please login"); print start_html; $parser= new XML::Parser(); $parser->setHandlers( Start => \&start_handler, Char => \&char_handler ); $document = $parser->parse (\*USERS); close (USERS);

Since the subroutines handle their own HTML, we don't need it here. We'll eliminate the my statement and use it on-the-fly instead. We'll also eliminate local($::flag); as it isn't needed at the file level. Finally we'll change some indenting and change double quotes to single quotes where possible:

$::flag = 0; open USERS, '../../xml_final/users/users.xml' or die "Could not open u +sers.xml: $!"; flock(USERS, LOCK_SH); my $parser = new XML::Parser(); $parser->setHandlers( Start => \&start_handler, Char => \&char_handler); my $document = $parser->parse(\*USERS); close USERS;

The else clause just prints a form and exits. Let's use an unless and a sub:

unless ( param ) { print login_form(); exit; } sub login_form { return header, start_html( -title => 'Login', -style => { -src => "../../xml_final/db.css"}), center( h1('Please login'), start_form, 'username:', textfield( -name => 'username'), 'password:', password_field( -name => 'passwor +d'), submit('send'), reset, end_form, a({ -href => 'newuser.pl'}, 'New User?') ), end_html; }

In order to import the center sub we'll have to add it to our use CGI statement.

Let's look at the whole thing:

#!/usr/bin/perl use strict; use warnings; use CGI qw( :standard center); use Fcntl qw( :flock ); use XML::Parser; unless ( param ) { print login_form(); exit; } $::flag = 0; open USERS, '../../xml_final/users/users.xml' or die "Could not open u +sers.xml: $!"; flock(USERS, LOCK_SH); my $parser = new XML::Parser(); $parser->setHandlers( Start => \&start_handler, Char => \&char_handler); my $document = $parser->parse(\*USERS); close USERS; sub login_form { return header, start_html( -title => 'Login', -style => { -src => "../../xml_final/db.css"}), center( h1('Please login'), start_form, 'username:', textfield( -name => 'username'), 'password:', password_field( -name => 'passwor +d'), submit('send'), reset, end_form, a({ -href => 'newuser.pl'}, 'New User?') ), end_html; } sub start_handler { my $element = $_[1]; $::flag = 1 if $::flag == 0 && $element eq 'username'; $::flag = 2 if $::flag == 1 && $element eq 'password'; } sub char_handler { return unless $::flag; warn '$::flag must be 0, 1, or 2 only' if $::flag > 2 or $::flag < + 0; return unless $::flag == 2; my $text = $_[1]; if ( $text eq param('password') ) { print redirect('http://www.domain.com/cgi-bin/xml_final/viewdb +.pl?username=' . param('username')); } else { print header, start_html( -title => 'Not so much correct with that login', -style => { -src => '../..//xml_final/db.css'}), h1('Incorrect password'), p({-align => 'center'}, a({-href => 'login.pl'}, 'Try Agian?') ), end_html; } exit; }

Unfortunately, I can not run this from my system. You'll have to test it yourself.




HTH,
Charles K. Clarkson


Comment on Re: Re: A CGI redirect problem
Select or Download Code

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://142183]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others examining the Monastery: (9)
As of 2014-09-19 06:00 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    How do you remember the number of days in each month?











    Results (130 votes), past polls