#!/usr/bin/perl -w
use strict;

=head1 NAME

bric_republish - republishes stories automatically

=head1 SYNOPSIS

bric_republish [options]

    --help     - shows this screen

    --man      - shows the full documentation

    --verbose  - print a running description to STDERR.  Add a second
                --verbose and you'll get debugging output too.  Without
                this option bric_republish is silent when successful.

    --server   - specifies the Bricolage server URL, defaults to
                the BRICOLAGE_SERVER environment variable if set,
                http://localhost otherwise.

    --username - the Bricolage username, defaults to the BRICOLAGE_USERNAME
                environment variable if set.

    --password - the password for the Bricolage user.  Default to the
                BRICOLAGE_PASSWORD environment variable if set.

    --story-id - specify a single story to publish

    --no-media - don't publish related media with story.  By default all
                related media are published with each story.

    --element  - only publish stories of this element (story type)

    --category - only publish stories in this category, specified by path

    --published-only - Deprecated; kept for backwards compatibility; Only
                the published version of all stories will be published.

    --chunks   - publish stories in chunks of this many.  Defaults to 0,
                which means to process them all at once.  This option can
                be used to avoid timing out on large jobs.

    --timeout  - specify the HTTP timeout for SOAP requests in seconds.
                Defaults to 30.

=head1 DESCRIPTION

This program publishes stories with no user interaction required. It looks up
and publishes the last published version of published stories (publish_status
is 1). This is useful to automatically update stories after element and
template changes. Also, some elements may have automated functionality that
benefits from being republished periodically - a "new stories" box on a Cover,
for example.

=head1 EXAMPLES

The most common use of this program will be from cron.  Setup a
crontab like this to republish all stories hourly:

    BRICOLAGE_USERNAME=admin
    BRICOLAGE_PASSWORD=admin_pass
    PATH=/usr/local/bricolage/bin:$PATH
    MAILTO=your-email@your-domain.com
    0 * * * * bric_republish

Or to republish Covers hourly and everything else once a day at 11:30

    BRICOLAGE_USERNAME=admin
    BRICOLAGE_PASSWORD=admin_pass
    PATH=/usr/local/bricolage/bin:$PATH
    MAILTO=your-email@your-domain.com
    0  *  * * * bric_republish --element Cover
    30 11 * * * bric_republish

Or to republish all stories every other hour but never republish media:

    BRICOLAGE_USERNAME=admin
    BRICOLAGE_PASSWORD=admin_pass
    PATH=/usr/local/bricolage/bin:$PATH
    MAILTO=your-email@your-domain.com
    0 */2 * * * bric_republish --no-media

=head1 AUTHOR

Sam Tregar <stregar@about-inc.com>

=head1 SEE ALSO

L<Bric::SOAP>

=cut

use Getopt::Long;
use Pod::Usage;
use Term::ReadPassword;

BEGIN {
    # get parameters from command line.  do this during compile so
    # $VERBOSE can effect use options and such.  also so errors get
    # detected as quick as possible - people are waiting out there!
    our $username        = $ENV{BRICOLAGE_USERNAME};
    our $password        = $ENV{BRICOLAGE_PASSWORD} || '';
    our $server          = $ENV{BRICOLAGE_SERVER} || 'http://localhost';
    our $VERBOSE         = 0;
    our $no_media        = 0;
    our $timeout         = 30;
    our $chunks          = 0;
    our ($element, $story_id, $category, $help, $man);
    GetOptions("help"            => \$help,
               "man"             => \$man,
               "verbose+"        => \$VERBOSE,
               "username=s"      => \$username,
               "password=s"      => \$password,
               "server=s"        => \$server,
               "category=s"      => \$category,
               "element=s"       => \$element,
               "no-media"        => \$no_media,
               "story-id=s"      => \$story_id,
               "published-only"  => \my $published_only,
               "timeout=s"       => \$timeout,
               "chunks=s"        => \$chunks,
              ) or  pod2usage(2);

    pod2usage(1)             if $help;
    pod2usage(-verbose => 2) if $man;

    if ($password eq '') {
        {
            $password = read_password('Password: ');
            redo unless $password;
        }
    }

    # check required options
    pod2usage("Missing required --username option ".
              "and BRICOLAGE_USERNAME environment variable unset.")
        unless defined $username;
    pod2usage("Missing required --password option ".
              "and BRICOLAGE_PASSWORD environment variable unset.")
        unless defined $password;
};

our $VERBOSE;
use SOAP::Lite ($VERBOSE > 2 ? (trace => [qw(debug)]) : ());
import SOAP::Data 'name';
use HTTP::Cookies;
require Data::Dumper if $VERBOSE;

main();

sub main {
    # connect to the server
    soap_connect();

    # get story ids to publish
    get_story_ids();

    # mix in related media unless --no-media
    our $no_media;
    get_media_ids() unless $no_media;

    # publish stories and media found
    publish_assets();

    print STDERR "bric_republish success.\n" if $VERBOSE;
    exit 0;
}

