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 n = new, d = delete, enter = jump to
  90
  91 =cut
  92
  93 #--
  94 # METHODS
  95
  96 # -- private methods
  97
  98 my $title;
  99 sub _build_gui {
 100     my ($self) = @_;
 101     my $tb  = $self->add('win_title', 'Window', -height=>1);
 102     $title  = $tb->add('title',  'Label', -bold=>1, -width=>40);
 103     $title->text("Building package from cpan");
 104
 105     $self->set_binding( sub { $title->text("foo")->draw; die; }, KEY_ENTER );
 106 }
 107
 108
 109 sub _build_menu {
 110     my ($self) = shift;
 111
 112     my $mnu_module = [
 113         { -label => 'Package new...', -callback => sub { warn; } },
 114         { -label => 'Exit',           -callback => sub { warn; } },
 115     ];
 116
 117 =pod
 118
 119     my $mnu_config = [];
 120     my $mnu_windows = [
 121         { -label => 'Packages queue', -callback => sub { warn; } },
 122         { -label => 'Window list',    -callback => sub { warn; } },
 123     ];
 124     my $mnu_help = [
 125         { -label => "Help", -callback => sub { warn; } },
 126         { -label => "Help", -callback => sub { warn; } },
 127         { -label => "Help", -callback => sub { warn; } },
 128         { -label => "Help", -callback => sub { warn; } },
 129     ];
 130     F1 - help
 131     F2 - packages queue
 132     F3 - window list
 133     F4 - config (?)
 134
 135 =cut
 136
 137     my $menus = [
 138         { -label => 'Module', -submenu => $mnu_module },
 139
 140     ];
 141     my $menu = $self->add(
 142         'menu', 'Menubar',
 143         -menu => $menus
 144     );
 145
 146 }
 147
 148
 149
 150 1;
 151 __END__