File Coverage

blib/lib/CopyTree/VendorProof.pm

Criterion	Covered	Total	%
statement	45	132	34.0
branch	9	58	15.5
condition	1	12	8.3
subroutine	10	15	66.6
pod	10	10	100.0
total	75	227	33.0

package CopyTree::VendorProof;

use 5.008000;
use strict;
use warnings;



# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.

# This allows declaration	use CopyTree::VendorProof ':all';
# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
# will save memory.

our $VERSION = '0.0013';

use Carp();
use Data::Dumper;
# Preloaded methods go here.

sub new{
	my $class = shift;

	bless  {source =>{}, destination =>{}}, $class;

}
sub reset{
	my $inst=shift;
	$inst->{'source'}={};
	$inst ->{'destination'} = {};
	return $inst;

}
sub src {
	my $self_inst = shift;
	Carp::croak ("src can only be used by a VendorProof instance\n") if (! ref $self_inst eq 'CopyTree::VendorProof');
		my $path = shift;
		my $cp_inst =shift; #IMPORTANT: objects cannot be hash keys or it will be sringified
		$self_inst -> {'source'}{$path}= $cp_inst;
	return $self_inst;
}


sub dst {
	my $self_inst = shift;
	Carp::croak ("dst can only be used by a VendorProof instance\n") if (! ref $self_inst eq 'CopyTree::VendorProof');
	my @keys = keys %{$self_inst ->{'destination'}};
	if (@_){

		my $path = shift;
		my $cp_inst =shift; #IMPORTANT: objects cannot be hash keys or it will be sringified
		if (@keys){#  We cannot use  $self_inst ->{'destination'} , since even if it's an empty hash ref, it is defined.
			Carp::croak ("you cannot have more than one destination. Previous destination is [".
					#$self_inst ->{'destination'}{$keys[0]}. "]");
					$keys[0]. "]");
		}
		#$keys[0]=$cp_inst;
		$keys[0]=$path;
		$self_inst -> {'destination'}{$keys[0]}=$cp_inst;
	}
	#returns the inst and the path
	#else { return ($keys[0], $self_inst ->{'destination'}{$keys[0]}) }
	else {
		if ($keys[0]){

			if ($keys[0] ne ''){
				return ($keys[0], $self_inst ->{'destination'}{$keys[0]});
			}
			else {Carp::croak("dest file is defined as '' (nothing)")}
		}
		else {Carp::croak("dest file is not defined.")}

	}

}
sub cp{
	my $inst=shift;
	my ($destpath, $destinst) = $inst ->dst;
	if (!$destpath or ! ref $destinst){
		Carp::croak("no valid destination instance\n");#dest path error is handled in $inst->dst
	}
	my $desttype = $destinst->is_fd ($destpath) ;
	#sanity check first, see if dest is a file and we have multi source or source that is dir
	my $totsrc =keys %{ $inst ->{'source'} };

	if($totsrc >1 and $desttype eq 'f'){
		Carp::croak("multi source and/or dir source cannot go into a file\n");
	}
	my @srcpaths = keys %{ $inst ->{'source'} };
	Carp::croak("you don't have a source") if (! @srcpaths);

	for my $srcpath (@srcpaths ){
		my $srcinst = $inst ->{'source'} ->{$srcpath};
		my $srctype = $srcinst -> is_fd($srcpath);
		#############D to D copy###############
		if ($srctype eq 'd'){
			if ($desttype ne 'd'){
				Carp::croak("you cannot copy a dir [$srcpath] into a non / non-existing dir [$destpath]\n");
			}
			my $srcbasedir = $srcpath;
			$srcbasedir =~s/.+\///; #takes last dirname, no parent
#			print $srcbasedir. "\n";
			my $srctree_no_srcdir =$srcinst->ls_tree($srcpath);
			$destinst-> cust_mkdir("$destpath/$srcbasedir"); #creates source dir under dest dir
			my ($files, $dirs) = $destinst ->ls_tree_fdret("", $srctree_no_srcdir);
		#	print Dumper $files; #/dwsfolder/new folder/1anovaSigNoMTC.with anno.csv',
		#	print Dumper $dirs; #'/dwsfolder/new folder',
			$destinst ->cust_mkdir("$destpath/$srcbasedir$_") for @$dirs;
			$inst ->copy_meth_deci($srcinst, $destinst, $srcpath, "$destpath/$srcbasedir", $_) for @$files;

		} #end if $srctype eq 'd'
		##############F to F / D copy#############
		elsif ($srctype eq 'f'){
			#file to file copy, file exists, overwrite with destpath.
			if ($desttype eq 'f' or $desttype eq 'pd'){
				print ("overwriting $destpath with $srcpath \n") if ($desttype eq 'f');
				$inst ->copy_meth_deci($srcinst, $destinst, $srcpath, $destpath,'' );

			}
			#file to dir copy, create source's basename under dest
			elsif ($desttype eq 'd'){
				my $source_no_parent = $srcpath;
				$source_no_parent =~s/.+\///; #deletes dir part of path, leaving only filename
				$inst-> copy_meth_deci($srcinst, $destinst, $srcpath, "$destpath/$source_no_parent", '');
			}

			else {
				Carp::carp ("destination type unclear [$desttype] for $destpath\n");
			}

		}
		else{
			Carp::carp ("source file [$srcpath] does not exist\n");
		}

	} #for my $srcinst

}
#evaluates source inst and dest inst, if same, use local copy meths, if diff, use remote copy meths
#this reduces network traffic
sub copy_meth_deci{
	my $cp_inst =shift;
	my $srcinst=shift;
	my $destinst=shift;
	my $srcpath=shift;
	my $destpath_basedir=shift;
	my $filefromfiles=shift;
	if ((ref $destinst) ne (ref $srcinst)){
		$destinst ->write_from_memory($srcinst ->read_into_memory("$srcpath$filefromfiles") , "$destpath_basedir$filefromfiles");
	}
		#reduces network traffic
	else{
		$destinst->copy_local_files("$srcpath$filefromfiles", "$destpath_basedir$filefromfiles");
	}

}

