File Coverage

blib/lib/CPAN/Repo/Server.pm

Criterion	Covered	Total	%
statement	6	7	85.7
branch			n/a
condition			n/a
subroutine	2	3	66.6
pod	0	1	0.0
total	8	11	72.7

package CPAN::Repo::Server;
use CPAN::Repo;
use Dancer ':syntax';
our $REPO_ROOT;

get '/' => sub { # home page
    set content_type => 'text/html';
    my $ret = 'list of available repos';
    my @l;
    for my $i (<$REPO_ROOT/*>){
     next unless -d $i;
     s/.*\/// for $i;
     push @l, $i
    }
    $ret.=''.( join "\n", map  {"$_"} @l ).''.signature();
    return $ret;

};

get '/list/$' => sub { # list of repos (a-la rest api, called from in CPAN::Repo pluggins)
    set content_type => 'text/plain';
    # template 'index';
    my @l;
    for my $i (<$REPO_ROOT/*>){
     next unless -d $i;
     s/.*\/// for $i;
     push @l, $i
    }
    return join "\n", @l;

};

get qr{/(\S+)/packages\.txt} => sub { # repo packages.txt
    set content_type => 'text/plain';
    my ($path) =  splat;
    my $ret;
    for my $p (split /\//, $path ){
	$ret.="# $p repository\n";
	if(open F, "$REPO_ROOT/$p/packages.txt"){
	 while (my $l = ){
	  $ret.="~$p/$l";
	 }; close F;
	}
	$ret.="\n";
    }
    return $ret;
};

get qr{^/repo/(\w+)/$} => sub { # repo index page
    set content_type => 'text/html';
    my ($cs_id) =  splat;
    my $ret = "$cs_id\n";
    $ret.="packages.txt\n";
    for my $d (<$REPO_ROOT/$cs_id/*.gz>){
      (my $l = $d)=~s/.*\/(.*)/$1/;
      $ret.="$l\n";
    }
    $ret.=signature();
    return $ret;
};

get qr{/.*/~(\w+)/(.*\.tar\.gz)} => sub { # distros

    my ($cs_id,$distro) =  splat;
    redirect "$cs_id/$distro"
};

sub signature {
 return "\n\ncpan repo server version $CPAN::Repo::VERSION\n\n";
}

1;