/[cvs]/nfo/perl/libs/OEF/Component/WebCache.pm
ViewVC logotype

Annotation of /nfo/perl/libs/OEF/Component/WebCache.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.2 - (hide annotations)
Thu Feb 20 21:09:59 2003 UTC (21 years, 4 months ago) by joko
Branch: MAIN
Changes since 1.1: +8 -5 lines
modified runtime namespace hierarchy

1 joko 1.1 ## ------------------------------------------------------------------------
2 joko 1.2 ## $Id: WebProxy.pm,v 1.1 2003/02/11 09:46:09 joko Exp $
3 joko 1.1 ## ------------------------------------------------------------------------
4 joko 1.2 ## $Log: WebProxy.pm,v $
5     ## Revision 1.1 2003/02/11 09:46:09 joko
6     ## + initial commit
7     ##
8 joko 1.1 ## ------------------------------------------------------------------------
9    
10    
11     package OEF::Component::WebProxy;
12    
13     use strict;
14     use warnings;
15    
16     use Data::Dumper;
17     use LWP::UserAgent;
18     use HTTP::Headers;
19    
20     use shortcuts qw( now );
21    
22     # get logger instance
23     my $logger = Log::Dispatch::Config->instance;
24    
25    
26     sub makeInternetRequest {
27    
28     my $self = shift;
29     my $url = shift;
30    
31     my $ua = LWP::UserAgent->new(
32     agent => 'Mozilla/4.0 (compatible; MSIE 5.5; Windows NT 5.0)',
33     env_proxy => 1,
34     keep_alive => 1,
35     timeout => 30,
36     );
37    
38     my $taskArgs;
39    
40     $logger->debug( __PACKAGE__ . "->makeInternetRequest( url $url ) started" );
41     $logger->info( "Internet request sent" );
42     my $response = $ua->get($url);
43     $logger->debug( __PACKAGE__ . "->makeInternetRequest( url $url ) ready" );
44     $logger->info( "Internet request ready" );
45    
46     #return if ($response->code() != 200);
47     return if (!$response->is_success);
48    
49     return $response;
50     }
51    
52    
53     sub fetchPageFromProxy {
54     my $self = shift;
55     my $url = shift;
56    
57     # trace
58     #print Dumper($self);
59     #exit;
60    
61 joko 1.2 my $proxyObj = $self->{app}->{storage}->{import}->remote('HttpProxy');
62     my @results = $self->{app}->{storage}->{import}->select($proxyObj, $proxyObj->{url} eq $url);
63 joko 1.1 my $content = $results[0]->{content} if $results[0]->{content};
64     my $oktxt = "no";
65     if ($content) {
66     $oktxt = "ok";
67     }
68     $logger->debug( __PACKAGE__ . "->fetchPageFromProxy ...$oktxt" );
69     return $content;
70     }
71    
72     sub cacheResponse {
73     my $self = shift;
74     my $url = shift;
75     my $response = shift;
76     return unless $response;
77     my $proxyObj = HttpProxy->new(
78     stamp => now(),
79     url => $url,
80     content => $response->content(),
81     request => Dumper($response->request()),
82     headers => Dumper($response->{_headers}),
83     code => $response->code(),
84     status => $response->status_line(),
85     age => $response->current_age(),
86     );
87     my $oktxt = "no";
88 joko 1.2 if ($self->{app}->{storage}->{import}->insert($proxyObj)) {
89 joko 1.1 $oktxt = "ok";
90     }
91     $logger->debug( __PACKAGE__ . "->savePageToProxy ...$oktxt" );
92     }
93    
94     sub getUrl {
95     my $self = shift;
96     my $url = shift;
97     my $force = shift;
98    
99     #print "force: ", $force, "\n";
100     #exit;
101    
102     if (!$url) {
103     $logger->error( __PACKAGE__ . "->getUrl: no url given" );
104     return;
105     }
106     $logger->debug( __PACKAGE__ . "->getUrl( url $url )" );
107     my $content;
108     if ( !$force && ($content = $self->fetchPageFromProxy($url)) ) {
109     #$self->cachePage($url, $content);
110     #$logger->info( __PACKAGE__ . "->getUrl: Proxy hit!" );
111     } else {
112     if (my $response = $self->makeInternetRequest($url) ) {
113     $self->cacheResponse($url, $response);
114     $content = $response->as_string();
115     } else {
116     $logger->error( __PACKAGE__ . "->getUrl( url $url ) failed" );
117     }
118     }
119     return $content;
120     }
121    
122     1;

MailToCvsAdmin">MailToCvsAdmin
ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed