pm-cb-g

#!/usr/bin/perl
use warnings;
use strict;
use Syntax::Construct qw{ // };

use FindBin;
use lib "$FindBin::Bin/lib";

use Getopt::Long qw( :config no_ignore_case );
use Pod::Usage;

use PM::CB::GUI;
use PM::CB::Control;

my ($bg_color, $fg_color, $author_color, $private_color, $gesture_color,
    $time_color, $font_name, $char_size, $stack_size, $seen_color, $warn_color,
    $no_time, $help, $pm_url, $browse_url, $random_url, $copy_link,
    $mce, $geometry, $log, $paste_keys, $browser);

BEGIN {
    ($bg_color, $fg_color, $author_color, $private_color, $gesture_color,
     $time_color, $seen_color, $warn_color, $font_name, $char_size, $stack_size,
     $no_time, $help, $pm_url, $random_url, $copy_link)
    = qw( white black blue magenta darkgreen darkcyan darkgray red Helvetica
          12 15 0 0 www.perlmonks.org 0 Control-Button-1 red);

    $paste_keys = 'Shift-Insert';
    $paste_keys .= ' XF86Paste' if $^O ne 'MSWin32';

    GetOptions(
        'a|author_color=s'  => \$author_color,
        'b|bg_color=s'      => \$bg_color,
        'B|browser=s'       => \$browser,
        'c|char_size=i'     => \$char_size,
        'C|copy_link=s'     => \$copy_link,
        'f|fg_color=s'      => \$fg_color,
        'F|font_name=s'     => \$font_name,
        'g|gesture_color=s' => \$gesture_color,
        'G|geometry=s'      => \$geometry,
        'h|help'            => \$help,
        'l|log=s'           => \$log,
        'm|mce_hobo'        => \$mce->{hobo},
        'M|mce_child'       => \$mce->{child},
        'n|no_time'         => \$no_time,
        'p|private_color=s' => \$private_color,
        'P|paste_keys=s'    => \$paste_keys,
        'r|random_url'      => \$random_url,
        's|stack_size=i'    => \$stack_size,
        'S|seen_color=s'    => \$seen_color,
        't|time_color=s'    => \$time_color,
        'u|url=s'           => \$pm_url,
        'U|browse_url=s'    => \$browse_url,
        'w|warn_color=s'    => \$warn_color,
    ) or pod2usage(-verbose => 0, -exitval => 1);
    $browse_url //= $pm_url;
    die "Can't combine mce_hobo and mce_child.\n"
        if $mce->{hobo} && $mce->{child};
    $mce = {} unless $mce->{hobo} || $mce->{child};

    $warn_color = 'red' if $warn_color eq $fg_color;
    $warn_color = 'orange' if $warn_color eq $fg_color;

    pod2usage(-verbose => 1, -exitval => 0) if $help;
}


use if $mce->{hobo} => 'MCE::Hobo';
use if $mce->{hobo} => 'MCE::Shared';

use if $mce->{child} => 'MCE::Child';
use if $mce->{child} => 'MCE::Channel';

use if ! %$mce => threads => (stack_size => 2 ** $stack_size);
use if ! %$mce => 'Thread::Queue';

my ($queue_class, $queue_constructor, $worker_class)
    = @{
        { 0 => [qw[ Thread::Queue new   threads ]],
          1 => [qw[ MCE::Shared   queue MCE::Hobo ]],
          2 => [qw[ MCE::Channel  new   MCE::Child ]],
        }->{ ($mce->{hobo} || 0) + 2 * ($mce->{child} || 0) }
    };

my ($to_gui, $to_comm, $to_control)
    = map $queue_class->$queue_constructor, 1, 2, 3;
my $control_t = $worker_class->create(sub {
    my $control = 'PM::CB::Control'->new({to_gui       => $to_gui,
                                          to_comm      => $to_comm,
                                          from_gui     => $to_control,
                                          worker_class => $worker_class,
                                          pm_url       => $pm_url,
                                          random_url   => $random_url});
    $control->start_comm;
});

my $gui = 'PM::CB::GUI'->new({
    bg_color      => $bg_color,
    fg_color      => $fg_color,
    author_color  => $author_color,
    private_color => $private_color,
    gesture_color => $gesture_color,
    time_color    => $time_color,
    font_name     => $font_name,
    char_size     => $char_size,
    stack_size    => $stack_size,
    seen_color    => $seen_color,
    warn_color    => $warn_color,
    mce           => keys %$mce ? $mce : undef,
    no_time       => $no_time,
    from_comm     => $to_gui,
    to_comm       => $to_comm,
    to_control    => $to_control,
    control_t     => $control_t,
    browse_url    => $browse_url,
    browser       => $browser,
    random_url    => $random_url,
    geometry      => $geometry,
    log           => $log,
    copy_link     => $copy_link,
    paste_keys    => $paste_keys});

$gui->gui;


# MCE::Channel can only enqueue, it has no insert method.
sub MCE::Channel::insert {
    my ($self, undef, $messages) = @_;
    $self->enqueue($messages);
}


=head1 NAME

pm-cb-g - A GUI client to PerlMonks' Chatter Box

=head1 SYNOPSIS

  pm-cb-g -a blue -b white -c 12 -f black -F Helvetica
          -p magenta -s 15 -S darkgray -t darkcyan -g darkgreen
          -u www.perlmonks.org -U www.perlmonks.org
          -C Control-Button-1 -l "" -B firefox
          [ -h -m/-M -n ]

=head1 OPTIONS

The default values are shown in the Synopsis above.

For colors, use a color name or C<#RRGGBB> code.

=over

=item B<a|author_color> I<color>

The color to display the names of authors of public messages.

=item B<b|bg_color> I<color>

The background color of the application.

=item B<B|browser> I<command>

The command ran to open urls. By default uses the system's default
browser.

=item B<c|char_size> I<size>

The size of all the characters (integer).

=item B<C|copy_link> I<event(s)>

The event(s) that copies the link under mouse cursor to the clipboard.

=item B<f|fg_color> I<color>

The foreground colour of the new messages.

=item B<F|font_name> I<font>

The font for all the characters.

=item B<g|gesture_color> I<color>

The foreground colour to display the names of gesture authors (C</me>).

=item B<G|geometry> I<width>xI<height>[+I<xpos>+I<ypos>]

Geometry of the main window. Use the optimal geometry if none given.

=item B<h|help>

Prints options and arguments.

=item B<l|log> I<filename>

Save all messages to the given log file. Don't save any messages if
the filename is empty.

=item B<m|mce_hobo>

Use L<MCE::Shared> and L<MCE::Hobo> instead of L<threads> and
L<Thread::Queue>.

=item B<M|mce_child>

Use L<MCE::Child> and L<MCE::Channel> instead of L<threads> and
L<Thread::Queue>.

=item B<n|no_time>

Don't show time stamps.

=item B<p|private_color> I<color>

The color for the authors of private messages.

=item B<P|paste_keys> I<event(s)>

The event(s) that paste text from the clipboard.

=item B<r|random_url>

Change the PM URL randomly time to time (should prevent lag).

=item B<s|stack_size> I<size>

Needed for L<threads>. Use a higher number if the program doesn't work
with the default value.

=item B<S|seen_color> I<color>

The color for already read messages.

=item B<t|time_color> I<color>

The color for time stamps.

=item B<u|url> I<[www.]perlmonks.(com|net|org)>

The address to use to communicate with PerlMonks.

=item B<U|browse_url> I<[www.]perlmonks.(com|net|org)>

The address to use to open PerlMonks links in the browser. Same as
B<url> if not specified.

=item B<w|warn_color> I<color>

The color that indicates a too long message.

=back

=head1 AUTHOR

E. Choroba

=head2 Contributors

H.Merijn Brand, LorenzoTa, Mario Roy, Nick Tonkin, Steve Rogerson

=cut