test10.pl to HTML.

index -|- end

Generated: Tue Feb 2 17:54:57 2010 from test10.pl 2005/05/08 5 KB.

#!/perl
package main ;
use strict;
use warnings;
use CGI;
###use CGI qw(:standard);
###use DBI;
require "extra.pl";
my $logfil = 'templog.txt';
my %hash;
my $code; ### = hashCode($title) + hashCode($author) + hashCode($publisher);
my $allOfRecord; ### = $bookRecords{$code};
my @arr;
###my ($LF);
open LF, ">$logfil"
   or die "Can NOT open LOG file $logfil!\n";
tolog ("$0 Started " . localtime(time()) . " ...\n");
print "Hello, World...test10.pl\n";
# Create an array from a hash - note input order
$hash{"book"} = "livre";
$hash{"apple"} = "pomme";
@arr = %hash;
print "@arr\n";
sub hashCode {
   my ($text) = @_; my $length = length($text);
   my @characters = unpack("C*", $text);
   my $char;
   my $code = 0;
   my $i = 1; 
   foreach $char (@characters) {
      $code += $char * 31^($length - $i);
      $i++;
   }
   return $code;
}
my $title = "Perl Cookbook";
my $author = "Tom Christiansen";
my $publisher = "O'Reilly";
my $copyRightYear = "1998";
my $otherData = "...";
$code = hashCode($title) + hashCode($author) + hashCode($publisher);
my %bookRecords = ( $code => "$title|$author|$publisher|$copyRightYear|$otherData" );
$code = hashCode($title) + hashCode($author) + hashCode($publisher);
$allOfRecord = $bookRecords{$code};
my $Sentence = "The Quick Brown Fox Jumped Over The Lazy Dog" ;
my @WordList = split(/ /, $Sentence );
my @lst = split(/\|/, $allOfRecord);
print "$allOfRecord is it!\n";
print "Or\n";
foreach  (@lst) {
   chomp;
   print "$_\n";
}
print @lst, "\n";
my @PPunct = ("&", "&&", "&&=", "&=",
   "<", "<<", "<<=", "<&=", "<&",
   "<=", "<==>", ">", ">&", ">>",
   ">>=", ">=",
   "*", "**", "**=", "*=", "*?",
   "@", "@*,", "@_",
   "`", "\\",
   "!", "!=",
   "^", "^=",
   ":", ",", "\$",
   ".", "\"",
   "=", "=>", "==", "=~",
   ">", "#", "-", "->",
   "-*-", "-=", "--", "-|",
   "%", "%=", 
   "+", "+=", "++", "+?",
   "#", "?", "?:", "?...?",
   "'", "\"", ";", "#!",
   "/", "/=", "//", "/.../",
   "~", "~~",
   "_","|", "|=", "|-", "||", "||=",
   "/o"
   );
my @PPairs = (
   "<", ">",
   "<%", "%>",
   "{", "}",
   "[", "]",
   "(", ")"
   );
my @DolVars = ( "\$1", "\$2", "\$3",
   "\$&", "\$<", "\$>", "\$'", "\$*",
   "\$@", "\$`", "\$\\", "\$!", "\$[",
   "\$]", "\$^", "\$^A", "\$^F",
   "\$^H", "\$^I", "\$^L", "\$^M",
   "\$^O", "\$^P", "\$^T", "\$^W", "\$^X",
   "\$:", "\$,", "\$.", "\$=", "\$-",
   "\$(", "\$)", "\$%", "\$+", "\$?",
   "\$\"", "\$;", "\$/", "\$~",
   "\$_", "\$|"
   );
my @PBPunc = qq/"(?!)", "(?!...", "(?:)",
   "(?...)", "(?=)", "(?#)", "(?i)"
   /;
my @TestArray = (
    "He",
    "As",
    "Well"
);
sub showarrcnts {
   my $i = @arr;
   tolog ("Arr array count = " . $i . "\n");
   $i = @PPunct;
   tolog ("PPunct array count = " . $i . "\n");
   $i = @PPairs;
   tolog ("PPairs array count = " . scalar @PPairs . "\n");
   $i = @DolVars;
   tolog ("DolVars array count = $i\n");
   $i = @PBPunc;
   tolog ("PBPunc array count = $i\n");
   $i = @TestArray;
   tolog ("TestArray array count = $i\n");
   ### tolog (join (/|/, sort @TestArray) );
   tolog (join ('|', sort @TestArray) );
   tolog ("\n");
}
showarrcnts();
##############################################
### Three bit of information, per user ...
### userfullname - their full name
### username - given, of user given
### password - allocated, or user chosen
### The UNIQUE KEY is 'username', where the value is userfullname
### The PASS KEY is a substitution of part the 'username', like 'userpass'
### Only two services -
### verify_2 ( name, pass ) - returns -
### 0 = no user name
### 1 = user name, but incorrect pass
### 2 = all ok
### and get_user_name ( name ), return FULL NAME
### that's it folks ...
###############################################
our %maindb;
require "extra2.pl";
my @keys = %maindb;
my $key;
tolog ("List of " . scalar @keys . " ups ...\n");
### tolog ("List of keys [" . join (' | ', @keys) );
###foreach (sort keys %maindb) {
###    tolog ( $maindb{$_} . "<br />\n" );
###}
foreach (keys %maindb) {
   tolog ( "Key=$_, Value=" . $maindb{$_} . "<br />\n" );
}
tolog ("Done list of " . (scalar @keys / 2) . " ups ...\n");
my $usr = 'unknown user';
my $nm = 'dbUser';
my $ps = 'pass';
### FAIL TEST
my $ok = verify_2($nm,$ps);
$usr = 'unknown user';
if ($ok) {
   $usr = get_user_name($nm);
}
tolog ( "Test $nm, **** " .
 (($ok == 2) ? 'ok' : ($ok == 1) ? 'need NEW pass' : 'failed') .
 " usr:$usr\n");
### NAME OK
$nm = 'dbUser2'; # set a valid user
$ok = verify_2($nm,$ps);
$usr = 'unknown user';
if ($ok) {
   $usr = get_user_name($nm);
}
tolog ( "Test $nm, **** " .
 (($ok == 2) ? 'ok' : ($ok == 1) ? 'need NEW pass' : 'failed') .
 " usr:$usr\n");
### NAME AND PASS OK
$ps = 'twouserpass';
$ok = verify_2($nm,$ps);
if ($ok) {
   $usr = get_user_name($nm);
}
tolog ( "Test $nm, **** " .
 (($ok == 2) ? 'ok' : ($ok == 1) ? 'need NEW pass' : 'failed') .
 " usr:$usr\n");
#######################################################
##sub tolog {
##   print @_;
##   print LF @_;
##}
close LF;
system $logfil;

index -|- top

checked by tidy  Valid HTML 4.01 Transitional