horiday blog

2013/11/20

■ [cygwin] [perl] cygwin 環境での WWW::Mechanize::Firefox

javascript を含むページのスクレイピングをしようと思い WWW::Mechanize::Firefox を使おうとすると下記のエラーが出てしまいました．

command timed-out at /usr/lib/perl5/site_perl/5.14/MozRepl/Client.pm line 186

上記の /usr/lib/perl5/site_perl/5.14/MozRepl/Client.pm 186 行近辺を見ると，

### adhoc
$command = join(" ", split(/\n/, $command)) if ($^O eq "cygwin");

というコードがあり，なぜか cygwin のときだけ特別扱いな処理がありました．これを下記のようにコメントアウトすると無事動かすことができました．

# 修正後
### adhoc
# $command = join(" ", split(/\n/, $command)) if ($^O eq "cygwin");

ref

http://search.cpan.org/~corion/WWW-Mechanize-Firefox-0.74/lib/WWW/Mechanize/Firefox.pm

2011/11/30

■ [perl] slideshare api を perl から使う

職場で slideshare にあるプレゼンファイルを検索，取得したいとけどどうすれば良いのかという話になっていたので，調べてみました．

まず SlideShare のSlideShare API > Apply for API Keyから申請をして，api_key と secret を取得します．

あとはここに書いてある WebAPI を使うのですが，perl だとWWW::SlideShareが便利そうだったのでこれを使ってみました．

下記のコードは slideshare にあるデータをプログラミングというキーワードで検索したした結果を表示するものです．

#!/usr/bin/env perl
# ss-search.pl
use strict;
use warnings;
use Data::Dumper;
use WWW::SlideShare;
use Unicode::Japanese;
use Unicode::RecursiveDowngrade;

sub main {
  my $api_key = 'orzZzz';
  my $secret = 'mjgZzz';
  my $ss = WWW::SlideShare->new(
				'api_key' => $api_key, 
				'secret' => $secret);

  my $kw = "プログラミング";
  $kw = Unicode::Japanese->new($kw, "euc")->utf8;
  my $h = $ss->search_slideshows({'q' => $kw, page => '1'});

  my $rd = Unicode::RecursiveDowngrade->new;
  $rd->filter(sub {
               Unicode::Japanese->new(shift, 'utf8')->euc
               });
  $h = $rd->downgrade($h);
  print Dumper $h;

}

main;

下記は実行結果…

