[Bps-public-commit] r10199 - in RT-Client-Console: trunk/lib/RT/Client
dams at bestpractical.com
dams at bestpractical.com
Sun Dec 30 11:40:14 EST 2007
Author: dams
Date: Sun Dec 30 11:40:11 2007
New Revision: 10199
Modified:
RT-Client-Console/ (props changed)
RT-Client-Console/trunk/lib/RT/Client/Console.pm
Log:
r39 at pundit: dams | 2007-12-30 16:39:09 +0000
doc, comments, cleaning
Modified: RT-Client-Console/trunk/lib/RT/Client/Console.pm
==============================================================================
--- RT-Client-Console/trunk/lib/RT/Client/Console.pm (original)
+++ RT-Client-Console/trunk/lib/RT/Client/Console.pm Sun Dec 30 11:40:11 2007
@@ -1,190 +1,205 @@
package RT::Client::Console;
-use warnings;
use strict;
+use warnings;
+
use Carp;
our $VERSION = '0.0.4';
+use Curses;
+use Curses::Forms::Dialog;
+use Curses::Forms::Dialog::Input;
use Params::Validate qw(:all);
+# global Curses handler
my $curses_handler;
-
sub get_curses_handler {
- return $curses_handler;
+ return $curses_handler;
}
-# global heap to keep an application-level state
+# main method. effectively starts the console
sub run {
- my ($class, @args) = @_;
- my %params = validate( @args, { curses_handler => { isa => 'Curses' },
- rt_servername => 0,
- rt_username => 0,
- rt_password => 0,
- queue_ids => 0,
- }
- );
-
-
- $curses_handler = delete $params{curses_handler};
-
- use RT::Client::Console::Session::Root;
- RT::Client::Console::Session::Root->create();
-
- use RT::Client::Console::Session::KeyHandler;
- RT::Client::Console::Session::KeyHandler->create();
-
- if ( exists $params{rt_servername}) {
- use RT::Client::Console::Cnx;
- RT::Client::Console::Cnx->connect(%params);
- }
-
- use RT::Client::Console::Session;
- RT::Client::Console::Session->run();
-
+ my $class = shift;
+ my %params = validate( @_, { curses_handler => { isa => 'Curses' },
+ rt_servername => 0,
+ rt_username => 0,
+ rt_password => 0,
+ }
+ );
+
+ $curses_handler = delete $params{curses_handler};
+
+ use RT::Client::Console::Session::Root;
+ RT::Client::Console::Session::Root->create();
+
+ use RT::Client::Console::Session::KeyHandler;
+ RT::Client::Console::Session::KeyHandler->create();
+
+ if ( exists $params{rt_servername}) {
+ use RT::Client::Console::Cnx;
+ RT::Client::Console::Cnx->connect(%params);
+ }
+
+ # starts POE runtime
+ use RT::Client::Console::Session;
+ RT::Client::Console::Session->run();
+
}
+
+# curses related methods
+
{
my $need_cls = 0;
sub cls {
my ($class) = @_;
- $need_cls = 1;
- return;
+ $need_cls = 1;
+ return;
}
sub need_cls {
- return $need_cls;
+ return $need_cls;
}
sub reset_cls {
- $need_cls = 0;
- return;
+ $need_cls = 0;
+ return;
}
}
+# draws the list of supported keys and description
sub draw_keys_label {
- my ($class, %params) = @_;
-
- my $max_length = $params{COLUMNS};
- my $current_x = 0;
-
- my $foreground = $params{FOREGROUND} || 'white';
- my $foreground2 = $params{FOREGROUND2} || 'yellow';
- my $background = $params{BACKGROUND} || 'blue';
-
- use Curses;
-
- foreach my $key_struct (@{$params{VALUE}}) {
- my ($key, $text) = @$key_struct;
- $key = " $key: ";
- $text = "$text ";
- attron(A_BOLD);
- $max_length -= length($key);
- $max_length >= 0 or last;
- my $label = Curses::Widgets::Label->new({
- BORDER => 0,
- LINES => 1,
- COLUMNS => length($key),
- Y => $params{Y},
- X => $params{X} + $current_x,
- VALUE => $key,
- FOREGROUND => $foreground2,
- BACKGROUND => $background,
- });
- $label->draw($class->get_curses_handler());
- $current_x += length($key);
- attroff(A_BOLD);
-
- $max_length - length($text) >= 0 or $text = substr($text, 0, $max_length);
- $max_length -= length($text);
- $label = Curses::Widgets::Label->new({
- BORDER => 0,
- LINES => 1,
- COLUMNS => length($text),
- Y => $params{Y},
- X => $params{X} + $current_x,
- VALUE => $text,
- FOREGROUND => $foreground,
- BACKGROUND => $background,
- });
- $label->draw($class->get_curses_handler());
- $current_x += length($text);
- $current_x++;
- $max_length--;
- }
-}
-# $params{Y}
-# $params{X}
-# $params{COLUMNS}
-# $params{FOREGROUND}
-# $params{BACKGROUND}
-# }
-
-
+ my $class = shift;
+ my %params = validate( @_, { COLUMNS => { type => SCALAR },
+ BACKGROUND => { type => SCALAR,
+ default => 'blue',
+ },
+ FOREGROUND => { type => SCALAR,
+ default => 'white',
+ },
+ FOREGROUND2 => { type => SCALAR,
+ default => 'yellow',
+ },
+ VALUE => { type => ARRAYREF }, # [ [ key => 'label' ], [...] ]
+ X => { type => SCALAR },
+ Y => { type => SCALAR },
+ }
+ );
+
+ my $current_x = 0;
+ my $max_length = $params{COLUMNS};
+ my $foreground = $params{FOREGROUND};
+ my $foreground2 = $params{FOREGROUND2};
+ my $background = $params{BACKGROUND};
+
+ foreach my $key_struct (@{$params{VALUE}}) {
+ my ($key, $text) = @$key_struct;
+ $key = " $key: ";
+ $text = "$text ";
+ attron(A_BOLD);
+ $max_length -= length($key);
+ $max_length >= 0 or last;
+ my $label = Curses::Widgets::Label->new({ BORDER => 0,
+ LINES => 1,
+ COLUMNS => length($key),
+ Y => $params{Y},
+ X => $params{X} + $current_x,
+ VALUE => $key,
+ FOREGROUND => $foreground2,
+ BACKGROUND => $background,
+ });
+ $label->draw($class->get_curses_handler());
+ $current_x += length($key);
+ attroff(A_BOLD);
+
+ $max_length - length($text) >= 0 or $text = substr($text, 0, $max_length);
+ $max_length -= length($text);
+ $label = Curses::Widgets::Label->new({ BORDER => 0,
+ LINES => 1,
+ COLUMNS => length($text),
+ Y => $params{Y},
+ X => $params{X} + $current_x,
+ VALUE => $text,
+ FOREGROUND => $foreground,
+ BACKGROUND => $background,
+ });
+ $label->draw($class->get_curses_handler());
+ $current_x += length($text);
+ $current_x++;
+ $max_length--;
+ }
+}
-use Curses::Forms::Dialog;
+# display a simple error message
sub error {
my ($class, $message) = @_;
dialog('Error', BTN_OK, $message,
qw(white red yellow));
- $class->cls();
+ $class->cls();
return;
}
-use Curses::Forms::Dialog::Input;
+# display an input box. returns the entered value on success, or empty list on
+# failure.
sub input_ok_cancel {
my ($class, $title, $message, $length) = @_;
my ($rv, $value) = input("[ $title ]", BTN_OK | BTN_CANCEL, $message, $length || 256,
qw(white blue yellow));
# XXX bug, if one doesn't enter anything, or an empty string or 0 or '0'...
- $class->cls();
+ $class->cls();
if ( $rv == 0) {
return $value
}
- return;
+ return;
}
+# display a list box
use Curses::Widgets::ListBox;
sub input_list {
- my ($class, %args) = @_;
- my @items = @{$args{items}};
-
- my $list_style = 1; #simple
- ref $items[0] eq 'HASH' and $list_style = 0; #complex
-
- my @display_items = $list_style ? @items : map { $_->{text} } @items;
- my @value_items = $list_style ? @items : map { $_->{value} } @items;
-
- my $i;
- my %index_of = map { $_ => $i++ } @value_items;
- my %name_of = reverse %index_of;
- my $value_idx = $index_of{$args{value}};
- my $title = $args{title};
-
- my ($screen_w, $screen_h);
- $curses_handler->getmaxyx($screen_h, $screen_w);
-
- use List::Util qw(min max);
- my $height = min(@display_items + 2, $screen_h - 20);
- my $width = min( max( map { length } (@display_items, $title) ) + 2, $screen_w - 20 );
-
- my $list_box = Curses::Widgets::ListBox->new({
- LINES => $height,
- COLUMNS => $width,
- Y => $screen_h/2-($height+2)/2,
- X => $screen_w/2-($width+2)/2,,
- LISTITEMS => \@display_items,
- MULTISEL => 0,
- VALUE => $value_idx,
- FOCUSSWITCH => "\n",
- SELECTEDCOL => 'red',
- CAPTION => $title,
- CAPTIONCOL => 'yellow',
- CURSORPOS => $value_idx,
- });
- $class->my_execute($list_box, $curses_handler);
- my $new_value = $name_of{$list_box->getField('VALUE')};
- $class->cls();
- return $new_value;
+ my $class = shift;
+ my %params = validate( @_, { items => { type => ARRAYREF }, # list items, array of (values or (hashrefs of text => value))
+ title => { type => SCALAR }, # list box title
+ value => { type => SCALAR }, # initial value
+ }
+ );
+ my @items = @{$params{items}};
+
+ my $list_style = 1; #simple
+ ref $items[0] eq 'HASH' and $list_style = 0; #complex
+
+ my @display_items = $list_style ? @items : map { $_->{text} } @items;
+ my @value_items = $list_style ? @items : map { $_->{value} } @items;
+
+ my $i;
+ my %index_of = map { $_ => $i++ } @value_items;
+ my %name_of = reverse %index_of;
+ my $value_idx = $index_of{$params{value}};
+ my $title = $params{title};
+
+ my ($screen_w, $screen_h);
+ $curses_handler->getmaxyx($screen_h, $screen_w);
+
+ use List::Util qw(min max);
+ my $height = min(@display_items + 2, $screen_h - 20);
+ my $width = min( max( map { length } (@display_items, $title) ) + 2, $screen_w - 20 );
+
+ my $list_box = Curses::Widgets::ListBox->new({ LINES => $height,
+ COLUMNS => $width,
+ Y => $screen_h/2-($height+2)/2,
+ X => $screen_w/2-($width+2)/2,,
+ LISTITEMS => \@display_items,
+ MULTISEL => 0,
+ VALUE => $value_idx,
+ FOCUSSWITCH => "\n",
+ SELECTEDCOL => 'red',
+ CAPTION => $title,
+ CAPTIONCOL => 'yellow',
+ CURSORPOS => $value_idx,
+ });
+ $class->my_execute($list_box, $curses_handler);
+ my $new_value = $name_of{$list_box->getField('VALUE')};
+ $class->cls();
+ return $new_value;
}
@@ -193,6 +208,7 @@
my %label_widgets;
my $widget_name_index = 0;
+# from a Perl structure, draw labels
sub struct_to_widgets {
my ($class, $header_labels, $max_lines, $max_columns) = @_;
my @header_labels = @$header_labels;
@@ -201,7 +217,7 @@
my %label_widgets;
foreach my $group (@header_labels) {
my $y = 0;
- use List::Util qw(max);
+ use List::Util qw(max);
my $key_width = max( map { length } map { $_->[0] } @$group );
$x + $key_width > $max_columns
and $key_width = $max_columns - $x;
@@ -254,6 +270,7 @@
}
+# temporary pause POE events and run the widget in modal mode
sub my_execute {
my $class = shift;
my $self = shift;
More information about the Bps-public-commit
mailing list