setprefs.pl, version supporting online users

#!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"; 
}

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

# Nobody should ever see this form, becuase we're sending 
# this with SubmitNoResponse. But I keep it around for 
# online users.

print <<END_of_Response;

<HTML> 
    <HEAD> 
    <META name="HandheldFriendly" content="true"> 
    <TITLE>Cookie has been set</TITLE> 
    </HEAD> 
    <BODY> 
    Thanks for your submission! 
    <p> 
    Please go back to the 
        <a href="/cgi-bin/movies2/frontpage.pl">
        Front Page to read more movie reviews. 
    <p>

END_of_Response

# 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) 2007, 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.