Beefy Boxes and Bandwidth Generously Provided by pair Networks
Keep It Simple, Stupid

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]
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others surveying the Monastery: (7)
As of 2021-06-22 22:53 GMT
Find Nodes?
    Voting Booth?
    What does the "s" stand for in "perls"? (Whence perls)

    Results (110 votes). Check out past polls.