#!/usr/bin/perl
use warnings;
use strict;

=head1 NAME

daizu - command line interface to Daizu CMS

=head1 SYNOPSIS

    export DAIZU_CONFIG=/etc/my-daizu-config.xml

    daizu checkout
    daizu update

    daizu update-urls example.com/blog
    daizu update-all-urls

    daizu publish http://example.com/new-file.html
    daizu publish-all http://example.com/

=head1 DESCRIPTION

This program allows you to operate Daizu, getting it to load content
from the Subversion repository (by checking out or updating working
copies), and publish the URLs generated by that content.

A Daizu configuration file is required.  You can specify
where yours is by setting the C<DAIZU_CONFIG> environment variable
to its path.  You can also provide the value in the C<-c> option when
you run C<daizu>.

The following subcommands are available:

=over

=cut

use Getopt::Std qw( getopts );
use DateTime;
use File::Path qw( mkpath );
use Path::Class qw( file );
use Carp::Assert qw( assert DEBUG );
use Daizu;
use Daizu::Wc;
use Daizu::File;
use Daizu::Publish qw( create_publishing_job );
use Daizu::Util qw(
    like_escape
    db_row_exists db_row_id db_select db_insert
    instantiate_generator
    update_all_file_urls
);

my %opt;
getopts('c:r:', \%opt) or usage();
usage() unless @ARGV;
my $command = shift @ARGV;

my %COMMANDS = (
    'load-revision' => \&cmd_load_revision,
    checkout => \&cmd_checkout,
    co => \&cmd_checkout,
    update => \&cmd_update,
    up => \&cmd_update,
    publish => \&cmd_publish,
    #add => \&cmd_add,
    #mkdir => \&cmd_mkdir,
    #replace => \&cmd_replace,
    'update-urls' => \&cmd_update_urls,
    'update-all-urls' => \&cmd_update_all_urls,
    'url-content' => \&cmd_url_content,
    'publish-all' => \&cmd_publish_all,
);

usage() unless exists $COMMANDS{$command};

my $cms = Daizu->new($opt{c});
$COMMANDS{$command}->($cms, \%opt, @ARGV);


=item load-revision

Load new revisions from the content repository, up to the latest revision.
If the C<-r> option is given then it specifies a revision number to
load up to instead.

Revisions are automatically loaded when working copies are checked out and
updated, so you won't normally need to do this.

=cut

sub cmd_load_revision
{
    my ($cms, $opt) = @_;
    my $revnum = $cms->load_revision($opt{r});
    print "Loaded revisions up to r$revnum\n";
}

=item checkout [branch]

Create a new working copy in the database and bring it up to the
latest revision of the content repository, or to the revision specified
by the C<-r> option.

An additional argument can be specified, which should identify a branch
to check out from.  It can be either the path of the branch in the
repository (something like I<branches/redesign>) or the ID number of a
branch in the database.  The default is I<trunk>.

=cut

sub cmd_checkout
{
    my ($cms, $opt, $branch) = @_;
    $branch = 'trunk' unless defined $branch;
    my $wc = Daizu::Wc->checkout($cms, $branch, $opt{r});
    print "Checked out working copy ", $wc->id, "\n";
}

=item update [wc-id]

Bring a working copy up to date with the latest revision, or the revision
specified by the C<-r> option.  If the extra argument is given then
the working copy specified by that ID number is updated (it should be the
C<id> column of the C<working_copy> table).  By default the live working
copy is updated.

=cut

sub cmd_update
{
    my ($cms, $opt, $wc_id) = @_;
    my $wc = Daizu::Wc->new($cms, $wc_id);
    my $new_revnum = $wc->update($opt{r});
    print "Updated working copy ", $wc->id, " to revision $new_revnum\n";
}

=item publish url [wc-id]

Publish the given URL, writing its output however is specified by the
configuration file.  This will fail if there isn't a suitable C<output>
element in the configuration file to specify the document root.

The extra argument gives the ID number of the working copy to get the
content from, and defaults to the live working copy.

=cut

sub cmd_publish
{
    my ($cms, $opt, $url, $wc_id) = @_;
    #create_publishing_job($cms, $opt{r});
    my $db = $cms->db;

    my $wc = Daizu::Wc->new($cms, $wc_id);
    $wc_id = $wc->id;

    my $url_info = $db->selectrow_hashref(q{
        select *
        from url
        where wc_id = ?
          and url = ?
          and status = 'A'
    }, undef, $wc_id, $url);
    die "no url '$url' found\n" unless defined $url_info;
    $url_info = { %$url_info };

    publish_guid_urls($cms, $wc_id, $url_info->{guid_id},
                      $url_info->{generator}, $url_info->{method},
                      [ $url_info ]);
}

