Upload media to twitter using perl - perl

Has anyone successfully uploaded media to Twitter, ie posted a tweet with an image using Perl?
I would like to upload images from my blog without doing it all manually.
update_with_media(status, media[]) is deprecated, and crashes. Twitter says to use plain update(), passing a media id. However it is first necessary to upload the media to get the id, and I can find no code examples.
Any experience in this area?
Cheers,
Peter

I thought I'd add an update here even though the thread is quite old. I too was looking for an answer to how to use Perl to upload media to twitter.
Net::Twitter is perfectly capable of sending PNG images up to Twitter, though the documentation is poor. The OP is correct that update_with_media is deprecated and crashed for us.
You do need to use the $nt->upload AND $nt->update methods combined. You upload the RAW PNG file encoded with base64, I could not get the RAW PNG file upload to work but no issues when base64 encoded. The upload method returns, on success, a JSON structure which has the media_ids in. These id's are then passed with the $nt->update method. Here's some actual code
use Net::Twitter;
use File::Slurp;
use MIME::Base64;
use Data::Dumper;
my $nt = Net::Twitter->new(
ssl => 1,
traits => [qw/API::RESTv1_1/],
consumer_key => $config->{twitter}{api_key},
consumer_secret => $config->{twitter}{api_secret},
access_token => $config->{twitter}{access_token},
access_token_secret => $config->{twitter}{access_token_secret},
);
my $filename = "<somelink to a PNG file>";
my $file_contents = read_file ($filename , binmode => ':raw');
my $status = $nt->upload(encode_base64($file_contents));
print "SendTweet: status = ".Dumper($status);
my $status2;
eval {
$status2 = $nt->update({status => $s , media_ids => $status->{media_id} });
print "status2 = ".Dumper($status2);
};
if ($#)
{
print "Error: $#\n";
}
The code is pulled directly from our working test code so should work. This code is purely proof of concept so you will need to add in all your twitter authentication etc.
We have only done PNG files but I see no reason why video etc shouldn't work fine as we simply followed the Twitter docs.
Rob

In the end I used readpipe with twurl. Had I known about twurl in the first place I likely would not have bothered with Net::Twitter! twurl works great, and returns a full json string to tell you what went wrong, if anything.

Pre-requisite: you need to get the Oauth keys for your twitter account. (See here - https://developer.twitter.com/en/docs/basics/authentication/guides/access-tokens.html). There are some step by step online exmaples elsewhere also that can help.
Here's the code I ended up with.
First call the tweet module (and these are not valid keys by the way - just insert yours)
use Jimtweet;
my $tweet=Jimtweet->new();
$tweet->consumer_key('KvfevhjwkKJvinvalidkeycvhejwkKJVCwe');
$tweet->consumer_secret('KvfevhjwkKJvcvnvalidkeyhejwkKJVCwe');
$tweet->oauth_token('KvfevhjwkKJvcvhenvalidkeyjwkKJVCwKvfevhjwkKJvcvhejwkKJVCweVU');
$tweet->oauth_token_secret('KvfevhjwkKJvcvhejwnvalidkeykKJVCwe');
my $res = $tweet->update_status($message, $ENV{DOCUMENT_ROOT}.$li);
Jimtweet is a free module I found online (I forget where), but I had to modify it to do the image upload. It follows below.
$message is the text status message to send
$li contains the local path to the file I want to upload. This is a file local on the server. $ENV{DOCUMENT_ROOT} contains the server path to the public HTML files on my website.
$res contains a JSON reply from twitter you can look at if you need to.
If you want to use this, cut & paste everything from 'package Jimtweet;' and on into a file called Jimtweet.pm which the above code should use. If your perl installation can't find the module try adding the line use lib "/home/your/path/to/jimtweet/directory;" before the use Jimtweet; line.
Twitter requires an image to be uploaded, it then returns a media_id, then you include the media_id in a regular message you want to post. See Jimtweet package below:
package Jimtweet;
#####JimTweet 0.1 By James Januszka 2010
#####Email:jimjanuszka#gmail.com
#####Twitter:#jamesjanuszka
#####Modifications by John Bell to include image upload. Twitter: #BellUkcbajr
use strict;
use warnings;
use LWP;
use HTTP::Headers;
use URI::Encode qw(uri_encode);
use URI::Escape qw(uri_escape);
use Digest::HMAC_SHA1;
####Constructor####
sub new {
my $self={};
$self->{OAUTH_VERSION}=uri_escape("1.0");
$self->{OAUTH_SIGNATURE_METHOD}=uri_escape("HMAC-SHA1");
$self->{OAUTH_TIMESTAMP}=undef;
$self->{OAUTH_NONCE}=undef;
$self->{AGENT}="jimtweet/0.1";
#####################
#Use this for status updates
$self->{URLx}="https://api.twitter.com/1.1/statuses/update.json";
#####################
#Use this for image upload
$self->{URL}="https://upload.twitter.com/1.1/media/upload.json";
$self->{BROWSER}=LWP::UserAgent->new(agent =>$self->{AGENT});
$self->{CONSUMER_KEY}=undef;
$self->{CONSUMER_SECRET}=undef;
$self->{OAUTH_TOKEN}=undef;
$self->{OAUTH_TOKEN_SECRET}=undef;
$self->{STATUS}=undef;
$self->{MEDIAurl}=undef;
bless($self);
return $self;
}
sub consumer_key{
my $self=shift;
if (#_) { $self->{CONSUMER_KEY}=uri_escape(shift) }
return $self->{CONSUMER_KEY};
}
sub consumer_secret{
my $self = shift;
if (#_) { $self->{CONSUMER_SECRET}=uri_escape(shift) }
return $self->{CONSUMER_SECRET};
}
sub oauth_token{
my $self = shift;
if (#_) { $self->{OAUTH_TOKEN}=uri_escape(shift) }
return $self->{OAUTH_TOKEN};
}
sub oauth_token_secret{
my $self = shift;
if (#_) { $self->{OAUTH_TOKEN_SECRET}=uri_escape(shift) }
return $self->{OAUTH_TOKEN_SECRET};
}
sub update_status(#){
sleep(2);
my $self = shift;
if (#_) { $self->{STATUS}=uri_escape(shift) }
if (#_) { $self->{MEDIAurl}=shift }
#Got parameters. Now create the POST to upload an image
my $seconds = time();
$self->{OAUTH_TIMESTAMP}=uri_escape($seconds);
$self->{OAUTH_NONCE}=$self->{OAUTH_TIMESTAMP};
#####################
#Use this for uploads. Parameters have to be in alphabetical order!
my $query=qq(oauth_consumer_key=$self->{CONSUMER_KEY}&oauth_nonce=$self->{OAUTH_NONCE}&oauth_signature_method=$self->{OAUTH_SIGNATURE_METHOD}&oauth_timestamp=$self->{OAUTH_TIMESTAMP}&oauth_token=$self->{OAUTH_TOKEN}&oauth_version=$self->{OAUTH_VERSION});
my $sig="POST&";
$sig .=uri_encode($self->{URL},1);
$sig .="&";
$sig .=uri_encode($query,1);
my $sig_key=$self->{CONSUMER_SECRET};
$sig_key .="&";
$sig_key .=$self->{OAUTH_TOKEN_SECRET};
my $hmac = Digest::HMAC_SHA1->new($sig_key);
$hmac->add($sig);
my $oauth_signature_base64=$hmac->b64digest;
$oauth_signature_base64 .="=";
my $utf8_oauth_signature_base64=uri_escape($oauth_signature_base64);
my $header=qq(OAuth oauth_nonce="$self->{OAUTH_NONCE}", oauth_signature_method="$self->{OAUTH_SIGNATURE_METHOD}", oauth_timestamp="$self->{OAUTH_TIMESTAMP}", oauth_consumer_key="$self->{CONSUMER_KEY}", oauth_token="$self->{OAUTH_TOKEN}", oauth_signature="$utf8_oauth_signature_base64", oauth_version="$self->{OAUTH_VERSION}");
my $res = $self->{BROWSER}->post(
$self->{URL},
'Authorization' => $header,
'content-type' => 'form-data',
'Content' => [ media => ["$self->{MEDIAurl}"] ]
);
use JSON;
my $response = decode_json ($res->content);
my $media_id = $response->{'media_id'};
$seconds = time();
$self->{OAUTH_TIMESTAMP}=uri_escape($seconds);
$self->{OAUTH_NONCE}=$self->{OAUTH_TIMESTAMP}
my $queryx=qq(media_ids=$media_id&oauth_consumer_key=$self->{CONSUMER_KEY}&oauth_nonce=$self->{OAUTH_NONCE}&oauth_signature_method=$self->{OAUTH_SIGNATURE_METHOD}&oauth_timestamp=$self->{OAUTH_TIMESTAMP}&oauth_token=$self->{OAUTH_TOKEN}&oauth_version=$self->{OAUTH_VERSION}&status=$self->{STATUS});
my $sigx="POST&";
$sigx .=uri_encode($self->{URLx},1);
$sigx .="&";
$sigx .=uri_encode($queryx,1);
my $hmacx = Digest::HMAC_SHA1->new($sig_key);
$hmacx->add($sigx);
my $oauth_signature_base64x=$hmacx->b64digest;
$oauth_signature_base64x .="=";
my $utf8_oauth_signature_base64x=uri_escape($oauth_signature_base64x);
my $headerx=qq(OAuth oauth_nonce="$self->{OAUTH_NONCE}", oauth_signature_method="$self->{OAUTH_SIGNATURE_METHOD}", oauth_timestamp="$self->{OAUTH_TIMESTAMP}", oauth_consumer_key="$self->{CONSUMER_KEY}", oauth_token="$self->{OAUTH_TOKEN}", oauth_signature="$utf8_oauth_signature_base64x", oauth_version="$self->{OAUTH_VERSION}");
#And done generating content. Now to POST to twitter.
$res = $self->{BROWSER}->post(
$self->{URLx},
'Authorization' => $headerx,
'content-type' => 'application/x-www-form-urlencoded',
'Content' => qq(media_ids=$media_id&status=$self->{STATUS})
);
return $res;
}
####Footer####
1; #so the require or use succeeds

Related

How do I do a chunked transfer-encoding upload with WWW:Mechanize?

I'm attempting to use a particular web service, and I can successfully perform the upload with the following command:
curl -X POST --header "Transfer-Encoding: chunked" -d #Downloads/file.pdf https://some.webservice/upload
I get back a json response indicate success.
However, I'm unable to figure out how to do the same with WWW::Mechanize.
$mech->post("https://" . $server . "/upload", Content_Type => 'multipart/form-data', Content => [upID => $upid, name => $dlfile, userID => 0, userK => 0, file_0 => [$dlfile]]);
This receives a similar json response with a big fat error message in it.
Do I need to explicitly set the Transfer-Encoding header first? Is there some other trick to it? Google's not shedding much light on this, Perlmonks neither, and the documentation's a little obtuse.
You can do it using HTTP::Request::StreamingUpload
my $starttime = time();
my $req = HTTP::Request::StreamingUpload->new(
POST => $url,
path => $file,
headers => HTTP::Headers->new(
'Transfer-Encoding' => 'chunked'
),
);
my $gen = $req->content;
die unless ref($gen) eq "CODE";
my $total = 0;
$req->content(sub {
my $chunk = &$gen();
$total += length($chunk);
print "\r$total / $size bytes ("
. int($total/$size*100)
. "%) sent, "
. int($total/1000/(time()-$starttime+1))
. " k / sec ";
return $chunk;
});
my $resp = $ua->request($req);
print "\n";
unless ($resp->is_success) {
die "Failed uploading the file: ", $resp->status_line;
}
my $con = $resp->content;
return $con;
Do you really need WWW::Mechanize? It is a subclass of LWP::UserAgent with additional functionality that gives browser-like functionality like filling in and submitting forms, clicking links, a page history with a "back" operation etc. If you don't need all of that then you may as well use LWP::UserAgent directly
Either way, the post method is inherited unchanged from LWP::UserAgent, and it's fine to use it directly as you have done
The way to send a chunked POST is to set the Content to a reference to a subroutine. The subroutine must return the next chunk of data each time it is called, and finally ann empty string or undef when there is no more to send
Is the data supposed to be a JSON string?
It's easiest to write a factory subroutine that returns a closure, like this
sub make_callback {
my ($data) = shift;
sub { substr($data, 0, 512, "") }
}
Then you can call post like this
my $payload = to_json(...);
$mech->post(
"https://$server/upload",
Content_Type => 'multipart/form-data',
Content => make_callback($payload)
);
Please be aware that all of this is untested

How Upload file using Mojolicious?

I have been trying out Mojolicious web framework based on perl. And I have try to develop a full application instead of the Lite. The problem I am facing is that I am trying to upload files to server, but the below code is not working.
Please guide me what is wrong with it. Also, if the file gets uploaded then is it in public folder of the application or some place else.
Thanks in advance.
sub posted {
my $self = shift;
my $logger = $self->app->log;
my $filetype = $self->req->param('filetype');
my $fileuploaded = $self->req->upload('upload');
$logger->debug("filetype: $filetype");
$logger->debug("upload: $fileuploaded");
return $self->render(message => 'File is not available.')
unless ($fileuploaded);
return $self->render(message => 'File is too big.', status => 200)
if $self->req->is_limit_exceeded;
# Render template "example/posted.html.ep" with message
$self->render(message => 'Stuff Uploaded in this website.');
}
(First, you need some HTML form with method="post" and enctype="multipart/form-data", and a input type="file" with name="upload". Just to be sure.)
If there were no errors, $fileuploaded would be a Mojo::Upload. Then you could check its size, its headers, you could slurp it or move it, with $fileuploaded->move_to('path/file.ext').
Taken from a strange example.
To process uploading files you should use $c->req->uploads
post '/' => sub {
my $c = shift;
my #files;
for my $file (#{$c->req->uploads('files')}) {
my $size = $file->size;
my $name = $file->filename;
push #files, "$name ($size)";
$file->move_to("C:\\Program Files\\Apache Software Foundation\\Apache24\\htdocs\\ProcessingFolder\\".$name);
}
$c->render(text => "#files");
} => 'save';
See full code here: https://stackoverflow.com/a/28605563/4632019
You can use Mojolicious::Plugin::RenderFile
Mojolicious::Plugin::RenderFile

First 8 bytes are always wrong when downloading a file from my script

I have a Mojolicious Lite script that "gives out" an executable file (user can download the file from the script's URL). I keep encoded data in an inline template in DATA section, then encode it and render_data.
get '/download' => sub {
my $self = shift;
my $hex_data = $self->render_partial( 'TestEXE' );
my $bin_data;
while( $hex_data =~ /([^\n]+)\n?/g ) {
$bin_data .= pack "H".(length $1), $1;
}
my $headers = Mojo::Headers->new;
$headers->add( 'Content-Type', 'application/x-download;name=Test.exe' );
$headers->add( 'Content-Disposition', 'attachment;filename=Test.exe' );
$headers->add( 'Content-Description', 'File Transfer');
$self->res->content->headers($headers);
$self->render_data( $bin_data );
};
__DATA__
## TestEXE.html.ep
4d5a90000300000004000000ffff0000b8000000000000004000000000000000
00000000000000000000000000000000000000000000000000000000b0000000
0e1fba0e00b409cd21b8014ccd21546836362070726f6772616d2063616e6e6f
....
When I run this locally (via built in webserver on http://127.0.0.1:3000/, Win7) I get the correct file (size and contents). But when I run it in CGI mode on shared hosting (Linux), it comes back with correct size, but first 8 bytes of the file are always incorrect (and always different). The rest of the file is correct.
If in my sub i specify $hex_data instead of $bin_data I get what suppose to be there.
I'm at lost.
render_partial isn't what you want.
First, re-encode the executable in base64 format, and specify that the template is base64 encoded (This is assuming hex is not a requirement for your app):
## template-name (base64)
Also, you don't actually need a controller method at all. Mojolicious will handle the process for you - all you have to do is appropriately name the template.
use Mojolicious::Lite;
app->start;
__DATA__
## Test.exe (base64)
...
http://127.0.0.1:3000/Test.exe will then download the file.
-
If you still want to use a controller method for app-specific concerns, get the data template specifically:
use Mojolicious::Lite;
get '/download' => sub {
my $self = shift;
# http://mojolicio.us/perldoc/Mojolicious/Renderer.pm#get_data_template
my $data = $self->app->renderer->get_data_template({}, 'Test.exe');
# Replace content-disposition instead of adding it,
# to prevent duplication from elsewhere in the app
$self->res->headers->header(
'Content-Disposition', 'attachment;filename=name.exe');
$self->render_data($data);
};
app->start;
__DATA__
## Test.exe (base64)
...
http://127.0.0.1:3000/download will get the template, set the header, and then download it as name.exe.

OpenID authentication to Google Apps via Perl and Net::OpenID::Consumer fails

I asked this over on Google's support forums for Apps integration, but got zero response. Maybe somebody here can help steer me in the right direction.
I'm trying to integrate a Perl application with Google Apps, and I'm having some trouble with the OpenID authentication. I've been using this PHP tutorial from Google as a kind of reference, since there are no Perl examples I can find.
My initial file, index.cgi (referred by manifest.xml, and the starting point of the OpenID transaction) is as follows:
use Net::OpenID::Consumer;
use CGI;
# ...
my $q = CGI->new();
my $domain = $q->param('domain');
if (!$domain) {
print $q->header(), 'Provide domain please.';
exit 0;
}
# my website
my $root = 'http://www.example.com/';
my $csr = Net::OpenID::Consumer->new(
# The user agent which sends the openid off to the server
ua => LWP::UserAgent->new,
# Who we are
required_root => $root,
# Consumer Key Secret from Google Apps Marketplace
consumer_secret => 'Zzzzzz9zzAAAAA....'
);
my $claimed_id = $csr->claimed_identity(
'https://www.google.com/accounts/o8/site-xrds?hd=' . $domain);
if ($claimed_id) {
my $check_url = $claimed_id->check_url(
# Upon validation, the user will be returned here, and real
# work may begin
return_to => $root . '/return.cgi',
trust_root => $root
);
print $q->redirect($check_url);
}
else {
print $q->header(), "Error";
}
This part seems to be working. That is, I get redirected to return.cgi with a bunch of openid.* parameters. However, at this point I get the following error:
no_identity_server The provided URL doesn't declare its OpenID identity server
I'm using the latest version of the Net::OpenID::Consumer module.
Here are the significant bits of return.cgi:
my $q = CGI->new();
my $csr = Net::OpenID::Consumer->new(
ua => LWP::UserAgent->new,
# The root of our URL
required_root => 'http://www.example.com/',
# Our password.
consumer_secret => 'Zzzzzz9zzAAAAA....',
# Where to get the information from.
args => $q
);
print $q->header();
$csr->handle_server_response(
not_openid => sub {
print "That's not an OpenID message. Did you just type in the URL?";
},
setup_required => sub {
my $setup_url = shift;
print 'You need to do something here.';
},
cancelled => sub {
print 'You cancelled your login.';
},
verified => sub {
my $vident = shift;
my $url = $vident->url;
print "You are verified as '$url'. ** FIN **";
},
error => sub { die "Can't figure it out: ", #_; }
);
As you can imagine, I'm wanting the verified sub to fire, but instead I'm getting an error. Anything obvious I'm missing? Any help would be appreciated.
So the solution, it turns out, is to switch modules. I changed to the skimpily documented Net::Google::FederatedLogin, and things are now working. The code is as follows (substitute example.com below for your actual developer's domain).
In your Google Apps Marketplace vendor profile, add the URL to index.cgi in the Application Manifest:
...
<Url>http://www.example.com/index.cgi?from=google&domain=${DOMAIN_NAME}</Url>
...
Then add the following code to your servers.
index.cgi
use CGI;
use Net::Google::FederatedLogin;
my $q = CGI->new();
my $domain = $q->param('domain');
if (!$domain) {
print $q->header(), 'Provide domain please.';
exit 0;
}
my $fl = Net::Google::FederatedLogin->new(
claimed_id =>
'https://www.google.com/accounts/o8/site-xrds?hd=' . $domain,
return_to =>
'http://www.example.com/return.cgi',
extensions => [
{
ns => 'ax',
uri => 'http://openid.net/srv/ax/1.0',
attributes => {
mode => 'fetch_request',
required => 'email',
type => {
email => 'http://axschema.org/contact/email'
}
}
}
] );
print $q->redirect($fl->get_auth_url());
return.cgi
use CGI;
use Net::Google::FederatedLogin;
my $q = CGI->new();
print $q->header();
my $fl = Net::Google::FederatedLogin->new(
cgi => $q,
return_to =>
'http://www.example.com/return.cgi' );
eval { $fl->verify_auth(); };
if ($#) {
print 'Error: ' . $#;
}
else {
# we've authenticated and gotten attributes --
my $ext = $fl->get_extension('http://openid.net/srv/ax/1.0');
print $ext->get_parameter('value.email');
}
(For a full sample, plus OAuth access to user data, see this post on my blog.)
In some cases, reportedly, this is caused by Perl missing Net::SSL, making it fail on Google's SSL URLs.
The step where it's failing is where it performs discovery on the identifier asserted by Google's server. For some reason discovery on that identifier URL is failing. It would be helpful to know what OpenID identifier the Google server is asserting to try to debug why discovery is not working for it.
I'm not sure what $domain is there, but you may need to escape it:
use URI::Escape 'uri_escape';
....
my $claimed_id = $csr->claimed_identity(
'https://www.google.com/accounts/o8/site-xrds?hd=' . uri_escape($domain) );
Also, the consumer_secret used by Net::OpenID::Consumer has no relationship to any other secret.

How can I log in to YouTube using Perl?

I am trying to write a Perl script to connect to me YouTube account but it doesnt seem to work. Basically I just want to connect to my account but apparently it is not working. I don't even have an idea on how I could debug this! Maybe it is something related to https protocol?
Please enlighten me! Thanks in advance.
use HTTP::Request::Common;
use LWP::UserAgent;
use strict;
my $login="test";
my $pass = "test";
my $res = "";
my $ua = "";
# Create user agent, make it look like FireFox and store cookies
$ua = LWP::UserAgent->new;
$ua->agent("Mozilla/5.0 (X11; U; Linux i686; en-US; rv:1.7.12) Gecko/20051213 Firefox/1.0.7");
$ua->cookie_jar ( {} );
# Request login page
$res = $ua->request(GET "https://www.google.com/accounts/ServiceLogin?service=youtube&hl=en_US&passive=true&ltmpl=sso&uilel=3&continue=http%3A//www.youtube.com/signup%3Fhl%3Den_US%26warned%3D%26nomobiletemp%3D1%26next%3D/index");
die("ERROR1: GET http://www.youtube.com/login\n") unless ($res->is_success);
# Now we login with our user/pass
$res = $ua->request(
POST "https://www.google.com/accounts/ServiceLoginAuth?service=youtube",
Referer => "http://www.youtube.com/login",
Content_Type => "application/x-www-form-urlencoded",
Content => [
currentform => "login",
next => "/index",
username => $login,
password => $pass,
action_login => "Log+In"
]
);
# YouTube redirects (302) to a new page when login is success
# and returns OK (200) if the login failed.
#die("ERROR: Login Failed\n") unless ($res->is_redirect());
print $res->content;
what i am doing is learning the web features of perl, so i dont want to use any library except wwwlib or mechanize to get the job done.
how can i just connect to my account using a perl script? this is my objective for now
hope someone can post a script or correct mine.
thank you guys for you help.
i am testing Webscarab now..
What data are you trying to grab? Why not just using an existing implementation like WebService::YouTube
Some comments on your code: I always avoided the shortcut $ua->request(GET/POST) method since I always ended up needing more flexibility that only the use of HTTP::Request and HTTP::Response allowed. I always felt the code was cleaner that way too.
Why is your code not working? Who knows.
Make sure your cookiejar is adding your cookies to the outgoing HTTP::Request. I'd suggest dumping all your headers when you do it in a browser and compare with the headers and data that libwww is sending. There may be some additional fields that they are checking for that vary for every hit. They may be checking for your UserAgent string. If you are just looking to learn libwww I'd suggest using a different site as a target as I'm sure YouTube has all sort of anti-scripting hardening.
Are you using YouTube's stable documented API?
Use an HTTP proxy such as WebScarab to watch the data flow.
Trey's suggestion to use somebody else's CPAN package for the mechanics is a good idea too.
Right right by and large, what you want to do is define a cookiejar for most of these websites that have a redirection login. This is what the package has done. Also the package tunes a lot of the lookups and scrapes based on the youtube spec.
Ajax content for example will be rough since its not there when your scraping
You just picked a somewhat rough page to start out with.
Enjoy
I'm actually working on this issue myself. Before, I would suggest read over this the API guide from Google as a good starting reference. If I'm reading it correctly, one begins with passing user credentials through a REST interface to get a Authentication Token. To handle that, I'm using the following:
sub getToken {
my %parms = #_;
my $response = LWP::UserAgent->new->post(
'https://www.google.com/youtube/accounts/ClientLogin',
[
Email => $parms{'username'},
Passwd => $parms{'password'},
service => "youtube",
source => "<<Your Value Here>>",
]
);
my $content = $response->content;
my ($auth) = $content =~ /^Auth=(.*)YouTubeUser(.*)$/msg
or die "Unable to authenticate?\n";
my ($user) = $content =~ /YouTubeUser=(.*)$/msg
or die "Could not extract user name from response string. ";
return ($auth, $user);
}
And I call that from the main part of my program as such:
## Get $AuthToken
my ($AuthToken, $GoogleUserName) = getToken((
username => $email, password => $password
));
Once I have these two things -- $AuthToken and $GoogleUserName, I'm still testing the LWP Post. I'm still writing this unit:
sub test {
my %parms = #_;
## Copy file contents. Use, foy's three param open method.
my $fileSize = -s $parms{'File'};
open(VideoFile, '<', "$parms{'File'}") or die "Can't open $parms{'File'}.";
binmode VideoFile;
read(VideoFile, my $fileContents, $fileSize) or die "Can't read $parms{'File'}";
close VideoFile;
my $r = LWP::UserAgent->new->post(
"http://uploads.gdata.youtube.com/feeds/api/users/$parms{'user'}/uploads",
[
Host => "uploads.gdata.youtube.com",
'Authorization' => "AuthSub token=\"$parms{'auth'}\"",
'GData-Version' => "2",
'X-GData-Key' => "key=$YouTubeDeveloperKey",
'Slug' => "$parms{'File'}",
'Content-Type' => "multipart/related; boundary=\"<boundary_string>\"",
'Content-Length' => "<content_length>",
'video_content_type'=> "video/wmv",
'Connection' => "close",
'Content' => $fileContents
]
);
print Dumper(\$r->content)
}
And that is called as
&test((auth=>$Auth, user=>$user, File=>'test.wmv'));