|
In a message dated 11/2/2005 12:54:25 P.M. Eastern Standard Time,
[EMAIL PROTECTED] writes:
> Good morning all!
> > I am still learning Perl and I discover Tk which is great > I show it to my boss and he like it too much now he has ask me > To do a program using Tk is a very simple program > I have a script in unix that we run to create documents for floor > Shop, this script is a one liner meaning this > > Mydoc -k -I"Comments" product > A B C D > > Let me explain > A this is the script > B this are some options they are always those two > C this area I write down any comment on why I did the document > D these is the name of the document > > Can some one help me ? juan --
attached are two scripts that may give you an idea of how to
proceed.
juan_gomez_1.pl is the perl/tk script to invoke an application.
juan_gomez_2.pl is the test application script that is invoked.
hth -- bill walters
|
############################################################################### ###############################################################################
# juan_gomez_1.pl 03nov05waw
# wrapper perl/tk script to invoke aonther perl script with a specified
# set of command line options.
# here's a quick, simple solution.
# limited data validation is done. NO attempt is made to handle errors.
# pragmata ####################################################################
use warnings;
use strict;
# modules #####################################################################
use Tk;
use Tk::Checkbutton;
use Tk::LabEntry;
# declarations ################################################################
use subs qw/invoke_wrapped_application prepare_for_next_invocation
validate_arguments_for_invocation/;
# main loop ###################################################################
# define tk widgets -----------------------------------------------------------
# main window: holds everything
my $MW = MainWindow->new(
-title => "Juan's Script Invoker",
);
# frames for holding options and actions buttons.
# nested frames allow more flexible grouping when pack()-ing.
my $options_frame_main = $MW->Frame(
-relief => 'flat',
);
my $options_frame_column_1 = $options_frame_main->Frame(
-relief => 'flat',
);
my $options_frame_column_2 = $options_frame_main->Frame(
-relief => 'flat',
);
my $actions_frame = $MW->Frame(
-relief => 'flat',
);
# command line option buttons. each option is on or off with no other data.
# value of option variable is actual switch string if button checked, empty
# string if not.
my $cl_opt_k_state = '';
my $cl_opt_k_button = $options_frame_column_1->Checkbutton(
-text => '-k kay option', # text in the button
-variable => \$cl_opt_k_state, # variable holds state of checkbutton
-onvalue => '-k', # variable value when button checked
-offvalue => '', # variable value when button not checked
);
my $cl_opt_l_state = '';
my $cl_opt_l_button = $options_frame_column_1->Checkbutton(
-text => '-l ell option',
-variable => \$cl_opt_l_state,
-onvalue => '-l',
-offvalue => '',
);
my $cl_opt_x_state = '';
my $cl_opt_x_button = $options_frame_column_2->Checkbutton(
-text => '-x eks option',
-variable => \$cl_opt_x_state,
-onvalue => '-x',
-offvalue => '',
);
my $cl_opt_y_state = '';
my $cl_opt_y_button = $options_frame_column_2->Checkbutton(
-text => '-y why? why not!',
-variable => \$cl_opt_y_state,
-onvalue => '-y',
-offvalue => '',
);
# buttons for triggering application actions
my $invoke = $actions_frame->Button( # invoke the wrapped application
-text => 'Invoke',
-command => sub { invoke_wrapped_application },
);
my $quit = $actions_frame->Button( # quit the perl/tk script
-text => 'Quit',
-command => sub { exit },
);
# labeled entry widgets for entering single line comment or product text.
# an attempt is made in widget to validate data.
my $comment = '';
my $comment_entry = $MW->LabEntry(
-label => 'Comment',
-labelPack => [qw/-side left -anchor w/],
-relief => 'groove',
-textvariable => \$comment,
-validate => 'key', # validate on each keypress
-validatecommand => sub { $_[0] !~ /"/ }, # no double-quote in comment
-invalidcommand => sub { $MW->bell }, # ring bell if invalid
);
my $product = '';
my $product_entry = $MW->LabEntry(
-label => 'Product',
-labelPack => [qw/-side left -anchor w/],
-relief => 'groove',
-textvariable => \$product,
-validate => 'key', # validate on each keypress
-validatecommand => sub { $_[0] !~ /\s/ }, # no whitespace in product name
-invalidcommand => sub { $MW->bell }, # ring bell if invalid
);
# pack widgets in main window -------------------------------------------------
$options_frame_main->pack(qw/-padx 3 -pady 3/);
$options_frame_column_1->pack(qw/-side left/);
$cl_opt_k_button->pack(qw/-side top -anchor w/);
$cl_opt_l_button->pack(qw/-side top -anchor w/);
$options_frame_column_2->pack(qw/-side right/);
$cl_opt_x_button->pack(qw/-side top -anchor w/);
$cl_opt_y_button->pack(qw/-side top -anchor w/);
$comment_entry->pack(qw/-fill x/);
$product_entry->pack(qw/-fill x/);
$actions_frame->pack(qw/-fill x -padx 3 -pady 3/);
$invoke->pack(qw/-side left -expand 1/);
$quit->pack(qw/-side left -expand 1/);
# run the perl/tk application -------------------------------------------------
MainLoop;
# clean up after running mainloop (usually not needed) ------------------------
# no cleanup done
# end main loop ###############################################################
# subroutines #################################################################
sub invoke_wrapped_application { # runs when Invoke button is clicked
my @arguments = (
$cl_opt_k_state, # options. will be `-x' or `' (empty string)
$cl_opt_l_state,
$cl_opt_x_state,
$cl_opt_y_state,
qq("$comment"), # quoted, possibly multi-word, comment
$product, # unquoted, single word (not checked) product name
);
validate_arguments_for_invocation @arguments;
my $script = 'juan_gomez_2.pl';
my $invocation = "perl $script";
# return both stdout and stderr to $result
my $result = `$invocation @arguments 2>&1`;
# check $result: undefined if invocation failed
if (defined $result) {
print "$0: invocation result: $result \n";
}
else {
print "$0: invocation failed: $! \n";
}
prepare_for_next_invocation;
}
sub prepare_for_next_invocation {
# next invocation gets a new product, everything else remains the same.
$product = '';
}
sub validate_arguments_for_invocation {
# validate switch combinations, etc., etc.
# no argument validation done yet
}
__END__
from juan gomez, 02nov05 ([EMAIL PROTECTED])
Hello
Good morning all!
I am still learning Perl and I discover Tk which is great
I show it to my boss and he like it too much now he has ask me
To do a program using Tk is a very simple program
I have a script in unix that we run to create documents for floor
Shop, this script is a one liner meaning this
Mydoc -k -I"Comments" product
A B C D
Let me explain
A this is the script
B this are some options they are always those two
C this area I write down any comment on why I did the document
D these is the name of the document
Can some one help me ?
###############################################################################
###############################################################################
# juan_gomez_2.pl test file 03nov05waw
my $file = "$0.out";
open FH, '>', $file or die "opening $file: $!";
{ local $" = '> <'; print FH "$0: args: <@ARGV> \n"; }
close FH or die "closing $file: $!";
print 'ok';
_______________________________________________ ActivePerl mailing list [email protected] To unsubscribe: http://listserv.ActiveState.com/mailman/mysubs
