← Back to branch summary

~ubuntu-branches/ubuntu/karmic/lire/karmic

« back to all changes in this revision

Viewing changes to all/lib/tests/UIPrefsTest.pm

  • Committer: Bazaar Package Importer
  • Author(s): Wolfgang Sourdeau
  • Date: 2005-04-25 23:10:41 UTC
  • mfrom: (2.1.2 hoary)
  • Revision ID: james.westby@ubuntu.com-20050425231041-8h3y0jyvmj0pe05o
Tags: 2:2.0.1-4
debian/control: build-depend an depend on libdbd-sqlite2-perl (>=
2:0.33-4) instead of libdbd-sqlite-perl.

Show diffs side-by-side

added added

removed removed

Lines of Context:
all/lib/tests/UIPrefsTest.pm
 
1
package tests::UIPrefsTest;
 
2
 
 
3
use strict;
 
4
 
 
5
use base qw/Lire::Test::TestCase/;
 
6
 
 
7
use Lire::Config::TypeSpec;
 
8
use Lire::Config::ConfigFile;
 
9
 
 
10
use Curses::UI;
 
11
 
 
12
use Lire::UI::Prefs;
 
13
use Lire::Test::CursesUIDriver;
 
14
 
 
15
use Lire::Utils qw/tempfile/;
 
16
 
 
17
sub new {
 
18
    my $self = shift->SUPER::new( @_ );
 
19
 
 
20
    $self->{'driver'} = new Lire::Test::CursesUIDriver();
 
21
    my $spec = new Lire::Config::ConfigSpec( 'name' => 'lire' );
 
22
    $spec->add( new Lire::Config::StringSpec( 'name' => 'test',
 
23
                                              'section' => 'programs',
 
24
                                              'summary' => 'Test Summary',
 
25
                                              'description' => '<para>Test Description</para>' ) );
 
26
    $spec->add( new Lire::Config::StringSpec( 'name' => 'another_prog',
 
27
                                              'section' => 'programs', ) );
 
28
    $spec->add( new Lire::Config::StringSpec( 'name' => 'wawa_prog',
 
29
                                              'summary' => "Summary with\nnewlines   \n   and wawas",
 
30
                                              'section' => 'programs' ) );
 
31
    $self->{'spec'} = $spec;
 
32
 
 
33
    return $self;
 
34
}
 
35
 
 
36
sub set_up {
 
37
    my $self = $_[0];
 
38
    $self->SUPER::set_up();
 
39
 
 
40
    $self->{'cfg'}{'_lr_config_spec'} = $self->{'spec'};
 
41
    my $fh;
 
42
    ( $fh, $self->{'cfg_filename'} ) = tempfile( 'lire_cfg_XXXXXX' );
 
43
    $self->{'driver'}->setup_curses_ui();
 
44
 
 
45
    $self->{'cfg_file'} =
 
46
      new Lire::Config::ConfigFile( 'spec' => $self->{'spec'},
 
47
                                    'filename' => $self->{'cfg_filename'} );
 
48
    $self->{'ui'} = new Curses::UI();
 
49
    $self->{'driver'}->set_curses_ui( $self->{'ui'} );
 
50
 
 
51
    return;
 
52
}
 
53
 
 
54
sub tear_down {
 
55
    my $self = $_[0];
 
56
    $self->SUPER::tear_down();
 
57
 
 
58
    $self->{'driver'}->teardown_curses_ui();
 
59
 
 
60
    unlink $self->{'cfg_filename'};
 
61
 
 
62
    return;
 
63
}
 
