Perl でウェブページの OGP の情報を取得する

[PR]上記の広告は3ヶ月以上新規記事投稿のないブログに表示されています。新しい記事を書く事で広告が消えます。

2024/11/22 16:59

ただいまコメントを受けつけておりません。

Perl でウェブページの OGP の情報を取得する

もっとモジュール使えば楽、特に HTML のパースはそうなんだろうけど、さくらインターネットのレンタルサーバライトプランで動くことを前提に書いている。

#!/usr/bin/perl

use HTML::Parser ();
use LWP::UserAgent;
use JSON::PP;
use CGI;
use Encode;

my $cgi = CGI::new();
my $browser = LWP::UserAgent->new;
my $enc = "utf8";

print "Status: 200 OK\n";
print "Content-Type: application/json; charset=UTF-8\n\n";

my $url = $cgi->url_param('url');
my %ogps = (result => "OK");

sub when_open_tag_found {
  my ($self, $tagname, $attr) = @_;
  if($tagname eq 'meta' and $attr->{'property'} and $attr->{'content'} ){
    $ogps{$attr->{'property'}} = Encode::decode($enc, $attr->{'content'});
  }
  if($tagname eq 'meta' and $attr->{'name'} and $attr->{'content'} ){
    $ogps{$attr->{'name'}} = Encode::decode($enc, $attr->{'content'});
  }
}

if($url) {
  eval {
    my $response = $browser->get($url);
    $ogps{'url'} = $url;

    my $parser = HTML::Parser->new(
        api_version => 3,
        start_h     => [\&when_open_tag_found, "self, tagname, attr"]);
    $parser->parse($response->content);

    my $json = JSON::PP->new->utf8->space_after->encode(\%ogps);
    print $json;
  };
  if (my $error = $@) {
    $json = JSON::PP->new->utf8->space_after->encode({
      result => "NG",
      message => $error
    });
    print $json;
  }
} else {
  print '{"result": "NG", "message":"No URL is found in parameter"}'
}

exit;