good is a gdrive client in perl

good.pl

#!/usr/bin/env perl
#
# my own little google drive client written in perl 
#

use strict;
use warnings;
use LWP::UserAgent;
use HTTP::Request;
use HTTP::Headers;
use HTTP::Request::Common;
use URI::Encode;
use Data::Dumper;
use Data::Printer;
use YAML qw( LoadFile DumpFile );
use JSON qw( from_json to_json );
use JSON qw( decode_json );
use Getopt::Long::Descriptive;
use DateTime;
use File::stat;
use Number::Bytes::Human qw(format_bytes);
use Term::ProgressBar;
use IO::Socket::SSL 'inet4';

my $cfg_file     = "$ENV{'USERPROFILE'}/.google-drive.yml";
my $cfg          = LoadFile($cfg_file);
my $access_token = $cfg->{'access_token'};
my $base_url     = 'https://www.googleapis.com/drive';
my $folder_id    = 'root';

my ( $opt, $usage ) = describe_options(
    '%c %o <some-arg>',
    [ 'verbose|v',    "verbose mode on" ],
    [ 'list|l=s',     "list a folder by path (use \"/\" for root)" ],
    [ 'show_id|si',   "show IDs when listing" ],
    [ 'tree|t=s',     "recursively list a folder by path" ],
    [ 'authorize|A',  "authorize the present program" ],
    [ 'refresh|R',    "force token refresh" ],
    [ 'mkfolder|m=s', "create a new folder" ],
    [ 'download|d=s', "download file under the specified path" ],
    [ 'bar|b',        "display download progress bar" ],
    [ 'delete|rm=s',  "delete item(s) under the specified path" ],
    [ 'parent|p=s', "parent path for folder creation", { default => 'root' } ],
    [ 'help|h',     "the present help screen" ],
);

print( $usage->text ), exit if $opt->help;

###########################################
sub authorize {
###########################################
    my $cfg           = shift;
    my $client_id     = $cfg->{client_id};
    my $client_secret = $cfg->{client_secret};
    my $redirect_uri  = "urn:ietf:wg:oauth:2.0:oob";
    my $scope         = 'https://www.googleapis.com/auth/drive';
    my %args          = (
        response_type => 'code',
        client_id     => $client_id,
        redirect_uri  => $redirect_uri,
        access_type   => "offline",
        prompt        => "consent",
        scope         => $scope,
    );
    my $url = URI->new("https://accounts.google.com/o/oauth2/v2/auth");
    $url->query_form(%args);
    print "open the following url in a browser to get the code:\n";
    print "$url\n";
    print "enter the returned code\n";
    my $code = <>;

    my $req = POST(
        'https://accounts.google.com/o/oauth2/token',
        [
            client_id     => $client_id,
            client_secret => $client_secret,
            code          => $code,
            grant_type    => 'authorization_code',
            redirect_uri  => $redirect_uri,
        ]
    );
    my $res = LWP::UserAgent->new()->request($req);
    print Dumper $res;    # debug/check
    my $auth = from_json( $res->content );
    p($auth) if $opt->verbose;

    foreach my $key ( 'access_token', 'refresh_token', 'expires_in' ) {
        $cfg->{$key} = $auth->{$key};
    }
    my $expat = time() + $auth->{expires_in};
    $cfg->{expires_at} = $expat;
    $cfg->{expires} = DateTime->from_epoch( epoch => $expat )->datetime;
}

###########################################
sub refresh_token {
###########################################
    my $cfg           = shift;
    my $refresh_token = $cfg->{refresh_token};
    my $token_req     = HTTP::Request::Common::POST(
        'https://accounts.google.com/o' . '/oauth2/token',
        [
            refresh_token => $cfg->{refresh_token},
            client_id     => $cfg->{client_id},
            client_secret => $cfg->{client_secret},
            grant_type    => 'refresh_token',
        ]
    );
    my $ua   = LWP::UserAgent->new();
    my $resp = $ua->request($token_req);
    print $resp->as_string if $opt->verbose;
    my $data        = from_json( $resp->content() );
    my $fresh_token = $data->{access_token};
    my $expires     = $data->{expires_in};
    print "\ntoken: $fresh_token, expires: $expires\n" if $opt->verbose;

    $cfg->{access_token} = $data->{access_token};
    $cfg->{expires_at}   = time() + $data->{expires_in};
    $cfg->{expires} =
      DateTime->from_epoch( epoch => $cfg->{expires_at} )->datetime;

    return 1;
}

###########################################
sub apireq {
###########################################
    my ( $method, $endpoint, $params, $post_data ) = @_;
    my $url = URI->new( $base_url . $endpoint );
    $url->query_form($params);
    print( "url: " . $url->as_string . "\n" ) if $opt->verbose;
    my $req = HTTP::Request->new(
        $method => $url->as_string,
        HTTP::Headers->new( Authorization => "Bearer $access_token" )
    );
    my $ua  = LWP::UserAgent->new();
    my $res = $ua->request($req);
    print( "status code: " . $res->code . "\n" )
      if ( $opt->verbose or $opt->delete );
    return $res->content();
}

