src/gtkdbi.pm

   1 #!/usr/bin/perl -w
   2 #
   3 # This is the basis of an application with signal handlers
   4 #
   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
   7 #
   8 # Skeleton subs of any missing signal handlers can be copied from
   9 # /home/ivan/gtkdbi/src/GtkdbiSIGS.pm
  10 #
  11 #==============================================================================
  12 #=== This is the 'window1' class
  13 #==============================================================================
  14 package window1;
  15 require 5.000; use strict 'vars', 'refs', 'subs';
  16 # UI class 'window1' (version 0.01)
  17 #
  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>
  20 #
  21 ## Unspecified copying policy, please contact the author\n#  Ivan Kohler,Chess room,888-670-SISD,215-996-0824 <ivan\@rootwood.haze.st>
  22 #
  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>
  27 #
  28 # from Glade file /home/ivan/gtkdbi/gtkdbi.glade
  29 # Tue Oct 23 01:53:38 PDT 2001
  30 #==============================================================================
  31
  32 BEGIN {
  33     use src::gtkdbiUI;
  34 } # End of sub BEGIN
  35
  36 use vars qw($ick_global_window1 $dbh $schema);
  37
  38 sub app_run {
  39     my ($class) = @_;
  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');
  45     Gtk->init;
  46     my $window = $class->new;
  47     $ick_global_window1 = $window;
  48     $window->TOPLEVEL->show;
  49
  50     # Put any extra UI initialisation (eg signal_connect) calls here
  51
  52     # Now let Gtk handle signals
  53     Gtk->main;
  54
  55     $window->TOPLEVEL->destroy;
  56
  57     return $window;
  58
  59 } # End of sub app_run
  60
  61 #===============================================================================
  62 #=== Below are the default signal handlers for 'window1' class
  63 #===============================================================================
  64 sub about_Form {
  65     my ($class) = @_;
  66     my $gtkversion =
  67         Gtk->major_version.".".
  68         Gtk->minor_version.".".
  69         Gtk->micro_version;
  70     my $name = $0;
  71     my $message =
  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
  81
  82 sub destroy_Form {
  83     my ($class, $data, $object, $instance) = @_;
  84     Gtk->main_quit;
  85 } # End of sub destroy_Form
  86
  87 sub toplevel_hide    { shift->get_toplevel->hide    }
  88 sub toplevel_close   { shift->get_toplevel->close   }
  89 sub toplevel_destroy { shift->get_toplevel->destroy }
  90
  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};
  99 #
 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");
 102 #
 103 #} # End of sub on_file1_activate
 104 #
 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};
 110 #
 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");
 113 #
 114 #} # End of sub on_help1_activate
 115
 116
 117 use vars qw($quit_dialog);
 118 #$quit_dialog = quit_dialog->new;
 119
 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};
 125
 126     $quit_dialog ||= quit_dialog->new;
 127
 128     #should disable window1 too
 129
 130     $quit_dialog->TOPLEVEL->show;
 131
 132 }
 133
 134 {
 135   package quit_dialog;
 136
 137   sub on_quit_no_clicked {
 138     my ($class, $data, $object, $instance, $event) = @_;
 139     $class->get_toplevel->hide;
 140   }
 141
 142   sub on_quit_yes_clicked {
 143     my ($class, $data, $object, $instance, $event) = @_;
 144     #exit;
 145     Gtk->main_quit;
 146   }
 147 }
 148
 149 use vars qw($about_dialog);
 150
 151 sub on_about1_activate {
 152     my ($class, $data, $object, $instance, $event) = @_;
 153
 154     $about_dialog ||= about_dialog->new;
 155
 156     #should disable window1 too
 157
 158     $about_dialog->TOPLEVEL->show;
 159
 160 }
 161
 162 {
 163   package about_dialog;
 164
 165   sub on_about_button_clicked {
 166     my ($class, $data, $object, $instance, $event) = @_;
 167     $class->get_toplevel->hide;
 168   }
 169
 170 }
 171
 172 use vars qw($connect_dialog);
 173
 174 sub on_connect1_activate {
 175     my ($class, $data, $object, $instance, $event) = @_;
 176
 177     $connect_dialog ||= connect_dialog->new;
 178
 179     $connect_dialog->read_sessions;
 180
 181     #should disable window1 too
 182
 183     $connect_dialog->TOPLEVEL->show;
 184
 185 }
 186
 187 {
 188   package connect_dialog;
 189
 190   use vars qw( $datasource $username $password ); #shouldn't be globals...
 191 #  $datasource = '';
 192 #  $username = '';
 193 #  $password = '';
 194
 195   use vars qw( %session_username %session_password ); #ick more
 196
 197   use subs qw( save_session );
 198
 199   sub on_abortconnect_button_clicked {
 200     my ($class, $data, $object, $instance, $event) = @_;
 201     $class->get_toplevel->hide;
 202   }
 203
 204   sub on_connect_button_clicked {
 205     my ($class, $data, $object, $instance, $event) = @_;
 206
 207     # dbh shouldn't be global.  alas.  window1 should pass a ref to connect dialog or something.
 208     use DBI;
 209     use DBIx::DBSchema 0.19;
 210     $@ = '';
 211     if ( $window1::dbh =
 212            eval { DBI->connect($datasource, $username, $password,
 213                                { RaiseError => 0, PrintError => 0 },
 214                               )
 215                 }
 216     ) {
 217
 218       save_session($datasource, $username, $password)
 219         unless exists $session_username{$datasource};
 220
 221       $class->get_toplevel->hide;
 222
 223       #shouldn't be global
 224       $window1::ick_global_window1->TOPLEVEL->set_title("gtkdbi - $datasource");
 225       $window1::ick_global_window1->FORM->{'entry1'}->set_text("Connected to $datasource");
 226
 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;
 230
 231 #      warn $window1::schema->pretty_print;
 232
 233       foreach my $table ( $window1::schema->tables ) {
 234         #make a
 235         warn $table;
 236
 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;
 240           next;
 241         };
 242         $sth->execute or do {
 243           warn "should pop up an error message ". $sth->errstr;
 244           next;
 245         };
 246
 247         my $rows = $sth->fetchall_arrayref({});
 248
 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 );
 252
 253         $window1::ick_global_window1->FORM->{'notebook1'}->append_page($window, $label);
 254
 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' );
 260
 261
 262       }
 263
 264     } else {
 265       warn "should pop up an error message $DBI::errstr $@";
 266     }
 267
 268   }
 269
 270   sub on_datasource_entry_changed {
 271     my ($class, $data, $object, $instance, $event) = @_;
 272     $datasource = $class->get_text;
 273   }
 274
 275   sub on_username_entry_changed {
 276     my ($class, $data, $object, $instance, $event) = @_;
 277     $username = $class->get_text;
 278   }
 279
 280   sub on_password_entry_changed {
 281     my ($class, $data, $object, $instance, $event) = @_;
 282     $password = $class->get_text;
 283   }
 284
 285   sub on_savesession_button_clicked {
 286     my ($class, $data, $object, $instance, $event) = @_;
 287
 288     save_session($datasource, $username, $password);
 289
 290   }
 291
 292   #sub, not method
 293   sub save_session {
 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: $!";
 298       #error dialog
 299       return;
 300     };
 301     print CONF "$datasource\t$username\t$password\n";
 302     close CONF;
 303   }
 304
 305   #method
 306   sub read_sessions {
 307     my $self = shift;
 308     #this is very lame and embarassing but it works for now.
 309     open(CONF, "<$ENV{HOME}/.gtkdbi") or return;
 310     while (<CONF>) {
 311       chomp;
 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 );
 319       $menuitem->show;
 320     }
 321     close CONF;
 322   }
 323
 324   sub on_session_optionmenu_changed {
 325     my( $self, $data ) = @_;
 326
 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});
 331   }
 332
 333 }
 334
 335 #################################3
 336
 337 package resultview;
 338
 339 sub new {
 340   my ( $self, $labeltext, $columns, $rows ) = @_;
 341
 342   my $widgets;
 343   my $forms;
 344
 345   #ganked from a glade-constructed gtkdbiUI.pm
 346
 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'};
 355                     #
 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'};
 362                         #
 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'};
 368
 369                         foreach my $column ( @$columns ) {
 370                             #
 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;
 377                             $vbox->show;
 378                             #$forms->{'window1'}{'vbox2'} = $widgets->{'vbox2'};
 379                                 #
 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;
 386                                 $button->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' );
 392                                 #
 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'} );
 398                                     $vbox->add($entry );
 399                                     #$widgets->{'entry2'}->show;
 400                                     $entry->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 );
 408
 409                                     #$forms->{'window1'}{'vbox2'}->set_child_packing($forms->{'window1'}{'entry2'}, 0, 0, 0, 'start' );
 410                                     $vbox->set_child_packing($entry, 0, 0, 0, 'start' );
 411                                 }
 412
 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' );
 415                         }
 416
 417 #                           #
 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'};
 423 #                               #
 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' );
 431 #                               #
 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' );
 444
 445                 #
 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 );
 453
 454   ( $widgets->{'scrolledwindow1'}, $label );
 455
 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' );
 461
 462
 463 }
 464
 465 1;
 466
 467 __END__
 468
 469 #===============================================================================
 470 #==== Documentation
 471 #===============================================================================
 472 =pod
 473
 474 =head1 NAME
 475
 476 gtkdbi - version 0.01 Tue Oct 23 01:49:12 PDT 2001
 477
 478 No description
 479
 480 =head1 SYNOPSIS
 481
 482  use gtkdbi;
 483
 484  To construct the window object and show it call
 485
 486  Gtk->init;
 487  my $window = window1->new;
 488  $window->TOPLEVEL->show;
 489  Gtk->main;
 490
 491  OR use the shorthand for the above calls
 492
 493  window1->app_run;
 494
 495 =head1 DESCRIPTION
 496
 497 Unfortunately, the author has not yet written any documentation :-(
 498
 499 =head1 AUTHOR
 500
 501 Ivan Kohler,Chess room,888-670-SISD,215-996-0824 <ivan\@rootwood.haze.st>
 502
 503 =cut