lib/App/CPAN2Pkg/Curses.pm

   1 #
   2 # This file is part of App::CPAN2Pkg.
   3 # Copyright (c) 2009 Jerome Quelin, all rights reserved.
   4 #
   5 # This program is free software; you can redistribute it and/or modify
   6 # it under the same terms as Perl itself.
   7 #
   8 #
   9
  10 package App::CPAN2Pkg::Curses;
  11
  12 use App::CPAN2Pkg;
  13 use Curses;
  14 use Curses::UI::POE;
  15 use POE;
  16
  17 use base qw{ Curses::UI::POE };
  18
  19
  20 # debugging with curses is not easy
  21 if ( exists $ENV{CPAN2PKG_DEBUG} ) {
  22     $SIG{__DIE__} = $SIG{__WARN__} = sub {
  23         open my $fh, '>>', 'stderr';
  24         print $fh @_;
  25     };
  26     warn '-' x 40 . "\n";
  27 }
  28
  29 #--
  30 # CONSTRUCTOR
  31
  32 sub spawn {
  33     my ($class, $opts) = @_;
  34
  35     my $cui = $class->new(
  36         -color_support => 1,
  37         inline_states  => {
  38             # inline states
  39             _start => \&_start,
  40             _stop  => sub { warn "_stop"; },
  41         },
  42     );
  43     return $cui;
  44 }
  45
  46
  47 #--
  48 # SUBS
  49
  50 #-- poe inline states
  51
  52 sub _start {
  53     my ($k, $self) = @_[KERNEL, HEAP];
  54
  55     $k->alias_set('ui');
  56     $self->_build_gui;
  57
  58     App::CPAN2Pkg->spawn($opts);
  59 }
  60
  61 #
  62
  63
  64
  65 =pod
  66
  67
  68 CPAN2Mdv - generating mandriva rpms from cpan
  69
  70 - Packages queue ------------------------------------------
  71 Language::Befunge [ok]
  72     Test::Exception [ok]
  73         Test::Harness [ok]
  74             File::Spec [ok]
  75                 Scalar::Util [ok]
  76                 Carp [ok]
  77                 Module::Build [ok]
  78                     Test::More [ok]
  79                 ExtUtils::CBuilder [ok]
  80         Sub::Uplevel [ok]
  81     Storable [ok]
  82     aliased [ok]
  83     Readonly [ok]
  84     Class::XSAccessor [ok]
  85         AutoXS::Header [ok]
  86     Math::BaseCalc [ok]
  87     UNIVERSAL::require [ok]
  88
  89 enter = jump to, n = new, d = delete
  90
  91 =cut
  92
  93 #--
  94 # METHODS
  95
  96 # -- private methods
  97
  98 sub _build_gui {
  99     my ($self) = @_;
 100
 101     $self->_build_title;
 102     $self->_build_main_window;
 103     $self->_set_bindings;
 104 }
 105
 106 sub _build_title {
 107     my ($self) = @_;
 108     my $tb = $self->add(undef, 'Window',
 109         -height => 1,
 110     );
 111     $self->{title} = $tb->add(undef, 'Label', -bold=>1);
 112 }
 113
 114 sub _build_main_window {
 115     my ($self) = @_;
 116
 117     my ($rows, $cols);
 118     getmaxyx($rows, $cols);
 119     my $mw = $self->add('win_queue', 'Window',
 120         -border => 1,
 121         '-y'    => 1,
 122         -height => $rows - 2,
 123     );
 124 }
 125
 126 sub _set_bindings {
 127     my ($self) = @_;
 128     $self->set_binding( sub{ die; }, "\cQ" );
 129 }
 130
 131
 132
 133 1;
 134 __END__