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

Google Docs Uploader

by alexbio (Monk)
on May 08, 2010 at 15:12 UTC ( #839022=CUFP: print w/replies, xml ) Need Help??

Update: Now file type is taken from the file extension, and then converted to MIME using Media::Type::Simple. Tested on Windows (virtual machine), it seems to work fine. I also added a check on the OS when password is requested. The previous version can be downloaded from here.

Hello everyone! I wrote a script to upload file to Google Documents. Documentation is included.

There is also a git repository.

Any hints are obviously welcome.

#!/usr/bin/perl # Upload documents to Google Documents. # # Copyright 2010 Alessandro Ghedini <> # -------------------------------------------------------------- # "THE BEER-WARE LICENSE" (Revision 42): # Alessandro Ghedini wrote this file. As long as you retain this # notice you can do whatever you want with this stuff. If we # meet some day, and you think this stuff is worth it, you can # buy me a beer in return. # -------------------------------------------------------------- use HTTP::Request::Common; use LWP::UserAgent; use JSON -support_by_pp; use Media::Type::Simple; use strict; die "For info type 'perldoc $0'\n" unless $#ARGV > 0; my (@files, $email, $pwd); for (my $i = 0; $i < $#ARGV + 1; $i++) { push(@files, $ARGV[$i+1]) if ($ARGV[$i] eq "-f"); $email = $ARGV[$i+1] if ($ARGV[$i] eq "-e"); die "For info type 'perldoc $0'\n" if ($ARGV[$i] eq "-h"); } print("Password: "); system('stty','-echo') if $^O eq 'linux'; chop($pwd = <STDIN>); system('stty','echo') if $^O eq 'linux'; print "\n"; my $ua = LWP::UserAgent -> new; my $url = ''; my %request = ('accountType', 'HOSTED_OR_GOOGLE', 'Email', $email, 'Passwd', $pwd, 'service', 'writely', 'source', 'GoogleDocsUploader-GoogleDocsUploader-00', ); my $response = $ua -> request(POST $url, [%request]) -> as_string; my $auth = (split /=/, (split /\n/, (split /\n\n/, $response)[1])[2])[ +1]; my $status = (split / /,(split /\n/, $response)[0])[1]; die("ERROR: Unauthorized.\n") if $status == 403; $url = "" +; $ua -> default_header('Authorization' => "GoogleLogin auth=$auth"); foreach my $file(@files) { if (!open(FILE, $file)) { print "ERROR: Unable to open '$file' file.\n"; next; } my $data = join("", <FILE>); close FILE; my $mime = type_from_ext(($file =~ m/([^.]+)$/)[0]); $ua -> default_header('Slug' => $file); my $request = HTTP::Request -> new(POST => $url); $request -> content_type($mime); $request -> content($data); my $response = $ua -> request($request) -> as_string; $status = (split / /,(split /\n/, $response)[0])[1]; my $body = (split /\n\n/, $response)[1]; if ($status != 201) { print "ERROR: $body"; next; } my $json = new JSON; my $json_text = $json -> decode($body); my $title = $json_text -> {entry} -> {title} -> {'$t'}; my $link = $json_text -> {entry} -> {link}[0] -> {href}; print "Document successfully created with title '$title'.\nLink:\n +$link\n"; } __END__ =head1 NAME - Uploads documents to Google Documents. =head1 USAGE GoogleDocsUploader [OPTIONS] =head1 OPTIONS =over =item -e Specifies the login email (e.g. =item -f Specifies the file to upload (can be more than one). =back =head1 MULTIPLE FILES UPLOAD You can upload multiple files by setting multiple '-f' options. =head1 FILE TYPE Allowed file types (checked with MIME) are: CSV text/csv TSV text/tab-separated-values TAB text/tab-separated-values HTML text/html HTM text/html DOC application/msword DOCX application/vnd.openxmlformats-officedocument. wordprocessingml.document ODS application/x-vnd.oasis.opendocument.spreadsheet ODT application/vnd.oasis.opendocument.text RTF application/rtf SXW application/vnd.sun.xml.writer TXT text/plain XLS application/ XLSX application/vnd.openxmlformats-officedocument. spreadsheetml.sheet PDF application/pdf PPT application/ PPS application/ =cut
Alex's Log -

Replies are listed 'Best First'.
Re: Google Docs Uploader
by roho (Canon) on May 09, 2010 at 16:13 UTC
    Hello Alex,
    I tried running the program on Windows and got a message that said I don't have a mime-info database. I went to as the message suggested, but only found *nix oriented packages. Do you know if a Windows package exists for the shared-mime-info database? Thanks, Roy

    "Its not how hard you work, its how much you get done."

      I made some changes in the script to make it work on Windows systems. I tested it using a virtual machine and it seems to do his job quite fine. Now the MIME is retrieved using another module which needs only the extension of the file.
      Alex's Log -

      Sorry, I didn't test it on Windows. I tried to search a mime-info package for windows but as you noticed it does not exist. If you want I think the script could run nicely under CygWin (I can't test it, I don't have a windows installation). Bye

      Alex's Log -

        You really should put that limitation into your OP as a LEADING update, and in your repository copy. There's no point in requiring the (make up a percentage) of Perl users who also use 'doze find out the hard way.

Log In?

What's my password?
Create A New User
Node Status?
node history
Node Type: CUFP [id://839022]
Front-paged by Arunbear
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others wandering the Monastery: (1)
As of 2018-08-22 02:04 GMT
Find Nodes?
    Voting Booth?
    Asked to put a square peg in a round hole, I would:

    Results (204 votes). Check out past polls.