view release on metacpan or  search on metacpan

lib/App/CPAN2Pkg/UI/Tk.pm  view on Meta::CPAN

#
# This file is part of App-CPAN2Pkg
#
# This software is copyright (c) 2009 by Jerome Quelin.
#
# This is free software; you can redistribute it and/or modify it under
# the same terms as the Perl 5 programming language system itself.
#
use 5.012;
use strict;
use warnings;

package App::CPAN2Pkg::UI::Tk;
# ABSTRACT: main cpan2pkg window
$App::CPAN2Pkg::UI::Tk::VERSION = '3.004';
use DateTime;
use List::Util qw{ first };
use Moose;
use MooseX::Has::Sugar;
use MooseX::POE;
use MooseX::SemiAffordanceAccessor;
use Readonly;
use Tk;
use Tk::Balloon;
use Tk::HList;
use Tk::NoteBook;
use Tk::PNG;
use Tk::ROText;
use Tk::Sugar;

with 'Tk::Role::HasWidgets';

use App::CPAN2Pkg::Utils     qw{ $SHAREDIR };

Readonly my $K  => $poe_kernel;
Readonly my $mw => $poe_main_window; # already created by poe


# -- attributes

# it's not usually a good idea to retain a reference on a poe session,
# since poe is already taking care of the references for us. however, we
# need the session to call ->postback() to set the various gui callbacks
# that will be fired upon gui events.
has _session => ( rw, weak_ref, isa=>'POE::Session' );


# -- initialization

#
# START()
#
# called as poe session initialization.
#
sub START {
    my ($self, $session) = @_[OBJECT, SESSION];
    $K->alias_set('main');
    $self->_set_session($session);
    $self->_build_gui;
}


# -- public logging events

{


    event log_out => sub {
        my ($self, $module, $line) = @_[OBJECT, ARG0 .. $#_ ];
        my $rotext = $self->_w( "rotext_$module" );
        $rotext->insert( 'end', "$line\n" );
        $rotext->yview( 'end' );
    };
    event log_err => sub {
        my ($self, $module, $line) = @_[OBJECT, ARG0 .. $#_ ];
        my $rotext = $self->_w( "rotext_$module" );
        $rotext->insert( 'end', "$line\n", "error" );
        $rotext->yview( 'end' );
    };
    event log_comment => sub {
        my ($self, $module, $line) = @_[OBJECT, ARG0 .. $#_ ];
        my $rotext = $self->_w( "rotext_$module" );
        my $timestamp = DateTime->now(time_zone=>"local")->hms;
        $rotext->insert( 'end', "* $timestamp $line\n", "comment" );
        $rotext->yview( 'end' );
    };
    event log_result => sub {
        my ($self, $module, $result) = @_[OBJECT, ARG0 .. $#_ ];
        my $rotext = $self->_w( "rotext_$module" );
        my $timestamp = DateTime->now(time_zone=>"local")->hms;
        $rotext->insert( 'end', "* $timestamp $result\n", "result" );
        $rotext->yview( 'end' );
    };
    event log_step => sub {
        my ($self, $module, $step) = @_[OBJECT, ARG0 .. $#_ ];
        my $rotext = $self->_w( "rotext_$module" );
        $rotext->insert( 'end', "\n\n** $step\n\n", "step" );
        $rotext->yview( 'end' );
    };
}


event module_state => sub {
    my ($self, $module) = @_[OBJECT, ARG0 .. $#_ ];
    my $modname = $module->name;

    # find relevant line in hlist
    my $hlist = $self->_w( "hlist" );
    my @children = $hlist->info( 'children' );
    my $elem     = first { $hlist->info(data=>$_) eq $modname } @children;

    # get bullet color
    my %color = (
        "not started"   => "black",
        "not available" => "yellow",
        importing       => "purple",
        building        => "orange",
        installing      => "blue",
        available       => "green",
        error           => "red",
    );
    my $colorl = $color{ $module->local->status };
    my $coloru = $color{ $module->upstream->status };

    # update bullets
    my $bulletl = _image( $SHAREDIR->file("bullets", "$colorl.png") );
    my $bulletu = _image( $SHAREDIR->file("bullets", "$coloru.png") );
    $hlist->itemConfigure( $elem, 0, -image=>$bulletl );
    $hlist->itemConfigure( $elem, 1, -image=>$bulletu );

#    $self->_w( "btn_close_$modname" )->configure( enabled )
#        if $module->local->status    eq 'available'
#        && $module->upstream->status eq 'available';

    $hlist->update;

    # allow user to mark a module as available
    return unless $module->local->status eq "error"
        or $module->upstream->status eq "error";
    my $nb = $self->_w('notebook');
    my $pane   = $nb->page_widget( $modname );
    my $button = $pane->Button(
        -text    => 'Mark module as available (locally & upstream)',
        -command => $self->_session->postback( "_on_btn_mark_available", $module ),
    )->pack( top, fillx );
    $self->_set_w( "mark_available_$modname" => $button );
    $nb->update;
};

# -- public events