Perl’s Hairiness

Never mind what this program does. Perl is damn hairy. C and Java are less hairy. Here’s some Perl code:

#!/usr/bin/perl
use warnings;
use strict;

# ferrety
# A friendly ascii ferret character.

## GLOBALS ##

# moods array
my @moods = {
    'happy',   'content', 'sad',          'lonely',
    'playful', 'antsy',   'scared',       'angry',
    'hurt',    'excited', 'affectionate', 'mischievous',
    'tired',   'sleepy'
};

# options hash
my %options = {
    'name'           => "",    # Character's name
    'clearOnStart'   => 1,     # Clear screen on startup?
    'clearOnRefresh' => 1,     # Clear screen on each refresh?
    'refreshRate'    => 2,     # Refresh rate (in seconds)
    'ferretyness'    => 20,    # See below
    'debug'          => 0,     # Turns on debugging output
    'renderingOff'   => 0,     # Disable character rendering - status only
    'artFile' => "ferrety.txt" # Artwork file
};

my @longopts = (

    # option               char args required
    [ 'name',                'n', 1, 1 ],
    [ 'no-clear-on-start',   'c', 0, 0 ],
    [ 'no-clear-on-refresh', 'C', 0, 0 ],
    [ 'refresh',             'r', 1, 0 ],
    [ 'ferretyness',         'f', 1, 0 ],
    [ 'debug',               'd', 0, 0 ],
    [ 'norender',            'R', 0, 0 ],
    [ 'art-file',            'a', 1, 0 ]
);

# command line handling
sub parseArgs {
    my @args = @_;
    my $cmdArg;
    my $longOpt;
    my $theopt;
    my $shortopt;
    my $optind;
    my $argValue;
    my @option;
    my @satisfied;

    for $optind ( 0 .. $#longopts ) {
        $satisfied[0] = !$longopts[$optind][3];
    }

    for $cmdArg ( 0 .. $#args ) {
        for $optind ( 0 .. $#longopts ) {
            $theopt   = $longopts[$optind][0];
            $shortopt = $longopts[$optind][1];
            if (   $args[$cmdArg] =~ m/^--$theopt/
                || $args[$cmdArg] =~ m/^-$shortopt/ )
            {
                @option = $longopts[$optind];

                if ( $option[2] ) {
                    $cmdArg++;

                    die( $option[0] . " requires an argument." )
                      if ( $args[$cmdArg] =~ m/^-/ );
                    $options[$optind] = $args[$cmdArg];
                }

                else {
                    $options[$optind] = 1;
                }

                $satisfied[$optind] = 1;
            }

        }

    }

    for $optind ( 0 .. $#longopts ) {
        die( $longopts[$optind][0] . "is a required argument." )
          if ( $longopts[$optind][3] && !$satisfied[$optind] );
    }

}

# Ferretyness - a measure of variability
# Ferrets are rather variable creatures.  Their moods and attittudes change
# quickly and often.  The Ferretyness setting is a percentage scale of
# variability.  0 means your ferret will never change.  100 means that it
# will change its mood every refresh.  Anywhere in between is an indication
# of the likelihood that your ferret will change its mood.  A setting of 20
# means that on average, your ferret will change its mood every 5 refreshes.
# But in the end, mood changes are up to random chance.

package Ferrety;

# constructor
sub new {
    my ($class) = @_;
    my $self = {
        _name    => undef,    # Character's name
        _mood    => undef,    # The current mood (used to determine
                              # overall reactions and responses
        _posture => undef,    # Body posture
        _face    => undef,    # Facial expression
        _eyes    => undef,    # Eye shape
        _started => time      # Creation timestamp
    };

    bless( $self, $class );
    return $self;
}

# copy constructor
sub copy {
    my ($class) = @_;
    my $self = {
        _name    => $class->{_name},
        _mood    => $class->{_mood},
        _posture => $class->{_posture},
        _face    => $class->{_face},
        _eyes    => $class->{_eyes},
        _started => $class->{_started}
    };

    bless( $self, $class );
    return $self;
}

# name accessor
sub name {
    my ( $self, $name ) = @_;
    $self->{_name} = $name if defined($name);
    return $self{_name};
}

# mood accessor
sub mood {
    my ( $self, $mood ) = @_;
    $self->{_mood} = $mood if defined($mood);
    return $self{_mood};
}

# posture accessor
sub posture {
    my ( $self, $posture ) = @_;
    $self->{_posture} = $posture if defined($posture);
    return $self{_posture};
}

# face accessor
sub face {
    my ( $self, $face ) = @_;
    $self->{_face} = $face if defined($face);
    return $self{_face};
}

# eyes accessor
sub eyes {
    my ( $self, $eyes ) = @_;
    $self->{_eyes} = $eyes if defined($eyes);
    return $self{_eyes};
}

# started accessor
sub started {
    my ( $self, $started ) = @_;
    return $self{_started};
}

# running time method in seconds
sub runtime {
    my ($self) = @_;
    return time - $self->started;
}

# print method
sub print {
    my ($self) = @_;

    printf( "Ferrety %s, mood: %s.\n", $self->name, $self->mood );

    # name, mood, posture, face, eyes, started
    printf( "posture: %s, face: %s, eyes: %s, running: %d seconds\n",
        $self->posture, $self->face, $self->eyes, $self->runtime )
      if ( $options{'debug'} );
}

# render method
sub render {

    # TODO Put code to render ASCII art character here
}

# driver
sub driver {

    # TODO Put main loop code here
}

# artfile parser
sub parse {

    # TODO Put art file parser code here
}

# personality
Advertisements

, , , ,

  1. #1 by Joshua on July 19, 2011 - 7:30 PM

    This program is about 20% done right now. And I’m loving perltidy more now that it no longer messes with my nice neat columnar formats that I enforce with spaces.

  2. #2 by cftarnas on July 20, 2011 - 2:15 AM

    You should look at some more “Modern Perl”, and take a look at Moose (or Class::Accessor for this, Moose is probably overkill) for defining the classes and their accessors as well as use Getopt::Long for the parameters processing. That would eliminate about 75% of the code above. Unless you are doing this as some exercise in wordy perl, then carry on.

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s

%d bloggers like this: