#!/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 - publish the published version rather than the
                current version (which is different from published version
                if the asset has been saved after publishing), and don't
                published unpublished assets
    
    --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.  In
its default mode it finds all stories that have been been published at
least once (publish_status is 1) and are not on any desks.  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;

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 $published_only  = 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"  => \$published_only,
               "timeout=s"       => \$timeout,
               "chunks=s"        => \$chunks,
              ) or  pod2usage(2);

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

    # 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, $published_only);
    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(no_workflow    => 1) unless $published_only;

    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, $published_only);
    my @opts;

    # 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 ) );

    push @opts, name(published_only => 1) if $published_only;

    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]]), @opts);
            _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), @opts);
        _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;
    }
}
