Re: Small examples of string eval

[gellyfish]

This is the only real example I could find in my own code, essentially it is a method on a base collection class to cause the collection to appear to be sorted on an arbitrary attribute (or attributes) of the objects in the collection. It uses eval to dynamically create a sort sub from a list of comparison specifications passed as an argument. Okay it doesn't fit the the 'small' criteria but I think it is illustrative of the kind of use string eval is good for:

sub sort
{
   my ( $self, $sort_spec ) = @_;
 
   my $sort_done = 0;
 
   if ( defined $sort_spec )
   {
 
     my @sort_objs;
 
     foreach my $obj ( @{$self->{_data}} )
     {
       my $sv = [];
       push @{$sv}, $obj->factory_index();
 
       foreach my $spec ( @{$sort_spec} )
       {
         my $meth = $spec->{Key};
         push @{$sv}, $obj->$meth();
       }
 
      push @sort_objs, $sv;
 
     }
 
 
     my @comparisons = ();
 
     my $index = 0;
 
     foreach my $spec ( @{$sort_spec} )
     {
       $index++;
       my $comp = '';
       my ($left_arg, $right_arg) = ('$a','$b');
 
       if ( exists $spec->{Direction} and $spec->{Direction} eq '-' )
       {
          ( $left_arg, $right_arg) = ('$b', '$a');
       }
 
       if ( $spec->{Compare} eq 'cmp' || $spec->{Compare} eq '<=>' )
       {
          $comp = "${left_arg}->[$index] $spec->{Compare} ${right_arg}
+->[$index]";
       }
       else
       {
         $comp = "$spec->{Compare}(${left_arg}->[$index],${right_arg}-
+>[$index])";
       }
 
       push @comparisons, $comp;
 
     }
      
     if ( $index )
     {
       my $sub = join ' || ' , @comparisons;
 
       $sub = "sub { $sub  };";
 
       *sortsub = eval $sub;
 
       $self->{_sort_index} = [];
 
       @{$self->{_sort_index}} = map { $_->[0] }
                                 sort sortsub  @sort_objs;
       
       $sort_done = 1;
 
       my $index = 0;
 
       foreach my $obj ( $self->list() )
       {
          $obj->factory_index($index++);
       }
 
     }
   }
 
  return $self->{_sorted} = $sort_done;
 
}

/J\

[brian_d_foy]

You don't need a eval to do this, and it's easier to do without it. You basically want a higher order function that composes other functions, and all of the functions are going to get the same arguments.

Starting from the finished product, you might have a sort subroutine like this, where the return value is the first thing that returns true (which should be -1 or 1).

sub sortsub {
    $a cmp $b ||
    other_function( $a, $b ) ||
    ...
    }

That's the same as writing it as a collection of subroutines that get arguments instead of using globals though:

sub sortsub {
    string_compare( $a, $b ) ||
    other_function( $a, $b ) ||
    ...
    }

But I can rewrite that sortsub to take a list of subroutine references as its arguments. Now my sortsub goes through each subroutine and returns when it finds one that returns a true value. If it finds 0 (meaning that sub thought the elements were equal), it goes onto the next subroutine.

sub sortsub {
    my @subs = @_;

    foreach my $sub ( @subs )
        {
        my $result = $sub->($a, $b);
        return $result if $result;
        }
    }

I can't use this in sort yet because I can't pass it arguments. I can, however, modify it to return a subroutine reference I can use:

sub make_sort_sub {
    my @subs = @_;

    return sub {
        foreach my $sub ( @subs )
            {
            my $result = $sub->($a, $b);
            return $result if $result;
            }
        };
    }

Now, I basically make the reference then use it in my sort block.

my $sort_sub = make_sort_sub( @sub_references );

my @sorted = sort { $sort_sub->() } @stuff;

And here's a full demo, using it with numbers, then strings, then a user-defined sort subroutine. I don't need an eval for any of it.

#!/usr/bin/perl
# pre-defined common sort subroutines
my %Subs = (
    numeric_descending => sub { $b <=> $a },
    numeric_ascending  => sub { $a <=> $b },
    string_descending  => sub { $b cmp $a },
    string_ascending   => sub { $b cmp $a },
    case_insensitive   => sub { "\L$a" cmp "\L$b" },
    );


sub make_sort_sub {
    my @subs = @_;

    return sub {
        foreach my $sub ( @subs )
            {
            my $result = $sub->($a, $b);
            return $result if $result;
            }
        };
    }
    
# numbers
{
my @use_these_subs = map { $Subs{$_} } qw(numeric_descending);
my $sort_sub = make_sort_sub( @use_these_subs );

my @sorted = 
    sort { $sort_sub->() } qw( 1 10 11 100 2 12 21 3 31 300 4 5 6 66 7
+ 71 );
print "@sorted\n";
}

# strings
{
my @use_these_subs = map { $Subs{$_} } qw(case_insensitive string_asce
+nding);
my $sort_sub = make_sort_sub( @use_these_subs );

my @sorted = 
    sort { $sort_sub->() } qw( Fred fred FReD Barney barney Betty BETT
+Y );
print "@sorted\n";
}

# strings by length with user defined subroutine
{
my @use_these_subs = ( sub { length $a <=> length $b } ); 
push @use_these_subs, map { $Subs{$_} } qw(string_ascending);
my $sort_sub = make_sort_sub( @use_these_subs );

my @sorted = 
    sort { $sort_sub->() } qw( Fred fred FReD Barney barney Betty BETT
+Y );
print "@sorted\n";
}

[spurperl]

Thank you, this is what I was looking for. I have a similar experience with string eval, generating subroutines that access certain data fields, using a configuration file. This was done to improve performance, as the generated subroutines were fine-tailored to the data extraction task at hand (with completely non-generic statements like substr($str, 2, 13)).

Unlike what many think, although the string eval is dangerous, it is necessary to efficiently and generically implement certain things that are impossible without it. The terrific "Higher Order Perl" has a lot of examples for smart usage of eval, and I'll look there as well.