Beefy Boxes and Bandwidth Generously Provided by pair Networks
Your skill will accomplish
what the force of many cannot

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 leaves swirl about...

How do I use this? | Other CB clients
Other Users?
Others taking refuge in the Monastery: (3)
As of 2018-02-25 02:13 GMT
Find Nodes?
    Voting Booth?
    When it is dark outside I am happiest to see ...

    Results (312 votes). Check out past polls.