#!/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__