setprefs.pl, basic version

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

# 
#            setprefs.pl 
# 
# Sample Perl script that processes the result of 
# editprefsform.pl to set preferences for each 
# M-Business Anywhere user. 
# 
# We grab the username and preferences from the form 
# submitted to us and we place the results in our 
# database. 
# 
# We also create a cookie with the user's uniqueID and set 
# that, just in case.

srand;

# The first thing we do is grab the preferences from the 
# submitted form and store them in an array.

for ($i=0; $i<11; $i++) { 
    $prefs[$i] = param($i) || "0"; 
}

# We also grab the user's firstname and strip out any 
# weird pattern-breaking characters.

$username = param("firstname");

$username =~ s/~:~/~;~/g;

# If they have an ID already, we use it. Otherwise, we 
# give them one.

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

# We create the cookie, with a name, ID, and expires time 
# of 10 years.

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

# We write the user's preferences into the database.

dbmopen(%prefs, "movieuserprefs", 0644) || die "cannot open DBM $!";

$prefstring = $username. "~:~". join ("~:~", @prefs);

$prefs{$myID} = $prefstring;

dbmclose(%prefs);

# Now, we use the Set-Cookie HTTP heading to actually set 
# the cookie. This is what the M-Business Sync Server needs 
# to set the value of a cookie.

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

# Nobody should ever see this form, becuase we're sending 
# this with submitnoresponse. But I keep it around for 
# debugging purposes.

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>";

# This used to be a bad idea because srand used time() as 
# its seed. In later versions of Perl, it doesn't.

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

# And now, the important legal message... 
# 
# Copyright (c) 2000, iAnywhere Solutions, Inc., 
# all rights reserved. 
# 
# IANYWHERE MAKES NO REPRESENTATIONS OR WARRANTIES ABOUT 
# THE SUITABILITY OF THE SOFTWARE, EITHER EXPRESS OR 
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE IMPLIED 
# WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR 
# PURPOSE, OR NON-INFRINGEMENT. IANYWHERE SHALL NOT BE 
# LIABLE FOR ANY DAMAGES SUFFERED BY LICENSEE AS A RESULT 
# OF USING, MODIFYING OR DISTRIBUTING THIS SOFTWARE OR 
# ITS DERIVATIVES.

Send feedback about this page using email.