The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl
use 5.012000;
use warnings;
use autodie;

use Cwd qw(abs_path);
use DBIx::RunSQL;
use Email::Valid;
use File::Basename qw(dirname basename);
use File::Copy::Recursive;
use File::Find::Rule;
use File::Path qw(mkpath);
use File::Spec;
use File::ShareDir;
use Getopt::Long qw(GetOptions);
use Pod::Usage  qw(pod2usage);
use String::Random;

use Dwimmer::Tools qw(sha1_base64 save_page _get_db);

my %opt;
GetOptions(\%opt,
    'email=s',
    'password=s',
    'root=s',
    'dbonly',
    'silent',
    'share=s',

    'setup',
    'upgrade',

    'username=s',

    'resetpw',
    'listusers',
    'showuser',
    'verify=s',
);
usage() if not $opt{root};

if ($opt{setup}) {
    if (-e $opt{root} and not $opt{dbonly}) {
        die "Root directory ($opt{root}) already exists"
    }

    usage() if not $opt{email};
    die 'Invalid e-mail' if not Email::Valid->address($opt{email});
    usage() if not $opt{password};
    die 'Password needs to be at least 6 characters' if length $opt{password} < 6;
} else {
    if (not -e $opt{root}) {
        die "Root directory ($opt{root}) does NOT exist.";
    }
}


if ($opt{resetpw}) {
    if (not $opt{password}) {
        die "Need password to set it";
    }
    if (not $opt{username}) {
        die "Need username to reset password";
    }

    $ENV{DWIMMER_ROOT} = $opt{root};
    my $db = _get_db();
    my $sha1 = sha1_base64( $opt{password} );
    my $user = $db->resultset('User')->find( { name => $opt{username} } );
    die "User was not found" if not $user;
    $user->sha1($sha1);
    $user->update;

    exit;
}

if (defined $opt{verify}) {
    die if $opt{verify} ne '0' and $opt{verify} ne '1';
    if (not -e $opt{root}) {
        die "Root directory ($opt{root}) does NOT exist.";
    }
    if (not $opt{username}) {
        die "Need username to verify";
    }

    $ENV{DWIMMER_ROOT} = $opt{root};
    my $db = _get_db();
    my $user = $db->resultset('User')->find( { name => $opt{username} } );
    die "User was not found" if not $user;
    $user->verified( $opt{verify} );
    $user->update;

    exit;
}

if ($opt{listusers}) {
    $ENV{DWIMMER_ROOT} = $opt{root};
    my $db = _get_db();
    my @users = $db->resultset('User')->all();
    die "No user was found" if not @users;
    foreach my $u (@users) {
        printf("%4s  '%s'\n", $u->id, $u->name);
    }

    exit;
}

