#!/usr/bin/perl

use strict;
use warnings;

use DBI;
use File::Glob qw(bsd_glob);
use String::Expando;

sub usage;
sub warning;
sub fatal;

(my $prog = $0) =~ s{.*/}{};

$ENV{'PATH'} = "$ENV{'PATH'}:/site/bin";

my $root = '/var/local/omeka-s';
my $release_url_format = "https://github.com/omeka/omeka-s/releases/download/v%(version)/omeka-s-%(version).zip";
my $module_url_format = "https://github.com/omeka-s-modules/%(name)/releases/download/v%(version)/%(name)-v%(version).zip";
my $expando = String::Expando->new;

chdir $root or fatal "chdir $root: $!";

@ARGV = qw(status) if !@ARGV;
my $cmd = shift @ARGV;
&{ __PACKAGE__->can('cmd_'.$cmd) || usage };

# --- Command handlers

sub cmd_new {
    # Create a new instance
    usage if @ARGV != 2;
    my ($inst, $version) = @ARGV;
    fatal "instance $inst version $version already exists"
        if -e "instances/$inst-$version"
        || -e "instances/$inst"
        || -e $inst;

    # Unzip the appropriate release
    my $zip = "releases/omeka-s-$version.zip";
    if (!-e $zip) {
        my $url = $expando->expand($release_url_format, {'version' => $version});
        # my $url = sprintf($release_url_format, $version, $version);
        system('wget', '-O', $zip, $url) == 0
            or fatal "wget: $!";
    }
    -d 'tmp' or mkdir 'tmp' or fatal "mkdir tmp: $!";
    my $tmpdir = "tmp/build.$inst";
    fatal "clean up after previous build before proceeding: $tmpdir"
        if -e $tmpdir;
    mkdir $tmpdir or fatal "mkdir $tmpdir: $!";
    system('unzip', '-d' => $tmpdir, "releases/omeka-s-$version.zip") == 0
        or fatal "unzip $!";
    my @contents = bsd_glob("$tmpdir/*");
    if (@contents == 1 && -d $contents[0]) {
        # ZIP file contents (files that make up the release) are rooted in a single directory
        $tmpdir = $contents[0];
    }
    elsif (@contents > 1) {
        # ZIP file contents are the files that make up the release
    }
    else {
        fatal "unzip failed to put contents of $zip into $tmpdir";
    }

    # Create the database and user
    my $dbuser = $inst . '_omeka_s';
    my $dbpasswd = new_user_password();
    my $dbname = $inst . '_omeka_s';
    dbrun(
        dbh('information_schema'),
        "CREATE USER $dbuser\@localhost IDENTIFIED BY '$dbpasswd'",
        "GRANT USAGE ON *.* TO $dbuser\@localhost",
        "GRANT SELECT, INSERT, UPDATE, DELETE, CREATE, REFERENCES, INDEX, ALTER, EXECUTE ON \`${dbname}\`.* to $dbuser\@localhost",
        "CREATE DATABASE $dbname",
    );

    # Put the files in place
    my ($uid, $gid);
    foreach my $login (qw(apache apache2 www-data httpd)) {
        my ($name, $passwd);
        ($name, $passwd, $uid, $gid) = getpwnam($login);
        last if defined $uid;
    }
    fatal "can't determine UID for web server"
        if !defined $uid;
    chown $uid, $gid, map { "$tmpdir/$_" }
        qw(files logs logs/application.log logs/sql.log);

    # Write DB config file
    open my $fh, '>', "$tmpdir/config/database.ini"
        or fatal "open $tmpdir/config/database.ini: $!";
    print $fh <<EOS;
user     = $dbuser
password = $dbpasswd
dbname   = $dbuser
host     = localhost
EOS

    # Activate instance
    rename $tmpdir, "instances/$inst-$version"
        or fatal "rename $tmpdir releases/omeka-s-$version: $!";
    symlink "$inst-$version", "instances/$inst"
        or fatal "symlink instances/$inst-$version instances/$inst: $!";
    symlink "instances/$inst", $inst
        or fatal "symlink instances/$inst $inst: $!";
    print STDERR "instance $inst created: version $version\n";
}

sub cmd_instances {
    my $instances = instances();
    foreach my $i (sort keys %$instances) {
        printf "%-6s %s\n", $i, $instances->{$i}{'version'};
    }
}

sub cmd_version {
    usage if @ARGV != 1;
    my ($i) = @ARGV;
    my $instances = instances();
    my $instance = $instances->{$i}
        or fatal "no such instance: $i";
    print $instance->{'version'}, "\n";
}

sub cmd_modules {
    usage if @ARGV > 1;
    my %module = modules(@ARGV);
    if (!%module) {
        print STDERR "No modules installed or downloaded\n";
        exit 0;
    }
    printf "%-20.20s %-10.10s %s\n", qw(Name Version Installed);
    foreach my $name (sort keys %module) {
        my $module = $module{$name};
        foreach my $version (sort keys %$module) {
            my @installed = grep { $_ ne '-'} sort keys %{ $module->{$version} };
            printf "%-20.20s %-10.10s %s\n", $name, $version//'?', join(' ', @installed);
        }
    }
}

sub cmd_install {
    if (@ARGV > 2 && $ARGV[0] =~ /^(module|theme)$/) {
        shift @ARGV;
        goto &{ __PACKAGE__->can('cmd_install_'.$1) || fatal "not implemented: install $1" };
    }
    else {
        usage;
    }
}

