Listing 3: setprefs.pl

For a full listing of this source code, see setprefs.pl, basic version.

All we need now is a script to process the results of the form we generated above. In other words, we need to set a cookie for the user, if one is not set already, and edit his preferences in our database.

We start off again with the usual headers (plus an srand call to start up our random number generator). 

#!D:\Perl\bin\perl.exe use CGI qw/:standard/; use CGI::Cookie; srand;
 

                  
               

            

            
Then we grab the parameters returned by the form. Note that all of our genre preference parameters within the previous form
               are named 1, 2, 3, and so on. So it is relatively easy to grab their values from a for loop.
            

            
We put the user's name into a variable called username and his preferences into an array of 11 true-or-false values. That
               last line there replaces any ~:~ strings with ~;~ in case somebody happened to include our record-separating string within his name. (Although that would be a really strange
               name.)
            

            

               

                  
for ($i=0; $i<11; $i++) { $prefs[$i] = param($i) || "0"; } 
    $username = param("firstname"); $username =~ s/~:~/~;~/g;

                  
               

            

            
If the user's cookie indicates he has an ID already, we use it. Otherwise, we generate one using the getrandomID function—this
               is a function created below that generates a random ID for us.
            

            

               

                  
%cookies = fetch CGI::Cookie; 
if ($cookies{'moviereviewID'} ) 
{ 
    $myID = $cookies{'moviereviewID'}->value; 
} 
else { 
    $myID = getrandomID(); 
}

                  
               

            

            
Then we use Perl's CGI::cookie function to create a cookie. I have set the expire time to 10 years from now, since we really
               do not want our cookies to expire between synchronizations. (If I wanted to be thorough, I could also define my own domain
               and path values for the cookie.)
            

            

               

                  
$tkcookie = new CGI::Cookie(-name=>'moviereviewID', 
    -value=>$myID, -expires=>'+10y');

                  
               

            

            
We write the user's preferences into the database, joining them together as a ~:~ -separated list of values.
            

            

               

                  
dbmopen(%prefs, "movieuserprefs", 0644) || 
    die "cannot open DBM $!"; $prefstring = $username. "~:~". 
    join ("~:~", @prefs); $prefs{$myID} = $prefstring; dbmclose(%prefs);

                  
               

            

            
Finally, we print out our HTML document. Note the set-cookie line among the HTTP headers. This document will be placed in
               the Forms Manager during the next synchronization. It is really just a bunch of debug information, and I do not really want
               our users to see it. (After the next synchronization, our users will be looking at the new frontpage.pl.) In the next section, we will find out how to hide this from the Forms Manager.
            

            

               

                  
print "Content-type: text/html\n"; 
print "Set-Cookie: $tkcookie\n"; 
print "Cache-Control: private\n";

print <<END_of_Response;

<HTML> <HEAD> <TITLE>Cookie has been set</TITLE> </HEAD> 
<BODY> Your cookie has been set. <p>

END_of_Response

print "This is debug information you'll never see. \n"; 
print "Your prefs string is $prefstring <p> \n"; 
print "And your ID is $myID \n </body></HTML>";

                  
               

            

            
Last but not least is our getrandomID() function, which takes the current time (in seconds) and appends a 7-digit random number to it.
            

            

               

                  
sub getrandomID { return (time(). sprintf("%07d",(int(rand(5000000))))); }

                  
               

            

            

               

                  

                  
               

            

            

               
Caution
               

               
Do not use this approach with getrandom() if you are using a version of Perl before 5.004. Perl versions before 5.004 used time() to seed the random number generator.
               

            

         

         

         

            

               
               Copyright © 2008, iAnywhere Solutions, Inc.