Beefy Boxes and Bandwidth Generously Provided by pair Networks
Think about Loose Coupling
 
PerlMonks  

Server getting and utilizing cookie

by Hammy (Scribe)
on Mar 02, 2001 at 01:23 UTC ( #61659=perlquestion: print w/ replies, xml ) Need Help??
Hammy has asked for the wisdom of the Perl Monks concerning the following question:

Hopefully this is a simple question. I am new to Perl / CGI and I can not figure out how to do the following: get a cookie (mycookie) if no cookie { set a cookie (mycookie) get a cookie (mycookie)(to see if their browser accepts cookies) if get a cookie (mycookie) { use mycookie do some database work } }

Comment on Server getting and utilizing cookie
Re: Server getting and utilizing cookie
by merlyn (Sage) on Mar 02, 2001 at 01:29 UTC
    Oddly enough, this is precisely demonstrated in my upcoming May 2001 WT column, where I talk about setting cookies for session management (including the necessary issues of logout and timeout).

    Sadly, I can't republish the column until it has appeared in print, so wait a month or two and you'll see the whole thing.

    -- Randal L. Schwartz, Perl hacker

      I still want to see your script that generates the first response of "I have done this already; see my WT column here". I know that this added twist of "upcoming column" is just a little special case designed to throw me off the trail.
      update I'm 100 posts old! I'd like to thank God, and the Academy, and Vroom, but not necessarily in that order. please enjoy my new home node image in celebration of this event.
        All in good fun, I promise. scans newest nodes, and looks for a similar WT column, then prints out a merlyn-like text.
        Update
        I guess I could've expected the reply I got... *sigh*
        I wanted to search only the code listings to maximize the possibility of really getting a relevant article. If I searched through the entire site, or through the articles, I got results that make even less sense then they do now. (see this for example) :)
        So, while I do plead ignorance to the column listed, I think my solution is better tailored for the situation.
        Here's some sample output :


        See my WT column on 'file' ideas. This smacks of cargo cult code. If I tried to run this past a customer, he'd shoot me. Are you sure you understand the problem?
        For a more full featured exploration of files concepts, see my WT Column.
        See my WT column on 'error' ideas.
        I've already covered this topic. Check out my Web Techniques column on the subject.
        I've already covered this topic. Check out my Web Techniques column on the subject.
        I don't see why people insist on trying to write partially implemented solutions for this type of thing, especially when they can reference this'mail' WT column.
        Why reinvent the wheel? Check mirod before you put serious time into this.
        I've already covered this topic. Check out my Web Techniques column on the subject.
        Oddly enough, this is precisely demonstrated in an upcoming WT column. Sadly, I can't republish the column until it has appeared in print, so wait a month or two and you'll see the whole thing.
        Oddly enough, this is precisely demonstrated in an upcoming WT column. Sadly, I can't republish the column until it has appeared in print, so wait a month or two and you'll see the whole thing.
        See my WT column on 'print' ideas.
        I don't see why people insist on trying to write partially implemented solutions for this type of thing, especially when they can reference this'x' WT column.
        I've written a lot of things here on the topic of printf. Try searching for them before asking questions like this.
        This smacks of cargo cult code. If I tried to run this past a customer, he'd shoot me. Are you sure you understand the problem?
        Oddly enough, this is precisely demonstrated in an upcoming WT column. Sadly, I can't republish the column until it has appeared in print, so wait a month or two and you'll see the whole thing.
        Why reinvent the wheel? Check chmodded before you put serious time into this.
        This smacks of cargo cult code. If I tried to run this past a customer, he'd shoot me. Are you sure you understand the problem?

        #/usr/bin/perl -w use LWP::Simple; use strict qw(like a dominatrix); $|++; #step 1 - get list of new nodes. # get list of answered nodes # remove all nodes answered. my %newestnodes = &GetNodes(); my @merlyn_preface; open ANSWERED, "<c:\\answered_nodes.txt" || die "No answers! $!"; while (<ANSWERED>) { chomp; delete $newestnodes{$_} if exists $newestnodes{$_}; } close ANSWERED; #step 3 - for each unreplied node, compile "best" words. foreach (sort keys %newestnodes){ my $keyword = GetNode ($_); my $column = GetAnswer($keyword); if (defined $column) { @merlyn_preface = ("I've already covered this topic. Check out + <A HREF='$column'>my Web Techniques</A> column on the subject.", "See my <A HREF='$column'>WT column on '$ke +yword' ideas.</A>", "For a more full featured exploration of $k +eyword concepts, see my <A HREF='$column'>WT Column</A>.", "I don't see why people insist on trying to + write partially implemented solutions for this type of thing, especi +ally when they can reference this<A HREF='$column'>'$keyword' WT colu +mn.</A>" ); } else { @merlyn_preface = ("I don't really understand your request, an +d I'm not sure you know what you want to do. Nonetheless, I suggest y +ou browse my <A HREF='http://www.stonehenge.com/merlyn/WebTechniques/ +'>Web Techniques Perl columns</A>, and see if something helps you the +re.", "This smacks of cargo cult code. If I tried + to run this past a customer, he'd shoot me. Are you sure you underst +and the problem?", "Why reinvent the wheel? Check [CPAN://$key +word] before you put serious time into this.", "I've written a lot of things here on the t +opic of $keyword. Try searching for them before asking questions like + this.", "Oddly enough, this is precisely demonstrat +ed in an upcoming WT column. Sadly, I can't republish the column unti +l it has appeared in print, so wait a month or two and you'll see the + whole thing.", "I smell homework!" ); } print $merlyn_preface [rand (scalar @merlyn_preface)];print "\n"; } open ANSWERED, ">>c:\\answered_nodes.txt" || die "No answers! $!"; foreach (sort keys %newestnodes){ print ANSWERED "$_\n";} close ANSWERED; #step 4 - search for appropriate articles, return the url for one. # if there are no appropriate articles, return "upcoming" or # "cargo cult!" #step 5 - add replied nodes to flat file sub GetNodes { my $newnodes = get('http://perlmonks.org/index.pl?node_id=3628'); my @newsopw = ($newnodes =~/New Questions\<\/a\>\<\/H3\>\<TABLE\>( +.*?)\<\/TABLE\>/i); $newsopw[0] =~s/ (\<\/TR\>)/\n/ig; my %checknodes; while ($newsopw[0]=~/\?node_id=(\d*)\&.*?\?node_id=(\d*)\&/ig){ $checknodes{$1}=1; } return %checknodes; } sub GetNode{ my $node = shift; my $url= "http://perlmonks.org/index.pl?node_id=$node"; my $nodetext = get ($url); if ($nodetext=~/<INPUT TYPE="hidden" NAME="node_id" VALUE="$node" +><INPUT type=hidden name=op value=vote>(.*?)<BR><BR>.*?<CENTER.*?TABL +E/sig) { $text=$1; $text =~s/0X240/ /g; $text =~s/<.*?>/ /g; $text =~s/[^a-zA-Z0-9 ]//ig; my @words = split /\s+/, $text; my %freq; my %common; open COMMON, "common.txt" or die "no common words"; while (<COMMON>) {chomp;my $tempwd= uc ($_) ;$common{"$tempwd" +}=1;} close COMMON; foreach (@words) { my $tempwd = uc($_); if ($common{"$tempwd"}) {;next} $freq{$_}++ ; } my $maxval; my $search=""; foreach (sort {$freq{$b} <=>$freq{$a}} keys %freq) { if ($freq{$_}>=$maxval) { next if !/[a-zA-Z0-9]/; $maxval=$freq{$_}; return $_; } else {last} }; } } sub GetAnswer{ my $keyword = shift; $merlyn = get "http://web.stonehenge.com/cgi/wtsearch?search=$keyw +ord"; # this had a die clause on it, but I think merlyn's got a throttle + on the page... # dying isn't sexy anyway. # if ($merlyn =~/<PRE>(.*?)<\/PRE>/gis ){ my $columns = $1; my %uniquecolumns; while ($columns =~m|http://www.stonehenge.com/merlyn/WebTechni +ques/col(\d+).listing.txt|gi) { $uniquecolumns{$1}=1; } foreach (sort {rand(1) <=>rand(1)} keys %uniquecolumns) { retu +rn "http://www.stonehenge.com/merlyn/WebTechniques/col$_.html"} } return undef; }