64
 
 
65
sub test_new {
 
66
    my $self = $_[0];
 
67
 
 
68
    $self->assert_dies( qr/missing \'ui\' parameter/,
 
69
                        sub { new Lire::UI::Prefs() } );
 
70
    $self->assert_dies( qr/missing \'config\' parameter/,
 
71
                        sub { new Lire::UI::Prefs( $self->{'ui'}) } );
 
72
    $self->assert_dies( qr/\'ui\' parameter should be a \'Curses::UI\' instance, not \'HASH/,
 
73
                        sub { new Lire::UI::Prefs( {}, {} ) } );
 
74
    $self->assert_dies( qr/\'config\' parameter should be a \'Lire::Config::ConfigFile\' instance, not \'HASH/,
 
75
                        sub { new Lire::UI::Prefs( $self->{'ui'}, {} ) } );
 
76
 
 
77
    my $prefs = new Lire::UI::Prefs( $self->{'ui'}, $self->{'cfg_file'} );
 
78
    $self->assert_str_equals( $self->{'ui'}, $prefs->{'_ui'} );
 
79
    $self->assert_str_equals( $self->{'cfg_file'}, $prefs->{'_cfg_file'} );
 
80
    $self->assert_not_null( $self->{'ui'}->getobj( 'prefs_win' ),
 
81
                            'was _create_prefs_win() called?' );
 
82
}
 
83
 
 
84
sub test_create_prefs_win {
 
85
    my $self = $_[0];
 
86
 
 
87
    my $ui = bless { '_ui' => $self->{'ui'},
 
88
                     '_cfg_file' => $self->{'cfg_file'} }, 'Lire::UI::Prefs';
 
89
    $ui->_create_prefs_win();
 
90
    my $win = $self->{'ui'}->getobj( 'prefs_win' );
 
91
    $self->assert_isa( 'Curses::UI::Window', $win );
 
92
    $self->assert_str_equals( 'Lire Preferences', $win->title() );
 
93
 
 
94
    foreach my $id ( qw/ section_menu buttons options_list option_summary option_help / ) {
 
95
        my $widget = $win->getobj( $id );
 
96
        $self->assert_not_null( $widget,
 
97
                                "missing widget '$id' in 'prefs_win'" );
 
98
    }
 
99
    $self->assert_str_equals( $ui, $win->userdata() );
 
100
 
 
101
    my $options = $win->getobj( 'options_list' );
 
102
    $self->assert_isa( 'Curses::UI::Listbox', $options );
 
103
    $self->assert_str_equals( \&Lire::UI::Prefs::_option_change_cb,
 
104
                              $options->{'-onchange'} );
 
105
    $self->assert_str_equals( \&Lire::UI::Prefs::_option_selchange_cb,
 
106
                              $options->{'-onselchange'} );
 
107
    my $opt_summary = $win->getobj( 'option_summary' );
 
108
    $self->assert_isa( 'Curses::UI::Label', $opt_summary );
 
109
 
 
110
    my $opt_help = $win->getobj( 'option_help' );
 
111
    $self->assert_isa( 'Curses::UI::TextViewer', $opt_help );
 
112
}
 
113
 
 
114
sub set_up_mock_prefs_win {
 
115
    my $self = $_[0];
 
116
 
 
117
    $self->{'ui_prefs'} = bless { '_ui' => $self->{'ui'},
 
118
                                  '_cfg_file' => $self->{'cfg_file'} },
 
119
                                    'Lire::UI::Prefs';
 
120
    $self->{'prefs_win'} =
 
121
      $self->{'ui'}->add( 'prefs_pane', 'Window', '-y' => 1 );
 
122
    return;
 
123
}
 
124
 
 
125
sub test_create_section_menu {
 
126
    my $self = $_[0];
 
127
 
 
128
    $self->set_up_mock_prefs_win();
 
129
    my $win = $self->{'prefs_win'};
 
130
    $self->{'ui_prefs'}->_create_section_menu( $win );
 
131
 
 
132
    my $section_menu = $win->getobj( 'section_menu' );
 
133
    $self->assert_isa( 'Curses::UI::Popupmenu', $section_menu );
 
134
    $self->assert_num_equals( 0, $section_menu->{'-selected'} );
 
135
    $self->assert_deep_equals( [ 'report', 'responder', 'operation',
 
136
                                 'path', 'docbook', 'programs' ],
 
137
                               $section_menu->{'-values'} );
 
138
    $self->assert_str_equals( 'Responder Preferences',
 
139
                              $section_menu->{'-labels'}{'responder'} );
 
140
    $self->assert_str_equals( \&Lire::UI::Prefs::_section_change_cb,
 
141
                              $section_menu->{'-onchange'} );
 
142
}
 
