view release on metacpan or  search on metacpan

lib/Acme/Tie/Eleet.pm  view on Meta::CPAN

      v => "\\/",
      w => [ "vv", "\\/\\/" ],
      'y' => "j",
      z => "2",
      );


#--
# Constructor

sub _new {
    # Create object.
    my $self = {
	letters    => 25,    # transform o to 0, l to 1, etc.
	spacer     => "1/0", # %age 0=no extra spaces, 'm/n'=m extra+n noextra, 60=3/5 at random
	case_mixer => 50,    # %age 0=nothing, 'm/n'=m ucase+n lcase, 25=1/4 at random
	words      => 1,     # transform cool to kewl or kool, etc.
	add_before => 15,    # add comments before sentence.
	add_after  => 15,    # add comments after sentences.
	extra_sent => 10,    # extra sentences.
	@_,                  # overwrite with user values.
	# internals, do not modify.
	_space    => "m0",
	_case_mix => "m0"
    };

    # Check patterns.
    $self->{spacer} =~ m!^(((\d+)/(\d+))|(\d+))$!
	or  croak "spacer: wrong pattern $self->{spacer}";
    $self->{spacer} =~ m!^(\d+)/(\d+)$! && $1+$2 == 0
	and croak "spacer: illegal pattern $self->{spacer}";
    $self->{case_mixer} =~ m!^(((\d+)/(\d+))|(\d+))$!
	or  croak "case_mixer: wrong pattern $self->{case_mixer}";
    $self->{case_mixer} =~ m!^(\d+)/(\d+)$! && $1+$2 == 0
	and croak "case_mixer: illegal pattern $self->{case_mixer}";

    # Init internals.
    $self->{spacer}      =~ m!^(\d+)/(\d+)$! && $1 == 0
	and $self->{_space}    = "n0";
    $self->{case_mixer} =~ m!^(\d+)/(\d+)$! && $1 == 0
	and $self->{_case_mix} = "n0";

    # Return the hash ref.
    return $self;
}


sub TIEHANDLE {
    # Process args.
    my $pkg = shift;
    my $fh  = shift;
    ref $pkg and croak "Not an instance method";

    $fh or croak "Filehandle is not an optional paramater";
    $fh->autoflush(1);

    my $self  = &_new; # magic call.
    $self->{FH} = $fh;

    # Return it.
    return bless( $self, $pkg );
}


sub TIESCALAR {
    # Process args.
    my $pkg = shift;
    ref $pkg and croak "Not an instance method";

    my $self  = &_new; # magic call.
    $self->{value} = undef;

    # Return it.
    return bless( $self, $pkg );
}


#--
# Handlers.

# Catch scalar fetching.
sub FETCH {
    my $self = shift;
    return $self->_transform( $self->{value} );
}

# Catch calls to print.
sub PRINT {
    my $self = shift;
    my $fh = $self->{FH};
    $_[0] or return;
    print $fh $self->_transform(join "", @_);
}

# Catch scalar storing.
sub STORE {
    $_[0]{value} = $_[1];
}


#--
# Modification plugins.

#
# All plugins will get (not counting the object that will always be
# the first argument) a string to modify. Each string will contain one
# and only one sentence.
#

# Add preambles randomly.
sub _apply_add_before {
    my ($self, $target) = @_;
    if ( rand(100) < $self->{add_before} ) {
	my $before = $beg[ rand( int(@beg) ) ];
	$target = $before.$target;
    }
    return $target;
}

# Add end of sentences randomly.
sub _apply_add_after {
    my ($self, $target) = @_;
    if ( rand(100) < $self->{add_after} ) {
	my $after = $end[ rand( int(@end) ) ];
	$target  .= $after;
    }
    return $target;
}

# Mix case as wanted.
sub _apply_case_mixer {
    my ($self, $target) = @_;

    if ( $self->{case_mixer} =~ m!^(\d+)/(\d+)$! ) {