Re: Server getting and utilizing cookie
by jeffpflueger (Beadle) on Mar 02, 2001 at 01:51 UTC
    I just figured this out yesterday for something I'm doing....

    my $cgi = new CGI (); my $cookie = $cgi -> cookie ( "WHATEVER" ); if ( defined $cookie ) { #cookie is there and do with it what you want, we'll print it: $cgi -> cookie ( "WHATEVER" ); } else { # Make a cookie my $cookie = $cgi -> cookie ( -name => "WHATEVER", -value => "WHATEVER" ); print $cgi -> header ( -type => "text/html", -cookie => $cookie ); }

    Something like that....you'll have to mess with it. I got all my learning about this from O'Reilly's CGI programming With Perl.

    Good luck

Re: Server getting and utilizing cookie
by dvergin (Monsignor) on Mar 02, 2001 at 06:41 UTC
    You still need a way to tell if the client is not accepting cookies. Otherwise you just keep making cookies and coming back to discover that the client needs a cookie. Here's the logic I'd use (in pseudo-code obviously):
    if $cookie = $cgi->cookie("Whatever") check to see if it meets our standards do business #elsif $cgi->cookie("CookieTest") ## Oops! mistyped... elsif $cgi->param("CookieTest") ## Corrected #we tried to set a cookie and failed bailout else set the cookie set a http location: header line that includes: the url by which we arrived here + CookieTest=1 in the query string clean up and exit end
    More questions? Just ask...
      This is close to what I have done for testing for users/browsers acceptance of cookies. Instead of using a test cookie though, directly set the necessary cookie and pass a query string in the redirect. I have run into situations where a user may accept one cookie but not the next!

      Modifying dvergin's pseudo-code:

      if $cookie = $cgi->cookie("CookieName") check to see if it meets our standards do business else if $cgi->param("TestingCookie") # no need to test value #we tried to set a cookie and failed bailout # or notify user of cookie failure and continue set the cookie set a http location: header line that includes: the url by which we arrived here + CookieName=value in the query string + a query string TestingCookie=1 clean up and exit end
        Good catch sutch. I puzzled over your comments until I realized that I had mis-typed. The line in my post should, of course, be:
        elsif $cgi->param("CookieTest") not elsif $cgi->cookie("CookieTest")
        And with that, I think our solutions are substantially the same.
      I implemented that solution (sort of) and I continually set the cookie everytime through the loop. I guess I don't quite get the "set the http location...." piece. My cookie must never get set. Any advice?

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://61659]
Approved by root
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others examining the Monastery: (6)
As of 2014-09-03 08:21 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    My favorite cookbook is:










    Results (35 votes), past polls