###########################################
sub list_folder {
###########################################
    my $folder_id = shift;
    my $opts->{q} = "'$folder_id' in parents";
    my $res       = apireq( 'GET', "/v2/files", $opts );
    my $data      = from_json($res);
    return $data;
}

###########################################
sub path_to_id {
###########################################
    my ( $path, $root_id ) = @_;
    my $found;
    my $node;
    if ( $path eq "/" or $path eq 'root' ) {
        $found        = 1;
        $node->{type} = 'folder';
        $node->{id}   = 'root';
        $node->{path} = '/';
        return ( $found, $node );
    }
    my @pc = split( "/", $path );
    my $node_path = '/';
    for my $p (@pc) {
        $found = 0;
        my $data = list_folder($root_id);
        for my $item ( @{ $data->{items} } ) {
            next unless $item->{title} eq $p;
            $root_id       = $item->{id};
            $found         = 1;
            $node->{type}  = $item->{mimeType};
            $node->{id}    = $root_id;
            $node->{path}  = $path;
            $node->{title} = $item->{title};
            $node->{fileSize} = $item->{fileSize} if $item->{fileSize};
            $node->{downloadUrl} = $item->{downloadUrl};
        }
    }
    return ( $found, $node );
}

###########################################
sub tree_list {
###########################################
    my ( $folder_id, $c ) = @_;
    my $data   = list_folder($folder_id);
    my $indent = " " x $c;
    for my $i ( sort { lc( $a->{title} ) cmp lc( $b->{title} ) }
        @{ $data->{items} } )
    {
        my $title = $i->{title};
        if ( !( $i->{mimeType} eq "application/vnd.google-apps.folder" ) ) {
            my $s = " $indent$title";
            if ( $i->{fileSize} ) {
                my $size =
                  format_bytes( $i->{fileSize}, si => 1, precision => 2 );
                $s .= " [$size]";
            }
            print "$s\n";
        }
        else {
            print " $indent$title\n";
            tree_list( $i->{id}, $c + 1 );
        }
    }
}

###########################################
sub create_folder {
###########################################
    my ( $title, $parent_id ) = @_;
    my $data = {
        'title'    => $title,
        'parents'  => [ { 'id' => $parent_id } ],
        'mimeType' => 'application/vnd.google-apps.folder'
    };
    my $url = URI->new( $base_url . "/v2/files" );
    my $req = POST(
        $url->as_string,
        Authorization  => "Bearer $access_token",
        'Content-Type' => 'application/json',
        Content        => to_json($data),
    );
    my $res = LWP::UserAgent->new()->request($req);
    print $res->code;
    return $res->content;
}

###########################################
sub download_file {
###########################################
    my ( $d_url, $localpath, $filesize ) = @_;
    my $ua = LWP::UserAgent->new();
    $ua->show_progress(1);
    my $start = time();
    my $req   = GET( $d_url, Authorization => "Bearer $access_token", );
    my $res   = $ua->request( $req, $localpath );
    print "status: " . $res->status_line() . "\n";
    if ( $res->content_length() ) {
        print "content_length: " . $res->content_length() . "\n";
    }
    else {
        print $res->headers_as_string . "\n";
    }
    my $dt = time() - $start;
    my $size;
    if ($filesize) {
        $size = $filesize;
    }
    else {
        $size = stat($localpath)->size;
    }
    my $avg_speed      = $size / $dt;
    my $nice_size      = format_bytes( $size, si => 1 );
    my $nice_avg_speed = format_bytes( $avg_speed, si => 1, precision => 2 );
    print
      "downloaded $nice_size in $dt seconds, avg speed: $nice_avg_speed/s\n";
    return $size;
}

###########################################
sub get_with_progress {
###########################################
	$|++;
    my ( $url, $path, $filesize ) = @_;
    open my $outhandle, ">", $path or die "Cannot create $path: $!";
    binmode $outhandle;    # needed for binary files on WinOS
    my $ua  = LWP::UserAgent->new;
    my $bar = Term::ProgressBar->new(
        {
            name  => 'Download',
            count => $filesize,
            ETA   => 'linear'
        }
    );
	$bar->minor(0);           		# turns off the floating asterisks.
    my $output      = 0;            # our downloaded data.
    my $total_size  = $filesize;    # total size of the URL.
    my $next_update = 0;            # reduce ProgressBar use.
	my $start = time();
    $ua->get(
        $url,
        Authorization => "Bearer $access_token",
        ":content_cb" => sub {
            my ( $chunk, $response, $protocol ) = @_;
            $output += length $chunk;

            # reduce usage, as per example 3 in POD.
            if ( $output >= $next_update ) {
                $next_update = $bar->update($output);
            }
            print {$outhandle} $chunk;
        }
    );
    $bar->update($total_size);
	my $size = format_bytes($filesize, si => 1, precision => 2);
	my $dt = time() - $start;
	my $v = format_bytes($filesize/$dt, si => 1, precision => 2) if $dt;
	print "\ndownloaded $size at $v/s\n" if $dt;
	return $output;
}

