#!/usr/bin/perl package rotate; use FindBin; use lib $FindBin::Bin; use CGI; use CGI::Carp qw(fatalsToBrowser); require Exporter; use vars qw/@ISA @EXPORT @EXPORT_OK $copyright $prgname/; $version = "HTML Rotate Ver 1.0"; $prgname = "HTML Rotate"; $copyright = "Copyright 2007 FocalMedia.Net - All Rights Reserved"; @ISA = qw(Exporter); @EXPORT = qw(check_access ); @EXPORT_OK = qw( ); &get_setup; sub check_access { my ($TheUsername, $ThePassword, $EnteredUser, $EnteredPass) = @_; my ($usercookie, $passcookie, $query); $query = new CGI; $usercookie = $query->cookie('htmlruser'); $passcookie = $query->cookie('htmlrpass'); if (($EnteredUser ne "") and ($EnteredPass ne "")) {&do_login ($EnteredUser, $EnteredPass);} if (($usercookie eq "") and ($passcookie eq "")){&login_screen;} if (($usercookie ne $TheUsername) or ($passcookie ne $ThePassword)){&wrongps_screen;} } sub do_login { my ($form_username, $form_password) = @_; my ($query, $thecookie1, $thecookie2, $scripts_admin); $query = new CGI; $thecookie1 = $query->cookie(-name=>'htmlruser', -value=>$form_username, -path=>'/'); $thecookie2 = $query->cookie( -name=>'htmlrpass', -value=>$form_password, -path=>'/'); print $query->header(-cookie=>[$thecookie1, $thecookie2]); #print "Content-type: text/html\n\n"; print " HTML Rotate "; exit; } sub login_screen { my ($newquery, $scripts_admin); my $newquery = CGI->new; print $newquery->header(); print $newquery->start_html("Control Panel"); print qq[

 

 

 

Login:
User Name:
Password:
       

 

]; exit; } sub wrongps_screen { my ($scripts_admin); my $query = CGI->new; print $query->header(); print $query->start_html("Control Panel"); print qq[

 

 

 

The user name or password you entered was incorrect. Please Retry.
User Name:
Password:
       

 

]; exit; } ###################################################################### sub get_setup { $exists = (-e "config.cgi"); if ($exists > 0) { open (STP, "config.cgi"); while (defined($line=)) { if ($line =~ m/#/g) { $r = pos($line); $line = substr($line, 0, $r - 1); } $line =~ s/\n//g; if ($line =~ /^WEBDIR/){$webdir = &get_setup_line($line, WEBDIR);} if ($line =~ /^WEBURL/){$weburl = &get_setup_line($line, WEBURL);} if ($line =~ /^SCRIPT_URL/){$script_url = &get_setup_line($line, SCRIPT_URL);} if ($line =~ /^USERNAME/){$username = &get_setup_line($line, USERNAME);} if ($line =~ /^PASSWORD/){$password = &get_setup_line($line, PASSWORD);} } close (STP); } } sub get_setup_line { my ($setup_line, $setup_var) = @_; $crit = "\""; $setup_line =~ m/$crit/g; $r1 = pos($setup_line); $setup_line =~ m/$crit/g; $r2 = pos($setup_line); $setup_line = substr($setup_line, $r1, ($r2 - $r1 - 1)); $return_val = $setup_line; return ($return_val); } #### END CONFIGURATION ######################################################## sub get_file_contents { my ($filename) = @_; my ($filesize, $filesize, $thefile); $filesize = (-s "$filename"); open (TFILECNTS, "$filename"); if ($flocking ne "No"){flock (TFILECNTS,2);} read(TFILECNTS,$thefile,$filesize); if ($flocking ne "No"){flock (TFILECNTS,2);} close (TFILECNTS); return ($thefile); } 1;