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;