]> iEval git - app-web-vpkbuilder.git/blob - lib/App/Web/VPKBuilder.pm
Do not create VPK if no vpk program is provided
[app-web-vpkbuilder.git] / lib / App / Web / VPKBuilder.pm
1 package App::Web::VPKBuilder;
2
3 use 5.014000;
4 use strict;
5 use warnings;
6 use parent qw/Plack::Component/;
7 our $VERSION = '0.000_001';
8
9 use File::Find qw/find/;
10 use File::Path qw/remove_tree/;
11 use File::Spec::Functions qw/abs2rel catfile rel2abs/;
12 use File::Temp qw/tempdir/;
13 use IO::Compress::Zip qw/zip ZIP_CM_LZMA/;
14 use sigtrap qw/die normal-signals/;
15
16 use Data::Diver qw/DiveRef/;
17 use File::Slurp qw/write_file/;
18 use HTML::Element;
19 use HTML::TreeBuilder;
20 use Hash::Merge qw/merge/;
21 use List::MoreUtils qw/uniq/;
22 use Plack::Request;
23 use Sort::ByExample qw/sbe/;
24 use YAML qw/LoadFile/;
25
26 sub new {
27 my $self = shift->SUPER::new(@_);
28 $self->{cfg} = {};
29 for (sort <cfg/*>) {
30 my $cfg = LoadFile $_;
31 $self->{cfg} = merge $self->{cfg}, $cfg
32 }
33 $self->{cfg}{vpk_extension} //= 'vpk';
34 $self->{cfg}{sort} = sbe $self->{cfg}{sort_order}, { fallback => sub { shift cmp shift } };
35 $self
36 }
37
38 sub addpkg {
39 my ($pkg, $dir) = @_;
40 return unless $pkg =~ /^[a-zA-Z0-9_-]+$/aa;
41 my @dirs = ($dir);
42 find {
43 postprocess => sub { pop @dirs },
44 wanted => sub {
45 my $dest = catfile @dirs, $_;
46 mkdir $dest if -d;
47 push @dirs, $_ if -d;
48 link $_, $dest if -f;
49 }}, catfile 'pkg', $pkg;
50 }
51
52 sub makepkg {
53 my ($self, @pkgs) = @_;
54 mkdir $self->{cfg}{dir};
55 my $dir = rel2abs tempdir 'workXXXX', DIR => $self->{cfg}{dir};
56 my $dest = catfile $dir, 'pkg';
57 mkdir $dest;
58 push @pkgs, split ',', ($self->{cfg}{pkgs}{$_}{deps} // '') for @pkgs;
59 @pkgs = uniq @pkgs;
60 addpkg $_, $dest for @pkgs;
61 write_file catfile ($dir, 'readme.txt'), $self->{cfg}{readme};
62 my @zip_files = catfile $dir, 'readme.txt';
63 if ($self->{cfg}{vpk}) {
64 system $self->{cfg}{vpk} => $dest;
65 push @zip_files, catfile $dir, "pkg.$self->{cfg}{vpk_extension}"
66 } else {
67 find sub { push @zip_files, $File::Find::name if -f }, 'pkg';
68 }
69 zip \@zip_files, catfile($dir, 'pkg.zip'), FilterName => sub { $_ = abs2rel $_, $dir }, -Level => 1;
70 open my $fh, '<', catfile $dir, 'pkg.zip';
71 remove_tree $dir;
72 [200, ['Content-Type' => 'application/zip', 'Content-Disposition' => 'attachment; filename=pkg.zip'], $fh]
73 }
74
75 sub makelist {
76 my ($self, $elem, $tree, $lvl, $key) = @_;
77 my $name = HTML::Element->new('span', class => 'name');
78 $name->push_content($key);
79 $elem->push_content($name) if defined $key;
80 if (ref $tree eq 'ARRAY') {
81 my $sel = HTML::Element->new('select', name => 'pkg');
82 my $opt = HTML::Element->new('option', value => '');
83 $opt->push_content('None');
84 $sel->push_content($opt);
85 for my $pkg (sort { $a->{name} cmp $b->{name} } values $tree) {
86 my $opt = HTML::Element->new('option', value => $pkg->{pkg}, $pkg->{default} ? (selected => 'selected') : ());
87 $opt->push_content($pkg->{name});
88 $sel->push_content($opt);
89 }
90 $elem->push_content($sel);
91 } else {
92 my $ul = HTML::Element->new('ul');
93 for my $key ($self->{cfg}{sort}->(keys $tree)) {
94 my $li = HTML::Element->new('li', class => "level$lvl");
95 $self->makelist($li, $tree->{$key}, $lvl + 1, $key);
96 $ul->push_content($li);
97 }
98 $elem->push_content($ul);
99 }
100 }
101
102 sub makeindex {
103 my ($self) = @_;
104 my ($pkgs, $tree) = ($self->{cfg}{pkgs}, {});
105 for (keys $pkgs) {
106 my $ref = DiveRef ($tree, split ',', $pkgs->{$_}{path});
107 $$ref = [] unless ref $$ref eq 'ARRAY';
108 push $$ref, {pkg => $_, name => $pkgs->{$_}{name}, default => $pkgs->{$_}{default}};
109 }
110 my $html = HTML::TreeBuilder->new_from_file('index.html');
111 $self->makelist(scalar $html->look_down(id => 'list'), $tree, 1);
112 my $ret = $html->as_HTML('', ' ');
113 utf8::encode($ret);
114 [200, ['Content-Type' => 'text/html;charset=utf-8'], [$ret]]
115 }
116
117 sub call{
118 my ($self, $env) = @_;
119 my $req = Plack::Request->new($env);
120 return $self->makepkg($req->param('pkg')) if $req->path eq '/makepkg';
121 $self->makeindex;
122 }
123
124 1;
125 __END__
126
127 =encoding utf-8
128
129 =head1 NAME
130
131 App::Web::VPKBuilder - Mix & match Source engine game mods
132
133 =head1 SYNOPSIS
134
135 use Plack::Builder;
136 use App::Web::VPKBuilder;
137 builder {
138 enable ...;
139 enable ...;
140 App::Web::VPKBuilder->new->to_app
141 }
142
143 =head1 DESCRIPTION
144
145 App::Web::VPKBuilder is a simple web service for building Source engine game VPK packages. It presents a list of mods sorted into (sub)categories. The user can choose a mod from each category and will get a VPK containing all of the selected packages.
146
147 =head1 CONFIGURATION
148
149 APP::Web::VPKBuilder is configured via YAML files in the F<cfg> directory. The recommended layout is to have an F<options.yml> file with the global options, and one file for each source mod (original mod that may be split into more mods).
150
151 =head2 Global options
152
153 =over
154
155 =item readme
156
157 A string representing the contents of the readme.txt file included with the package.
158
159 =item sort_order
160
161 An array of strings representing the sort order of (sub)categories. (sub)categories appear in this order. (sub)categories that are not listed appear in alphabetical order after those listed.
162
163 =item dir
164
165 A string representing the directory in which the packages are built. Must be on the same filesystem as the package directory (F<pkg/>). Is created if it does not exist (but its parents must exist).
166
167 =item vpk
168
169 A string representing the program that makes a package out of a folder. Must behave like the vpk program included with Source engine games: that is, when called like C<vpk path/to/folder> it should create a file F<path/to/folder.ext>, where C<ext> is given by the next option. If not provided, the folder is included as-is.
170
171 =item vpk_extension
172
173 The extension of a package. Only useful with the C<vpk> option. Defaults to C<vpk>
174
175 =back
176
177 Example:
178
179 ---
180 readme: "Place the .vpk file in your custom directory (<steam root>/SteamApps/common/Team Fortress 2/tf/custom/)"
181 sort_order: [Scout, Soldier, Pyro, Demoman, Heavy, Engineer, Medic, Sniper, Spy, Sounds, Model]
182 dir: work
183 vpk: ./vpk
184 vpk_extension: vpk
185
186 =head2 Mods
187
188 Each source mod is composed of one or more directories (mods) in the F<pkg/> directory and a config file. Each config file should contain a hash named C<pkgs>. For each directory the hash should contain an entry with the directory name as key. Mod directory names may only contain the characters C<a-zA-Z0-9_->.
189
190 Mod options:
191
192 =over
193
194 =item name
195
196 A string representing the (human readable) name of the mod.
197
198 =item path
199
200 A comma-delimited string of the form C<category,subcategory,subcategory,...,item>. There can be any number of subcategories, but the default stylesheet is made for two-element paths (C<category,item>).
201
202 If multiple mods have the same path, the user will be allowed to choose at most one of them.
203
204 =item default
205
206 A boolean which, if true, marks this mod as the default mod for its path.
207
208 =item deps
209
210 A comma-delimited string representing a list of mods that must be included in the final package if this mod is included. The pkgs hash need not contain an entry for the dependencies.
211
212 For example, if two mods share a large part of their contents, then the shared part could be split into a third mod, and both of the original mods should depend on it. This third mod should not be included in the hash, as it shouldn't need to be manually selected by the user.
213
214 =back
215
216 Example:
217
218 ---
219 pkgs:
220 mymod-basher:
221 name: MyMod
222 path: "Scout,Boston Basher"
223 default: true
224 deps: mymod-base
225 mymod-sandman:
226 name: MyMod
227 path: "Scout,Sandman"
228 default: true
229 deps: mymod-base
230
231
232 =head1 TODO
233
234 For 0.001:
235 * Tests
236 * More/Clearer documentation
237 * Nicer user interface
238
239 =head1 AUTHOR
240
241 Marius Gavrilescu, E<lt>marius@ieval.roE<gt>
242
243 =head1 COPYRIGHT AND LICENSE
244
245 Copyright (C) 2014 by Marius Gavrilescu
246
247 This library is free software; you can redistribute it and/or modify
248 it under the same terms as Perl itself, either Perl version 5.18.2 or,
249 at your option, any later version of Perl 5 you may have available.
250
251
252 =cut
This page took 0.103304 seconds and 5 git commands to generate.