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::Basename qw/fileparse/;
  10 use File::Find qw/find/;
  11 use File::Path qw/remove_tree/;
  12 use File::Spec::Functions qw/catfile rel2abs/;
  13 use File::Temp qw/tempdir/;
  14 use IO::Compress::Zip qw/zip ZIP_CM_LZMA/;
  15 use sigtrap qw/die normal-signals/;
  16
  17 use Data::Diver qw/DiveRef/;
  18 use File::Slurp qw/write_file/;
  19 use HTML::Element;
  20 use HTML::TreeBuilder;
  21 use Hash::Merge qw/merge/;
  22 use List::MoreUtils qw/uniq/;
  23 use Plack::Request;
  24 use Sort::ByExample qw/sbe/;
  25 use YAML qw/LoadFile/;
  26
  27 sub new {
  28         my $self = shift->SUPER::new(@_);
  29         $self->{cfg} = {};
  30         for (sort <cfg/*>) {
  31                 my $cfg = LoadFile $_;
  32                 $self->{cfg} = merge $self->{cfg}, $cfg
  33         }
  34         $self->{cfg}{vpk}           //= 'vpk';
  35         $self->{cfg}{vpk_extension} //= 'vpk';
  36         $self->{cfg}{sort} = sbe $self->{cfg}{sort_order}, { fallback => sub { shift cmp shift } };
  37         $self
  38 }
  39
  40 sub addpkg {
  41         my ($pkg, $dir) = @_;
  42         return unless $pkg =~ /^[a-zA-Z0-9_-]+$/aa;
  43         my @dirs = ($dir);
  44         find {
  45                 postprocess => sub { pop @dirs },
  46                 wanted => sub {
  47                         my $dest = catfile @dirs, $_;
  48                         mkdir $dest if -d;
  49                         push @dirs, $_ if -d;
  50                         link $_, $dest if -f;
  51         }}, catfile 'pkg', $pkg;
  52 }
  53
  54 sub makepkg {
  55         my ($self, @pkgs) = @_;
  56         mkdir $self->{cfg}{dir};
  57         my $dir = rel2abs tempdir 'workXXXX', DIR => $self->{cfg}{dir};
  58         my $dest = catfile $dir, 'pkg';
  59         mkdir $dest;
  60         push @pkgs, split ',', ($self->{cfg}{pkgs}{$_}{deps} // '') for @pkgs;
  61         @pkgs = uniq @pkgs;
  62         addpkg $_, $dest for @pkgs;
  63         system $self->{cfg}{vpk} => $dest;
  64         write_file catfile ($dir, 'readme.txt'), $self->{cfg}{readme};
  65         zip [catfile($dir, "pkg.$self->{cfg}{vpk_extension}"), catfile($dir, 'readme.txt')], catfile($dir, 'pkg.zip'), FilterName => sub { $_ = fileparse $_ }, -Level => 1;
  66         open my $fh, '<', catfile $dir, 'pkg.zip';
  67         remove_tree $dir;
  68         [200, ['Content-Type' => 'application/zip', 'Content-Disposition' => 'attachment; filename=pkg.zip'], $fh]
  69 }
  70
  71 sub makelist {
  72         my ($self, $elem, $tree, $lvl, $key) = @_;
  73         my $name = HTML::Element->new('span', class => 'name');
  74         $name->push_content($key);
  75         $elem->push_content($name) if defined $key;
  76         if (ref $tree eq 'ARRAY') {
  77                 my $sel = HTML::Element->new('select', name => 'pkg');
  78                 my $opt = HTML::Element->new('option', value => '');
  79                 $opt->push_content('None');
  80                 $sel->push_content($opt);
  81                 for my $pkg (sort { $a->{name} cmp $b->{name} } values $tree) {
  82                         my $opt = HTML::Element->new('option', value => $pkg->{pkg}, $pkg->{default} ? (selected => 'selected') : ());
  83                         $opt->push_content($pkg->{name});
  84                         $sel->push_content($opt);
  85                 }
  86                 $elem->push_content($sel);
  87         } else {
  88                 my $ul = HTML::Element->new('ul');
  89                 for my $key ($self->{cfg}{sort}->(keys $tree)) {
  90                         my $li = HTML::Element->new('li', class => "level$lvl");
  91                         $self->makelist($li, $tree->{$key}, $lvl + 1, $key);
  92                         $ul->push_content($li);
  93                 }
  94                 $elem->push_content($ul);
  95         }
  96 }
  97
  98 sub makeindex {
  99         my ($self) = @_;
 100         my ($pkgs, $tree) = ($self->{cfg}{pkgs}, {});
 101         for (keys $pkgs) {
 102                 my $ref = DiveRef ($tree, split ',', $pkgs->{$_}{path});
 103                 $$ref = [] unless ref $$ref eq 'ARRAY';
 104                 push $$ref, {pkg => $_, name => $pkgs->{$_}{name}, default => $pkgs->{$_}{default}};
 105         }
 106         my $html = HTML::TreeBuilder->new_from_file('index.html');
 107         $self->makelist(scalar $html->look_down(id => 'list'), $tree, 1);
 108         my $ret = $html->as_HTML('', ' ');
 109         utf8::encode($ret);
 110         [200, ['Content-Type' => 'text/html;charset=utf-8'], [$ret]]
 111 }
 112
 113 sub call{
 114         my ($self, $env) = @_;
 115         my $req = Plack::Request->new($env);
 116         return $self->makepkg($req->param('pkg')) if $req->path eq '/makepkg';
 117         $self->makeindex;
 118 }
 119
 120 1;
 121 __END__
 122
 123 =encoding utf-8
 124
 125 =head1 NAME
 126
 127 App::Web::VPKBuilder - Mix & match Source engine game mods
 128
 129 =head1 SYNOPSIS
 130
 131   use Plack::Builder;
 132   use App::Web::VPKBuilder;
 133   builder {
 134     enable ...;
 135     enable ...;
 136     App::Web::VPKBuilder->new->to_app
 137   }
 138
 139 =head1 DESCRIPTION
 140
 141 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.
 142
 143 =head1 CONFIGURATION
 144
 145 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).
 146
 147 =head2 Global options
 148
 149 =over
 150
 151 =item readme
 152
 153 A string representing the contents of the readme.txt file included with the package.
 154
 155 =item sort_order
 156
 157 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.
 158
 159 =item dir
 160
 161 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).
 162
 163 =item vpk
 164
 165 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. Defaults to 'vpk' (requires a script named vpk in the PATH).
 166
 167 =item vpk_extension
 168
 169 The extension of a package. Defaults to C<vpk>
 170
 171 =back
 172
 173 Example:
 174
 175   ---
 176   readme: "Place the .vpk file in your custom directory (<steam root>/SteamApps/common/Team Fortress 2/tf/custom/)"
 177   sort_order: [Scout, Soldier, Pyro, Demoman, Heavy, Engineer, Medic, Sniper, Spy, Sounds, Model]
 178   dir: work
 179   vpk: ./vpk
 180   vpk_extension: vpk
 181
 182 =head2 Mods
 183
 184 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_->.
 185
 186 Mod options:
 187
 188 =over
 189
 190 =item name
 191
 192 A string representing the (human readable) name of the mod.
 193
 194 =item path
 195
 196 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>).
 197
 198 If multiple mods have the same path, the user will be allowed to choose at most one of them.
 199
 200 =item default
 201
 202 A boolean which, if true, marks this mod as the default mod for its path.
 203
 204 =item deps
 205
 206 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.
 207
 208 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.
 209
 210 =back
 211
 212 Example:
 213
 214   ---
 215   pkgs:
 216     mymod-basher:
 217       name: MyMod
 218       path: "Scout,Boston Basher"
 219       default: true
 220       deps: mymod-base
 221     mymod-sandman:
 222       name: MyMod
 223       path: "Scout,Sandman"
 224       default: true
 225       deps: mymod-base
 226
 227
 228 =head1 TODO
 229
 230 For 0.001:
 231 * Tests
 232 * More/Clearer documentation
 233 * Nicer user interface
 234
 235 =head1 AUTHOR
 236
 237 Marius Gavrilescu, E<lt>marius@ieval.roE<gt>
 238
 239 =head1 COPYRIGHT AND LICENSE
 240
 241 Copyright (C) 2014 by Marius Gavrilescu
 242
 243 This library is free software; you can redistribute it and/or modify
 244 it under the same terms as Perl itself, either Perl version 5.18.2 or,
 245 at your option, any later version of Perl 5 you may have available.
 246
 247
 248 =cut