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;