gorillanest/perl/cgi.pl

#!/usr/bin/env perl

# > perl/cgi.pl
# what the bloody fuck is wrong with you?
# why is there a perl folder???
# its source / scripts at worst, but what the fuck is a perl folder meant to represent?
# you wanted groupping by files types anyways? we already had that, its called extensions!
# you encoded in the name that its cgi, but not what its a cgi for. might as well me just 'pl'
# to encode its perl bro.
# in fact, i think you *should* call it perl/pl
#
# non retarded options:
# * frontend/cgi.pl
# * source/gorillanest.cgi.pl
# * gorillanest-frontend.cgi.pl
# or any combination of the above, because the problem is not "what is the best name",
# but "OH GOD perl/cgi.pl IS RETARDED"

# XXX
# why are we passing around root like a cheap whore?                            because root is where things are (f(x) -> y)        have you considered suicide?
# looking into it, i think we should have a global config object using
# https://metacpan.org/pod/Readonly                                             fuck read only, constants are for faggots           says the nigger who has a "globals are evil phase".
#                                                                                                                                   choose one retard
# i modified the routing heavily, this is how people do it;                     very scary
# pretty clean
# you must also realize that not all routes are necessarily templates,          then they are routed by nginx.                      no you gorilla nigger because of coupling.
# it could be a redirect for example, so the original solution would                                                                you want your server to do a bare minimum
# complicate beyond comprehension                                               ACK.

use strict;
use warnings;
use CGI;
use Template;
use URI::Escape;
use Cwd;
use Data::Dumper;
use Git::Repository;

use lib qw(. ..);
BEGIN {
    # ignores redefinition... and everything else
    open my $stderr, '>&', \*STDERR;
    open STDERR, '>', '/dev/null';
    require 'config.default.pl';
    require 'config.pl' if -f 'config.pl';
    open STDERR, '>&', $stderr;
}

sub info {
    warn join(' ', @_);
}


sub serve_template {
    my $template = Template->new({INCLUDE_PATH => 'template'});
    my ($template_name, $data) = @_;

    $template->process($template_name, $data)
        or info("Template: " . $template->error());
}

# significant dirs only
sub GN::directories {
    my $root = $_[0];
    opendir my $dir, $root or die "$root: $!";
    my @directories;
    my %drop = (
        '.'  => 0,
        '..' => 0,
        );
    foreach (readdir $dir) {
        push(@directories, $_) if (-d join('/', $_[0], $_) && ($drop{$_} // 1));
    }
    closedir $dir;
    return \@directories;
}

# probably should output all repos recursively, currently just outputs list of users
sub GN::index { # /
    my ($root) = @_;
    my %data;

    my @directories = map { my $i = $_; map { join('/', $i, $_) } @{GN::directories(join('/', $root, $i))} } @{GN::directories($root)};
    $data{directories} = \@directories;
    if ($data{directories}) { $data{found} = 1; }

    serve_template("index.tt", \%data);
}

sub GN::user { # /$username/
    my ($root, $username) = @_;

    my %data;
    my @directories = @{GN::directories(join('/', $root, $data{username}))};
    $data{directories} = \@directories;
    if ($data{directories}) { $data{found} = 1; }

    serve_template("index_user.tt", \%data);
}

sub GN::repository { # /$username/$repository
    my ($root, $username, $repository) = @_;

    die 'not implemented';
}

sub GN::cgi {
    my ($data, $routes, $routes_cache) = @_;
	my $cgi = CGI->new;
	my %header = (
		-Content_Type => 'text/html',
		-charset      => 'UTF-8',
		);
	my $method = $ENV{'REQUEST_METHOD'} || '';
	my $uri = $ENV{'REQUEST_URI'} || '/';

    print $cgi->header;
    return if $method eq 'HEAD';

	for my $pattern (keys %$routes) {
		if ($uri =~ $routes_cache->{$pattern}) {
			my $handler = $routes->{$pattern};
			$handler->($uri, $1, $2, $3);
            return;
		}
	}

	serve_template("404.tt", {}); # XXX missing code
}

sub GN::init() {
    my $root = GIT_ROOT;
    my %data = (
        found => 0,
        );
    my %routes = (
        '/'                   => sub { GN::index($root); },
        '/~([\w.]+)'          => sub { GN::user($root, @_) },
        '/~([\w.]+)/([\w.]+)' => sub { GN::repository($root, @_) },
        );
    my %routes_cache = map { $_ => qr{^$_$} } keys %routes;
    return \%data, \%routes, \%routes_cache;
}

sub GN::main() {
    my ($data, $routes, $routes_cache) = GN::init();
    GN::cgi($data, $routes, $routes_cache);
}

GN::main() if !caller;

1;