#webliberty::Ping.pm (2007/03/01) #Copyright(C) 2002-2007 Knight, All rights reserved. package webliberty::Ping; use strict; use LWP::UserAgent; ### コンストラクタ sub new { my $class = shift; my $self = { ping_url => undef, url => undef, blog_name => undef }; bless $self, $class; return $self; } ### 更新PING送信 sub send_ping { my $self = shift; my %args = @_; $self->{ping_url} = $args{'ping_url'}; $self->{url} = $args{'url'}; $self->{blog_name} = $args{'blog_name'}; my $ping_date = <<"_PING_"; weblogUpdates.ping $self->{blog_name} $self->{url} _PING_ my $request_ins = new HTTP::Request(POST => $self->{ping_url}); $request_ins->content_type('text/xml'); $request_ins->content("$ping_date"); my $useragent_ins = new LWP::UserAgent; my $response_ins = $useragent_ins->request($request_ins); if ($response_ins->is_success) { if ($response_ins->content =~ m/flerror<\/name>.*1<\/boolean>.*message<\/name>\s*(.+)<\/value>/s) { return (0, $1); } } else { return (0, 'No Response'); } return 1; } 1;