Category: Fun
Author/Contact Info davidhj at mail dot com
Description: Ever write code like this? 
for (@foo) {
 print "foo is $_";
}
# ... more stuff
for (@foo) {
 print "Now I have more stuff to do with the same array...";
 print "The length of foo is " . length $_;
}

[download]

This is particularly common when you're outputting HTML or whatever. You have to write the same for loop or if ... else structure over and over again. This is not lazy!

To encourage laziness, here is an idea. Comments very welcome - this is version 0.0001 at most. I will improve it but only if it is useful and has not been done before.

The logic is to make control structures into objects. You can then reuse them more elegantly by manipulating them. E.g., you can have the same array for a foreach loop, but change what you do in the loop body. If you need to change the array, you only have to do it once.

Packaging structure is non-existent as yet, bugs have not been found. YHBW.

 
package Control;

use strict;
use vars qw/$AUTOLOAD/;

sub new {
 my $class = shift;

 my $self = { @_ };
 bless $self, $class;
}

sub _do_code {
 my $self = shift;

 my ($code, $context) = @_;

 if (ref $code) {
  local $_ = $context if $context;
  return &$code;
 } else {
  local $_ = $context if $context;
  my $rv = eval $code;
  die $@ if $@;
  return $rv;
 }
}

sub AUTOLOAD {
 my $self = shift;

 my $name = $AUTOLOAD;
 $name =~ s/.*:://;

 my $rv = $self->{$name};
 if (@_) {
  $self->{$name} = shift;
 }

 return $rv;
}

package Foreach;

use strict;
use vars qw/@ISA/;

use Control;
@ISA = qw/Control/;

sub run {
 my $self = shift;

 foreach (@{ $self->{array} }) {
  $self->_do_code($self->{body}, $_);
 }
}

package If;

use strict;
use vars qw/@ISA/;

use Control;
@ISA = qw/Control/;

sub run {
 my $self = shift;

 if ( $self->_do_code( $self->{condition} ) ) {
  $self->_do_code( $self->{body}, $_ );
 } else {
  my $done;
ELSIF:  foreach my $elsif ( @{ $self->{elsifs} } ) {
   if ( $self->_do_code( $elsif->{condition} ) ) {
    $self->_do_code( $elsif->{body}, $_ );
    $done++;
    last ELSIF;
   }
  }

  if ($self->{else} and not $done) {
   $self->_do_code($self->{else}, $_ );
  }
 }
}

sub elsif {
 my $self = shift;
 my $elsif = { @_ };

 push @{ $self->{elsifs} }, $elsif;
}

1;

=head1 Name

Control - OO control structures

=head1 Synopsis

 #!/usr/bin/perl -w

 use Control;

 my @bar = (1,2,3,"dog");
 my $loop = new Foreach (
  body  => 'print $_ . "\n"',
  array  => \@bar
 );
 
 $loop->run;
 
 $loop->{array} = [3,4,5,"cat"];
 $loop->run;
 $loop->{body} = sub { print "The length of $_ is " . (length $_) . "\
+n";};
 $loop->run;
 
 my $if = new If (
  condition  => '$_ % 2',
  body  => sub { print "$_ is an odd number\n" }
 );

 for ( 0 .. 10 ) {
  $if->run;
 }

 $if->elsif (
  condition => 'not $_ % 2',
  body => 'print "$_ is an even number\n"'
 );

 for (11 .. 20) {
  $if->run;
 }

=cut
Replies are listed 'Best First'.
Re: OO Control loops
by Juerd (Abbot) on Jan 04, 2002 at 01:11 UTC
    Oh. My. Goth^WGod.
    Do you really think this makes things _easier_?


    By the way... Ever heard of CODE references (anonymous subs)?

    2;0 juerd@ouranos:~$ perl -e'undef christmas'
Segmentation fault
2;139 juerd@ouranos:~$

    [download]

[reply]
[d/l]

      Well, obviously it is slower and uglier than using normal control loops, and I wouldn't suggest using it always. But if you have to write repeated control structures, and don't want to write the same code many times, it may be useful.

      As for subrefs, this code is essentially a pretty interface to them, though you can also use strings to eval. I assume what you are thinking of is: 

      my $subref = sub {print shift() . "\n";};
my $subref2 = sub {print "Length is " . length shift() . "\n";};
foo($subref);
foo($subref2);

sub foo {
 my $code = shift;
 foreach (@some_array) {
  &$code($_);
 }
}

      [download]

      which is the same but less flexible. But maybe you have something else in mind.

      dave hj~

[reply]
[d/l]
        Repeated control structures can be a sign of bad programming. But still, I'd rather use the same structure over and over than an OO way to obscurely do the same thing less efficiently.

        And about the subrefs: Sorry, my bad. I only saw the 'print ...' example and somehow didn't notice the other one. The example of what you thought I was thinking about, was not what I meant, but I still like that better than the OO thingy :) 

        2;0 juerd@ouranos:~$ perl -e'undef christmas'
Segmentation fault
2;139 juerd@ouranos:~$

        [download]

[reply]
[d/l]

Back to Code Catacombs