use Perl

• This reminds me of something I did once (Score:1)

  by stvn (5613) <stevan@iinteractive.com> on 2005.01.20 14:20 (#37678) Homepage Journal

  This reminds me of something I did once on a long Metro-North ride home from NYC after reading a having read a paper on Smalltalk.

  #!/usr/bin/perl
  
  use strict;
  use warnings;
  
  use Test::More tests => 2;
  
  {
      package Boolean;
  
      use strict;
      use warnings;
  
      sub import {
          no strict 'refs';
          *{(caller())[0] . '::cond'} = \&cond;
      }
  
      sub cond (&) {
          my ($block) = @_;
          return bless $block, "Boolean";
      }
  
      sub isFalse {
          my ($self, $sub) = @_;
          $sub->() if not $self->();
          return $self;
      }
  
      sub isTrue {
          my ($self, $sub) = @_;
          $sub->() if $self->();
          return $self;
      }
  
      sub whileTrue {
          my ($self, $sub) = @_;
          $sub->() while $self->();
          return $self;
      }
  
  }
  
  BEGIN {
      # this would normally be 'use Boolean'
      Boolean->import();
  }
  
  {
      my $e = 0;
      cond { $e < 10 }->whileTrue( sub { $e++ } );
      cmp_ok($e, '==', 10, '... $e is 10 now');
  }
  
  {
      my $e = 2;
      cond { $e == 2 }->
          isTrue(
              cond { $e == 3 }->
                      isFalse(sub {
                              pass('... we got to the correct branch');
                          })->
                      isTrue(sub {
                              fail('we should not end up here');
                          })
              )->
          isFalse(sub {
                  fail('we should not end up here');
              });
  }

  --
  -stvn

  Reply to This

  • Re:This reminds me of something I did once (Score:2)

    by Ovid (2709)

    Sweet! I would change two methods:

    sub isFalse {
        my ($self, $sub) = @_;
        ! $self->() && $sub->();
        return $self;
    }
    
    sub isTrue {
        my ($self, $sub) = @_;
        $self->() && $sub->();
        return $self;
    }

    Maybe I can slip this into production ... (no, I'm not serious.)