#!/usr/bin/perl
use warnings;
use strict;
# Tk support is enabled if the Tk module is used before POE itself.
use Tk;
use POE;
use POE qw( Component::EasyDBI );
use Data::Dumper qw/Dumper/;
use Perl6::Say;
# -- Set up the DBI
POE::Component::EasyDBI->spawn( # or new(), witch returns an obj
alias => 'EasyDBI',
dsn => 'dbi:Oracle:localhost',
username => 'username',
password => 'password',
options => {
AutoCommit => 0,
},
);
# -- Create the session that will drive the user interface.
POE::Session->create(
inline_states => {
_start => \&ui_start,
ev_count => \&ui_count,
ev_clear => \&ui_clear,
get_some_data => \&get_some_data,
dummy_result_handler => \&dummy_result_handler,
},
);
# Run the program until it is exited.
$poe_kernel->run();
exit 0;
=head2 METHODEN
=head3 ui_start( ??? )
Create the user interface when the session starts. This assumes
some familiarity with Tk. ui_start() illustrates four important
points.
1. Tk events require a main window. POE creates one for internal
use and exports it as $poe_main_window. ui_start() uses that as the
basis for its user interface.
2. Widgets we need to work with later, such as the counter display,
must be stored somewhere. The heap is a convenient place for them.
3. Tk widgets expect callbacks in the form of coderefs. The
session's postback() method provides coderefs that post events when
called. The Button created in ui_start() fires an "ev_clear" event
when it is pressed.
4. POE::Kernel methods such as yield(), post(), delay(), signal(),
and select() (among others) work the same as they would without Tk.
This feature makes it possible to write back end sessions that
support multiple GUIs with a single code base.
=cut
sub ui_start {
my ( $self, $kernel, $session, $heap ) = @_[ OBJECT, KERNEL, SESSION, HEAP ];
# ------------------------------------------------------------
# - Initialisierung
# ------------------------------------------------------
# -- Test: etwas Inhalt einfügen
# ...
# ------------------------------------------------------
$heap->{testlabel} = $poe_main_window->Label(-text => 'start')->pack();
# ------------------------------------------------------------
# - Statusbar
# -> für den UI-Counter
require Tk::StatusBar;
$heap->{statusbar} = $poe_main_window->StatusBar();
$heap->{statusbar}->addLabel(
-relief => 'flat',
-text => "Welcome to the statusbar",
);
$heap->{statusbar}->addLabel(
-text => 'Frame:',
-width => '10',
-anchor => 'center',
);
$heap->{statusbar}->addLabel(
-width => 20,
-anchor => 'center',
-textvariable => \$heap->{counter},
-foreground => 'blue',
);
$heap->{statusbar}->addLabel(
-width => 10,
-anchor => 'center',
-text => "Clear",
-foreground => 'blue',
-command => $session->postback("ev_clear"),
-event => '<Button-1>',
);
# ------------------------------------------------------------
# - Test-Zeug
testzeug( $heap, $poe_main_window );
say "yield2get_some_data";
$kernel->yield('get_some_data');
say "yield2ev_count";
$kernel->yield("ev_count");
} # /ui_start
=head3 testzeug( $heap, $poe_main_window )
Dient dazu diverses Testzeug auszuführen, z.B: Debugging.
Bei Auslieferung des Programms sollte diese Funktion nichts mehr machen, aber
dennoch enthalten sein damit man später mal schnell was debuggen kann.
=cut
sub testzeug {
my $heap = shift;
my $mw = shift;
} # /testzeug
=head2 ui_count( ??? )
Handle the "ev_count" event by increasing a counter and displaying
its new value.
=cut
sub ui_count {
my ($self, $kernel, $heap) = @_[OBJECT, KERNEL, HEAP];
$heap->{counter}++;
$kernel->yield("ev_count");
} # /ui_count
=head2 ui_clear
Handle the "ev_clear" event by clearing and redisplaying the
counter.
=cut
sub ui_clear {
$_[HEAP]->{counter} = 0;
} # /ui_clear
=head2 dummy_result_handler( ... )
$_[ARG0] = {
sql => The SQL you sent
result => hash ref of hash refs keyed on primary key
placeholders => The placeholders
action => 'hashhash'
cols => array of columns in order (to help recreate the sql order)
error => Error occurred, check this first
result => ... result varies ...
}
print Dumper $_[ARG0]->{sql};
=cut
sub dummy_result_handler {
my ($self, $kernel, $heap) = @_[OBJECT, KERNEL, HEAP];
$heap->{testlabel}->configure(-text => $_[ARG0]->{result}->{CurrentTime});
print Dumper $_[ARG0];
$kernel->delay( 'get_some_data' => 2 );
} # /dummy_result_handler
=head2 get_some_data( ... )
Fetch some data here
=cut
sub get_some_data {
my ($self, $kernel, $heap) = @_[OBJECT, KERNEL, HEAP];
#say "get_it";
$kernel->post( 'EasyDBI',
hash => {
sql => q{select to_char(sysdate, 'Dy DD-Mon-YYYY HH24:MI:SS') as "CurrentTime" from dual},
event => 'dummy_result_handler',
}
);
} # /get_some_data
=head1 QUELLEN
http://poe.perl.org/?POE_Cookbook/Tk_Interfaces
This sample program creates a very simple Tk counter. Its interface
consists of three widgets: A rapidly increasing counter, and a
button to reset that counter.
=cut