% perl ss-search.pl
$VAR1 = [
         bless( {
                  '_data' => {
                               'ID' => '4022379
 ',
                               'Slideshow' => '
 ',
                               'Status' => '2
 ',
                               'InContest' => '0
',
                               'ThumbnailSmallURL' => 'http://cdn.slidesharecdn.com/r-100508200327-phpapp02-thumbnail-2
 ',
                               'Format' => 'pdf
 ',
                               'Title' => '普通のプログラミング言語R
 ',
                               'SlideshowType' => '0
 ',
                               'Username' => 'shuyo
 ',
                               'ThumbnailURL' => 'http://cdn.slidesharecdn.com/r-100508200327-phpapp02-thumbnail
 ',
                               'URL' => 'http://www.slideshare.net/shuyo/r-4022379
 ',
                               'Embed' => '<div style="width:425px" id="__ss_4022379"><strong style="display:block;margin:12px 0 4px"><a href="http://www.slideshare.net/shuyo/r-4022379" title="普通のプログラミング言語R">普通のプログラミング言語R</a></strong><object id="__sse4022379" width="425" height="355"><param name="movie" value="http://static.slidesharecdn.com/swf/ssplayer2.swf?doc=r-100508200327-phpapp02&stripped_title=r-4022379&userName=shuyo" /><param name="allowFullScreen" value="true"/><param name="allowScriptAccess" value="always"/><param name="wmode" value="transparent"/><embed name="__sse4022379" src="http://static.slidesharecdn.com/swf/ssplayer2.swf?doc=r-100508200327-phpapp02&stripped_title=r-4022379&userName=shuyo" type="application/x-shockwave-flash" allowscriptaccess="always" allowfullscreen="true" wmode="transparent" width="425" height="355"></embed></object><div style="padding:5px 0 12px">View more <a href="http://www.slideshare.net/">presentations</a> from <a href="http://www.slideshare.net/shuyo">Shuyo Nakatani</a>.</div></div>
 ',
                               'Language' => 'ja
 ',
                               'Updated' => 'Mon May 10 10:11:23 -0500 2010
 ',
                               'Download' => '1
 ',
                               'DownloadUrl' => 'http://s3.amazonaws.com/ppt-download/r-100508200327-phpapp02.pdf?response-content-disposition=attachment&Signature=m8OizC9neJu82l41jZSX9C53F%2F4%3D&Expires=1322808380&AWSAccessKeyId=AKIAJLJT267DEGKZDHEQ
 ',
                               'Created' => 'Sat May 08 20:03:12 -0500 2010
 ',
                               'Description' => 'Tsukuba.R #7
 '
                             }
                }, 'WWW::SlideShare::Object' ),
...

取得したプレゼンファイルを見ていると，キレイなレイアウトが多くて自分の作るドキュメントにも参考になりそうなものが多そうですね．

関連リンク

2011/06/02

■ [perl] perl で youtube の検索

youtube の動画を検索するにはどうしたら良いのかと聞かれたので，サンプルコードを作ってみました．API で検索をするには，認証などが不要なようです．

リファレンスガイド: Data API プロトコルを見ると，

動画を検索するには、次の URL にリクエストに合わせてクエリパラメータを付加し、HTTP GET リクエストを送信します。

http://gdata.youtube.com/feeds/api/videos

たとえば次の URL へのリクエストでは、検索キーワード「football」に一致し、キーワード「soccer」には一致しない最近アップロードされた動画の 10 本ずつのセットの 2 番目のセットを検索します。

http://gdata.youtube.com/feeds/api/videos?
    vq=football+-soccer
    &orderby=published
    &start-index=11
    &max-results=10

ということでサンプルコードは下記のようになりました．atom で取得しようとしたのですが，扱い方が良くわからなかったので，rss にしました．

#!/usr/bin/env perl
# search-youtube.pl
use strict;
use Data::Dumper;
use URI;
use XML::Simple;
use LWP::Simple;
use Unicode::RecursiveDowngrade;
use Unicode::Japanese;
use Jcode;

sub main {
  my $kw = "香川大学";
  my $h = search_youtube($kw);

  print Dumper $h;
}

sub search_youtube {
  my $kw = shift;
  my $h;

  my $proxy = 'http://gdata.youtube.com/feeds/api/videos';
  my $uri   = URI->new( $proxy );

  my $u_kw = Jcode::convert($kw , "utf8", "euc-jp" );

  $uri->query_form(
		   vq => $u_kw,
		   orderby => "relevance",
		   alt => 'rss'
		  );

  my $xml = get($uri->as_string);
  my $xs  = XML::Simple->new();
  my $ref = $xs->XMLin( $xml, forcearray => 1 );

  my $count = 0;
  foreach my $i (@{$ref->{channel}[0]{item}}) {
    $h->{$count}{title} = shift @{$i->{title}};
    $h->{$count}{link} = shift @{$i->{link}};
    $h->{$count}{description} = $i->{'description'}[0];
    $h->{$count}{keywords} = $i->{'media:group'}[0]{'media:keywords'};
    $h->{$count}{author} = $i->{author}[0];
    $h->{$count}{viewcount} = $i->{'yt:statistics'}[0]{viewCount};
    $h->{$count}{pubdate} = $i->{pubDate}[0];
    $h->{$count}{thumb} = $i->{'media:group'}[0]{'media:thumbnail'}[1];
    $count++;
  }

  my $rd = Unicode::RecursiveDowngrade->new;
  $rd->filter(sub {
                Unicode::Japanese->new(shift, 'utf8')->euc
                });
  $h = $rd->downgrade($h);

  return $h;
}

main;

上記のコードを search-youtube.pl として保存して，実行すると下記のようになります．

% perl youtube-search.pl
$VAR1 = {
          '11' => {
                    'link' => 'http://www.youtube.com/watch?v=F_abi4096VQ&feature=youtube_gdata',
                    'viewcount' => '1697',
                    'pubdate' => 'Tue, 08 Feb 2011 17:51:56 +0000',
                    'author' => 'BBRarkaic3',
                    'description' => '香川大学第42回定期演奏会、Ⅲstageメイン曲. びびる大好きスイートなメロディと、きらびやかなリズム。 日本一のマンドリンクラブと自負し続けます。 素晴らしい！！！！ 指揮：四国の伝説、細川一樹氏(香川県在住&#12959;2011年現在) ※香川大学演奏のデモCDなどの購入等の問い合わせは、香川大学マンドリンクラブまでびびる大好き',
                     'thumb' => {
                                 'width' => '120',
                                 'time' => '00:03:45.250',
                                 'url' => 'http://i.ytimg.com/vi/F_abi4096VQ/1.jpg',
                                 'height' => '90'
                               },
                    'keywords' => [
                                    'マンドリン, 江頭'
                                  ],
                    'title' => '「雲の行方」 香川大学第４２回定期演奏会 3-3finalステージ 2010年12/18'
                 },
...

キムミギュ(Kim Migyu)さんのお話

関連リンク

リファレンスガイド: Data API プロトコル

2011/03/14

■ [perl] Windows 環境にてコマンドで音量の調節をする

Windows 環境にて，コマンドで音量の調節をしたいと思ったのですが，有効なコマンドがわかりませんでした．

どうしようかなと思ったいたら，cpan で Win32::Sound - cpan というモジュールがあったのでこれを使ってみました．

さっそくこのモジュールを入れて，下記のコードを実行してみると，どうも左右のバランスがズレて設定される模様…．

use Win32::Sound;
Win32::Sound::Volume('100%');

調べてみると，Win32::Sound の 0.49 以前にはバグがあるみたいで，下記のようにしないと左右の音量を均等に調節できませんでした．下記のコードで

perl vol-set.pl 100

などとすると音量を 100% にしたり 0% にすることができました．

#!/usr/bin/env perl
# vol-set.pl: perl vol-set.pl 50
use strict;
use Win32::Sound;

my $vol = shift @ARGV || 0;
if ($vol > 100 || $vol < 0) {
  $vol = 50;
}
$vol .= "%";
print "vol set $vol\n";
win32_volume($vol);

sub win32_volume {
  my(@in) = @_;
  if (not scalar @in) {
    my $volume = Win32::Sound::_Volume();
     if (wantarray) {
      my $left  = ($volume >> 16) & 0x0000FFFF;
      my $right = ($volume      ) & 0x0000FFFF;
      return ($left, $right);
    }
    return $volume;
  }
  # Allows '0%'..'100%'   
  $in[0] =~ s{ ([\d\.]+)%$ }{ int($1*65535/100) }ex if defined $in[0];
  $in[1] =~ s{ ([\d\.]+)%$ }{ int($1*65535/100) }ex if defined $in[1];
  $in[1] = $in[0] unless defined $in[1];
 
  my $volume = (($in[0] & 0x0000FFFF) << 16) | ($in[1] & 0x0000FFFF);

  return Win32::Sound::_Volume($volume, 0);
}

関連リンク

2010/11/01

■ [perl] WWW::Mechanize でアクセスしたときのエラー処理

perl から WWW::Mechanize を使って，Web ページを解析していたときに，ページが取得できなかったときのことを考えずにコードを書いていました．

しかし実際はサーバから Temporarily Unavailable が返ってくるとプログラムごと終了してしまいました．

そこで下記のように get したあとに結果を確認するようにしたのですが，結局 get した時点でエラーを吐いて終わってしまいました．

my $mech = WWW::Mechanize->new();
$mech->get("http://whitebase.org/");
if ($mech->success()) {
  # code for page access
  print "ok\n";
} else {
  # code for not success
  print "not ok\n";
}

$mech->success() 自体使えないじゃないかと思いながら，WWW::Mechanize の仕様を確認してみると，下記のように書いてあり，デフォルトでエラー時には CORE::die が呼び出されているということがわかりました．

onerror => \&func
Reference to a die-compatible function, such as Carp::croak, 
that is called when there's a fatal error.

If this is set to undef, no errors will ever be shown.

If this value is not passed, Mech uses Carp::croak if Carp is 
installed, or CORE::die if not.

ということで，mechanize を new するときに下記のように書くと，エラー時には何も成功するまでトライ(汗)するようになりました... 実際には retry の処理などを書かないといけないのですが，get 時に問題があったら終了しないようにはできそうです．

my $mech = WWW::Mechanize->new(onerror => undef);
until (my $response = $mech->get("$url")) {}

関連リンク

WWW::Mechanize - search.cpan.org

2010/01/15

■ [perl] YouTube から高画質な flv を取得する perl スクリプト

職場で知り合いから flv だけを取得するプログラムを作って欲しいと言わたので作ってみました．get-youtubeflv.pl(後述) を下記のように実行します．実行には WebService::YouTube::Util が必要です．Ubuntu や debian などでは libwebservice-youtube-perl というパッケージがあるようです．

% perl get-youtubeflv.pl videoid > output.flv

videoid は http://www.youtube.com/watch?v=ETnQ2TDqCZM といった url の v= に続く文字列です．

#!/usr/bin/env perl
# get-youtubeflv.pl
use strict;
use WebService::YouTube::Util;
use LWP::Simple;

my $video_id = shift @ARGV or "ETnQ2TDqCZM";
my $uri = WebService::YouTube::Util->get_video_uri($video_id);
$uri .= "&fmt=35";
my $content = get($uri);
print $content;

高画質な flv の取得にはここに書かれている fmt の種類のまとめから手頃に使える fmt=35 を選びました．

fmt=35
- 次期 "高画質"
- flv: H264+AAC
fmt=22
- HD画質
- mp4: H264+AAC

とても簡単なプログラムなので，取得の途中経過は表示しません．サイズの大きな flv の取得時にはちょっと不便かもしれませんね．

関連リンク

WebService-YouTube

2009/01/31

■ [perl] flickr API の flickr.tags.getClusters

職場で flickr API の flickr.tags.getClusters を使ってタグから関連する別のタグを得たいのでサンプルを作って欲しいと言われました．

flickr API は使ったことがなかったので，API Keyを作ってさっそく試してみました．

Flickr のサンプルは沢山あるだろうと思っていたのですが，手頃なサンプルがなくてFlickr and Perlが一番まともな感じでした．

問題の flickr.tags.getClusters はサンプルコードを Web 検索で見つけられなかったので，自分で適当に作ってしまいました．flickr.tags.getClusters で得られる結果を xpath でゴリゴリできるかと思っていたのですが，やり方がわからなかったので，結果の $response をそのままゴリゴリしました．このやり方は絶対間違っていそう...

下記のコードを実行すると，無事タグのクラスタが得られました．

% perl get-tagclust.pl schubert
tag: schubert
$VAR1 = {
  '1' => {
    'musica' => 1,
    'music' => 1,
    'piano' => 1
  },
  '0' => {
    'wien' => 1,
    'austria' => 1,
    'vienna' => 1
  },
  '2' => {
    'mozart' => 1,
    'haydn' => 1,
    'beethoven' => 1
  }
};

結果を見るとおそらく共起頻度の高いものをクラスタリングしているのでしょうね．

#!/usr/bin/env perl
# get-tagclust.pl
# usage:
#   get-tagclust.pl <tag>
use strict;
use Data::Dumper;
use Flickr::API;
local $Data::Dumper::Indent = 1;

my $tag = shift @ARGV || "cows";
my %tagclust = get_flickrtagclust($tag);

print "tag: $tag\n";
print Dumper \%tagclust;

sub get_flickrtagclust {
 my $tag = shift;
 my $api_key = 'xxx';
 my $api_secret = xxx'';
 
 my $api = new Flickr::API(
			    { 
			     'key' => $api_key,
		     'secret' => $api_secret,
			    });
  my $response = $api->execute_method('flickr.tags.getClusters',
			      {
				       'key' => $api_key,
				       'tag' => $tag,
			      });
  my @tmp = @{$response->{tree}{children}[1]{children}};
  my $count = 0;
  my %clust;
  foreach my $i (@tmp) {
    my @list = ();
    if ($i->{name} eq "cluster") {
      foreach my $j (@{$i->{children}}) {
	if ($j->{children}[0]->{content}) {
	  push @list, $j->{children}[0]->{content};
	}
      }
    }
    if (@list > 0) {
      foreach (@list) {
	$clust{$count}{$_}++;
      }
      $count++;
    }
  }

  return %clust;
}

関連リンク

Flickr API
Flickr and Perl by Jimmy O'Regan
Perl使ってFlickrAPIでの認証法がやっとわかった: 私と同じように $response をそのまま処理…

2008/02/08

■ [perl] perl でエクセルファイルからテキストを抽出する

職場でなぜか膨大なエクセルファイルを Web ページにしたいと言われました．

perl では Spreadsheet::ParseExcel というモジュールを使うとできるらしい．

さっそくこのモジュールをインストールして，サンプルコードを実行すると

Weak references are not implemented in the version of perl at /usr/....

というエラーで実行できない．エラーをそのまま検索してみると，Scalar::Util を再インストールするとなおるとのこと．そこで，

cpan> install Scalar::Util

すると今度は，

Cannot forceunlink /usr/lib/perl5/5.8/cygwin/auto/List/Util/Util.dll Permission denied

実行中のファイルだから上書きできないということらしい(cygwin だからなのですが)．

上記の Util.dll を消すと cpan 自体が使えなくなるので，どうしようかと cpan 上で再構築することで対処できた．

% cpan
cpan> look Scalar::Util
Scar::Util のビルドに入る
% perl Makefile.PL
% make uninstall
% perl Makefile.PL -xs
% make
% make install
% exit

cygwin は変なところでつまづくので，面倒ですね．サクサク動く coLinux の方が良いのでしょうか．

最終的にエクセルファイルからテキストを抽出するコードは下記のものを参考にさせてもらいました．日本語もオケらしい...

Spreadsheet-ParseExcel README_Japan.htm

use strict;
use Spreadsheet::ParseExcel;
use Spreadsheet::ParseExcel::FmtJapan;
my $oExcel = new Spreadsheet::ParseExcel;
#sjis、jisなどのコード
my $oFmtJ = Spreadsheet::ParseExcel::FmtJapan->new(Code => 'euc');
my $oBook = $oExcel->Parse('Excel/Test97.xls', $oFmtJ);
#情報の取り出し例
my($iR, $iC, $oWkS, $oWkC);
   
print "FILE  :", $oBook->{File} , "\n";
print "COUNT :", $oBook->{SheetCount} , "\n";
print "AUTHOR:", $oBook->{Author} , "\n";
for(my $iSheet=0; $iSheet < $oBook->{SheetCount} ; $iSheet++) {
  $oWkS = $oBook->{Worksheet}[$iSheet];
  print "--------- SHEET:", $oWkS->{Name}, "\n";
  for(my $iR = $oWkS->{MinRow} ; 
          defined $oWkS->{MaxRow} && $iR <= $oWkS->{MaxRow} ; $iR++) {
      for(my $iC = $oWkS->{MinCol} ;
             defined $oWkS->{MaxCol} && $iC <= $oWkS->{MaxCol} ; $iC++) {
          $oWkC = $oWkS->{Cells}[$iR][$iC];
          print "( $iR , $iC ) =>", $oWkC->Value, "\n" if($oWkC);
      }
  }
}

2007/01/17

■ [perl] Perl Hacks

出たら買おうかなと思っています．

2007/01/03

■ [perl] 検索エンジン Web サービス

最近検索エンジンへの検索式(検索キーワード)を拡張するプログラムを書いています．

似たような話で Google や Yahoo! の関連検索があります．検索キーワードに「11n」と入れると下記のように「無線 11n」という検索キーワードに関連したキーワードを付けてくれるものです．

Google や Yahoo! の関連検索については下記に少し分析が書かれていますが，ユーザの検索キーワードベースか Web コンテンツベースかという違いがあるような気がします．

Google と Yahoo! の関連検索(エッセンシャル・サーチエンジン)

私もあるキーワードに対して関連語を用意して，その有効性を調べてみようと思って検索エンジンに色々な問い合わせを行なっていたところ，ある時急に検索エンジンから接続を拒否されました．

どうやらプログラムでやたら検索エンジンを利用するのはイケなかったようです...すいません．

そこで開発者用の検索エンジンの Web サービスというのを使ってみました．それぞれ下記のようなものになっています．

Yahoo!JAPAN

アクセス方法: REST
検索制限回数: 50000 /24h
1 検索における最大検索結果数: 50
1 クエリにおける最大検索語数: ?

Google

アクセス方法: SOAP
検索制限回数: 1000 /1day
1 検索における最大検索結果数: 10
1 クエリにおける最大検索語数: 32

Google の方は利用可能な検索回数が少ない上に，現在は新規利用者を打ち切りしているので Yahoo! の方を使ってみました．

まずこのページからアプリケーション ID を登録して，下記のコードを実行したら Web 検索結果が得られました．

yapi_test.pl

#!/usr/bin/env perl
# yapi_test.pl: 
# usage:
#   yapi_test.pl <kw>
use strict;
use LWP::Simple;
use XML::Simple;
use Data::Dumper;

my $kw = shift;
$kw =~ s/([^0-9A-Za-z_])/'%'.unpack('H2',$1)/ge;
$kw =~ s/ /+/g;

my $appid = "your appid";
my $top = "http://api.search.yahoo.co.jp/WebSearchService/V1/webSearch?";
my $url = $top . "appid=$appid&query=$kw&results=50";

my @ranking = map {$_->{Url}} @{get_results($url)}; 
print Dumper @ranking;

sub get_results {
   my ($url) = @_;
   my $yahoo_response = get($url);
   my $xmlsimple = XML::Simple->new();
   my $yahoo_xml = $xmlsimple->XMLin($yahoo_response);
   if (ref($yahoo_xml->{Result}) eq "ARRAY") { # found: many
       return $yahoo_xml->{Result};
   } elsif (ref($yahoo_xml->{Result}) eq "HASH") { # found: 1
       return [$yahoo_xml->{Result}];
   }
   return []; # not found
}

実行すると下記のような感じになります．これで一日 5 万回まで実験ができそうです．

% perl yapi_test.pl 'som_pak vsom'
$VAR1 = 'http://mikilab.doshisha.ac.jp/dia/research/report/2005/0822/007/report20050822007.html';
$VAR2 = 'http://www.okada.jp.org/RWiki/index.php?R%A4%C7SOM(%BC%AB%B8%CA%C1%C8%BF%A5%B2%BD%A5%DE%A5%C3%A5%D7)';
$VAR3 = 'http://www.cis.hut.fi/research/som_pak/som_doc.txt';
$VAR4 = 'http://hpux.connect.org.uk/hppd/cgi-bin/wwwtar?/hpux/NeuralNets/som_pak-1.2/som_pak-1.2-src-9.01.tar.gz+som_pak-1.2/makefile.bsd+text';
$VAR5 = 'http://www.cis.hut.fi/somtoolbox/package/docs2/som_sompaktrain.html';
....

<前の10件

horiday blog

2013/11/20

■ [cygwin] [perl] cygwin 環境での WWW::Mechanize::Firefox

2011/11/30

■ [perl] slideshare api を perl から使う

2011/06/02

■ [perl] perl で youtube の検索

2011/03/14

■ [perl] Windows 環境にてコマンドで音量の調節をする

2010/11/01

■ [perl] WWW::Mechanize でアクセスしたときのエラー処理

2010/01/15

■ [perl] YouTube から高画質な flv を取得する perl スクリプト

2009/01/31

■ [perl] flickr API の flickr.tags.getClusters

2008/02/08

■ [perl] perl でエクセルファイルからテキストを抽出する

2007/01/17

■ [perl] Perl Hacks

2007/01/03

■ [perl] 検索エンジン Web サービス

about me

cal

archives

categories

search

links

recent

		2024-12
日	月	火	水	木	金	土
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