package tests::UIPrefsTest; use strict; use base qw/Lire::Test::TestCase/; use Lire::Config::TypeSpec; use Lire::Config::ConfigFile; use Curses::UI; use Lire::UI::Prefs; use Lire::Test::CursesUIDriver; use Lire::Utils qw/tempfile/; sub new { my $self = shift->SUPER::new( @_ ); $self->{'driver'} = new Lire::Test::CursesUIDriver(); my $spec = new Lire::Config::ConfigSpec( 'name' => 'lire' ); $spec->add( new Lire::Config::StringSpec( 'name' => 'test', 'section' => 'programs', 'summary' => 'Test Summary', 'description' => 'Test Description' ) ); $spec->add( new Lire::Config::StringSpec( 'name' => 'another_prog', 'section' => 'programs', ) ); $spec->add( new Lire::Config::StringSpec( 'name' => 'wawa_prog', 'summary' => "Summary with\nnewlines \n and wawas", 'section' => 'programs' ) ); $self->{'spec'} = $spec; return $self; } sub set_up { my $self = $_[0]; $self->SUPER::set_up(); $self->{'cfg'}{'_lr_config_spec'} = $self->{'spec'}; my $fh; ( $fh, $self->{'cfg_filename'} ) = tempfile( 'lire_cfg_XXXXXX' ); $self->{'driver'}->setup_curses_ui(); $self->{'cfg_file'} = new Lire::Config::ConfigFile( 'spec' => $self->{'spec'}, 'filename' => $self->{'cfg_filename'} ); $self->{'ui'} = new Curses::UI(); $self->{'driver'}->set_curses_ui( $self->{'ui'} ); return; } sub tear_down { my $self = $_[0]; $self->SUPER::tear_down(); $self->{'driver'}->teardown_curses_ui(); unlink $self->{'cfg_filename'}; return; } sub test_new { my $self = $_[0]; $self->assert_dies( qr/missing \'ui\' parameter/, sub { new Lire::UI::Prefs() } ); $self->assert_dies( qr/missing \'config\' parameter/, sub { new Lire::UI::Prefs( $self->{'ui'}) } ); $self->assert_dies( qr/\'ui\' parameter should be a \'Curses::UI\' instance, not \'HASH/, sub { new Lire::UI::Prefs( {}, {} ) } ); $self->assert_dies( qr/\'config\' parameter should be a \'Lire::Config::ConfigFile\' instance, not \'HASH/, sub { new Lire::UI::Prefs( $self->{'ui'}, {} ) } ); my $prefs = new Lire::UI::Prefs( $self->{'ui'}, $self->{'cfg_file'} ); $self->assert_str_equals( $self->{'ui'}, $prefs->{'_ui'} ); $self->assert_str_equals( $self->{'cfg_file'}, $prefs->{'_cfg_file'} ); $self->assert_not_null( $self->{'ui'}->getobj( 'prefs_win' ), 'was _create_prefs_win() called?' ); } sub test_create_prefs_win { my $self = $_[0]; my $ui = bless { '_ui' => $self->{'ui'}, '_cfg_file' => $self->{'cfg_file'} }, 'Lire::UI::Prefs'; $ui->_create_prefs_win(); my $win = $self->{'ui'}->getobj( 'prefs_win' ); $self->assert_isa( 'Curses::UI::Window', $win ); $self->assert_str_equals( 'Lire Preferences', $win->title() ); foreach my $id ( qw/ section_menu buttons options_list option_summary option_help / ) { my $widget = $win->getobj( $id ); $self->assert_not_null( $widget, "missing widget '$id' in 'prefs_win'" ); } $self->assert_str_equals( $ui, $win->userdata() ); my $options = $win->getobj( 'options_list' ); $self->assert_isa( 'Curses::UI::Listbox', $options ); $self->assert_str_equals( \&Lire::UI::Prefs::_option_change_cb, $options->{'-onchange'} ); $self->assert_str_equals( \&Lire::UI::Prefs::_option_selchange_cb, $options->{'-onselchange'} ); my $opt_summary = $win->getobj( 'option_summary' ); $self->assert_isa( 'Curses::UI::Label', $opt_summary ); my $opt_help = $win->getobj( 'option_help' ); $self->assert_isa( 'Curses::UI::TextViewer', $opt_help ); } sub set_up_mock_prefs_win { my $self = $_[0]; $self->{'ui_prefs'} = bless { '_ui' => $self->{'ui'}, '_cfg_file' => $self->{'cfg_file'} }, 'Lire::UI::Prefs'; $self->{'prefs_win'} = $self->{'ui'}->add( 'prefs_pane', 'Window', '-y' => 1 ); return; } sub test_create_section_menu { my $self = $_[0]; $self->set_up_mock_prefs_win(); my $win = $self->{'prefs_win'}; $self->{'ui_prefs'}->_create_section_menu( $win ); my $section_menu = $win->getobj( 'section_menu' ); $self->assert_isa( 'Curses::UI::Popupmenu', $section_menu ); $self->assert_num_equals( 0, $section_menu->{'-selected'} ); $self->assert_deep_equals( [ 'report', 'responder', 'operation', 'path', 'docbook', 'programs' ], $section_menu->{'-values'} ); $self->assert_str_equals( 'Responder Preferences', $section_menu->{'-labels'}{'responder'} ); $self->assert_str_equals( \&Lire::UI::Prefs::_section_change_cb, $section_menu->{'-onchange'} ); } sub test_create_buttons { my $self = $_[0]; $self->set_up_mock_prefs_win(); my $win = $self->{'prefs_win'}; $self->{'ui_prefs'}->_create_buttons( $win ); my $buttons = $win->getobj( 'buttons' ); $self->assert_isa( 'Curses::UI::Buttonbox', $buttons ); $self->assert_str_equals( '< Cancel >', $buttons->{'-buttons'}[0]{'-label'} ); $self->assert_str_equals( \&Lire::UI::Prefs::_cancel_cb, $buttons->{'-buttons'}[0]{'-onpress'} ); $self->assert_str_equals( '< OK >', $buttons->{'-buttons'}[1]{'-label'} ); $self->assert_str_equals( \&Lire::UI::Prefs::_ok_cb, $buttons->{'-buttons'}[1]{'-onpress'} ); } sub test_show { my $self = $_[0]; my $driver = $self->{'driver'}; my $prefs_win = ''; $driver->add_event_loop_handler( sub { $prefs_win = $_[1] } ); my $section_menu = ''; my $sel = ''; no warnings 'redefine'; local *Lire::UI::Prefs::_section_change_cb = sub { $section_menu = shift; $sel = $section_menu->get() }; my $prefs = new Lire::UI::Prefs( $self->{'ui'}, $self->{'cfg_file'} ); my $ui_prefs_win = $driver->find_widget( '/prefs_win' ); my $ui_section_menu = $driver->find_widget( '/prefs_win/section_menu' ); $prefs->show(); $self->assert_str_equals( $ui_prefs_win, $prefs_win ); $self->assert_null( $self->{'ui'}->getobj( 'prefs_win' ) ); $self->assert_str_equals( $ui_section_menu, $section_menu ); $self->assert_str_equals( 'report', $sel ); } sub test_section_change_cb { my $self = $_[0]; my $driver = $self->{'driver'}; my $spec = $self->{'spec'}; my $listbox = ''; my $sel = -1; no warnings 'redefine'; local *Lire::UI::Prefs::_option_change_cb = sub { $listbox = shift; $sel = $listbox->{'-selected'} }; my $prefs = new Lire::UI::Prefs( $self->{'ui'}, $self->{'cfg_file'} ); my $section_menu = $driver->find_widget( '/prefs_win/section_menu' ); $section_menu->{'-selected'} = 5; # Programs Lire::UI::Prefs::_section_change_cb( $section_menu ); my $options = $driver->find_widget( '/prefs_win/options_list'); $self->assert_deep_equals( [ $spec->get( 'test' ), $spec->get( 'another_prog' ), $spec->get( 'wawa_prog' ) ], $options->{'-values'} ); $self->assert_deep_equals( { $spec->get( 'another_prog' ) =>'another_prog', $spec->get( 'test' ) => 'test', $spec->get( 'wawa_prog' ) => 'wawa_prog'}, $options->{'-labels'} ); $self->assert_num_equals( 0, $sel ); $self->assert_str_equals( $options, $listbox ); } sub test_option_selchange_cb { my $self = $_[0]; my $driver = $self->{'driver'}; my $spec = $self->{'spec'}; my $listbox = ""; no warnings 'redefine'; local *Lire::UI::Prefs::_option_change_cb = sub { $listbox = shift }; my $prefs = new Lire::UI::Prefs( $self->{'ui'}, $self->{'cfg_file'} ); my $options = $driver->find_widget( '/prefs_win/options_list' ); $options->{'-ypos'} = 0; $options->{'-values'} = [ $spec->get( 'another_prog' ), $spec->get( 'test' ) ]; $options->{'-selected'} = undef; Lire::UI::Prefs::_option_selchange_cb( $options ); $self->assert_str_equals( $options, $listbox ); $self->assert_num_equals( 0, $options->{'-selected'} ); } sub test_option_change_cb { my $self = $_[0]; my $driver = $self->{'driver'}; my $spec = $self->{'spec'}; my $prefs = new Lire::UI::Prefs( $self->{'ui'}, $self->{'cfg_file'} ); my $options = $driver->find_widget( '/prefs_win/options_list' ); $options->{'-values'} = [ $spec->get( 'another_prog' ), $spec->get( 'test' ), $spec->get( 'wawa_prog' ) ]; $options->{'-ypos'} = 0; $options->{'-selected'} = 1; Lire::UI::Prefs::_option_change_cb( $options ); $self->assert_num_equals( 1, $options->{'-ypos'} ); my $opt_summary = $driver->find_widget( '/prefs_win/option_summary' ); $self->assert_str_equals( 'Test Summary', $opt_summary->text() ); my $opt_help = $driver->find_widget( '/prefs_win/option_help' ); $self->assert_str_equals( 'Test Description', $opt_help->text() ); my $opt_widget = $driver->find_widget( '/prefs_win' )->getobj( 'option_widget' ); $self->assert_isa( "Lire::UI::StringWidget", $opt_widget ); $self->assert_str_equals( 'Test Description', $opt_help->text() ); $options->{'-selected'} = 0; Lire::UI::Prefs::_option_change_cb( $options ); $self->assert_str_equals( 'another_prog', $opt_summary->text() ); $self->assert_str_equals( 'No help available.', $opt_help->text() ); $self->assert_str_not_equals( $opt_widget, $driver->find_widget( '/prefs_win/option_widget' ) ); $options->{'-selected'} = 2; Lire::UI::Prefs::_option_change_cb( $options ); $self->assert_str_equals( 'Summary with newlines and wawas', $opt_summary->text() ); my $texteditor = ''; my $nothing = ''; my $scrollpos = 0; no warnings 'redefine'; local *Curses::UI::TextEditor::cursor_up = sub { $texteditor = shift; $nothing = shift; $scrollpos = shift; }; $opt_help->{'-yscrpos'} = 1; $options->{'-selected'} = 1; Lire::UI::Prefs::_option_change_cb( $options ); $self->assert_str_equals( '', $texteditor ); $opt_help->{'-yscrpos'} = 3; $options->{'-selected'} = 2; Lire::UI::Prefs::_option_change_cb( $options ); $self->assert_str_equals( $opt_help, $texteditor ); $self->assert_null( $nothing ); $self->assert_num_equals( 3, $scrollpos ); return; } sub test_option_change_cb_empty { my $self = $_[0]; my $driver = $self->{'driver'}; my $cfg_file = new Lire::Config::ConfigFile( 'spec' => new Lire::Config::ConfigSpec(), 'filename' => $self->{'cfg_filename'} ); my $prefs = new Lire::UI::Prefs( $self->{'ui'}, $cfg_file ); my $options = $driver->find_widget( '/prefs_win/options_list' ); $options->{'-values'} = []; $options->{'-ypos'} = 1; $options->{'-selected'} = 1; Lire::UI::Prefs::_option_change_cb( $options ); $self->assert_num_equals( 0, $options->{'-ypos'} ); $self->assert_null($options->{'-selected'}, "-selected should be undef" ); my $opt_summary = $driver->find_widget( '/prefs_win/option_summary' ); $self->assert_str_equals( '', $opt_summary->text() ); my $opt_help = $driver->find_widget( '/prefs_win/option_help' ); $self->assert_str_equals( '', $opt_help->text() ); } sub test_get_var { my $self = $_[0]; my $prefs = bless { '_ui' => $self->{'ui'}, '_cfg_file' => $self->{'cfg_file'} }, 'Lire::UI::Prefs'; my $test_in_file = $self->{'cfg_file'}->get( 'test' ); $self->assert_str_equals( $test_in_file, $prefs->_get_var( 'test' ) ); $self->assert( ! $self->{'cfg_file'}->is_set( 'another_prog' ), "'another_prog' unexpectedly set" ); $self->{'cfg'}{'another_prog'} = '/bin/ls'; my $prog_from_config = Lire::Config->get_var( 'another_prog' ); my $prog_from_file = $prefs->_get_var( 'another_prog' ); $self->assert_str_not_equals( $prog_from_config, $prog_from_file ); $self->assert( $self->{'cfg_file'}->is_set( 'another_prog' ), "'another_prog' should now be set in config file" ); $self->assert_str_equals( '/bin/ls', $prog_from_file->get() ); } sub test_ok_cb { my $self = $_[0]; my $prefs_win = '< undef (loose_focus not called) >'; my $cfg_file = '< undef (save not called) >'; my $prefs = new Lire::UI::Prefs( $self->{'ui'}, $self->{'cfg_file'} ); no warnings 'redefine'; local *Curses::UI::Window::loose_focus = sub { $prefs_win = shift }; local *Lire::Config::ConfigFile::save = sub { $cfg_file = shift }; my $btn_box = $self->{'driver'}->find_widget( '/prefs_win/buttons' ); Lire::UI::Prefs::_ok_cb( $btn_box ); $self->assert_str_equals( $self->{'ui'}->getobj( 'prefs_win' ), $prefs_win ); $self->assert_str_equals( $self->{'cfg_file'}, $cfg_file ); } sub test_cancel_cb { my $self = $_[0]; my $prefs_win = '< undef (loose_focus not called) >'; my $cfg_file = '< undef (revert not called) >'; my $prefs = new Lire::UI::Prefs( $self->{'ui'}, $self->{'cfg_file'} ); no warnings 'redefine'; local *Curses::UI::Window::loose_focus = sub { $prefs_win = shift }; local *Lire::Config::ConfigFile::revert = sub { $cfg_file = shift }; my $btn_box = $self->{'driver'}->find_widget( '/prefs_win/buttons' ); Lire::UI::Prefs::_cancel_cb( $btn_box ); $self->assert_str_equals( $self->{'ui'}->getobj( 'prefs_win' ), $prefs_win ); $self->assert_str_equals( $self->{'cfg_file'}, $cfg_file ); } 1;