理系学生日記

おまえはいつまで学生気分なのか

Perl のスレッドを使ってみる

perl でスレッドが有効になっているか(使えるか)は,

$ perl -V

で確認できます.

ぼくは最初こんな感じで出た.これだと perl のスレッドは有効化されていません.

$ perl -V | grep thread
    useithreads=undef, usemultiplicity=undef

useithreads が undef だと,そもそもスレッドは使えませんから,perl をインストールしなおしますね.

$ sudo port deactivate perl5.10
$ sudo port install perl5.10 +threads

すると,perl -V でこんな表示が出るようになります.

perl -V|grep thread
    osname=darwin, osvers=9.5.0, archname=darwin-thread-multi-2level
    config_args='-Dusethreads -des -Dprefix=/opt/local -Dccflags=-I'/opt/local/include' -Dldflags=-L/opt/local/lib -Dvendorprefix=/opt/local'
    useithreads=define, usemultiplicity=define
    /opt/local/lib/perl5/5.10.0/darwin-thread-multi-2level
    /opt/local/lib/perl5/site_perl/5.10.0/darwin-thread-multi-2level
    /opt/local/lib/perl5/vendor_perl/5.10.0/darwin-thread-multi-2level

useithreads=define が出れば,スレッドが使えます! やった!

perl におけるスレッドについては,perlthrtut が詳しいので,一度読んでみると良いかなーって思います.デッドロックからバイナリセマフォ,一般化セマフォとかまで,コード付きで分かりやすい解説が載ってました.


以下は,ファイルにリストしてる youtube の 動画の URL をダウンロードして,m4a に変えてみるスクリプト.OCW とかが画面無しで聞けたらいいなーとか思ってたんですが,ここにスレッドを使ってみた.10 個の URL がリストしてあったりとかすると,10 個のスレッドが作られて,それぞれのスレッドでダウンロードとコンバートが行われる感じ.スレッド間でのデータ共有とかは全くしてないですね.

#!/opt/local/bin/perl
use strict;
use warnings;
use LWP::UserAgent;
use Getopt::Std;
use File::Path;
use threads;

getopts( 'f:d:', \my %opts );
die "usage: $0 -f urllist\n" unless $opts{f};

# destination directory
$opts{d} = '.';
mkpath [ $opts{d} ] unless -d $opts{d};

open my $fh, '<', $opts{f} or die "$opts{f}";
my @urls = <$fh>;
close $fh;

# create threads
my @threads = map {
    threads->create( \&convert, $_ );
} @urls;
$_->join() for (@threads);

sub convert {
    my $url = shift;

    my $ua = LWP::UserAgent->new;
    my $response = $ua->get( $url );
    my $content = $response->content;
    my ($title) = $content =~ m[<title>(.*)</title>];
    $title =~ tr[ /][--]; # normalize 

    if( $content =~ /video_id=(.+?)&l.*?&t=(.+?)&/ ){
        my $mp4_url = "http://www.youtube.com/get_video?video_id=$1&t=$2&fmt=18";
        $ua->mirror($mp4_url, "$opts{d}/$title.mp4");
        qx( ffmpeg -i "$opts{d}/$title.mp4" -y -acodec copy -ac 2 -ab 128 "$opts{d}/$title.m4a" );
    }else{
        warn "Error in processing $title\n";
    }
}