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;



Reply via email to