view release on metacpan or  search on metacpan

t/repos/repoadd.pl  view on Meta::CPAN

	$self;
}

sub addEntry
{
	my($self, $pkg) = @_;

	my $pi = $pkg->info;
	my $name = join q{-}, map { $_->[0] } @{$pi}{qw/name version/};

	my $dir = "$self->{'dir'}/$name";
	if(-d $dir){
		system 'rm' => '-r', "$dir";
		if($?){
			print STDERR "$PROG: failed to unlink dir: $dir\n";
			exit 1;
		}
	}
	mkdir $dir or die "mkdir: $!";

	my %deps;
	for my $dkey (@DepFields){
		$deps{$dkey} = delete $pi->{$dkey} if($pi->{$dkey});
	}
	$self->writeFile("$dir/depends", \%deps);

	$pi->{'filename'} = [ $pkg->fileName ];
	for my $fld (@DescFields){
		$pi->{$fld} = [] unless($pi->{$fld});
	}
	$self->writeFile("$dir/desc", $pi);
}

package main;

sub usage
{
	print STDERR "usage: $PROG [repo dir path] [package path]\n";
	exit 2;
}

sub main
{
	usage() if(@_ != 2);
	my($dbname, $pkgpath) = @_;

	my $dbdir = "$dbname/contents";
	unless(-d $dbdir){
		print STDERR "$PROG: dir named $dbname must exist in current directory\n";
		exit 1;
	}
	unless(-f $pkgpath){
		print STDERR "$PROG: $pkgpath is not a valid path\n";
		exit 1;
	}
	my $db = DBDir->fromPath($dbdir);
	my $pkg = PkgFile->fromPath($pkgpath);
	$db->addEntry($pkg);

	my $dest = "$dbname/" . $pkg->fileName;
	rename $pkgpath, $dest or die "rename: $!";

	return 0;
}

exit main(@ARGV);