ActiveState Perl 5.8.3
PAR .83
Windows XP w/SP1
using: pp -g ticketron.pl -o ticketron.exe
== CODE ==
use strict;
use warnings;
use Win32::Console;
use Tk;
use DBI;
Win32::Console::Free;
# needed for PAR to make EXE file
use Encode::Unicode;
my ($mw, $lbl_userid, $output, $userid, $email);
my ($dbh, $sth,);
my $uid = "rpts";
my $pwd = "rpts";
my $dbname = "LIMSRPTS";
my %attr = (PrintError => 0, RaiseError => 1, AutoCommit => 0);
# create the main window
$mw = MainWindow->new( -title => 'Ticket Tracker');
$mw->geometry('+250+250');
$mw->resizable(0,0);
$mw->raise;
# menubar
$mw->configure(-menu => my $menubar = $mw->Menu,);
my $file = $menubar->cascade(-label => '~File', -tearoff => 0);
my $edit = $menubar->cascade(-label => '~Edit', -tearoff => 0);
my $help = $menubar->cascade(-label => '~Help', -tearoff => 0);
my $new = $file->command(
-label => "Quit",
-accelerator => 'Ctrl-q',
-underline => 0,
-command => \&exit,
);
# create a toolbar
$mw->Button(
-text => "Connect",
-width => 10,
-command => sub{
$dbh = DBI->connect("dbi:Oracle:$dbname", $uid, $pwd, \%attr)
or print STDOUT;
$userid = uc($userid);
$sth = $dbh->prepare( "select * from USER where NAME = ?");
$sth->execute && print STDOUT;
$dbh->commit;
$dbh->disconnect;
print "Update completed...\n";
}
)->grid(-row => 0, -column => 0, -padx => 2, -pady => 2, -sticky => 'w');
# create a toolbar
$mw->Button(
-text => "Exit",
-width => 10,
-command => sub{exit}
)->grid(-row => 0, -column => 1, -padx => 2, -pady => 2, -sticky => 'w');
# output for SQL etc.
$output = $mw->Scrolled(
'Text',
-scrollbars => 'e',
-width => '35',
-height => '3',
-wrap => 'word',
-relief => 'groove',
)->grid(-row => '1', -column => '0', -columnspan => '3', -sticky => 'news');
# send errors to text box
$SIG{'__WARN__'} = sub { print STDERR @_ };
tie(*STDOUT, 'Tk::Text', $output);
tie(*STDERR, 'Tk::Text', $output);
MainLoop;