John W. Burns am Mittwoch, 21. Dezember 2005 16.22:
> I'm building a diagnostic medical questionnaire using Perl Tk. Need to
> create a Tk callback process for several hundred sub routines.
> I've experimented with the following code. It does recognize the two
> subroutines "foo" and "moo", but calls only the first
> subroutine "foo"; it does give correct answer. It doesn't call "moo."
> Perl Cookbook indicates use of backslash operator
> to create a reference to a named function but not for unnamed ones. Can
> anyone show me what I'm doing wrong?
moo is called, but has some errors resulting in no output, see below:
> Thanks
> John Burns
>
> #!/usr/local/bin/perl
> use warnings;
>
> # reference_to_functions8.pl
> # Dispatch Tables
>
> # See Making Sense of Subroutines
> #by Rob Kinyon | Pages: 1, 2, 3, 4
>
> # Adding and removing available subroutines is
> # simpler than the if-elsif-else scenario, and
> # this is much safer than the soft references scenario.
> # Perl Cookbook 11.4 shows following example
>
> my %dispatch = (
> "foo" => sub {
> my $x = 3;
> my $ans = ($x**2);
>
> print "answer is: $ans \n"; #prints "answer is: 9"
>
>
> },
> "moo" => sub {
> my @data = (3,5,13);
> my $radius;
> my $radius_ref = @data;
*if* you want to make a ref:
my $radius_ref = [EMAIL PROTECTED];
but there is no need to make a ref only to dereference it later.
> foreach $radius(@$radius_ref) {
>
> print "my radius is: $radius \n";
>
> my $area = 3.14159 * ( $radius ** 2);
> print "and circle area is $area \n";
>
> }
> }
> );
>
>
> my $name;
> my $key;
> my $dispatch;
>
> #use following to test for key name in hash
> foreach $name("foo", "moo") {
>
> if (exists $dispatch{$name}) {
> print "$name is a subroutine.\n";
>
> }
> else {
> print "$name is not a subroutine.\n";
> }
> }
>
> #use following to test for presence of a key in a hash
> foreach $key (keys %dispatch) {
> print "$key => $dispatch->{$key}\n"
print "$key => $dispatch{$key}\n";
($dispatch is a hash, not a hash ref)
> }
>
>
> my $input;
> foreach $input("foo", "moo"){
> if ( exists $dispatch{ $input } ) {
> $dispatch{ $input }->( );
> }
> else {
> die "Cannot find the subroutine $input\n";
> }
>
> }
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
<http://learn.perl.org/> <http://learn.perl.org/first-response>
