view release on metacpan or  search on metacpan

lib/Conjury/Core.pm  view on Meta::CPAN

	for my $d (@$directory) {
		unless (-d $d) {
			my $output = "Directory $d not present";
			cast_error $output unless $if_present;
			cast_warning $output if $verbose;
			next;
		}

		$d = abs_path($d);
		my $c = $Context_By_Directory{$d};
		$c = Conjury::Core::Context->new(Directory => $d) if (!defined($c));

		if (defined($c)) {
			my @deferred_spells = eval {
				fetch_spells Context => $c, @fetch_args;
			};

			if ($@) {
				cast_warning "Problem deferring spells to $d ...";
				die $@;
			}

			push @spells, @deferred_spells;
		}
	}

	return Conjury::Core::Spell->new(Factors => \@spells);
}

=pod

=item filecopy

$spell = filecopy
   (Journal => I<journal>,
    Factors => [ I<spell1>, I<spell2>, ... ],
    Directory => F<directory>,
    File => [ F<file1>, F<file2>, ... ],  # array or scalar is okay
    Permission => I<permission>,
    Owner => [ I<user>, I<group> ];

Creates a spell object that copies a file or a list of files to a directory.

The 'File' argument is required and must specify a filename or a list of
filenames.  The 'Directory' argument is required and must specify the
destination directory for the copy action.

Use the optional 'Factors' argument to add spells explicitly to the list of
factors.  If there are already spells that produce the files in the 'File'
list, they need not be listed here.  They will be fetched and automatically
appended to the factors list.

Use the optional 'Journal' argument to specify a journal object for the spell.

Use the optional 'Permission' argument to specify that the C<chmod> builtin
should be used to set the access permissions associated with the files after
they have been copied to the destination.  The syntax requirements for 
C<chmod> apply.

Use the optional 'Owner' argument to specify that the C<chown> builtin should
be used to set the user and group ownership after the files have been copied to
the destination.  The syntax requirements for C<chown> apply.

=cut

sub filecopy {
	my %arg = @_;
	my $error = $prototype{_filecopy_f()}->validate(\%arg);
	croak _filecopy_f, "-- $error" if $error;

	my $journal = $arg{Journal};
	my $directory = $arg{Directory};
	my $file_arg = $arg{File};
	my $permission = $arg{Permission};
	my $owner = $arg{Owner};
	my $factors_ref = $arg{Factors};

	my $files = (!ref $file_arg) ? [ $file_arg ] : $file_arg;

	$permission = oct $permission
	  if (defined($permission) && $permission =~ /\A0\d+\Z/);

	my @factors = (defined $factors_ref) ? @$factors_ref : ();

	my $verbose = exists $Option{'verbose'};
	my $preview = exists $Option{'preview'};

	my @product = map File::Spec->catfile($directory, basename($_)), @$files;
	my $file_str = join(' ', @$files);
	my $product_str = join(' ', @product);

	my $profile = _filecopy_f;
	$profile .= " $directory $file_str";
	$profile .= " permission $permission" if defined($permission);
	$profile .= " owner $owner->[0] $owner->[1]" if defined($owner);

	if ($verbose) {
		print _filecopy_f, "--\n";
		print "  File => [", (join ',', (map "'$_'", @$files)), "]\n";
		print "  Directory => ", $directory, "\n";
		print "  Permission => $permission\n" if defined($permission);
		print "  Owner => ['$owner->[0]','$owner->[2]']\n" if defined($owner);
	}

	my $action = sub {
		use File::Copy qw();

		my $result;
		for (my $i = 0; $i < @$files; ++$i) {
			print "syscopy $files->[$i] $product[$i]\n";
			if (!$preview) {
				File::Copy::syscopy($files->[$i], $product[$i])
				  || do { return $! };
			}
		}

		if (defined($permission)) {
			my $valstr = sprintf "%o", $permission;
			print "chmod $valstr $product_str\n";

		    if (!$preview) {
				chmod($permission, @product) == @product
				  || do {
					  my $result = $!;
					  unlink @product;
					  return $result;
				  };
			}
		}

		if (defined($owner)) {
			my ($user, $group) = @$owner;
			my ($name, $pass);
			
			unless ($user =~ /\A\d+\Z/) {
				($name, $pass, $user) = getpwnam($user);
			}

			unless ($group =~ /\A\d+\Z/) {
				($name, $pass, $group) = getgrnam($group);
			}

			print "chown $owner->[0] $owner->[1] $product_str\n";

			if (!$preview) {
				chown($user, $group, @product) == @product
				  || do {
					  my $result = $!;
					  unlink @product;
					  return $result;
				  };
			}
		}

		return $result;
	};
	
	push @factors, @$files;

	return Conjury::Core::Spell->new
	  (Product => \@product,
	   Factors => \@factors,
	   Profile => $profile,
	   Action => $action,
	   Journal => $journal);
}

=pod

=item dispell

$spell = dispell
   (Journal => I<journal>,
    Factors => [ I<spell1>, I<spell2>, ... ],
    Directory => [ F<directory1>, F<directory2>, ...] # array or scalar okay
    File => [ F<file1>, F<file2>, ... ],  # array or scalar okay
    Require => 1;

Creates a spell object that erases files or lists of files in a directory.

One or both of the arguments, 'File' and 'Directory', are required.  The 'File'
argument specifies a filename or a list of filenames to unlink with the
'unlink' builtin function.  The 'Directory' argument specifies a directory or a
list of directories to remove with the 'rmdir' builtin.

The 'Require' argument is optional.  If it is set, then the files and
directories to be unlinked or removed are required to exist when the action is
executed to erase them.

Use the optional 'Factors' argument to add spells explicitly to the list of
factors.

Use the optional 'Journal' argument to specify a journal object for the spell.

=cut

sub dispell {
	my %arg = @_;
	my $error = $prototype{_dispell_f()}->validate(\%arg);
	croak _dispell_f, "-- $error" if $error;

	my $journal = $arg{Journal};
	my $factors_ref = $arg{Factors};
	my @factors = (defined $factors_ref) ? @$factors_ref : ();
	my $file_arg = $arg{File};
	my $directory_arg = $arg{Directory};