###########################################
sub downsync {
###########################################
	my ($folder_id, $local_path, $total_size) = @_;
    mkdir($local_path) unless -e $local_path;
	my $folder_data = list_folder($folder_id);
    for my $item ( @{ $folder_data->{items} } ) {
        if (!($item->{mimeType} eq 'application/vnd.google-apps.folder')){
            my $file_name = $item->{title};
            my $file_path = File::Spec->catfile($local_path, $file_name);
            my $download_url = $item->{downloadUrl};
            print "downloading $file_name\n";
            my $d = get_with_progress($download_url, $file_path, $item->{fileSize});
            $total_size += $d;
		}
        if ($item->{mimeType} eq 'application/vnd.google-apps.folder'){
			my $folder_path = File::Spec->catfile($local_path, $item->{title});
            $total_size = downsync($item->{id}, $folder_path, $total_size) 
		}
	}
    return $total_size
}
	
###########################################
sub delete_obj {
###########################################
    my $obj_id   = shift;
    my $endpoint = "/v2/files/" . $obj_id;
    return apireq( "DELETE", $endpoint );
}

if ( $opt->authorize ) {
    authorize($cfg);
    DumpFile( $cfg_file, $cfg );
    $access_token = $cfg->{access_token};
}

if ( $opt->refresh ) {
    refresh_token($cfg);
    DumpFile( $cfg_file, $cfg );
    $access_token = $cfg->{access_token};
}

# auto-refresh:
my $time_left = $cfg->{expires_at} - time();
if ( $time_left < 60 ) {
    print "refreshing access token\n";
    refresh_token($cfg);
    DumpFile( $cfg_file, $cfg );
    $access_token = $cfg->{access_token};
}

if ( $opt->list ) {
    my $path = $opt->list;
    my ( $found, $node ) = path_to_id( $path, 'root' );
    p($node) if $opt->verbose;
    die("error: path not found") unless $found;
    my $data = list_folder( $node->{id} );
    print "\n";
    for my $item ( sort { lc( $a->{title} ) cmp lc( $b->{title} ) }
        @{ $data->{items} } )
    {
        my $s = " ";
        if ( $opt->show_id ) {
            $s = $item->{'id'} . " ";
        }
        $s .= sprintf( "%-68s", $item->{'title'} );
        if ( $item->{fileSize} ) {
            my $size = sprintf( "%-8s",
                format_bytes( $item->{fileSize}, si => 1, precision => 2 ) );
            $s .= " " . $size;
        }
        print "$s\n";
    }
}

if ( $opt->{tree} ) {
    my ( $f, $node ) = path_to_id( $opt->tree, 'root' );
    die("error path not found") unless $f;
    tree_list( $node->{id}, 0 );
}

if ( $opt->mkfolder ) {
    my ( $ok, $node ) = path_to_id( $opt->parent );
    die("error: parent path not found") unless $ok;
    die("error: parent path is not a folder")
      unless ( $node->{type} eq 'application/vnd.google-apps.folder'
        or $opt->parent eq 'root' );
    my $req = create_folder( $opt->mkfolder, $node->{id} );
    my $js = from_json($req);
    p($js);
}

if ( $opt->download ) {
    my ( $ok, $node ) = path_to_id( $opt->download, 'root' );
    die("error: path not found") unless $ok;
    if ( $node->{type} eq 'application/vnd.google-apps.folder' ) {
		my $start = time();
        my $total_size = downsync($node->{id}, $node->{title}, 0);
		my $nice_size = format_bytes($total_size, si => 1, precision => 2);
		my $dt = time() - $start;
		print "downloaded $nice_size in $dt seconds\n";
    }
	else {
		my $url = $node->{downloadUrl};
		if ( !$url ) {
			print("error: missing download url");
			p($node);
			exit();
		}
		if ( $opt->bar ) {
			get_with_progress( $url, $node->{title}, $node->{fileSize} );
		}
		else {
			print "downloading...\n";
			download_file( $url, $node->{title} );
		}
	}
}

if ( $opt->delete ) {
    my ( $ok, $node ) = path_to_id( $opt->delete, 'root' );
    die("error: path not found") unless $ok;
    if ( $node->{id} eq 'root' ) {
        print("error: we're not going to delete the root itself, are we?");
        exit();
    }
    my $op = delete_obj( $node->{id} );
    p($op);
}

Another one in the "rest" clients series, this time for google drive.
Tested on Win7 with perl 5, version 24, subversion 1 (v5.24.1) built for MSWin32-x64-multi-thread