view Lib/Deployment/Batch/CopyFile.pm @ 94:79bf75223afe

Fixed security related bugs
author wizard
date Thu, 29 Apr 2010 01:31:27 +0400
parents 16ada169ca75
children 76515373dac0
line wrap: on
line source

use strict;
package Deployment::Batch;
our %Dirs;
package Deployment::Batch::CopyFile;
use base qw(Deployment::Batch::Generic);
use File::Copy;
require URI::file;
use Common;

BEGIN {
    DeclareProperty Src => ACCESS_READ;
    DeclareProperty Dst => ACCESS_READ;
}

sub CTOR {
    my ($this,$src,$dest,$Dir) = @_;

    $src or die "Source file name is required";
    $dest or die "Destination file name is reqiured";
                       
    my $uriSrc = URI::file->new($src)->abs($this->Context->{PackageDir});

    my $uriDest = URI::file->new($dest);
    
    $uriDest = $uriDest->abs(
        ($Dir and $Dirs{$Dir}) ?
            $Dirs{$Dir} :
            $this->Context->{PackageDir}
    );

    $this->{$Src} = $uriSrc->file;
    $this->{$Dst} = $uriDest->file;
}

sub Run {
    my ($this) = @_;

    $this->Log("Copy '$this->{$Src}' to '$this->{$Dst}'");

    Deployment::Batch->Backup( File => $this->{$Dst} );
    
    copy($this->{$Src},$this->{$Dst}) or die "copy failed: $!";
}

1;