App-Web-VPKBuilder

 view release on metacpan or  search on metacpan

index.html  view on Meta::CPAN

<!DOCTYPE html>
<title>VPK Builder</title>
<meta charset="utf-8">
<link rel="stylesheet" href="/static/index.css">

<h1>Select package components</h1>
<form action="/makepkg" method="POST">
<div id="list"></div>
<input type="submit" value="Make package">
</form>

lib/App/Web/VPKBuilder.pm  view on Meta::CPAN

	addpkg $_, $dest for @pkgs;
	write_file catfile ($dir, 'readme.txt'), $self->{cfg}{readme};
	my @zip_files = catfile $dir, 'readme.txt';
	if ($self->{cfg}{vpk}) {
		system $self->{cfg}{vpk} => $dest;
		push @zip_files, catfile $dir, "pkg.$self->{cfg}{vpk_extension}"
	} else {
		find sub { push @zip_files, $File::Find::name if -f }, $dest;
	}
	zip \@zip_files, catfile($dir, 'pkg.zip'), FilterName => sub { $_ = abs2rel $_, $dir }, -Level => 1;
	open my $fh, '<', catfile $dir, 'pkg.zip' or return [500, ['Content-Type' => 'text/plain;charset=utf-8'], ['Error opening pkg.zip']]; ## no critic (RequireBriefOpen)
	remove_tree $dir;
	[200, ['Content-Type' => 'application/zip', 'Content-Disposition' => 'attachment; filename=pkg.zip'], $fh]
}

sub makelist {
	my ($self, $elem, $tree, $lvl, $key) = @_;
	my $name = HTML::Element->new('span', class => 'name');
	$name->push_content($key);
	$elem->push_content($name) if defined $key;
	if (ref $tree eq 'ARRAY') {

lib/App/Web/VPKBuilder.pm  view on Meta::CPAN

	my ($pkgs, $tree) = ($self->{cfg}{pkgs}, {});
	for (keys %$pkgs) {
		my $ref = DiveRef ($tree, split /,/, $pkgs->{$_}{path});
		$$ref = [] unless ref $$ref eq 'ARRAY';
		push @{$$ref}, {pkg => $_, name => $pkgs->{$_}{name}, default => $pkgs->{$_}{default}};
	}
	my $html = HTML::TreeBuilder->new_from_file('index.html');
	$self->makelist(scalar $html->look_down(id => 'list'), $tree, 1);
	my $ret = $html->as_HTML('', ' ');
	utf8::encode($ret);
	[200, ['Content-Type' => 'text/html;charset=utf-8'], [$ret]]
}

sub call{
	my ($self, $env) = @_;
	my $req = Plack::Request->new($env);
	return $self->makepkg($req->param('pkg')) if $req->path eq '/makepkg';
	$self->makeindex;
}

1;



( run in 0.242 second using v1.01-cache-2.11-cpan-4d50c553e7e )