Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl: the Markov chain saw

comment on

( #3333=superdoc: print w/replies, xml ) Need Help??
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]; }

In reply to Re: Automatic Uploader Script by moklevat
in thread Automatic Uploader Script by sadarax

Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":

  • Are you posting in the right place? Check out Where do I post X? to know for sure.
  • Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
    <code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
  • Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
  • Want more info? How to link or or How to display code and escape characters are good places to start.
Log In?

What's my password?
Create A New User
and the web crawler heard nothing...

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

    Results (133 votes). Check out past polls.