# gets a list of story ids, modified by options
sub get_story_ids {
    our ($soap, $element, $story_id, $category, $help, $man);
    our @story_ids;

    # quit early if the user specified a story_id
    if ($story_id) {
        @story_ids = ($story_id);
        return;
    }

    # default search
    my @search = (
        name(publish_status    => 1),
    );

    push(@search, name(element  => $element))  if $element;
    push(@search, name(category => $category)) if $category;

    # run the search
    $soap->uri('http://bricolage.sourceforge.net/Bric/SOAP/Story');

    print STDERR "Calling Bric::SOAP::Story->list_ids(",
    join(', ', map { $_->name . " => \"" . $_->value . "\"" } @search),
        ")\n" if $VERBOSE;

    # run list_ids
    my $response = $soap->list_ids(@search);

    # check fault
    _print_fault($response) if $response->fault;

    # return result list
    my $list  = $response->result;
    @story_ids = sort { $a <=> $b } @$list if $list;

    print STDERR "Bric::SOAP::Story->list_ids returned: ",
    join(', ', @story_ids), "\n"
        if $VERBOSE > 1;
}

# find related media for stories to be published
sub get_media_ids {
    our ($soap, @media_ids, @story_ids);
    my %media_ids;

    # switch to Story module
    $soap->uri('http://bricolage.sourceforge.net/Bric/SOAP/Story');

    foreach my $story_id (@story_ids) {
        # get story document
        print STDERR "Calling Bric::SOAP::Story->export($story_id).\n"
           if $VERBOSE;

        my $response = $soap->export(name(story_id => $story_id));
        _print_fault($response) if $response->fault;

        my $doc = $response->result;

        # find related media ids and store into hash to unique
        map { $media_ids{$_} = 1 } $doc =~ /related_media_id=['"](\d+)/g;
    }
    @media_ids = sort { $a <=> $b } keys %media_ids;

    print STDERR "Found related media ids: ",
    join(', ', @media_ids), "\n"
        if $VERBOSE > 1;
}

# publish stories and media found
sub publish_assets {
    our ($soap, @story_ids, @media_ids, $chunks);

    # do nothing if we've got nothing
    return unless @story_ids;

    # switch to Workflow module
    $soap->uri('http://bricolage.sourceforge.net/Bric/SOAP/Workflow');

    # collect ids for publish
    my @ids = ( ( map { name(story_id => $_) } @story_ids ),
              (   map { name(media_id => $_) } @media_ids ) );

    if ($chunks) {
        # step through @ids $chunks at a time
        my ($start, $end);
        for ($start = 0; $start <= $#ids; $start = $end + 1) {
            $end = $start + $chunks - 1;
            $end = $#ids if $end > $#ids;

            print STDERR "Calling Bric::SOAP::Workflow->publish(\n",
            join(",\n", map { "\t". $_->name ." => ". $_->value }
                @ids[$start .. $end]), "\n)\n"
                if $VERBOSE > 1;

            my $r = $soap->publish(
                name( publish_ids    => [ @ids[$start .. $end] ] ),
                name( published_only => 1 ), # Always published_version only.
            );
            _print_fault($r) if $r->fault;
        }
    } else {
        # publish everything at once
        print STDERR "Calling Bric::SOAP::Workflow->publish(\n",
            join(",\n",
            map { "\t". $_->name ." => ". $_->value } @ids), "\n)\n"
                if $VERBOSE > 1;

        my $r = $soap->publish(
            name( publish_ids    => \@ids ),
            name( published_only => 1 ), # Always published_version only.
        );
        _print_fault($r) if $r->fault;
    }
}

#
# startup dance routines
#

# connects to a specific SOAP server
sub soap_connect {
    our ($server, $username, $password, $timeout, $soap);

    # fixup server if missing http://
    $server = "http://$server" unless $server =~ m!^https?://!;

    # setup soap object to login with
    $soap = new SOAP::Lite
            uri      => 'http://bricolage.sourceforge.net/Bric/SOAP/Auth',
            readable => $VERBOSE >= 2 ? 1 : 0;
    $soap->proxy($server . '/soap',
                 cookie_jar => HTTP::Cookies->new(ignore_discard => 1),
                 timeout => $timeout,
                );

    # login
    print STDERR "Logging in to $server as $username...\n" if $VERBOSE;
    my $response = $soap->login(name(username => $username),
                                name(password => $password));
    die "Login to $server as $username failed.\n" if $response->fault;
    print STDERR "Login to $server success.\n" if $VERBOSE;
}

# prints out fault message
sub _print_fault {
    my $r = shift;
    if ($r->faultstring eq 'Application error' and
        ref $r->faultdetail and ref $r->faultdetail eq 'HASH'    ) {
        # this is a bric exception, the interesting stuff is in detail
        die "Call to Bric::SOAP failed : \n" .
            join("\n", values %{$r->faultdetail});
    } else {
        die "Call to Bric::SOAP failed : \n" .
            $r->faultstring;
    }
}