Skip to content

Instantly share code, notes, and snippets.

@jacoby jacoby/dropbox_copy.pl

Last active Sep 19, 2019
Embed
What would you like to do?
Download Dropbox directories to places where you don't have Dropbox
#!/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<jacoby.david@gmail.com>
=cut
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.