sub ls_tree{
	my $class_inst = shift;
	my $fullpath = shift; #this path is the full path

	my ($files,$dirs) = $class_inst->fdls( 'fdarrayrefs', $fullpath); #returns full path
	my %structure;

#starts inf loop of recursive case
	if( @$dirs) {
		for (@$dirs){
			my $itemfullpath= $_;
			s/^\Q$fullpath\E\/?// ;# $_ now carries no root path, and does not start with a slash
			$structure{$_}=$class_inst->ls_tree($itemfullpath);
		}
	#DO NOT return, otherwise @$files will be omitted in the first level
	}
#base case of no dirs under existing:
	#DO NOT use else, becuase even with @$dirs, we still need to populate @$files
	#if else is accidentally used, it only returns files at the last level
	for (@$files){
		s/^\Q$fullpath\E\/?// ;
		$structure {$_} =undef;
	}
	return \%structure;

}
sub path{
	my $inst =shift;
	my $path =shift;
	if ($path and $path ne ''){ #and is lower precedence than &&
		$inst ->{'path'} =$path;
		return $inst;
	}
	elsif ($inst ->{'path'} ne ''){
		return $inst ->{'path'};
	}
	else {Carp::croak("you must set a path through \$inst ->SUPER::path('someplace/something') to use this\n")}
}
sub fdls_ret{
	my $inst = shift;
	my $lsoption =shift;
	my ($files, $dirs)=@_;
	my @results;
	if ($lsoption eq 'f'){
		return @$files;
	}
	elsif ($lsoption eq 'd'){
		return @$dirs;
	}
	elsif ($lsoption eq 'fdarrayrefs'){
		return ($files, $dirs);
	}
	elsif ($lsoption eq ''){
		push @results, @$files if (@$files);
		push @results, @$dirs if (@$dirs);
		return @results;
	}
	else {Carp::croak("wrong options: 'f', 'd', 'fdarrayrefs' allowable for lsoption\n")}

}
sub ls_tree_fdret{
	my $inst = shift;
	Carp::croak("ls_tree_fdret item must be an instance, not a class\n") unless (ref $inst);
	my $inst_root_path =shift;
	my $hashref = shift;
	my $files=shift; #this is only for the recursive action. no need for first call
	my $dirs=shift;#this is only for the recursive action. no need for first call
	$files =[] if (!ref $files);
	$dirs =[] if (!ref $dirs);

		$inst_root_path =~s/\/$//; #removes trailing slashes, if any
		for (keys %$hashref){
			if (ref $hashref->{$_}){
#			  print "$_ is dir, gonna push $inst_root_path/$_\n";
				push @$dirs, "$inst_root_path/$_";
				#since we pass refs into the recursive structure, updates to $files and $dirs are automatically reflected
				my ($newfiles, $newdirs)= $inst->ls_tree_fdret("$inst_root_path/$_", $hashref->{$_}, $files, $dirs);
			}
			else{
#			  print "$_ is file, gonna push $inst_root_path/$_\n";
				push @$files, "$inst_root_path/$_";

			}
		}#end for keys hashref
		return ($files, $dirs);

}



# Autoload methods go after =cut, and are processed by the autosplit program.

1;
__END__