view release on metacpan or  search on metacpan

lib/Test/AutoBuild/Lib.pm  view on Meta::CPAN

		foreach (@files) { $_ = File::Spec->catfile($dir, $_) };
		eval {
		    mkpath($new_target);
		};
		if ($@) {
		    die "could not create directory '$new_target': $@";
		}
		my %newoptions = %{$options};
		$newoptions{glob} = 0;
		@files > 0 && _copy (\%newoptions, @files, $new_target);
	    } else {
		my @dir = File::Spec->splitdir($newfile);
		pop @dir;
		my $basedir = File::Spec->catdir(@dir);
		if (!-d $basedir) {
		    eval {
			$log->debug("Creating base $basedir");
			mkpath($basedir);
		    };
		    if ($@) {
			die "could not create directory '$basedir': $@";
		    }
		}

		if (-e $newfile) {
		    $log->debug("unlinking target $newfile which already exists");
		    if ((unlink $newfile) != 1) {
			die "could not unlink target $newfile: $!";
		    }
		}

		if (-f && $options->{'symbolic-link'}){
		    $log->debug("symbolic linking file $_ to $newfile");
		    if (!symlink ($_, $newfile)) {
			die "could not symbolic link to target $newfile: $!";
		    }
		} elsif (-f && $options->{link}){
		    $log->debug("linking file $_ to $newfile");
		    if (!link ($_, $newfile)) {
			# XXX fallback to copy ?
			die "could not hardlink to target $newfile: $!";
		    }
		} else {
		    $log->debug("copying file $_ to $newfile");
		    if (!copy($_, $newfile)) {
		       die "could not copy to target $newfile: $!";
		    }
		    &setStats($newfile, stat($_));
		}
	    }
	}
    }
}

sub setStats {
    my $file = shift;
    my $sb = shift;
    confess "called setStats with an undefined file" unless defined $file;
    confess "called setStats with an undefined sb" unless defined $sb;
    chmod ($sb->mode, $file);
    chown ($sb->uid, $sb->gid, $file);
}

sub delete_files {
    my $dir = shift;

    my $log = Log::Log4perl->get_logger();

    my $glob = catfile($dir, "*");
    $log->info("Removing all files matching '$glob'");

    my @todelete = bsd_glob($glob);
    foreach (@todelete) {
	$log->info("File to remove is '$_'");
    }

    if (@todelete) {
	rmtree(\@todelete, 0, 0);
    }
}

sub _expand_macro {
    my $in = shift;
    my $macro = shift;
    my $name = shift;
    my @values = @_;
    my @out;
    foreach my $entry (@{$in}) {
	my $src = $entry->[0];
	my $dst = $entry->[1];
	if ($dst =~ /$macro/) {
	    foreach my $value (@values) {
		(my $file = $dst) =~ s/$macro/$value/;
		my $vars = {};
		map { $vars->{$_} = $entry->[2]->{$_} } keys %{$entry->[2]};
		$vars->{$name} = $value;
		push @out, [$src, $file, $vars];
	    }
	} else {
	    push @out, $entry;
	}
    }
    return \@out;
}

sub _expand_standard_macros {
    my $in = shift;
    my $runtime = shift;
    my $out = _expand_macro($in, "%m", "module", $runtime->modules);
    $out = _expand_macro($out, "%p", "package_type", $runtime->package_types);
    $out = _expand_macro($out, "%g", "group", $runtime->groups);
    $out = _expand_macro($out, "%r", "repository", $runtime->repositories);
    $out = _expand_macro($out, "%c", "build_counter", $runtime->build_counter);
    $out = _expand_macro($out, "%h", "hostname", hostname());
    return $out;
}

=item ($config, $fh, $error) = Test::AutoBuild::Lib::load_template_config($file, [\%vars])

This method loads the content of the configuration file C<$file>,
passes it through the L<Template> module, and then creates an