# This has never worked. Working copies can't be edited without corrupting them.
sub cmd_add
{
    my ($cms, $opt, $wc_id, $path, $filename) = @_;
    my $data = load_file($filename);

    my $wc = Daizu::Wc->new($cms, $wc_id);
    my $file_id = $wc->add_file($path, \$data);

    print "Saved new file with ID $file_id\n";
}

# This has never worked. Working copies can't be edited without corrupting them.
sub cmd_mkdir
{
    my ($cms, $opt, $wc_id, $path) = @_;

    my $wc = Daizu::Wc->new($cms, $wc_id);
    my $file_id = $wc->add_directory($path);

    print "Created new directory with ID $file_id\n";
}

# This has never worked. Working copies can't be edited without corrupting them.
sub cmd_replace
{
    my ($cms, $opt, $wc_id, $path, $filename) = @_;
    my $data = load_file($filename);

    my $wc = Daizu::Wc->new($cms, $wc_id);

    my $file_id = db_row_id($cms->{db}, 'wc_file', path => $path, is_dir => 0);
    die "$0: file '$path' doesn't exist, or is a directory\n"
        unless defined $file_id;
    $wc->change_file_content($file_id, \$data);

    print "Replaced content for file with ID $file_id\n";
}

=item update-urls path [wc-id]

Generate the URLs for file at the given path.
The resulting URLs are stored
in the database and assumed to have been published, so you'd better actually
publish any new ones straight after doing this.

The extra argument specifies the ID number of the working copy to generate
URLs for, and defaults to the live working copy.

=cut

sub cmd_update_urls
{
    my ($cms, $opt, $path, $wc_id) = @_;

    my $wc = Daizu::Wc->new($cms, $wc_id);
    my $file = $wc->file_at_path($path);
    $file->update_urls_in_db;
}

=item update-all-urls [wc-id]

Same as C<update-urls> above, but generates URLs for all files which
currently exist in the working copy.

Note that currently URLs which are no longer attached to an extant file
will not be marked 'gone' as they should be.  Also note that if this
fails half-way through it may leave the database partially updated.

=cut

sub cmd_update_all_urls
{
    my ($cms, $opt, $wc_id) = @_;
    my $db = $cms->db;

    my $wc = Daizu::Wc->new($cms, $wc_id);
    my ($new_redirects, $new_gone) = update_all_file_urls($cms, $wc->{id});

    if ($new_redirects) {
        my $sth = $db->prepare(q{
            select u.url, r.url
            from url u
            inner join url r on r.id = u.redirect_to_id
            where u.status = 'R'
        });
        $sth->execute;

        my %fh;
        while (my ($src, $target) = $sth->fetchrow_array) {
            # TODO - very inefficient to use output_config every time round.
            my ($config) = $cms->output_config($src);
            $src = URI->new($src);
            my $path = $src->rel($config->{url});
            $path = '/' if $path eq './';
            next if $path eq $src || $path =~ m!^\.\.?/!;
            assert(defined $path && $path ne '') if DEBUG;
            $path = "/$path" unless $path =~ m!^/!;

            my $filename = $config->{redirect_map};
            next unless defined $filename;
            if (!exists $fh{$filename}) {
                open my $fh, '>', $filename
                    or die "Error opening redirect map '$filename': $!\n";
                $fh{$filename} = $fh;
            }

            my $fh = $fh{$filename};
            print $fh "$path\t$target\n";
        }
    }

    if ($new_gone) {
        my $sth = $db->prepare(q{
            select url
            from url
            where status = 'G'
        });
        $sth->execute;

        my %fh;
        while (my ($url) = $sth->fetchrow_array) {
            # TODO - very inefficient to use output_config every time round.
            my ($config) = $cms->output_config($url);
            $url = URI->new($url);
            my $path = $url->rel($config->{url});
            $path = '/' if $path eq './';
            next if $path eq $url || $path =~ m!^\.\.?/!;
            assert(defined $path && $path ne '') if DEBUG;
            $path = "/$path" unless $path =~ m!^/!;

            my $filename = $config->{gone_map};
            next unless defined $filename;
            if (!exists $fh{$filename}) {
                open my $fh, '>', $filename
                    or die "Error opening gone map '$filename': $!\n";
                $fh{$filename} = $fh;
            }

            my $fh = $fh{$filename};
            print $fh "$path\t1\n";
        }
    }
}

=item url-content url [wc-id]

Generate the content for the specified URL, and print it to the standard
output.  Doesn't update the database or publish the content anywhere.

Takes the content from the specified working copy, or the live
working copy by default.

=cut

