package ML use LWP sub new my Ver my class args my self bless Ver Ver

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
package ML;
use LWP;
sub new {
my $Ver = 0.1;
my ($class, %args) = @_;
my $self = bless {
Ver=>$Ver,
remote_ip => $ENV{REMOTE_ADDR},
charset => 'win', # koi,utf
server => 'universal.mainlink.ru',
timeout => 120, # таймаут для обновления ссылок в секундах
defaut_message => '',
%args
}, $class;
!$self->{$_} and die qq|ml.pm error: missing parameter "$_" in cal to "new"!|
foreach qw(Ver charset server timeout);
return $self;
}
sub GetLinks(){
my $self = shift;
my $ua = LWP::UserAgent->new(agent => 'ML');
$ua->timeout($self->{timeout});
$self->{uri}="$ENV{HTTP_HOST}".PackUri(($ENV{REDIRECT_URL}?$ENV{REDIRECT_URL}:$ENV{REQUEST_URI}));
my $req = HTTP::Request->new(GET => "http://$self->{server}/l.aspx?u=$self->{uri}".
($self->{charset}?"&cs=$self->{charset}":''),['Referer' => 'http://откуда_урл/']);
my $res = $ua->request($req);
if($res->{_content}){return Parse($res->{_content})}else{return $self->{defaut_message}}
}
sub PackUri(){
my $uri = shift;
$uri =~ s/%(..)/pack("c",hex($1))/ge; # Convert %XX from hex numbers to alphanumeric
$uri =~ s/([^A-Za-z0-9])/sprintf("%%%02X", ord($1))/seg;
return $uri;
}
sub Parse(){my $link_text = shift;return @links = split(/ \| /, unescape($link_text));}
sub unescape {
my($todecode) = @_;
$todecode =~ tr/+/ /; # pluses become spaces
$todecode =~ s/%([0-9a-fA-F]{2})/pack("c",hex($1))/ge;
return $todecode;
}
1;