The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl -s

use strict;
use warnings;
use Cwd 'abs_path';
use File::Copy;
use File::Basename;
use File::Path qw.make_path.;
use MIME::Base64;
use Digest::MD5 'md5_hex';
use ExtUtils::MakeMaker;
use Pod::Simple::Search;
use Pod::Simple::XHTML;
use DBI;

our ($force, $email);

my $path = shift;
unless ($path) {
	print "\nUsage: quiki_create <path>\n\n",
		"Create new Quiki instance in <path>, see Quiki documentation for more info.\n";
	exit;
}

if (!-d $path) {
    my $ans = prompt "The directory '$path' does not exists. Should I create it?", "yes";
    if ($ans eq "yes") {
        make_path($path);
    }
    else {
        die "Directory does not exists.\n"
    }
}

print "Creating files:\n";
create_files_from_data($path);
create_html_files();

print "Creating user database... ";
if (!-f "$path/data/users.sqlite") {
    $email or $email = prompt "\n  Enter wiki administrator email address: ";
    my $dbh = DBI->connect("dbi:SQLite:dbname=$path/data/users.sqlite","","");
    $dbh->do("CREATE TABLE auth (username PRIMARY KEY, password, email, perm_group);");

    my $sth = $dbh->prepare("INSERT INTO auth VALUES (?, ?, ?, ?);");
    $sth->execute("admin", md5_hex("admin"), $email, 'admin');
    print "done.\n";
} else {
    my (@ccols, @row);
    my $dbh = DBI->connect("dbi:SQLite:dbname=$path/data/users.sqlite","","");

    my $sth = $dbh->prepare("PRAGMA table_info(auth)");
    $sth->execute;
    while (@row = $sth->fetchrow_array) {
        push @ccols, $row[1];
    }

    unless (grep { $_ eq "perm_group" } @ccols) {
        $dbh->do("ALTER TABLE auth ADD COLUMN perm_group;");
        $dbh->do("UPDATE auth SET perm_group = 'admin' WHERE username == 'admin';");
        $dbh->do("UPDATE auth SET perm_group = 'user'  WHERE username != 'admin';");
    }
    print "upgraded.\n";
}


print "Setting up permissions... ";
chmod 0755, "$path/quiki.cgi";
chmod 07777, "$path/data/"; # +t u+s g+s
chmod 0777, "$path/data/content";
chmod 0777, "$path/data/content/index";
chmod 0777, "$path/data/users.sqlite";

my @dirs = qw.locks meta revs attach.;
for my $d (@dirs) {
    (!-d "$path/data/$d")  and mkdir "$path/data/$d";
    chmod 0777, "$path/data/$d";
}

print "done.\n";

if (!-f "$path/data/quiki_id") {
    print "Generating Quiki identification... ";
    my $rand = int(rand(100000));
    open FH, ">$path/data/quiki_id" or die;
    print FH $rand;
    close FH;
    print "done.\n";
}

sub create_files_from_data {
    my $path = shift;
    my $file = undef;
    my $base64 = "";
    my $mode = undef;
    while(<DATA>) {
        if (/^(!!|)----(.+)----(BIN|)\n$/) {
            if ($file) {
                if ($mode) {
                    $mode = undef;
                    binmode $file;
                    print {$file} decode_base64($base64);
                    $base64 = undef;
                }
                print " created.\n";
                close $file;
            }
            my $f = $2;
            if ($force || !-f "$path/$f" || $1) {
                print " - $f...";
                my $folder = dirname(abs_path($path) . "/$f");
                (!-d $folder) && (make_path($folder));
                open $file, ">$path/$f" or die $!;

                $mode = "BIN" if ($3 eq "BIN");
            }
            else {
                print " - $f... skipped.\n";
                $file = undef;
            }
        }
        elsif ($file) {
            if ($mode) {
                $base64.=$_;
            }
            else {
                print {$file} $_;
            }
        }
    }
    if ($file) {
        if ($mode) {
            $mode = undef;
            binmode $file;
            print {$file} decode_base64($base64);
            $base64 = undef;
        }
        print " created.\n";
        close $file;
    }
}


sub create_html_files {
    my $doc = Pod::Simple::Search->new->find('Quiki::Syntax');
    my $parser = Pod::Simple::XHTML->new();
    mkdir "$path/help";
    open HELP, ">$path/help/syntax.html" or die;
    $parser->output_fh(*HELP);
    $parser->parse_file($doc);
    close HELP;
    print " - help/syntax.html... created.\n";
}

=encoding UTF-8

=head1 NAME

quiki_create.pl - Deploys a Quiki!

=head1 SYNOPSIS

  quiki_create.pl /path/to/your/new/quiki/apache/dir

=head1 DESCRIPTION

Creates the needed files for a Quiki installation.

=head1 SEE ALSO

Quiki

=head1 AUTHOR

Alberto Simões, E<lt>ambs@cpan.orgE<gt>
Nuno Carvalho, E<lt>smash@cpan.orgE<gt>


=head1 COPYRIGHT & LICENSE

Copyright 2009-2010 Alberto Simoes and Nuno Carvalho.

This program is free software; you can redistribute it and/or modify it
under the terms of either: the GNU General Public License as published
by the Free Software Foundation; or the Artistic License.

See http://dev.perl.org/licenses/ for more information.

=cut


__DATA__