Daio Today

個人的事情で IO::All を使っていた部分は IO::File を使うようにダサ方向に変更させてもらいました。すんません。
オリジナルのコードにライセンスは明記されていなかったのだけど、このコードはオリジナルのコードに準じるという事にします。

追記: 時間を置いてトラックバックpingを2回送ってみたが、反映されないみたい

package Net_YouTube;

use strict;
use warnings;
use LWP::UserAgent;
use HTTP::Request;
use HTTP::Request::Common;
#use IO::All;
use IO::File;
use utf8;
use File::Basename;

sub upload {
    my %arg = @_;
    my $username = $arg{'username'} || die 'username is required';
    my $auth_token = $arg{'auth_token'} || die 'auth_token is required';
    my $developer_key = $arg{'developer_key'} || die 'developer_key is required';
    my $filename = $arg{'filename'} || die 'filename is required';
    my $video_detail = $arg{'video_detail'} || die 'video_detail is required';
    my $content_type = $arg{'content_type'} || die 'content_type is required';
    #my $data = io($filename)->binary->all;
    my $fh = IO::File->new($filename, 'r');
    $fh->binmode;
    my $data = '';
    my $buff;
    while ($fh->read($buff, 1024)) {
        $data .= $buff;
    }
    my $url =
      "http://uploads.gdata.youtube.com/feeds/api/users/$username/uploads";
    my $request = HTTP::Request->new( POST => $url );

    $request->header(
        "Authorization" => "GoogleLogin auth=$auth_token",
        "X-GData-Key"   => "key=$developer_key",
        Slug            => basename($filename),
        Content_Type    => 'multipart/related',
    );
    $request->add_part(
        HTTP::Message->new(
            [ Content_type => 'application/atom+xml' ],
            $video_detail
        )
    );
    $request->add_part(
        HTTP::Message->new( [ Content_type => $content_type ], $data ) );

    my $ua = LWP::UserAgent->new( keep_alive => 1 );
    my $response = $ua->request($request);
    die $response->status_line unless ( $response->is_success );
    return $response->content;
}

sub auth {
    my %arg = @_;
    my $username = $arg{'username'} || die 'username is required';
    my $password = $arg{'password'} || die 'password is required';
    my $request = POST(
        "https://www.google.com/youtube/accounts/ClientLogin",
        Content_Type => 'application/x-www-form-urlencoded',
        Content      => [
            Email   => $username,
            Passwd  => $password,
            service => "youtube",
            source  => "uploads",
        ],
    );
    my $ua = LWP::UserAgent->new( keep_alive => 1 );
    my $response = $ua->request($request);
    die $response->status_line unless ( $response->is_success );
    $response->content =~ /Auth=(.*?)\n/;
    return $1;
}

sub video_detail {
    my $param = shift;
    foreach my $key ( keys %$param ){
        utf8::encode($param->{$key}) if utf8::is_utf8($param->{$key});
    }
    my $title = $param->{title} || die "title is required";
    my $description = $param->{description} || die "description is required";
    my $category = $param->{category} || "People";
    my $keywords = $param->{keywords} || die "keywords is required";

my $video_detail = << "XML";
<?xml version="1.0"?>
<entry xmlns="http://www.w3.org/2005/Atom"
 xmlns:media="http://search.yahoo.com/mrss/"
 xmlns:yt="http://gdata.youtube.com/schemas/2007">
    <media:group>
    <media:title type="plain">$title</media:title>
    <media:description type="plain">$description</media:description>
    <media:category scheme="http://gdata.youtube.com/schemas/2007/categories.cat">$category</media:category>
    <media:keywords>$keywords</media:keywords>
  </media:group>
</entry>
XML
   return $video_detail;
}

sub video_id {
    my ($xml) = @_;
    if ($xml =~ /<id(?:[^>]*)>[^<]+\/(\w+)<\/id>/) {
        return $1;
    }
    return undef;
}

sub video_url {
    my ($video_id) = @_;
    return sprintf('http://jp.youtube.com/watch?v=%s', $video_id);
}

1;
__END__
=head1 NAME

Net_YouTube - YouTube Video upload API

=head1 SYNOPSIS

 # account settings
 my $username = "your_account";
 my $password = "your_password";
 my $developer_key = "your_developer_key";
 
 # video settings
 my $filename = "/path/to/movie01.mpg";
 my $content_type = "video/mpeg";
 my %detail = (
     title       => "test",
     description => "description",
     keywords    => "tag1,tag2",
 );
 
 use Net_YouTube;
 
 # Get authentication token
 my $auth_token = Net_YouTube::auth(
     username => $username,
     password => $password,
 );
 
 # Get video detail
 my $video_detail = Net_YouTube::video_detail(\%detail);
 
 # Upload video
 my $result = Net_YouTube::upload(
     username => $username,
     auth_token => $auth_token,
     developer_key => $developer_key,
     filename => $filename,
     video_detail => $video_detail,
     content_type => $content_type,
 );

=head1 SEE ALSO

http://yusukebe.com/archives/08/03/13/123113.html

=cut