143
 
 
144
sub test_create_buttons {
 
145
    my $self = $_[0];
 
146
 
 
147
    $self->set_up_mock_prefs_win();
 
148
    my $win = $self->{'prefs_win'};
 
149
    $self->{'ui_prefs'}->_create_buttons( $win );
 
150
 
 
151
    my $buttons = $win->getobj( 'buttons' );
 
152
    $self->assert_isa( 'Curses::UI::Buttonbox',  $buttons );
 
153
    $self->assert_str_equals( '< Cancel >',
 
154
                              $buttons->{'-buttons'}[0]{'-label'} );
 
155
    $self->assert_str_equals( \&Lire::UI::Prefs::_cancel_cb,
 
156
                              $buttons->{'-buttons'}[0]{'-onpress'} );
 
157
    $self->assert_str_equals( '< OK >',
 
158
                              $buttons->{'-buttons'}[1]{'-label'} );
 
159
    $self->assert_str_equals( \&Lire::UI::Prefs::_ok_cb,
 
160
                              $buttons->{'-buttons'}[1]{'-onpress'} );
 
161
}
 
162
 
 
163
sub test_show {
 
164
    my $self = $_[0];
 
165
 
 
166
    my $driver = $self->{'driver'};
 
167
    my $prefs_win = '<undef>';
 
168
    $driver->add_event_loop_handler( sub { $prefs_win = $_[1] } );
 
169
 
 
170
    my $section_menu = '<undef>';
 
171
    my $sel = '<undef>';
 
172
    no warnings 'redefine';
 
173
    local *Lire::UI::Prefs::_section_change_cb =
 
174
      sub { $section_menu = shift;
 
175
            $sel = $section_menu->get() };
 
176
    my $prefs = new Lire::UI::Prefs( $self->{'ui'}, $self->{'cfg_file'} );
 
177
    my $ui_prefs_win = $driver->find_widget( '/prefs_win' );
 
178
    my $ui_section_menu = $driver->find_widget( '/prefs_win/section_menu' );
 
179
    $prefs->show();
 
180
    $self->assert_str_equals( $ui_prefs_win, $prefs_win );
 
181
    $self->assert_null( $self->{'ui'}->getobj( 'prefs_win' ) );
 
182
    $self->assert_str_equals( $ui_section_menu, $section_menu );
 
183
    $self->assert_str_equals( 'report', $sel );
 
184
}
 
185
 
 
186
sub test_section_change_cb {
 
187
    my $self = $_[0];
 
188
 
 
189
    my $driver = $self->{'driver'};
 
190
    my $spec = $self->{'spec'};
 
191
 
 
192
    my $listbox = '<undef>';
 
193
    my $sel = -1;
 
194
    no warnings 'redefine';
 
195
    local *Lire::UI::Prefs::_option_change_cb =
 
196
      sub { $listbox = shift;
 
197
            $sel = $listbox->{'-selected'} };
 
198
 
 
199
    my $prefs = new Lire::UI::Prefs( $self->{'ui'}, $self->{'cfg_file'} );
 
200
    my $section_menu = $driver->find_widget( '/prefs_win/section_menu' );
 
201
    $section_menu->{'-selected'} = 5; # Programs
 
202
 
 
203
    Lire::UI::Prefs::_section_change_cb( $section_menu );
 
204
 
 
205
    my $options = $driver->find_widget( '/prefs_win/options_list');
 
206
    $self->assert_deep_equals( [ $spec->get( 'test' ),
 
207
                                 $spec->get( 'another_prog' ),
 
208
                                 $spec->get( 'wawa_prog' ) ],
 
209
                               $options->{'-values'} );
 
210
    $self->assert_deep_equals( { $spec->get( 'another_prog' ) =>'another_prog',
 
211
                                 $spec->get( 'test' ) => 'test',
 
212
                                 $spec->get( 'wawa_prog' ) => 'wawa_prog'},
 
213
                               $options->{'-labels'} );
 
214
 
 
215
    $self->assert_num_equals( 0, $sel );
 
216
    $self->assert_str_equals( $options, $listbox );
 
217
}
 
