Beefy Boxes and Bandwidth Generously Provided by pair Networks
Do you know where your variables are?
 
PerlMonks  

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 = 'http://www.divshare.com/api/'; 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 = "www.divshare.com"; 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 = 'http://upload.divshare.com/api/upload'; 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.

        http://www.divshare.com?error=true&description=Please+upload+a+file.
        STATUS: 200 OK
        Returned no content
        Upload Response: HTTP::Response=HASH(0x8a62e0c)

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://656934]
help
Chatterbox?
[Corion]: marto: Yes, they were left in the dark about that :-D
[Corion]: I heard a good analogy to the GDPR, which likely only works for Germans. GDPR is the new "separating your thrash", which is common in Germany. I equate "sharing" data with littering - and likely the fight will also take 30+ years for data sharing to ...
[Corion]: ... become as socially inacceptable as littering is today
[Corion]: Has anybody worked with Template::Liquid and Template::Liquid:: Include? I must be doing something stupid because Template::Liquid:: Include won't interpolate variables in the include files for me...
[Corion]: Template::LiquidX ::Include I meant...
[Corion]: Doh - 3rd time's the charm, maybe? Tempalte::LiquidX ::Tag::Include :D
[Corion]: Ah well, you know what it should be ;) hard, copied link

How do I use this? | Other CB clients
Other Users?
Others scrutinizing the Monastery: (7)
As of 2018-05-25 12:48 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    Notices?