Download Dropbox directories to places where you don't have Dropbox

dropbox_copy.pl

#!/home/djacoby/webserver/perl/bin/perl

# This program is used to download a Dropbox directory onto a machine
# without Dropbox tools installed

use strict;
use warnings;
use utf8;
use feature qw{ postderef say signatures state };
no warnings qw{ experimental::postderef experimental::signatures };

use Carp;
use IO::File;
use JSON;
use Getopt::Long;
use Pod::Usage;
use WebService::Dropbox;
use YAML qw{LoadFile};
use File::Path qw{make_path};

my $json    = JSON->new->canonical->pretty;
my $config  = config();
my $dropbox = WebService::Dropbox->new( { key => $config->{key}, } );

# Authorization
if ( $config->{token} ) {
    $dropbox->access_token( $config->{token} );
}
else {
    my $url = $dropbox->authorize;

    print "Please Access URL and press Enter: $url\n";
    print "Please Input Code: ";
    chomp( my $code = <STDIN> );
    unless ( $dropbox->token($code) ) {
        die $dropbox->error;
    }
    print "Successfully authorized.\nYour AccessToken: ",
        $dropbox->access_token, "\n";
}

if ( $config->{directory} ) {
    my $remote = '/' . $config->{directory};
    get_dir( $remote, $dropbox );
}

exit;

# get_dir() takes $remote, the directory to be copied,
# and a WebService::Dropbox object. I am on an anti-globals
# kick but otherwise would've kept that and just passed $remote

sub get_dir ( $remote, $dropbox ) {
    my $local = join '', $ENV{HOME}, '/Dropbox', $remote;
    if ( !-d $local ) { make_path($local) }
    my $result = $dropbox->list_folder($remote);
    for my $e ( $result->{entries}->@* ) {

        # if it's a folder/directory, recurse
        if ( $e->{'.tag'} eq 'folder' ) {
            my $next = $e->{path_display};
            get_dir( $next, $dropbox );
        }

        # if it's a file, we download it
        if ( $e->{'.tag'} eq 'file' ) {
            my $file = $e->{path_display};
            get_file( $file, $dropbox );
        }
    }
}

# get_file() takes $remote, the file to be copied, and a
# WebService::Dropbox object

sub get_file ( $remote, $dropbox ) {
    my $local    = join '', $ENV{HOME}, '/Dropbox', $remote;
    my $fh       = IO::File->new( $local, '>' );
    my $response = $dropbox->download( $remote, $fh );

    # say $json->encode($response);
}

# one-stop shop to get the Dropbox configuration and the flags.

sub config () {
    my $config_file = $ENV{HOME} . '/.dropbox.yml';
    croak 'No Config' unless -f $config_file;
    my $config = LoadFile($config_file);
    $config->{download} = 0;
    $config->{upload}   = 0;
    GetOptions(
        'help'        => \$config->{help},
        'man'         => \$config->{man},
        'directory=s' => \$config->{directory},
    );

    pod2usage( -verbose => 2, -exitval => 1 ) if $config->{man};
    pod2usage( -verbose => 1, -exitval => 1 ) if $config->{help};
    pod2usage( -verbose => 1, -exitval => 1 )
        unless $config->{directory} =~ /\w/;
    delete $config->{help};
    delete $config->{man};
    return $config;
}

exit;

=head1 NAME

dropbox_copy.pl - Download a directory from Dropbox

=head1 SYNOPSIS

	dropbox_copy.pl -d 'Images'

=head1 DESCRIPTION

This program copies whole directories from Dropbox

=head1 OPTIONS

=over 4

=item B<-d>, B<--directory>

The name of the directory to be copied.

=item B<-h>, B<--help>

Short-form user documentation

=item B<-m>, B<--manual>

Long-form user documentation

=back

=head1 LICENSE

This is released under the Artistic 
License. See L<perlartistic>.

=head1 AUTHOR

Dave Jacoby L<[email protected]>

=cut