view release on metacpan or  search on metacpan

lib/App/Followme/UploadLocal.pm  view on Meta::CPAN

package App::Followme::UploadLocal;

use 5.008005;
use strict;
use warnings;

use lib '../..';

use base qw(App::Followme::ConfiguredObject);

use File::Copy;
use File::Path qw(remove_tree);
use File::Spec::Functions qw(abs2rel splitdir catfile);

our $VERSION = "2.03";

#----------------------------------------------------------------------
# Read the default parameter values

sub parameters {
    my ($pkg) = @_;

    return (
            remote_directory => '',
            permissions => 0644,
           );
}

#----------------------------------------------------------------------
# Add a directory to the remote site

sub add_directory {
    my ($self, $dir) = @_;

    my $new_dir = catfile($self->{remote_directory}, $dir);
    my $status = mkdir($new_dir);

    if ($status) {
        my $permissions = $self->{permissions} | 0111;
        chmod($permissions, $new_dir);
    }

    return $status;
}

#----------------------------------------------------------------------
# Add a file to the remote site

sub add_file {
    my ($self, $local_filename, $remote_filename) = @_;

    my $new_file = catfile($self->{remote_directory}, $remote_filename);
    my $status = copy($local_filename, $new_file);

    chmod($self->{permissions}, $new_file) if $status;
    return $status;
}

#----------------------------------------------------------------------
# Close the connection

sub close {
    my ($self) = @_;
    return;
}

#----------------------------------------------------------------------
# Delete a directory from the remote site

sub delete_directory {
    my ($self, $dir) = @_;

    my $err;
    my $new_dir = catfile($self->{remote_directory}, $dir);
    remove_tree($new_dir, {error => $err});

    my $status = ! ($err && @$err);
    return $status;
}

#----------------------------------------------------------------------
# Delete a file from the remote site

sub delete_file {
    my ($self, $filename) = @_;

    my $new_file = catfile($self->{remote_directory}, $filename);
    my $status = unlink($new_file);

    return $status;
}

#----------------------------------------------------------------------
# Open the connection to the remote site

sub open {
    my ($self, $user, $password) = @_;

    # Check existence of remote directory
    my $found = $self->{remote_directory} && -e $self->{remote_directory};

    die "Could not find remote_directory: $self->{remote_directory}"
        unless $found;

    return;
}

1;
__END__
=encoding utf-8

=head1 NAME

App::Followme::UploadLocal - Upload files through file copy