App-Smbxfer
view release on metacpan or search on metacpan
Changes
MANIFEST
Makefile.PL
README
bin/smbxfer
lib/App/Smbxfer.pm
t/00.load.t
t/pod-coverage.t
t/pod.t
t/xfer_essentials.t
t/test_resources/dir_to_upload/d0/t0
t/test_resources/dir_to_upload/d1/t1
t/test_resources/dir_to_upload/d1/d2/t2
t/test_resources/dir_to_upload/d1/d3/t3
t/test_resources/dir_to_upload/d1/d3/d4/t4
META.yml Module meta-data (added by MakeMaker)
lib/App/Smbxfer.pm view on Meta::CPAN
use Exporter;
use Getopt::Long;
use IO::Prompt;
use Filesys::SmbClient;
# Exports...
use base qw( Exporter );
our @EXPORT_OK = qw(
credentials do_smb_transfer parse_smb_spec
create_smb_dir_path create_local_dir_path smb_element_type
smb_upload smb_download
);
__PACKAGE__->run unless caller;
#######
sub usage {
qq{
USAGE
Smbxfer <options> //<server>/<share>[/<path>[/<filename>]] <local-name>
lib/App/Smbxfer.pm view on Meta::CPAN
create_local_dir_path( $local_path, $smb_parent_path );
# postfix destination path with parent dirs we just created from source...
$local_path .= '/' . $smb_parent_path;
}
}
my $rc = 0;
if( $source_is_local ) {
# Transfer: local -> remote...
$rc = smb_upload(
SMB_OBJ => $smb,
SOURCE => $local_path,
SMB_PATH_SPEC => $smb_path_spec,
RECURSIVE => $recursive
);
}
else {
# Transfer: remote -> local...
$rc = smb_download(
SMB_OBJ => $smb,
lib/App/Smbxfer.pm view on Meta::CPAN
}
else {
warn "$src_basename is not a directory or a file...ignoring.\n";
}
return 1;
}
#########################
sub smb_upload {
my %param = @_;
my $smb = $param{SMB_OBJ} or croak "Filesys::SmbClient object required for upload";
my $local_src = $param{SOURCE} or croak "Name of local file or directory required for upload";
my $smb_path_spec = $param{SMB_PATH_SPEC} or croak "SMB path specification of destination required for upload";
my $recursive = $param{RECURSIVE};
my $elem_type = smb_element_type( $smb, $smb_path_spec );
my ($src_basename) = ($local_src =~ m|([^/]*)$| );
if( -d $local_src ) {
# Upload directory...
unless( $recursive ) {
print "Omitting directory $local_src in non-recursive mode.\n";
return;
lib/App/Smbxfer.pm view on Meta::CPAN
$smb->mkdir( $smb_path_spec . '/' . $src_basename, '0666' )
or croak "SMB error: cannot mkdir: $!";
}
opendir( my $local_dir, $local_src )
or croak "cannot opendir: $!";
while ( my $local_dir_elem = readdir( $local_dir ) ) {
next if $local_dir_elem =~ /^\.{1,2}$/; # skip . and ..
smb_upload(
SMB_OBJ => $smb,
SOURCE => $local_src . '/' . $local_dir_elem,
SMB_PATH_SPEC => $smb_path_spec . '/' . $src_basename,
RECURSIVE => 1
);
}
closedir( $local_dir );
}
elsif( -f $local_src ) {
# Upload file...
lib/App/Smbxfer.pm view on Meta::CPAN
do_smb_transfer(
SMB_OBJECT => $smb,
LOCAL_PATH => $local_path,
SMB_PATH_SPEC => $remote_smb_path_spec,
SOURCE_IS_LOCAL => $whether_or_not_source_is_local_path,
RECURSIVE => 1,
CREATE_PARENTS => 1
);
Handles setup for upload/download, then delegates responsibility for file
transfer to the appropriate handler.
=head2 parse_smb_spec
my ($smb_parent_path, $smb_path, $smb_share_spec) =
( parse_smb_spec( $smb_path_spec ) )[2,3,4];
Given a Samba location identifier with optional leading 'smb:', returns a
number of potentially useful pieces of the path (server, share, path name,
basename, etc.).
lib/App/Smbxfer.pm view on Meta::CPAN
smb_download(
SMB_OBJ => $smb,
SMB_PATH_SPEC => $smb_path_spec,
LOCAL_DEST_NAME => $local_path,
RECURSIVE => 0
);
Download a file from a Samba network share to the local filesystem.
=head2 smb_upload
smb_upload(
SMB_OBJ => $smb,
SOURCE => $local_path,
SMB_PATH_SPEC => $smb_path_spec,
RECURSIVE => 1
);
Upload a file from the local filesystem to a Samba network share.
=head1 PROGRAM: USAGE
lib/App/Smbxfer.pm view on Meta::CPAN
=item C<< source OR destination must be in "SMB path spec" format >>
Exactly one of the source and destination must be formatted in "SMB path
specification" format: '//<server>/<share>[/<path>]'
=item C<< Error: local source F< source > is not a file or a directory >>
Only files or directories may be uploaded to a Samba server.
=item C<< Error: SMB source F< source > is not a file or a directory >>
Only files or directories may be downloaded from a Samba server.
=item C<< Error: when transferring a directory source, any existing destination
must also be a directory >>
lib/App/Smbxfer.pm view on Meta::CPAN
structures implies restrictions on the location of the target file).
=item C<< Omitting directory $src_smb_path in non-recursive mode. >>
The --recursive option must be used for directory transfers.
=item C<< F< path > is not a directory or a file...ignoring. >>
Only files or directories can be uploaded or downloaded using smb_upload() or
smb_download().
=item C<< cannot open file: ... >>
Local OS error while trying to open a file.
=item C<< cannot mkdir F< path >: ... >>
t/xfer_essentials.t view on Meta::CPAN
#
# Careful tests of the essentials, namely upload/download...
#
use strict;
use Test::More tests => 9;
use Test::Differences qw( eq_or_diff );
use Filesys::SmbClient;
use IO::Prompt;
use File::Find;
t/xfer_essentials.t view on Meta::CPAN
my $password = prompt( "password? ", -e => '*' );
my $path_file = prompt( "enter the path to any existing file on the share (relative to share root): " );
my $path_dir = prompt( "enter the path to any existing directory on the share (relative to share root): " );
my $smb_share_spec = "smb://$server/$share";
my $smb = Filesys::SmbClient->new(
username => $username, password => $password, workgroup => $domain
);
# name of dir that will be uploaded as a test:
my $local_dirname_to_upload = 'dir_to_upload';
# local relative path to directory containing test resources:
my $local_path_to_test_resources = 't/test_resources';
my $local_path_to_upload = "$local_path_to_test_resources/$local_dirname_to_upload";
# name of temp dir to create at root of SMB share:
my $remote_smbxfer_dirname = 'smbxfer_test';
my $remote_smbxfer_path_spec = $smb_share_spec . '/' . $remote_smbxfer_dirname;
# Make dir for testing...
$smb->mkdir( $remote_smbxfer_path_spec, '0666' )
or die "SMB error: cannot mkdir for testing: $!";
# Future 'die()'s should clean up after tests before really 'die()'ing
$SIG{__DIE__} = sub { cleanup( $smb, $remote_smbxfer_path_spec ); die @_ };
t/xfer_essentials.t view on Meta::CPAN
#
# parse_smb_spec()
#
ok( my ($smb_share_path, $smb_path_spec) = (parse_smb_spec( $smb_share_spec ))[3,5], "parse share spec" );
#
# validated_paths()
#
is( (App::Smbxfer::validated_paths(
SMB => $smb, SOURCE => $local_path_to_upload, DEST =>
"//$server/$share/$remote_smbxfer_dirname", SOURCE_IS_LOCAL => 1
))[1],
"$smb_share_spec/$remote_smbxfer_dirname",
"validated_paths normalizes remote destination as expected"
);
#
# do_smb_transfer() tests...
#
ok(
# Upload a directory recursively...
# ( an smb_upload() test; also tests parent path creation )
do_smb_transfer(
SMB_OBJECT => $smb,
LOCAL_PATH => $local_path_to_upload,
SMB_PATH_SPEC => "$smb_path_spec/$remote_smbxfer_dirname",
SOURCE_IS_LOCAL => 1,
RECURSIVE => 1,
CREATE_PARENTS => 1
),
"test a transfer: upload test dir"
);
my $downloaded_dir = tempdir();
ok(
# Download the same directory recursively to a new location...
# ( an smb_download() test; also tests parent path creation )
do_smb_transfer(
SMB_OBJECT => $smb,
LOCAL_PATH => $downloaded_dir,
SMB_PATH_SPEC =>
"$smb_path_spec/$remote_smbxfer_dirname/$local_path_to_upload",
SOURCE_IS_LOCAL => 0,
RECURSIVE => 1,
CREATE_PARENTS => 1
),
"test a transfer: download test dir to new location"
);
# Check that the upload/download actually worked: diff the dir structure of the
# local source directory we just uploaded and the one we subsequently
# downloaded...
# ...every path in the source directory used for the test upload...
my @uploaded_list;
find(
sub {
return if $_ eq '.';
push @uploaded_list, $File::Find::name;
},
$local_path_to_upload
);
# ...every path in the new directory subsequently downloaded to temp space...
my @downloaded_list;
find(
sub {
return if $_ eq '.';
# Remove leading path of local temporary directory and remote temp dir
# because we want to compare only the part of the path representing
t/xfer_essentials.t view on Meta::CPAN
($File::Find::name =~ m|
.*?
$downloaded_dir/
$remote_smbxfer_dirname/
(.*)
|x);
$path_relative_to_temp =~ s|^/||;
push @downloaded_list, $path_relative_to_temp;
},
"$downloaded_dir/$remote_smbxfer_dirname/$local_path_to_upload"
);
my @uploaded_paths = sort @uploaded_list;
my @downloaded_paths = sort @downloaded_list;
eq_or_diff( \@downloaded_paths, \@uploaded_paths, "uploaded and downloaded dir contents are the same" );
cleanup( $smb, $remote_smbxfer_path_spec );
#~~~~ ((( begin test cleanup ))) ~~~~
sub cleanup {
my ($smb, $path_spec_to_remove) = @_;
# Attempt to remove all data created on SMB share for testing...
if( defined $smb ) {
( run in 1.854 second using v1.01-cache-2.11-cpan-b16cb0d3907 )