218
 
 
219
sub test_option_selchange_cb {
 
220
    my $self = $_[0];
 
221
 
 
222
    my $driver = $self->{'driver'};
 
223
    my $spec = $self->{'spec'};
 
224
    my $listbox = "<undef>";
 
225
    no warnings 'redefine';
 
226
    local *Lire::UI::Prefs::_option_change_cb = sub { $listbox = shift };
 
227
 
 
228
    my $prefs = new Lire::UI::Prefs( $self->{'ui'}, $self->{'cfg_file'} );
 
229
    my $options = $driver->find_widget( '/prefs_win/options_list' );
 
230
    $options->{'-ypos'} = 0;
 
231
    $options->{'-values'} = [ $spec->get( 'another_prog' ),
 
232
                              $spec->get( 'test' ) ];
 
233
    $options->{'-selected'} = undef;
 
234
    Lire::UI::Prefs::_option_selchange_cb( $options );
 
235
    $self->assert_str_equals( $options, $listbox );
 
236
    $self->assert_num_equals( 0, $options->{'-selected'} );
 
237
}
 
238
 
 
239
sub test_option_change_cb {
 
240
    my $self = $_[0];
 
241
 
 
242
    my $driver = $self->{'driver'};
 
243
    my $spec = $self->{'spec'};
 
244
    my $prefs = new Lire::UI::Prefs( $self->{'ui'}, $self->{'cfg_file'} );
 
245
 
 
246
    my $options = $driver->find_widget( '/prefs_win/options_list' );
 
247
    $options->{'-values'} = [ $spec->get( 'another_prog' ),
 
248
                              $spec->get( 'test' ),
 
249
                              $spec->get( 'wawa_prog' ) ];
 
250
    $options->{'-ypos'} = 0;
 
251
    $options->{'-selected'} = 1;
 
252
 
 
253
    Lire::UI::Prefs::_option_change_cb( $options );
 
254
    $self->assert_num_equals( 1, $options->{'-ypos'} );
 
255
 
 
256
    my $opt_summary = $driver->find_widget( '/prefs_win/option_summary' );
 
257
    $self->assert_str_equals( 'Test Summary', $opt_summary->text() );
 
258
    my $opt_help = $driver->find_widget( '/prefs_win/option_help' );
 
259
    $self->assert_str_equals( 'Test Description', $opt_help->text() );
 
260
 
 
261
    my $opt_widget =
 
262
      $driver->find_widget( '/prefs_win' )->getobj( 'option_widget' );
 
263
    $self->assert_isa( "Lire::UI::StringWidget", $opt_widget );
 
264
    $self->assert_str_equals( 'Test Description', $opt_help->text() );
 
265
 
 
266
    $options->{'-selected'} = 0;
 
267
    Lire::UI::Prefs::_option_change_cb( $options );
 
268
    $self->assert_str_equals( 'another_prog', $opt_summary->text() );
 
269
    $self->assert_str_equals( 'No help available.', $opt_help->text() );
 
270
    $self->assert_str_not_equals( $opt_widget,
 
271
                                  $driver->find_widget( '/prefs_win/option_widget' ) );
 
272
 
 
273
    $options->{'-selected'} = 2;
 
274
    Lire::UI::Prefs::_option_change_cb( $options );
 
275
    $self->assert_str_equals( 'Summary with newlines and wawas', $opt_summary->text() );
 
276
 
 
277
    return;
 
278
}
 
279
 
 
280
sub test_option_change_cb_empty {
 
281
    my $self = $_[0];
 
282
    my $driver = $self->{'driver'};
 
283
 
 
284
    my $cfg_file =
 
285
      new Lire::Config::ConfigFile( 'spec' => new Lire::Config::ConfigSpec(),
 
286
                                    'filename' => $self->{'cfg_filename'} );
 
287
    my $prefs = new Lire::UI::Prefs( $self->{'ui'}, $cfg_file );
 
288
 
 
289
    my $options = $driver->find_widget( '/prefs_win/options_list' );
 
290
    $options->{'-values'} = [];
 
291
    $options->{'-ypos'} = 1;
 
292
    $options->{'-selected'} = 1;
 
293
 
 
294
    Lire::UI::Prefs::_option_change_cb( $options );
 
295
    $self->assert_num_equals( 0, $options->{'-ypos'} );
 
296
    $self->assert_null($options->{'-selected'}, "-selected should be undef" );
 
297
 
 
298
    my $opt_summary = $driver->find_widget( '/prefs_win/option_summary' );
 
299
    $self->assert_str_equals( '', $opt_summary->text() );
 
300
    my $opt_help = $driver->find_widget( '/prefs_win/option_help' );
 
301
    $self->assert_str_equals( '', $opt_help->text() );
 
302
}
 