if ($opt{showuser}) {
    if (not $opt{username}) {
        die "Need username to ";
    }

    $ENV{DWIMMER_ROOT} = $opt{root};
    my $db = _get_db();
    my $user = $db->resultset('User')->find( { name => $opt{username} } );
    die "User was not found" if not $user;
    foreach my $key (qw(id name email fname lname country state validation_key verified register_ts)) {
        say "$key " . ($user->$key // '');
    }

    exit;
}


if (not $opt{upgrade} and not $opt{setup}) {
    usage();
}




# When we are in the development environment (have .git) set this to the root directory
# When we are in the installation environment (have Makefile.PL) set this to the share/ subdirectory
my $dist_dir;
if (-e File::Spec->catdir(dirname(dirname abs_path($0)) , '.git') ) {
    $dist_dir = dirname(dirname abs_path($0))
} elsif (-e File::Spec->catdir(dirname(dirname abs_path($0)) , 'Makefile.PL') ) {
    $dist_dir = File::Spec->catdir( dirname(dirname abs_path($0)), 'share' );
} else {
    $dist_dir = File::ShareDir::dist_dir('Dwimmer');
}
# die $dist_dir;

my $db_dir = File::Spec->catdir($opt{root}, 'db');
mkpath $db_dir if not -e $db_dir;

if (not $opt{dbonly}) {
    foreach my $dir (qw(views public bin environments)) {
        my $from = File::Spec->catdir( $dist_dir, $dir );
        my $to   = File::Spec->catdir( $opt{root}, $dir );
		print "dircopy $from $to\n";
		chmod 0644, File::Find::Rule->file()->in($to) if -d $to;
        File::Copy::Recursive::dircopy( $from, $to ) or die $!;
    }
	my $from = File::Spec->catdir( $dist_dir, 'config.yml');
    my $to   = File::Spec->catdir( $opt{root} );
	print "fcopy $from $to\n";
	chmod 0644, File::Find::Rule->file()->in($to) if -d $to;
    File::Copy::Recursive::fcopy( $from, $to ) or die $!;
}

# backup the database
if ($opt{upgrade}) {
    my $db_dir = File::Spec->catdir($opt{root}, 'db');
    my $dbfile = File::Spec->catfile( $db_dir, 'dwimmer.db' );
    my $time = time;
    if (-e $dbfile) {
        File::Copy::Recursive::fcopy($dbfile, "$dbfile.$time");
    }
}

my $dbfile = File::Spec->catfile( $db_dir, 'dwimmer.db' );
if (not $opt{upgrade}) {
    setup_db($dbfile);
}

my @upgrade_from;

foreach my $sql ( glob File::Spec->catfile($dist_dir, 'schema', '*.sql' ) ) {
	next if basename($sql) !~ m{^\d+\.sql$};
	push @upgrade_from, sub {
	    my $dbfile = shift;

	    DBIx::RunSQL->create(
	        dsn => "dbi:SQLite:dbname=$dbfile",
	        sql => $sql,
	        verbose => 0,
	    );
	};
}

upgrades($dbfile);

say 'You can now launch the application and visit the web site';

exit;
##################################################################

sub setup_db {
    my $dbfile = shift;

    die "Database file '$dbfile' already exists\n" if -e $dbfile;

    # 0
    my $sql = File::Spec->catfile($dist_dir, 'schema', 'dwimmer.sql');
    DBIx::RunSQL->create(
        dsn => "dbi:SQLite:dbname=$dbfile",
        sql => $sql,
        verbose => 0,
    );

    my $dbh = DBI->connect("dbi:SQLite:dbname=$dbfile");
    my $time = time;
    my $validation_key = String::Random->new->randregex('[a-zA-Z0-9]{10}') . $time . String::Random->new->randregex('[a-zA-Z0-9]{10}');
    $dbh->do('INSERT INTO user (name, sha1, email, validation_key, verified, register_ts) VALUES(?, ?, ?, ?, ?, ?)',
        {},
        'admin', sha1_base64($opt{password}), $opt{email}, $validation_key, 1, $time);

    $Dwimmer::Tools::dbfile = $dbfile;

    my $site = 1;
    $dbh->do("INSERT INTO site (name, owner) VALUES ('www', 1)");
    save_page($site, {
            create       => 1,
            editor_title => 'Welcome to your Dwimmer installation',
            editor_body  => '<h1>Dwimmer</h1>',
            author       => 1,
            filename     => '/',
    });


    return if $opt{silent};

    say 'Database created.';

    return;
}

sub upgrades {
    my $dbfile = shift;
    my $dbh = DBI->connect("dbi:SQLite:dbname=$dbfile");

    my ($version) = $dbh->selectrow_array('PRAGMA user_version');
    foreach my $v ($version .. @upgrade_from-1) {
        $upgrade_from[$v]->($dbfile);
    }
}



sub usage {
    pod2usage();
}

=head1 SYNOPSIS

=head2 Required parameter:

   --root    PATH/TO/ROOT    path to the root of the installation

=head2 To setup a new instance:

   --setup
   --email email        of administrator
   --password PASSWORD  of administrator

Optional parameters:

   --dbonly             Create only the database (for development)
   --silent             no success report (for testing)

=head2 To upgrade run:

   --upgrade


=head2 Admin tools:

=over 4

=item * List users:

   --listusers

=item * Show details of a user:

   --showuser
   --username USERNAME    
   
=item * Set or remove verified bit of a user:

   --verify [0|1]
   --username USERNAME

=item * Set the password of a specific user:

   --resetpw
   --username USERNAME
   --password PASSWORD

=back

=cut