File Coverage

blib/lib/WWW/YouTube/VideoURI.pm

Criterion	Covered	Total	%
statement	21	35	60.0
branch	0	4	0.0
condition			n/a
subroutine	7	9	77.7
pod	0	2	0.0
total	28	50	56.0

# $Id: VideoURI.pm,v 1.1 2007/08/29 17:35:11 gavin Exp $
# Copyright (c) Gavin Brown. All rights reserved. This program is free
# software; you can redistribute it and/or modify it under the same
# terms as Perl itself.
package WWW::YouTube::VideoURI;
use Carp;
use HTTP::Request::Common;
use LWP;
use URI;
use URI::Escape;
use vars qw($VERSION);
use strict;

our $VERSION = '0.1';

sub new {
	my $self = bless({}, shift);
	$self->{ua} = LWP::UserAgent->new(
		agent => sprintf(
			'%s/%s, %s',
			ref($self),
			$VERSION,
			ucfirst($^O)
		),
		max_redirect => 0,
		requests_redirectable => [],
	);
	return $self;
}

sub get_video_uri {
	my ($self, $uri_s) = @_;
	my $uri = URI->new($uri_s);
	my %params = $uri->query_form;
	croak("Malformed URL or missing parameter") if ($params{v} eq '');

	my $new_uri = sprintf(
		'http://www.youtube.com/v/%s',
		uri_escape($params{v})
	);
	my $req = GET($new_uri);
	my $res = $self->{ua}->request($req);

	croak($res->status_line) if ($res->is_error);

	my $target = URI->new_abs($res->header('Location'), $new_uri);
	my %target_params = $target->query_form;

	return sprintf(
		'http://www.youtube.com/get_video.php?video_id=%s&t=%s',
		uri_escape($params{v}),
		uri_escape($target_params{t})
	);
}

1;

__END__