303
 
 
304
sub test_get_var {
 
305
    my $self = $_[0];
 
306
 
 
307
    my $prefs = bless { '_ui' => $self->{'ui'},
 
308
                     '_cfg_file' => $self->{'cfg_file'} }, 'Lire::UI::Prefs';
 
309
 
 
310
    my $test_in_file = $self->{'cfg_file'}->get( 'test' );
 
311
    $self->assert_str_equals( $test_in_file, $prefs->_get_var( 'test' ) );
 
312
 
 
313
    $self->assert( ! $self->{'cfg_file'}->is_set( 'another_prog' ),
 
314
                   "'another_prog' unexpectedly set" );
 
315
    $self->{'cfg'}{'another_prog'} = '/bin/ls';
 
316
    my $prog_from_config = Lire::Config->get_var( 'another_prog' );
 
317
    my $prog_from_file = $prefs->_get_var( 'another_prog' );
 
318
    $self->assert_str_not_equals( $prog_from_config, $prog_from_file  );
 
319
    $self->assert( $self->{'cfg_file'}->is_set( 'another_prog' ),
 
320
                   "'another_prog' should now be set in config file" );
 
321
    $self->assert_str_equals( '/bin/ls', $prog_from_file->get() );
 
322
}
 
323
 
 
324
 
 
325
sub test_ok_cb {
 
326
    my $self = $_[0];
 
327
 
 
328
    my $prefs_win = '< undef (loose_focus not called) >';
 
329
    my $cfg_file = '< undef (save not called) >';
 
330
 
 
331
    my $prefs = new Lire::UI::Prefs( $self->{'ui'}, $self->{'cfg_file'} );
 
332
 
 
333
    no warnings 'redefine';
 
334
    local *Curses::UI::Window::loose_focus = sub { $prefs_win = shift };
 
335
    local *Lire::Config::ConfigFile::save = sub { $cfg_file = shift };
 
336
 
 
337
    my $btn_box = $self->{'driver'}->find_widget( '/prefs_win/buttons' );
 
338
    Lire::UI::Prefs::_ok_cb( $btn_box );
 
339
    $self->assert_str_equals( $self->{'ui'}->getobj( 'prefs_win' ),
 
340
                              $prefs_win );
 
341
 
 
342
    $self->assert_str_equals( $self->{'cfg_file'}, $cfg_file );
 
343
}
 
344
 
 
345
sub test_cancel_cb {
 
346
    my $self = $_[0];
 
347
 
 
348
    my $prefs_win = '< undef (loose_focus not called) >';
 
349
    my $cfg_file = '< undef (revert not called) >';
 
350
 
 
351
    my $prefs = new Lire::UI::Prefs( $self->{'ui'}, $self->{'cfg_file'} );
 
352
 
 
353
    no warnings 'redefine';
 
354
    local *Curses::UI::Window::loose_focus = sub { $prefs_win = shift };
 
355
    local *Lire::Config::ConfigFile::revert = sub { $cfg_file = shift };
 
356
 
 
357
    my $btn_box = $self->{'driver'}->find_widget( '/prefs_win/buttons' );
 
358
    Lire::UI::Prefs::_cancel_cb( $btn_box );
 
359
    $self->assert_str_equals( $self->{'ui'}->getobj( 'prefs_win' ),
 
360
                              $prefs_win );
 
361
 
 
362
    $self->assert_str_equals( $self->{'cfg_file'}, $cfg_file );
 
363
}
 
364
 
 
365
1;