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 # CONSTRUCTOR
  21
  22 sub spawn {
  23     my ($class, $opts) = @_;
  24
  25     my $cui = $class->new(
  26         -color_support => 1,
  27         inline_states  => {
  28             # inline states
  29             _start => \&_start,
  30             _stop  => sub { warn "_stop"; },
  31         },
  32     );
  33     return $cui;
  34 }
  35
  36
  37 #--
  38 # SUBS
  39
  40 #-- poe inline states
  41
  42 sub _start {
  43     my ($k, $self) = @_[KERNEL, HEAP];
  44
  45     $k->alias_set('ui');
  46     $self->_build_gui;
  47
  48     App::CPAN2Pkg->spawn($opts);
  49 }
  50
  51 #
  52
  53
  54
  55 =pod
  56
  57
  58 CPAN2Mdv - generating mandriva rpms from cpan
  59
  60 - Packages queue ------------------------------------------
  61 Language::Befunge [ok]
  62     Test::Exception [ok]
  63         Test::Harness [ok]
  64             File::Spec [ok]
  65                 Scalar::Util [ok]
  66                 Carp [ok]
  67                 Module::Build [ok]
  68                     Test::More [ok]
  69                 ExtUtils::CBuilder [ok]
  70         Sub::Uplevel [ok]
  71     Storable [ok]
  72     aliased [ok]
  73     Readonly [ok]
  74     Class::XSAccessor [ok]
  75         AutoXS::Header [ok]
  76     Math::BaseCalc [ok]
  77     UNIVERSAL::require [ok]
  78
  79 n = new, d = delete, enter = jump to
  80
  81 =cut
  82
  83 #--
  84 # METHODS
  85
  86 # -- private methods
  87
  88 my $title;
  89 sub _build_gui {
  90     my ($self) = @_;
  91     my $tb  = $self->add('win_title', 'Window', -height=>1);
  92     $title  = $tb->add('title',  'Label', -bold=>1, -width=>40);
  93     $title->text("Building package from cpan");
  94
  95     $self->set_binding( sub { $title->text("foo")->draw; die; }, KEY_ENTER );
  96 }
  97
  98
  99 sub _build_menu {
 100     my ($self) = shift;
 101
 102     my $mnu_module = [
 103         { -label => 'Package new...', -callback => sub { warn; } },
 104         { -label => 'Exit',           -callback => sub { warn; } },
 105     ];
 106
 107 =pod
 108
 109     my $mnu_config = [];
 110     my $mnu_windows = [
 111         { -label => 'Packages queue', -callback => sub { warn; } },
 112         { -label => 'Window list',    -callback => sub { warn; } },
 113     ];
 114     my $mnu_help = [
 115         { -label => "Help", -callback => sub { warn; } },
 116         { -label => "Help", -callback => sub { warn; } },
 117         { -label => "Help", -callback => sub { warn; } },
 118         { -label => "Help", -callback => sub { warn; } },
 119     ];
 120     F1 - help
 121     F2 - packages queue
 122     F3 - window list
 123     F4 - config (?)
 124
 125 =cut
 126
 127     my $menus = [
 128         { -label => 'Module', -submenu => $mnu_module },
 129
 130     ];
 131     my $menu = $self->add(
 132         'menu', 'Menubar',
 133         -menu => $menus
 134     );
 135
 136 }
 137
 138
 139
 140 1;
 141 __END__