sub cmd_install_module {
    usage if @ARGV < 2 || @ARGV > 3;
    my ($inst, $name, $version) = @ARGV;
    fatal "no such instance: $inst" if !-e "instances/$inst";
    my $zip;
    my $zip_versioned = "modules/$name-$version.zip";
    my $zip_unversioned = "modules/$name.zip";
    if (defined $version) {
        if (-e $zip_versioned) {
            $zip = $zip_versioned;
        }
        elsif (-e $zip_unversioned) {
            $zip = $zip_unversioned;
            warning "unversioned zip file $zip";
        }
        else {
            my $url = $expando->expand($module_url_format, {'name' => $name, 'version' => $version});
            # my $url = sprintf($module_url_format, xxx);
            system('wget', '-O', $zip, $url) == 0
                or fatal "wget: $!";
            fatal "module download failed to produce file: $name -> ?? $zip"
                if ! -e $zip;
        }
    }
    else {
        my @zips = glob("modules/$name-*.zip");
        if (@zips == 1) {
            ($zip) = @zips;
            $zip =~ m{.+/$name-(.+)\.zip$};
            print STDERR "installing version $1 of $name\n";
        }
        elsif (@zips > 1) {
            fatal "multiple versions found; please specify one";
        }
        elsif (-e "modules/$name.zip") {
            $zip = "modules/$name.zip";
            print STDERR "oman: warning: unversioned zip file $zip\n";
        }
        else {
            fatal "no such module: $name";
        }
    }
    if (defined $zip) {
        if (-e "instances/$inst/modules/$name") {
            fatal "module $name is already installed";
        }
        system('unzip', '-qq', $zip, '-d', "instances/$inst/modules") == 0
            or fatal "can't unzip $zip to instances/$inst/modules: $!";
    }
}

# --- Other functions

sub dbh {
    my ($dbname, $dbuser, $dbpasswd) = @_;
    my $dbh = DBI->connect("DBI:mysql:database=$dbname", $dbuser, $dbpasswd);
    $dbh->{RaiseError} = 1;
    $dbh->{AutoCommit} = 1;
    return $dbh;
}

sub dbrun {
    my $dbh = shift;
    $dbh->begin_work;
    foreach my $sql (@_) {
        my @params;
        ($sql, @params) = @$sql if ref($sql) eq 'ARRAY';
        my $sth = $dbh->prepare($sql);
        $sth->execute;
    }
    $dbh->commit;
}

sub test {
    my $dbh = dbh('information_schema');
    my $sth = $dbh->prepare('SELECT count(*) FROM TABLES');
    $sth->execute;
    my ($n) = $sth->fetchrow_array;
    print $n, "\n";
}

sub new_user_password {
    my @parts;
    open my $fh, '-|', 'shuffle', '/usr/share/dict/words';
    while (<$fh>) {
        next if !/^[a-z]{5,}$/;
        chomp;
        push @parts, $_;
        return join('', @parts) if @parts == 3;
    }
}

sub instances {
    my %instance;
    my @d = grep { -l $_ } glob('instances/*');
    foreach (@d) {
        my $iv = readlink($_) or next;
        $iv =~ /^(.+)-([^-]+)$/ or next;
        my ($i, $v) = ($1, $2);
        $instance{$i} = {
            'version' => $v,
        };
    }
    return wantarray ? keys %instance : \%instance;
}

sub modules {
    my ($i) = @_;
    $i = '*' if !@_;
    my @ini = glob("instances/$i/modules/*/config/module.ini");
    return if !@ini;
    my %module;
    foreach my $f (@ini) {
        my (undef, $inst, undef, $mod) = split m{/}, $f;
        next if !-l "instances/$inst";
        open my $fh, '<', $f or fatal "open $f: $!";
        my %hash;
        my $hash = \%hash;
        while (<$fh>) {
            next if /^\s*(?:#.*)?$/;  # Skip blank lines and comments
            chomp;
            $hash = $hash{trim($1)} ||= {}, next
                if /^\[(.+)\]$/;
            $hash->{normkey($1)} = normval($2), next
                if /^([^=]+)=(.*)$/;
            fatal "unrecognized line in $f: $_";
        }
        my $version = $hash{'info'}{'version'} || '?';
        $module{$mod}{$version}{$inst} = \%hash;
    }
    foreach (glob('modules/*-*.zip')) {
        m{modules/(.+)-(.+)\.zip$}
            or next;
        $module{$1}{$2}{'-'} = { 'info' => {'version' => $2} };
    }
    return wantarray ? %module : \%module;
}

sub trim {
    local $_ = shift;
    s/^\s+|\s+$//g;
    return $_;
}

sub normkey {
    local $_ = trim(lc shift);
    tr/_/-/;
    return $_;
}

sub normval {
    local $_ = trim(shift);
    if (s/^(["'])//) {
        fatal "misquoted value: $_" if !s/$1$//;
    }
    return $_;
}

sub usage {
    print STDERR <<"EOS";
usage: $prog CMD [ARG...]
commands:
  new INSTANCE VERSION                        create a new instance
  instances                                   list instances
  version INSTANCE                            print an instance's version
  modules [INSTANCE]                          list installed modules
  install module INSTANCE MODULE [VERSION]    install a module in an instance
EOS
    exit 1;
}

sub warning {
    print STDERR "$prog: warning: @_\n";
}

sub fatal {
    print STDERR "$prog: @_\n";
    exit 2;
}