Beefy Boxes and Bandwidth Generously Provided by pair Networks
Don't ask to ask, just ask

Re: Automatic Uploader Script

by moklevat (Priest)
on Dec 13, 2007 at 22:48 UTC ( #656934=note: print w/replies, xml ) Need Help??

in reply to Automatic Uploader Script

In the "put up or shut up" department, I needed some procrastination time, was looking for an excuse to do something with LWP::UserAgent and XML::Simple, and thought that I might test my assertion that the published API would make it possible to accomplish your task.

This works for logging in and requesting an upload ticket, and you will need to enter your particulars (email address and password, api key, and secret key). You will also need to develop the upload form and deal with the site's redirection scheme for a complete solution.

I welcome any and all suggestions for improvements!

#!/usr/bin/perl use warnings; use strict; use LWP::UserAgent; use XML::Simple qw(:strict); use Digest::MD5 qw (md5_hex); my $api_key = ''; my $secret = ''; my $email = ''; my $password = ''; my $api_url = ''; my $user_agent = LWP::UserAgent->new; $user_agent ->timeout(10); ## Login to Divshare and get an API Session key my $api_session_key = login($user_agent, $api_key, $email, $password); ## Using the API Session Key compute the API Signature using the "secr +et" key my $api_sig = gen_api_sig($secret, $api_session_key); ## Request an upload ticket my $upload_ticket = get_upload_ticket($user_agent, $api_key, $api_ses +sion_key, $api_sig); print "Your upload ticket is $upload_ticket\n"; ## Logout my $logout = logout($user_agent, $api_key, $api_session_key, $api_sig) +; sub login { my ($user_agent,$api_key,$email,$password)=@_; my $login_response = $user_agent->post($api_url, { 'method' => "login", 'api_key' => "$api_key", 'user_email' => "$email", 'user_password'=> "$password" }); my $api_session_xml= $login_response -> content; my $api_session_key= XMLin($api_session_xml, forcearray=>1, keyatt +r=>[] )->{api_session_key}; return $api_session_key->[0]; } sub gen_api_sig { my ($secret,$api_session_key) = @_; my $build_string = $secret.$api_session_key; my $api_sig = md5_hex($build_string); return $api_sig; } sub get_upload_ticket { my ($user_agent, $api_key, $api_session_key, $api_sig) = @_; my $upload_ticket_response = $user_agent->post($api_url, { 'method' => "get_upload_ticke +t", 'api_key' => "$api_key", 'api_session_key' => "$api_sess +ion_key", 'api_sig' => "$api_sig" }); my $upload_ticket_xml = $upload_ticket_response -> content; my $upload_ticket_result = XMLin($upload_ticket_xml, forcearray=>1 +, keyattr=>[] ) ->{upload_ticket}; return $upload_ticket_result->[0]; } sub logout { my ($user_agent, $api_key, $api_session_key, $api_sig) = @_; my $logout_response = $user_agent->post($api_url, { 'method' => "logout", 'api_key' => "$api_key", 'api_session_key' => "$api_session_key", 'api_sig' => "$api_sig" }); my $logout_xml = $logout_response -> content; my $logout_result = XMLin($logout_xml, forcearray=>1, keyattr=>[] +) ->{logged_out}; return $logout_result->[0]; }

Replies are listed 'Best First'.
Re^2: Automatic Uploader Script
by sadarax (Sexton) on Dec 13, 2007 at 23:17 UTC
    Wow Moklevat, that is a really cool. You definitely 'put up' the code.

    I will certainly be using this, and working on getting that upload function working. If all goes well, I may try to spin this into a module like everyone suggested and throw it up on CPAN. That is of course, if you don't mind me using your code.

    I'm still learning Modules, so it may take me a while though.

      I, moklevat, release the code for use without restriction and without warranty of merchantability for any purpose (or whatever).
        I am sorry to have to come begging for more help, but I am thoroughly stuck on the upload code for this. I have tried a few variations, but nothing seems to work. I ended up using a form (as the API instructions specified), I don't know if my code will help at all.

        my $response_url = ""; open my $FILE, "video.avi" or die "Cannot open file\n"; ## Attempt to upload a file my $upload = upload( $user_agent, $upload_ticket, $response_url, $FILE +, $folder_id, ); close $FILE; # Not yet Supported: Email, file_descript, and multiple files sub upload { my $post_url = ''; my ($user_agent, $upload_ticket, $response_url, $file1, $folder_id) += @_; my $html_form = '<form action="' . $post_url . '" method="post" enctype="multipart +/form-data"> <input type="hidden" name="upload_ticket" value="' . $upload_ticke +t . '" /> <input type="hidden" name="response_url" value="' . $response_url +. '" /> <input type="file" name="file1" /> <input type="text" name="file1_description" maxlength="255" /> <select name="folder_id"> <option value="' . $folder_id . '">[Folder Title 1]</option> </select> <input type="submit" value="Upload" /> </form>'; use HTML::Form; my $form = HTML::Form->parse($html_form, $post_url); # set form attributes $form->attr("upload_ticket", $upload_ticket); $form->attr("file1", $file1); $form->attr("file1_description", "$file1"); $form->attr("folder_id", $folder_id); push @{ $user_agent->requests_redirectable }, 'POST'; my $upload_response = $user_agent->request($form->click) or die "Use +r-Agent POST failed\n"; print $upload_response->base . "\n"; # Check the return object if( $upload_response->is_success ) { print "STATUS: " . $upload_response->status_line . "\n"; my $upload_xml = $upload_response -> content; if( defined $upload_xml && $upload_xml !~ "" ) { if( $upload_xml =~ "error" ) { print $upload_xml . "\n"; } } elsif( defined $upload_response ) { print "Returned no content\n Upload Response: $upload_response\n +"; } else { print "$upload_xml\n"; } return $upload_xml; } else { print STDERR $upload_response->status_line, "\n"; } }

        I typically get this print out when I run the script.
        STATUS: 200 OK
        Returned no content
        Upload Response: HTTP::Response=HASH(0x8a62e0c)

Log In?

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://656934]
[MidLifeXis]: I think I forgot "running on a farm of commodore 64, vic 20s, trs 80s, and apple ]|[e systems"
[GotToBTru]: oh I know what it is .. but it is a number only slightly useful to me and of no possible use to our customer
[MidLifeXis]: Whew - you just saved the free world. <o)
[GotToBTru]: i guess it's a placeholder, the code will only fill it in if there is nothing else to use
[GotToBTru]: but then .. if you have nothing to say, why not say nothing?
[MidLifeXis]: I have a user who has a lot of say on how some of our processes work that abhors significant blanks. Perhaps that is a part of it. A not-so-obvious "this space intentionally left blank" indicator.
[MidLifeXis]: On the back end, however, that doesn't mean that i have to use that value to indicate "undefined", no matter how much he thinks I should.

How do I use this? | Other CB clients
Other Users?
Others studying the Monastery: (8)
As of 2017-01-20 19:11 GMT
Find Nodes?
    Voting Booth?
    Do you watch meteor showers?

    Results (176 votes). Check out past polls.