sub cmd_url_content
{
    my ($cms, $opt, $url, $wc_id) = @_;
    my $db = $cms->db;

    my $wc = Daizu::Wc->new($cms, $wc_id);
    my ($guid_id, $method, $argument, $type, $status, $redir_id) =
        db_select($db,
            url => { wc_id => $wc->id, url => $url },
            qw( guid_id method argument content_type status redirect_to_id ),
        );
    die "$0: URL '$url' does not exist in working copy " . $wc->id . "\n"
        unless defined $guid_id;
    die "$0: URL '$url' previously existed but no longer has content\n"
        if $status eq 'G';
    if ($status eq 'R') {
        my ($redir_url) = db_select($db, url => $redir_id, 'url');
        die "$0: URL '$url' redirects to '$redir_url'\n";
    }

    my ($file_id) = db_row_id($db, 'wc_file',
        wc_id => $wc->id, guid_id => $guid_id,
    );
    die "$0: URL '$url' marked active, but it's content no longer exists\n"
        unless defined $file_id;

    my $file = Daizu::File->new($cms, $file_id);

    my $generator = $file->generator;
    die "$0: URL '$url' has generator 'none', so it shouldn't exist\n"
        unless defined $generator;

    die "$0: generator for '$url' is missing method '$method'\n"
        unless $generator->can($method);
    binmode STDOUT
        or die "error setting binmode on STDOUT: $!";
    $generator->$method($file, [ {
        url => $url,
        method => $method,
        argument => $argument,
        type => $type,
        fh => \*STDOUT,
    } ]);
}

sub publish_guid_urls
{
    my ($cms, $wc_id, $guid_id, $gen_class, $method, $urls) = @_;
    my $db = $cms->db;

    my ($file_id) = db_row_id($db, 'wc_file',
        wc_id => $wc_id, guid_id => $guid_id,
    );
    die "$0: URLs of GUID $guid_id marked active, but file no longer exists\n"
        unless defined $file_id;
    my $file = Daizu::File->new($cms, $file_id);

    # TODO - wrong root file, although it's not clear what the right one is.
    my $generator = instantiate_generator($cms, $gen_class, $file);
    die "$0: generator '$gen_class' is missing method '$method'\n"
        unless $generator->can($method);

    for my $url_info (@$urls) {
        my $out_url = $url_info->{url} = URI->new($url_info->{url});

        my ($config, $docroot, $path, $filename) = $cms->output_config($out_url);
        die "No output path defined for URL '$out_url'\n"
            unless defined $docroot;

        # TODO - open in staging area and move into place after all publication
        # TODO - set mtime to modified_at
        mkpath(file($docroot, $path)->stringify);
        open my $fh, '>', file($docroot, $path, $filename)
            or die "error opening output file '$docroot/$path/$filename': $!";
        binmode $fh
            or die "error setting binmode on output file: $!";
        $url_info->{fh} = $fh;
    }

    $generator->$method($file, $urls);
}

=item publish-all base-url [wc-id]

Generates content for all URLs which start with the base URL given.
For example, if base-url is L<http://www.daizucms.org/> then all of
the URLs on that domain will be generated.  The content is written
to the proper output location as for the C<publish> command.

=cut

sub cmd_publish_all
{
    my ($cms, $opt, $base_url, $wc_id) = @_;
    my $db = $cms->db;

    my $wc = Daizu::Wc->new($cms, $wc_id);
    $wc_id = $wc->id;

    my $sth = $db->prepare(q{
        select *
        from url
        where wc_id = ?
          and url like ?
          and status = 'A'
        order by guid_id, generator, method
    });
    $sth->execute($wc_id, like_escape($base_url) . '%');

    my $cur_guid_id;
    my $cur_generator;
    my $cur_method;
    my @urls;
    while (my $r = $sth->fetchrow_hashref) {
        if (@urls && ($r->{guid_id} != $cur_guid_id ||
                      $r->{generator} ne $cur_generator ||
                      $r->{method} ne $cur_method))
        {
            publish_guid_urls($cms, $wc_id, $cur_guid_id,
                              $cur_generator, $cur_method, \@urls);
            @urls = ();
        }

        $cur_guid_id = $r->{guid_id};
        $cur_generator = $r->{generator};
        $cur_method = $r->{method};
        push @urls, { %$r };
    }

    publish_guid_urls($cms, $wc_id, $cur_guid_id, $cur_generator,
                      $cur_method, \@urls)
        if @urls;
}

sub load_file
{
    my ($filename) = @_;
    return do {
        open my $fh, '<', $filename
            or die "$0: error opening input file '$filename': $!\n";
        binmode $fh;
        local $/;
        <$fh>;
    };
}

sub usage
{
    print STDERR "Usage: $0 [OPTIONS] COMMAND [ARGS...]\n";
    exit 1;
}

=back

=head1 COPYRIGHT

This software is copyright 2006 Geoff Richards E<lt>geoff@laxan.comE<gt>.
For licensing information see this page:

L<http://www.daizucms.org/license/>

=cut

# vi:ts=4 sw=4 expandtab
