3 # This is the basis of an application with signal handlers
5 # You can safely edit this file, any changes that you make will be preserved
6 # and this file will not be overwritten by the next run of Glade::PerlGenerate
8 # Skeleton subs of any missing signal handlers can be copied from
9 # /home/ivan/gtkdbi/src/GtkdbiSIGS.pm
11 #==============================================================================
12 #=== This is the 'window1' class
13 #==============================================================================
15 require 5.000; use strict 'vars', 'refs', 'subs';
16 # UI class 'window1' (version 0.01)
18 # Copyright (c) Date Tue Oct 23 01:49:12 PDT 2001
19 # Author Ivan Kohler,Chess room,888-670-SISD,215-996-0824 <ivan\@rootwood.haze.st>
21 ## Unspecified copying policy, please contact the author\n# Ivan Kohler,Chess room,888-670-SISD,215-996-0824 <ivan\@rootwood.haze.st>
23 #==============================================================================
24 # This perl source file was automatically generated by
25 # Glade::PerlGenerate version 0.59 - Wed Jun 20 14:48:25 BST 2001
26 # Copyright (c) Author Dermot Musgrove <dermot.musgrove\@virgin.net>
28 # from Glade file /home/ivan/gtkdbi/gtkdbi.glade
29 # Tue Oct 23 01:53:38 PDT 2001
30 #==============================================================================
36 use vars qw($ick_global_window1 $dbh $schema);
40 #$class->load_translations('Gtkdbi');
41 $class->load_translations('gtkdbi');
42 # You can use the line below to load a test .mo file before it is installed in
43 # the normal place (eg /usr/local/share/locale/fr/LC_MESSAGES/Gtkdbi.mo)
44 # $class->load_translations('Gtkdbi', 'test', undef, '/home/ivan/gtkdbi/ppo/Gtkdbi.mo');
46 my $window = $class->new;
47 $ick_global_window1 = $window;
48 $window->TOPLEVEL->show;
50 # Put any extra UI initialisation (eg signal_connect) calls here
52 # Now let Gtk handle signals
55 $window->TOPLEVEL->destroy;
59 } # End of sub app_run
61 #===============================================================================
62 #=== Below are the default signal handlers for 'window1' class
63 #===============================================================================
67 Gtk->major_version.".".
68 Gtk->minor_version.".".
72 __PACKAGE__." ("._("version")." $VERSION - $DATE)\n".
73 _("Written by")." $AUTHOR \n\n".
74 _("No description")." \n\n".
75 "Gtk ". _("version").": $gtkversion\n".
76 "Gtk-Perl "._("version").": $Gtk::VERSION\n".
77 _("run from file").": $name";
78 __PACKAGE__->message_box($message, _("About")." \u".__PACKAGE__, [_('Dismiss'), _('Quit Program')], 1,
79 "$Glade::PerlRun::pixmaps_directory/glade2perl_logo.xpm", 'left' );
80 } # End of sub about_Form
83 my ($class, $data, $object, $instance) = @_;
85 } # End of sub destroy_Form
87 sub toplevel_hide { shift->get_toplevel->hide }
88 sub toplevel_close { shift->get_toplevel->close }
89 sub toplevel_destroy { shift->get_toplevel->destroy }
91 #==============================================================================
92 #=== Below are the signal handlers for 'window1' class
93 #==============================================================================
94 #sub on_file1_activate {
95 # my ($class, $data, $object, $instance, $event) = @_;
96 # my $me = __PACKAGE__."->on_file1_activate";
97 # # Get ref to hash of all widgets on our form
98 # my $form = $__PACKAGE__::all_forms->{$instance};
100 # # REPLACE the line below with the actions to be taken when __PACKAGE__."->on_file1_activate." is called
101 # __PACKAGE__->show_skeleton_message($me, \@_, __PACKAGE__, "$Glade::PerlRun::pixmaps_directory/glade2perl_logo.xpm");
103 #} # End of sub on_file1_activate
105 #sub on_help1_activate {
106 # my ($class, $data, $object, $instance, $event) = @_;
107 # my $me = __PACKAGE__."->on_help1_activate";
108 # # Get ref to hash of all widgets on our form
109 # my $form = $__PACKAGE__::all_forms->{$instance};
111 # # REPLACE the line below with the actions to be taken when __PACKAGE__."->on_help1_activate." is called
112 # __PACKAGE__->show_skeleton_message($me, \@_, __PACKAGE__, "$Glade::PerlRun::pixmaps_directory/glade2perl_logo.xpm");
114 #} # End of sub on_help1_activate
117 use vars qw($quit_dialog);
118 #$quit_dialog = quit_dialog->new;
120 sub on_quit1_activate {
121 my ($class, $data, $object, $instance, $event) = @_;
122 # my $me = __PACKAGE__."->on_quit1_activate";
123 # Get ref to hash of all widgets on our form
124 # my $form = $__PACKAGE__::all_forms->{$instance};
126 $quit_dialog ||= quit_dialog->new;
128 #should disable window1 too
130 $quit_dialog->TOPLEVEL->show;
137 sub on_quit_no_clicked {
138 my ($class, $data, $object, $instance, $event) = @_;
139 $class->get_toplevel->hide;
142 sub on_quit_yes_clicked {
143 my ($class, $data, $object, $instance, $event) = @_;
149 use vars qw($about_dialog);
151 sub on_about1_activate {
152 my ($class, $data, $object, $instance, $event) = @_;
154 $about_dialog ||= about_dialog->new;
156 #should disable window1 too
158 $about_dialog->TOPLEVEL->show;
163 package about_dialog;
165 sub on_about_button_clicked {
166 my ($class, $data, $object, $instance, $event) = @_;
167 $class->get_toplevel->hide;
172 use vars qw($connect_dialog);
174 sub on_connect1_activate {
175 my ($class, $data, $object, $instance, $event) = @_;
177 $connect_dialog ||= connect_dialog->new;
179 $connect_dialog->read_sessions;
181 #should disable window1 too
183 $connect_dialog->TOPLEVEL->show;
188 package connect_dialog;
190 use vars qw( $datasource $username $password ); #shouldn't be globals...
195 use vars qw( %session_username %session_password ); #ick more
197 use subs qw( save_session );
199 sub on_abortconnect_button_clicked {
200 my ($class, $data, $object, $instance, $event) = @_;
201 $class->get_toplevel->hide;
204 sub on_connect_button_clicked {
205 my ($class, $data, $object, $instance, $event) = @_;
207 # dbh shouldn't be global. alas. window1 should pass a ref to connect dialog or something.
209 use DBIx::DBSchema 0.19;
212 eval { DBI->connect($datasource, $username, $password,
213 { RaiseError => 0, PrintError => 0 },
218 save_session($datasource, $username, $password)
219 unless exists $session_username{$datasource};
221 $class->get_toplevel->hide;
224 $window1::ick_global_window1->TOPLEVEL->set_title("gtkdbi - $datasource");
225 $window1::ick_global_window1->FORM->{'entry1'}->set_text("Connected to $datasource");
227 #$window1::schema = new_odbc DBIx::DBSchema $window1::dbh;
228 #DBI::type_info Pg driver returned no results for type 23 at /usr/local/share/perl/5.6.1/DBIx/DBSchema/Table.pm line 172.
229 $window1::schema = new_native DBIx::DBSchema $window1::dbh;
231 # warn $window1::schema->pretty_print;
233 foreach my $table ( $window1::schema->tables ) {
237 #maybe this should go in a sub around resultview
238 my $sth = $window1::dbh->prepare("SELECT * FROM $table") or do {
239 warn "should pop up an error message ". $window1::dbh->errstr;
242 $sth->execute or do {
243 warn "should pop up an error message ". $sth->errstr;
247 my $rows = $sth->fetchall_arrayref({});
249 #my $view = resultview->new( $table, [ $schema->table($table)->columns ], [] );
250 #my($window, $label) = resultview->new( $table, [ $window1::schema->table($table)->columns ], [] );
251 my($window, $label) = resultview->new( $table, [ $window1::schema->table($table)->columns ], $rows );
253 $window1::ick_global_window1->FORM->{'notebook1'}->append_page($window, $label);
255 # $forms->{'window1'}{'notebook1'}->append_page($forms->{'window1'}{'scrolledwindow1'}, $widgets->{'tablelabel1'} );
256 # $widgets->{'tablelabel1'}->show;
257 # $forms->{'window1'}{'tablelabel1'} = $widgets->{'tablelabel1'};
258 # $forms->{'window1'}{'tablelabel1'}->set_alignment(0.5, 0.5 );
259 # $forms->{'window1'}{'vbox1'}->set_child_packing($forms->{'window1'}{'notebook1'}, 1, 1, 0, 'start' );
265 warn "should pop up an error message $DBI::errstr $@";
270 sub on_datasource_entry_changed {
271 my ($class, $data, $object, $instance, $event) = @_;
272 $datasource = $class->get_text;
275 sub on_username_entry_changed {
276 my ($class, $data, $object, $instance, $event) = @_;
277 $username = $class->get_text;
280 sub on_password_entry_changed {
281 my ($class, $data, $object, $instance, $event) = @_;
282 $password = $class->get_text;
285 sub on_savesession_button_clicked {
286 my ($class, $data, $object, $instance, $event) = @_;
288 save_session($datasource, $username, $password);
294 my($datasource, $username, $password) = @_;
295 #this is very lame and embarassing but it works for now.
296 open(CONF, ">>$ENV{HOME}/.gtkdbi") or do {
297 warn "should pop up an error message: can't open $ENV{HOME}/.gtkdbi: $!";
301 print CONF "$datasource\t$username\t$password\n";
308 #this is very lame and embarassing but it works for now.
309 open(CONF, "<$ENV{HOME}/.gtkdbi") or return;
312 my($datasource, $username, $password) = split(/\t/, $_);
313 $session_username{$datasource} = $username;
314 $session_password{$datasource} = $password;
315 my $menuitem = new Gtk::MenuItem($datasource);
316 my $class = ref($self);
317 $menuitem->signal_connect('activate', "$class\::on_session_optionmenu_changed", $datasource );
318 $self->FORM->{'session_optionmenu_menu'}->append( $menuitem );
324 sub on_session_optionmenu_changed {
325 my( $self, $data ) = @_;
327 # via $window1:: ???? ! this is getting worse and worse.
328 $window1::connect_dialog->FORM->{'datasource_entry'}->set_text($data);
329 $window1::connect_dialog->FORM->{'username_entry'}->set_text($session_username{$data});
330 $window1::connect_dialog->FORM->{'password_entry'}->set_text($session_password{$data});
335 #################################3
340 my ( $self, $labeltext, $columns, $rows ) = @_;
345 #ganked from a glade-constructed gtkdbiUI.pm
347 # Construct a GtkScrolledWindow 'scrolledwindow1'
348 $widgets->{'scrolledwindow1'} = new Gtk::ScrolledWindow( undef, undef);
349 $widgets->{'scrolledwindow1'}->set_policy('always', 'always' );
350 $widgets->{'scrolledwindow1'}->border_width(0 );
351 $widgets->{'scrolledwindow1'}->hscrollbar->set_update_policy('continuous' );
352 $widgets->{'scrolledwindow1'}->vscrollbar->set_update_policy('continuous' );
353 $widgets->{'scrolledwindow1'}->show;
354 $forms->{'window1'}{'scrolledwindow1'} = $widgets->{'scrolledwindow1'};
356 # Construct a GtkViewport 'viewport1'
357 $widgets->{'viewport1'} = new Gtk::Viewport(new Gtk::Adjustment( 0.0, 0.0, 101.0, 0.1, 1.0, 1.0), new Gtk::Adjustment( 0.0, 0.0, 101.0, 0.1, 1.0, 1.0) );
358 $widgets->{'viewport1'}->set_shadow_type('in' );
359 $forms->{'window1'}{'scrolledwindow1'}->add_with_viewport($widgets->{'viewport1'} );
360 $widgets->{'viewport1'}->show;
361 $forms->{'window1'}{'viewport1'} = $widgets->{'viewport1'};
363 # Construct a GtkHBox 'hbox1'
364 $widgets->{'hbox1'} = new Gtk::HBox(0, 0 );
365 $forms->{'window1'}{'viewport1'}->add($widgets->{'hbox1'} );
366 $widgets->{'hbox1'}->show;
367 $forms->{'window1'}{'hbox1'} = $widgets->{'hbox1'};
369 foreach my $column ( @$columns ) {
371 # Construct a GtkVBox 'vbox2'
372 #$widgets->{'vbox2'} = new Gtk::VBox(0, 0 );
373 my $vbox = new Gtk::VBox(0, 0 );
374 #$forms->{'window1'}{'hbox1'}->add($widgets->{'vbox2'} );
375 $forms->{'window1'}{'hbox1'}->add($vbox);
376 #$widgets->{'vbox2'}->show;
378 #$forms->{'window1'}{'vbox2'} = $widgets->{'vbox2'};
380 # Construct a GtkButton 'button1'
381 #$widgets->{'button1'} = new Gtk::Button(_('button1'));
382 my $button = new Gtk::Button($column);
383 #$forms->{'window1'}{'vbox2'}->add($widgets->{'button1'} );
384 $vbox->add($button );
385 #$widgets->{'button1'}->show;
387 #$forms->{'window1'}{'button1'} = $widgets->{'button1'};
388 #$forms->{'window1'}{'button1'}->can_focus(1 );
389 $button->can_focus(1 );
390 #$forms->{'window1'}{'vbox2'}->set_child_packing($forms->{'window1'}{'button1'}, 0, 0, 0, 'start' );
391 $vbox->set_child_packing($button, 0, 0, 0, 'start' );
393 # Construct a GtkEntry 'entry2'
394 foreach my $row ( @$rows ) {
395 #$widgets->{'entry2'} = new Gtk::Entry;
396 my $entry = new Gtk::Entry;
397 #$forms->{'window1'}{'vbox2'}->add($widgets->{'entry2'} );
399 #$widgets->{'entry2'}->show;
401 #$forms->{'window1'}{'entry2'} = $widgets->{'entry2'};
402 $entry->can_focus(1 );
403 #$entry->set_text(_('') );
404 $entry->set_text($row->{$column});
405 $entry->set_max_length(0 );
406 $entry->set_visibility(1 );
407 $entry->set_editable(1 );
409 #$forms->{'window1'}{'vbox2'}->set_child_packing($forms->{'window1'}{'entry2'}, 0, 0, 0, 'start' );
410 $vbox->set_child_packing($entry, 0, 0, 0, 'start' );
413 #$forms->{'window1'}{'hbox1'}->set_child_packing($forms->{'window1'}{'vbox2'}, 1, 1, 0, 'start' );
414 $forms->{'window1'}{'hbox1'}->set_child_packing($vbox, 1, 1, 0, 'start' );
418 # # Construct a GtkVBox 'vbox3'
419 # $widgets->{'vbox3'} = new Gtk::VBox(0, 0 );
420 # $forms->{'window1'}{'hbox1'}->add($widgets->{'vbox3'} );
421 # $widgets->{'vbox3'}->show;
422 # $forms->{'window1'}{'vbox3'} = $widgets->{'vbox3'};
424 # # Construct a GtkButton 'button2'
425 # $widgets->{'button2'} = new Gtk::Button(_('button2'));
426 # $forms->{'window1'}{'vbox3'}->add($widgets->{'button2'} );
427 # $widgets->{'button2'}->show;
428 # $forms->{'window1'}{'button2'} = $widgets->{'button2'};
429 # $forms->{'window1'}{'button2'}->can_focus(1 );
430 # $forms->{'window1'}{'vbox3'}->set_child_packing($forms->{'window1'}{'button2'}, 0, 0, 0, 'start' );
432 # # Construct a GtkEntry 'entry3'
433 # $widgets->{'entry3'} = new Gtk::Entry;
434 # $forms->{'window1'}{'vbox3'}->add($widgets->{'entry3'} );
435 # $widgets->{'entry3'}->show;
436 # $forms->{'window1'}{'entry3'} = $widgets->{'entry3'};
437 # $forms->{'window1'}{'entry3'}->can_focus(1 );
438 # $forms->{'window1'}{'entry3'}->set_text(_('') );
439 # $forms->{'window1'}{'entry3'}->set_max_length(0 );
440 # $forms->{'window1'}{'entry3'}->set_visibility(1 );
441 # $forms->{'window1'}{'entry3'}->set_editable(1 );
442 # $forms->{'window1'}{'vbox3'}->set_child_packing($forms->{'window1'}{'entry3'}, 0, 0, 0, 'start' );
443 # $forms->{'window1'}{'hbox1'}->set_child_packing($forms->{'window1'}{'vbox3'}, 1, 1, 0, 'start' );
446 # Construct a GtkLabel 'tablelabel1'
447 #$widgets->{'tablelabel1'} = new Gtk::Label(_('tabletable1'));
448 my $label = new Gtk::Label($labeltext);
449 #$widgets->{'tablelabel1'}->set_justify('center' );
450 $label->set_justify('center' );
451 #$widgets->{'tablelabel1'}->set_line_wrap(0 );
452 $label->set_line_wrap(0 );
454 ( $widgets->{'scrolledwindow1'}, $label );
456 # $forms->{'window1'}{'notebook1'}->append_page($forms->{'window1'}{'scrolledwindow1'}, $widgets->{'tablelabel1'} );
457 # $widgets->{'tablelabel1'}->show;
458 # $forms->{'window1'}{'tablelabel1'} = $widgets->{'tablelabel1'};
459 # $forms->{'window1'}{'tablelabel1'}->set_alignment(0.5, 0.5 );
460 # $forms->{'window1'}{'vbox1'}->set_child_packing($forms->{'window1'}{'notebook1'}, 1, 1, 0, 'start' );
469 #===============================================================================
471 #===============================================================================
476 gtkdbi - version 0.01 Tue Oct 23 01:49:12 PDT 2001
484 To construct the window object and show it call
487 my $window = window1->new;
488 $window->TOPLEVEL->show;
491 OR use the shorthand for the above calls
497 Unfortunately, the author has not yet written any documentation :-(
501 Ivan Kohler,Chess room,888-670-SISD,215-996-0824 <ivan\@rootwood.haze.st>