1: #!/usr/local/bin/perl
2:
3: ################################################################################
4: # Simple cookie grab and re post to site
5: ################################################################################
6: # Name: c_g_p.cgi
7: # Date Created: 05-10-2001
8: # Last Modified: 10-31-2001
9: # Version: 1.1
10: # Author: Shawn McKinley
11: # Copyright Info: Freely distributable
12: ################################################################################
13: # This was designed for a site that issued a new cookie every five minutes
14: # and required you have the current cookie every time you logged into the site.
15: # I wanted to be able to grab some data from the site with a cron job, but
16: # was unable to without their continually renewing cookie.
17: ################################################################################
18: use strict;
19: # ALWAYS use strict. It will save you time and effort down the road as it
20: # catches many common exceptions at the start of your script.
21: use LWP::UserAgent;
22: use HTTP::Cookies;
23: # Modules written by Gisle Aas (http://search.cpan.org/search?dist=libwww-perl)
24: # For all calls below, see documentation on the libwww-perl module on CPAN
25: my $cook = 'http://www.perlhelp.com/cgi-bin/perlhelp/index.cgi';
26: # Web page you want to collect your cookies from
27: my $page = 'http://www.perlhelp.com';
28: # Web page you want to open using the collected cookies
29: my $ua = LWP::UserAgent->new;
30: $ua->agent('Mozilla/4.0 (compatible; MSIE 5.5; Windows NT 5.0; PERLHELP)');
31: my $jar = HTTP::Cookies->new;
32: $ua->cookie_jar($jar);
33: my $req = HTTP::Request->new('POST',$cook);
34: $req->content_type('application/x-www-form-urlencoded');
35: my $res=$ua->request($req);
36: my $original=&display($req->as_string(),$res->as_string());
37: # For demonstration of what is going on when you call the script
38: # At this point, the script will report back to you what was sent to the
39: # server to get the cookie, and what was returned
40: $req = HTTP::Request->new('GET',$page);
41: $req->content_type('application/x-www-form-urlencoded');
42: $res=$ua->request($req);
43: my $final=&display($req->as_string(),$res->as_string());
44: # For demonstration of what is going on when you call the script
45: # At this point, the script has already retrieved the cookie from $cook, and
46: # will report back to you what was sent to the server with the cookie, and
47: # what was returned for your final page from $page.
48: # Saves the final returned page with both sets of headers.
49: my $content = $res->as_string();
50: # Returns the results of the page you are wanting.
51: # The cookie has been retrieved from $cook and sent to $page.
52: # &save($original,$final,$content);
53: # Save the file to log for study, or manipuliate the $content via regex
54: # for use in site pages.
55: print qq~Content-type: text/html\n\n~;
56: # Used pre for formatting on HTML
57: print $original,$final,qq~
~;
58:
59: sub display {
60: for (@_) { s/(.*?)\n\n.*/$1/sim; }
61: # This line rips out everything but the header. HTTP headers are separated
62: # from the body of an HTML page by two newlines (\n\n)
63: my($date,$time)=&date;
64: my $h=qq~\n\nat $date $time\n~;
65: $h.=qq~------------------------------\n--- Sent ---\n------------\n$_[0]\n\n~;
66: $h.=qq~------------------------------\n- Received -\n------------\n$_[1]\n\n~;
67: return($h);
68: }
69:
70: sub date {
71: my ($s,$m,$h,$D,$M,$Y,$wd,$yd,$dst)=localtime(time);
72: my $date="0"x(2-length($M+1)).($M+1)."/"."0"x(2-length($D)).$D."/".($Y+1900);
73: # This line formats the date to mm/dd/yyyy. It must add 1 to month and
74: # 1900 to year as localtime reports back month ($M) in 0 through 11 format
75: # and year ($Y) in the number of years since 1900 format.
76: my $time=$h.":".$m.":".$s;
77: # This line formats the time stamp in hh:mm:ss
78: return($date,$time);
79: }
80:
81: sub save {
82: my ($d,$time)=&date;
83: $d=~s/\///g;
84: # This formats $date to mmddyyyy format for using it as a file name;
85: open (F,">$d.txt") or die "Couldn't open $d: $!";
86: # Open a file (overwriting anything that is currently there) in the format
87: # of mmddyyyy.txt
88: print F $_[0],$_[1],$_[2];
89: # Write data to file
90: close (F);
91: }
