Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl: the Markov chain saw
 
PerlMonks  

subroutine ref while "strict refs"

by viffer (Beadle)
on Jul 28, 2014 at 08:37 UTC ( #1095308=perlquestion: print w/replies, xml ) Need Help??

viffer has asked for the wisdom of the Perl Monks concerning the following question:

Hi all, I've seen a number of emails on this subject but unfortunately haven't managed to find a solution to the specific issue I'm having.

Essentially I am loading data into a hash of hashes, one field of which contains a sub routine that I need to perform if all the keys match.

That part is all working fine - except for the fact that unless I turn off strict I can't use it! :)

Sample data I'm loading into the hash is:

000.01|RECD_TYPE|01-03|CHAR(3)|RECORD TYPE|check_char 000.02|DATE_TIME| 05-21|CHAR(17)|TIME STAMP|check_time 000.03|DATE_ISSUE|23-30|CHAR(8)|DATE OF ISSUE|check_date 010.01|RECD_TYPE|01-03|CHAR(3)|RECORD TYPE|check_char 010.02|PROP_NUMB|05-11|PIC(9999999)|PROPERTY NUMBER|check_numeric

I'm loading the data into my hash of hashes table via

open( $record_layout, '<', $RECORD_LAYOUT ) or die "Open file $RECORD_LAYOUT failed $!"; #Load record formats into a hash. If record layout changes simply chan +ge layout while ($record = <$record_layout>) { chomp $record; my @fields = split(/\|/, $record); my @keys = split(/\./, $fields[0]); $keys[1] =~ s/\s*$//; $keys[1] = int($keys[1]); if (! $rec_layout_hash{$keys[0]}) { $rec_layout_hash{$keys[0]} = {}; } else { $rec_layout_hash{$keys[0]}->{$keys[1]} = {}; } $rec_layout_hash{$keys[0]}->{$keys[1]} = {'field_type' => $fields[1], 'chars_position' => $fields[2], 'field_length' => $fields[3], 'sub_routine' => $fields[5], }; } close $record_layout;
Then reading the hashes to obtain and call the subroutine via

my $input_file; my $line; open( $input_file, '<', $ARGV[0] ) or die "Open file $ARGV[0] failed $!"; while ($line = <$input_file>) { chomp $line; my @fields = split(/\|/, $line); #Check if record is a valid record type if ($fields[0] !~ /$record_types/) { fatal_error (2, "record contains invalid file type fields[0] - + Record: $line"); exit 0; } #Check if number of fields in record matches the number in the record +layout my $expected_nbr_of_fields_in_record = keys %{$rec_layout_hash{$fi +elds[0]}}; my $actual_fields_count = @fields; if ($actual_fields_count != $expected_nbr_of_fields_in_record) { fatal_error (1, "record does not contain correct number of fi +elds - Expected $expected_nbr_of_fields_in_record but record containe +d $actual_fields_count fields - $line"); exit 0; } #Process each field from the input data one field at a time for (my $i = 1; $i <= $actual_fields_count; $i++) { my $j = $i; $j -= 1; #$j is minus 1 becau +se the fields array starts at zero, whilst the actual field number in + the record array starts at 1 #Determine which sub routine is required to check the data from the re +cord_layout hash my $sub_routine = $rec_layout_hash{$fields[0]}{$i}{"sub_rout +ine"}; #Call sub routine and pass the actual field day and the expected lengt +h of the fiel my $value1 = $fields[$j]; my $value2 = $rec_layout_hash{$fields[0]}{$i}{"field_length" +}; &{ $sub_routine } ($value1, $value2); } }
It's when I then call the sub routine that I get the message
Can't use string ("check_char") as a subroutine ref while "strict refs" in use

Is there any way I can call the sub routine - which will be in a separate module (not that that should make any difference) without turned off strict? Thanks for your time Kev

Replies are listed 'Best First'.
Re: subroutine ref while "strict refs"
by Anonymous Monk on Jul 28, 2014 at 09:24 UTC

    One way is a dispatch table:

    sub quz { ... } my %dtbl = ( foo => sub { ... }, bar => sub { ... }, quz => \&quz, # etc. ); my $sub_routine = "quz"; $dtbl{$sub_routine}->($value1,$value2);

    By the way, your input file looks like something you might want to read via Text::CSV.

Re: subroutine ref while "strict refs"
by McA (Priest) on Jul 28, 2014 at 09:56 UTC

    Hi,

    in you current use case I would also recommend to use a dispatching table as Anonymous monk adviced.

    But the following self contained examlple should show you a way to achieve what you want to do without warnings:

    #!/usr/bin/perl use strict; use warnings; use 5.010; use Carp; my $ref = get_func_reference('my_check_func'); # call it $ref->('To check'); sub my_check_func { my ($param) = @_; $param //= ''; say "Check: $param"; } sub get_func_reference { my ($function_name) = @_; $ref = \&{$function_name}; unless(defined(&$ref)) { confess "ERROR: No function defined for name '$function_name'. +\n"; } return $ref; }

    Regards
    McA

Re: subroutine ref while "strict refs"
by Anonymous Monk on Jul 28, 2014 at 09:53 UTC

    You should always use strict; (and use warnings; too). Having said that, you can turn strict off locally, for only that tiny bit of code that needs it:

    use strict; { # limit scope of "no strict" to this block no strict 'refs'; &{ $sub_routine } ($value1, $value2); }

    Although I personally like the dispatch table better.

Re: subroutine ref while "strict refs"
by viffer (Beadle) on Jul 28, 2014 at 09:08 UTC
    I can probably put
    if ($sub_routine =~ /check_char/} { check_char ($value1, $value2); }
    but is there a neater way? If someone else changes the record layout and adds a new subroutine, then the code would need to be changed to cater for it, which probably isn't ideal.
      If anyone adds a subroutine, you will at least need a new 'use' statement to reference it. There does not seem to be much advantage in eliminating the need for other changes. Use a method that is clear and easy to modify. I like the dispatch table. Add a new entry for each new subroutine.
      Bill
        If anyone adds a subroutine, you will at least need a new 'use' statement to reference it.

        What?

Re: subroutine ref while "strict refs"
by ikegami (Patriarch) on Jul 28, 2014 at 19:43 UTC
    my %checkers = map {; no strict 'refs'; $_ => \&$_ } qw( check_char check_time check_date check_numeric );
    or
    my %checkers = map { $_ => \&$_ } # \&$_ is except from strict refs. qw( check_char check_time check_date check_numeric );
    Then in the loop,
    my $checker_name = $rec_layout_hash{$fields[0]}{$i}{"sub_routine"}; my $checker = $checkers{$checker_name} or die("Unrecognized checker $checker_name\n"); $checker->($value1, $value2);
      \&$_ is except from strict refs

      Very good point, although I think (?) that's just a specific case of the more general exemption my $x = "foo"; my $y = \&$x; &$y; or my $y = \&{"foo"}; &$y;

        I didn't mean to be exclusionary. \&{EXPR} as a whole is exempt, including the \&$NAME shorthand. CONST->() is also exempt.

        For example, (\&$name)->() is the same as $name->(), but it bypasses the symbolic reference check requested by using strict.

      Thanks to everyone for your input, a number of options to consider. Much appreciated.

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlquestion [id://1095308]
Approved by hippo
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others exploiting the Monastery: (3)
As of 2022-05-25 16:43 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    Do you prefer to work remotely?



    Results (90 votes). Check out past polls.

    Notices?