view release on metacpan or  search on metacpan

lib/Dist/Banshee/Mint.pm  view on Meta::CPAN

sub _copy_files {
	my ($from_dir, $to_dir) = @_;
	mkdir $to_dir if not -d $to_dir;
	for my $entry (read_dir($from_dir)) {
		my $from = catfile($from_dir, $entry);
		if (-f $from) {
			copy($from, catfile($to_dir, $entry)) or die "Could not copy";
		}
		elsif (-d $from) {
			_copy_files(catdir($from_dir, $entry), catdir($to_dir, $entry));
		}
	}
}

sub instantiate_profile {
	my ($profile_name, $dist_name) = @_;

	my $source_dir = _find_profile($profile_name);

	my $inherit_file = catfile($source_dir, 'inherit');
	if (-f $inherit_file) {
		for my $ancestor (read_lines($inherit_file)) {
			instantiate_profile($ancestor, $dist_name);
		}
	}

	mkdir $dist_name;
	_copy_files(catdir($source_dir, 'skeleton'), $dist_name);

	my $module_template = catdir($source_dir, 'Template.pm');
	if (-f $module_template) {
		(my $module = $dist_name) =~ s/-/::/g;
		my @parts = split /-/, $dist_name;
		my $module_name = join '::', @parts;
		my $body = read_text($module_template);
		$body =~ s/%MODULE%/$module/g;
		my $module_file = catfile($dist_name, 'lib', @parts) . '.pm';
		mkpath(dirname($module_file));
		write_text($module_file, $body);
	}
	return;

}

sub transact_update(&) {
	my $function = shift;

	my $success = eval {
		mkdir '.banshee-update';
		$function->();
		rmtree('.banshee');
		rename '.banshee-update', '.banshee';
		1;
	} or do {
		rmdir '.banshee-update';
		die $@;
	}
}

sub update_script {
	my ($skeleton_name, $script_name) = @_;

	my $source_dir = catfile(_find_profile($skeleton_name), 'skeleton', '.banshee');

	my $source = catfile($source_dir, $script_name);
	my $sink = catfile('.banshee-update', $script_name);
	my $patch = catfile('.banshee', $script_name . '.patch');
	if ($patch && -f $patch) {
		my $text = read_text($source);
		my $patch = read_text($patch);
		my $output = patch($text, $patch, { STYLE => 'Unified' });
		write_text($sink, $output);
	}
	else {
		copy($source, $sink) or die "Couldn't copy $script_name from $skeleton_name";
	}

	return;
}

sub update_patch {
	my ($skeleton_name, $script_name) = @_;

	my $source_dir = catfile(_find_profile($skeleton_name), 'skeleton', '.banshee');

	my $source = catfile('.banshee', $script_name);
	my $sink = catfile($source_dir, $script_name);
	my $diff = diff($sink, $source, { STYLE => 'Unified' });
	my $patch = "$source.patch";

	if (length $diff) {
		write_text($patch, $diff);
	}
	elsif (-f $patch) {
		unlink $patch or die "Couldn't remove patch $patch";
	}
	return;
}

sub keep_file {
	my $name = shift;
	my $source = catfile('.banshee', $name);
	my $sink = catfile('.banshee-update', $name);
	copy($source, $sink) or die "Couldn't keep $name";
	return;
}

sub keep_patches {
	keep_file($_) for grep { /\.patch$/ } read_dir('.banshee');
	return;
}

sub keep_config {
	keep_file($_) for grep { /\.json$/ } read_dir('.banshee');
	return;
}

1;