Correct proxy script for html2canvas - html2canvas

I'm trying to get html2render ( http://html2canvas.hertzen.com/ ) to work on my website. It works for the basic stuff - but none of the images show (as they are on a cdn.domain.com subdomain).
I've been reading up, and it seems that it doesn't like other domains out of the box. I found a couple of PHP proxy scripts:
https://github.com/brcontainer/html2canvas-php-proxy
https://github.com/adjdred/html2canvas-proxy-php
I tried to get those going, but we don't have curl enabled on this server. So, I'm resorting to writing something in Perl.
Here is what I've got so far:
use MIME::Base64;
use File::Slurp;
handle();
sub handle {
print ('Access-Control-Max-Age:' . 5 * 60 * 1000);
print ("Access-Control-Allow-Origin: *");
print ('Access-Control-Request-Method: *');
print ('Access-Control-Allow-Methods: OPTIONS, GET');
print ('Access-Control-Allow-Headers *');
print ("Content-Type: application/javascript");
#print $IN->header;
my $url = $IN->param('url');
$url =~ s|https://cdn.xxx.net|/srv/www/xxx.net/www|g;
if (-e $url) {
my $file = read_file($url);
use JSON;
my $mime_type;
if ($url =~ /\.jpe?g$/i) {
$mime_type = "image/jpg"
} elsif ($url =~ /\.png$/i) {
$mime_type = "image/png"
}
print JSON::encode_json([{
"pathinfo" => $url,
"error" => undef,
"data" => encode_base64($file),
"mime_type" => $mime_type
}]);
} else {
print "ACK!";
}
}
However, it still doesn't work :( There is little (none??) documentation on the proxy (apart from telling you that you need it in some cases!)
Can anyone share what the outputted data should look like? I tried to work it out based on the above example codes , but my PHP is a bit rusty (and I don't have a server with PHP and Curl enabled, that I can test it out on)
Thanks!

Ok, well not so much an answer about the proxy - but I did come across a post:
HTML2Canvas with CORS in S3 and CloudFront
In here, is shows an example of using:
useCORS: true,
... so I tried that:
html2canvas(document.body, {
useCORS: true,
onrendered: function(canvas) {
}
});
...and it works!!!!
In my instance, I was just using domain.com and cdn.domain.com as the CDN. If you are using other 3rd party CDN's, you may need to look at enabling the CORs headers.

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

Upload media to twitter using 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

Less verbose debug screen in Catalyst?

in my stage server I would like to activate the debug so the clients can find errors for themselves before the app goes to the production server.
BUT I only want the first part of the message, not the Request, or the Session Data.
For example: Couldn't render template "templates/home.tt2: file error - templates/inc/heater: not found".
The message is enough for me and for my client to see that the "header" call is misspelled.
The Request has a lot of irrelevant information for the client, but also has A LOT of internal developing information that should be hidden all the time!!
Regards
What you want is to override Catalyst's dump_these method. This returns a list of things to display on Catalyst's error debugging page.
The default implementation looks like:
sub dump_these {
my $c = shift;
[ Request => $c->req ],
[ Response => $c->res ],
[ Stash => $c->stash ],
[ Config => $c->config ];
}
but you can make it more restrictive, for example
sub dump_these {
my $c = shift;
return [ Apology => "We're sorry that you encountered a problem" ],
[ Response => substr($c->res->body, 0, 512) ];
}
You would define dump_these in your app's main module -- the one where you use Catalyst.
I had a similar problem that I solved by overriding the Catalyst method log_request_parameters.
Something like this (as #mob said, put it in your main module):
sub log_request_parameters {
my $c = shift;
my %all_params = #_;
my $copy = Clone::clone(\%all_params); # don't change the 'real' request params
# Then, do anything you want to only print what matters to you,
# for example, to hide some POST parameters:
my $body = $copy->{body} || {};
foreach my $key (keys %$body) {
$body->{$key} = '****' if $key =~ /password/;
}
return $c->SUPER::log_request_parameters( %$copy );
}
But you could also simply return at the beginning, if you don't want any GET/POST parameters displayed.
Well, I didn't think of the more obvious solution, in your case: you could simply set your log level to something higher than debug, which would prevent these debug logs from being displayed, but would keep the error logs:
# (or a similar condition to check you are not on the production server)
if ( !__PACKAGE__->config->{dev} ) {
__PACKAGE__->log->levels( 'warn', 'error', 'fatal' ) if ref __PACKAGE__->log;
}

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'));