Stories
Slash Boxes
Comments
NOTE: use Perl; is on undef hiatus. You can read content, but you can't post it. More info will be forthcoming forthcomingly.

All the Perl that's Practical to Extract and Report

The Fine Print: The following comments are owned by whoever posted them. We are not responsible for them in any way.
 Full
 Abbreviated
 Hidden
More | Login | Reply
Loading... please wait.
  • 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
    • 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.)