subroutine ref while "strict refs"

[viffer]

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

[Anonymous Monk]

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.

[McA]

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

[Anonymous Monk]

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.

[ikegami]

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);

[Anonymous Monk]

\&$_ 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;

[ikegami]

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.

[viffer]

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

[viffer]

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.

[BillKSmith]

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.

[Anonymous Monk]

If anyone adds a subroutine, you will at least need a new 'use' statement to reference it.

What?