##### exported package globals go here
#
# the default settings hash reference, the only exprted global variabl
+e
my ($DEFAULTS) = {};


##### non-exported package globals go here
#
# the default morse set
my %ORG_CHARS =( # international morsecode 'chart'
    'A' => '.-',        'B' => '-...',      'C' => '-.-.',      'D' =>
+ '-..',
    'E' => '.',         'F' => '..-.',      'G' => '--.',       'H' =>
+ '....',
    'I' => '..',        'J' => '.---',      'K' => '-.-',       'L' =>
+ '.-..',
    'M' => '--',        'N' => '-.',        'O' => '---',       'P' =>
+ '.--.',
    'Q' => '--.-',      'R' => '.-.',       'S' => '...',       'T' =>
+ '-',
    'U' => '..-',       'V' => '...-',      'W' => '.--',       'X' =>
+ '-..-',
    'Y' => '-.--',      'Z' => '--..',      '1' => '.----',     '2' =>
+ '..---',
    '3' => '...--',     '4' => '....-',     '5' => '.....',     '6' =>
+ '-....',
    '7' => '--...',     '8' => '---..',     '9' => '----.',     '0' =>
+ '-----',
    ',' => '--..--',    '.' => '.-.-.-',    '?' => '..--..',
    '!' => '.-.--.', # apparently same as q(') so i'll re-define it as
+ '.-.--.'
                     # i am quite uncertain about the validity of this
+ 'hack'
                     # as accepted international morse code, but hey, 
+when in perl
    ';' => '-.-.-',     ':' => '---...',    '/' => '-..-.',     '-' =>
+ '-....-',
    "'" => '.----.',    '(' => '-.--.-',    ')' => '-.--.-',    '_' =>
+ '..--.-',
    'Á' => '.--.-', #A w/a accent
    'Å' => '.--.-', #A w/a circle
    'Ä' => '.-.-',  #A w/2 dots
    'É' => '..-..', #E w/a accent
    'Ñ' => '--.--', #N w/a tilde
    'Ö' => '---.',  #O w/2 dots (umlaut)
    'Ü' => '..--',  #U w/2 dots (umlaut)
    );# endof %ORG_CHARS;

my %REVERSE_CHARS = reverse(%ORG_CHARS);
# the default settings hash gets more stuff
$DEFAULTS->{CHARS_HASH_REF}= \%ORG_CHARS;
$DEFAULTS->{REVERSE_CHARS_HASH_REF}= \%REVERSE_CHARS;
$DEFAULTS->{MIN_PER_CENT}=50;
# only the above should be set by user, the below only by subs
$DEFAULTS->{ORIGINAL_INPUT}=''; # if you wanna figure out how these ar
+e set
$DEFAULTS->{INPUT_AS_TEXT}='';  # just take a look at toText and/or to
+Morse
$DEFAULTS->{INPUT_AS_MORSE}=''; # it's pretty obvious from there

my ($GODLY_DEFAULTS) = {%{$DEFAULTS}};
# the untouchable hardcoded defaults, that you might wanna revert to s
+ometime
# and that the OOP uses by default, not DEFAULTS

##### non-explicitly exported subroutines
#
# the constructor for Object Oriented Morse::Code,
# aka the only non-explicitly exported sub
sub new
{
    my $class_aka_package_type = $_[0];
    my $self;

    if(ref $_[1])
    {
        $self = bless {}, $class_aka_package_type;
  # bless an anonymous hash into $self, which is of type $class_aka_pa
+ckage_type

        my $pref = $_[1];
        foreach my $key ( keys %{$GODLY_DEFAULTS} )
        {
            if(defined $pref->{$key})
            {
                $self->{$key} = $pref->{$key};
            }
            else
            {
                $self->{$key} = $GODLY_DEFAULTS->{$key};
            }
        }
    }
    else # set the settings to the defaults
    {
        $self = bless $GODLY_DEFAULTS, $class_aka_package_type;
    }

    return $self; #i don't like magic, so i'm doing an explicit return
}# endof sub new # aka the constructor
#
##### endof non-explicitly exported subroutines

########### private sub's
# private functions, i wonder what they're hiding
#
# neat little titled hr, that does a < 80 chars since int rounds down
my $_titled_hr=
    sub
    {
        my $string= join('', @_);
        my $oy = int (80 -(length $string) )/ 2;
        return "\n","-" x $oy, $string, "-" x $oy,"\n";
    };

# prints out $key = $value pairs for %:: aka %Morse::Code::
my $_dump_hash =
  sub{
        my $reference = shift;
        print $_titled_hr->(" Data::Dumper ");
            eval(q(
            use Data::Dumper;
            print Dumper($reference);
                   ));
    };
#
#### endof private sub's

#### explicitly exported subs - Morse::Code qw(:all);
#
# prints out the anon hash for the calling object and/or the package
sub debug
{
    my $self = shift;

    if(ref $self)
    {
        print $_titled_hr->($self);

        $_dump_hash->($self);

        my $do_package_hash=shift || 0;

        if($do_package_hash)
        {
            $_dump_hash->(\%::);
        }
    }
    else
    {
        print "you can only see the package %:: \n";
        $_dump_hash->(\%::);
    }
}# endof debug

# decides whether to call toText or toMorse based on the % of morse pa
+ssed
sub morsify
{
    my ($self,$min_per_cent);
    # tried using _¢ as _cent but perl complained

    if(ref($_[0]))
    {
        $self=shift;
        $min_per_cent=$self->{MIN_PER_CENT};
    }# the first arg is always a reference to the object when ->
    else
    {
        $min_per_cent=$DEFAULTS->{MIN_PER_CENT};
    }

    my $dis = shift;
    my $count = 0;
    # figure out the number of valid text characters in $dis
    while ($dis=~ /[^ .-]/g) # ie chars other than ' ', '.', or '-'
    {
        $count++;
    } # the g makes it faster?

    my $per_cent_of_text = int $count/(length $dis)*100;
    # what % of the string passed was text(ie not ' ', '.', or '-')

    if($per_cent_of_text > $min_per_cent)
    {
        return ( ($self)?$self->toMorse($dis):&toMorse($dis) );
    }
    else
    {
        return ( ($self)?$self->toText($dis):&toText($dis) );
    }
}# endof morsify

# like the name says
sub resetDefaults
{
    if(ref $_[0])
    {
        my $self=shift;
        $self = $GODLY_DEFAULTS;
        return $self;
    }
    else
    {
        $DEFAULTS = $GODLY_DEFAULTS;
    }
}

# translates text to - . -..- -  
sub toMorse
{
    my ($self,$dis,$temp_chars_hash_ref);

    if(ref($_[0]))
    {
        $self=shift;
        $temp_chars_hash_ref=$self->{CHARS_HASH_REF};
        $dis = shift;
        $self->{ORIGINAL_INPUT}=$dis;
        $self->{INPUT_AS_TEXT}=$dis;
    }# the first arg is always a reference to the object when ->
    else
    {
        $dis = shift;
        $temp_chars_hash_ref = $DEFAULTS->{CHARS_HASH_REF};
        # set the globals to what they should be
        $DEFAULTS->{ORIGINAL_INPUT} = $dis;
        $DEFAULTS->{INPUT_AS_TEXT} = $dis;
    }

       $dis =~ tr/[a-z]/[A-Z]/; # upper case with a regex, why? i don'
+t know
    my @dis = split('',$dis);
    my $abc="";

    for(0..$#dis)
    {
        if(defined $temp_chars_hash_ref->{$dis[$_]})
        {
            $dis = $temp_chars_hash_ref->{$dis[$_]};
        }
        else
        {
            $dis = $dis[$_];
        }

        $abc .= $dis . " ";
    }

    # YAG
    $DEFAULTS->{INPUT_AS_MORSE} = $abc;
    $self->{INPUT_AS_MORSE}=$DEFAULTS->{INPUT_AS_MORSE};
    return "$abc";
}# endof toMorse


# translates - . -..- -  to text
sub toText
{
    my ($self,$dis,$temp_reverse_chars_hash_ref);

    if(ref($_[0]))
    {
        $self=shift;
        $dis = shift;
        $temp_reverse_chars_hash_ref=$self->{REVERSE_CHARS_HASH_REF};
        $self->{ORIGINAL_INPUT}=$dis;
        $self->{INPUT_AS_MORSE}=$dis;
    }# the first arg is always a reference to the object when ->
    else
    {
        $dis = shift;
        $temp_reverse_chars_hash_ref = $DEFAULTS->{REVERSE_CHARS_HASH_
+REF};
        # set the globals to what they should be
        $DEFAULTS->{ORIGINAL_INPUT} = $dis;
        $DEFAULTS->{INPUT_AS_MORSE} = $dis;
    }

    my @words = split('  ',"$dis");
    my $braces;
    my $abc="";

    for(0..$#words)
    {
        my @letters = split(' ',$words[$_]);

        for my $op(0..$#letters)
        {
            if(defined $temp_reverse_chars_hash_ref->{$letters[$op]})
            {
                $dis = $temp_reverse_chars_hash_ref->{$letters[$op]};
            }
            else
            {
                $dis = $letters[$op];
            }
    
            if($dis eq '(')
            {
                if(defined $braces) # try and figure out nested braces
                {
                    undef $braces; $dis=')';
                    # doesn't work too well. it turns (()) into ()()
                }
                else
                {
                    $braces=1;
                }
            }

            $abc .= $dis;
        }
        
        $abc .= " ";
    }

    # yet another global
    $DEFAULTS->{INPUT_AS_TEXT}= $abc;
    $self->{INPUT_AS_TEXT}=$DEFAULTS->{INPUT_AS_TEXT};
    return $abc;
}# endof toText

1 # where's the ; you ask? ask dominus at perlmonks.org and perl.plove
+r.com

__END__
# Below is stub documentation for your module. You better edit it!

=head1 NAME

Morse::Code - translate between Morse Code and text

=head1 SYNOPSIS

=begin text

  use Morse::Code qw(:all);

  print &toMorse("oy");
  print &toText(&toMorse("oy"));
  
  my %CHARS = (O=>'--',Y='-0');
  # O and Y are uppercase on purpose, cause toMorse assumes they are
  # calling &morsify("vey"); would result in "ve -0";

  my $defaults_href = {
                       CHARS_HASH_REF => \%CHARS,
                # a reference to the custom chars hash

                       REVERSE_CHARS_HASH_REF => { reverse( %CHARS) },
                # a reference to the reverse custom hash
                # the above two go as a pair, try not to omit one as y
+ou
                # will get unwanted results, and feel like an arse

                       MIN_PER_CENT => 70
                # the comparison value for morsify, in deciding what t
+o call
                      };

  $Morse::Code::DEFAULTS = $defaults_href;
  print &morsify("oy");

  &resetDefaults();
  # resets $Morse::Code::DEFAULTS to GODLY_DEFAULTS, a private variabl
+e

  print &morsify("oy, vey!");

  my $ojb = new Morse::Code();
  print $ojb->morsify("oy");

  my $obj2 = new Morse::Code($defaults_href);
  print $ojb->morsify("oy");

  # with a little help from data dumper, see what you have
  &debug(); # same as &debug(1)
  $obj2->debug(1); # same as $obj2->debug(); combined with &debug();

=end text

=head1 DESCRIPTION

Morse::Code a module to translate to/from Morse code with the option t
+o specify
customized Morse code sets.

** As vroom is my witness i will tye up all lose ends.

=head2 EXPORT

None by default.
Use qw(:all) to use package in objectless fashion, like &morsify("oy")
+;

When using qw(:all) and you wan't to override default settings,
mess with $Morse::Code::DEFAULTS


=head1 AUTHOR

=begin html

H.D.(crazyinsomniac), <crazyinsomniac@yahoo.com>

http://www.crazyinsomniac.f2s.com/

I<usually at> http://www.perlmonks.org/index.pl?node=crazyinsomniac

=end html

=head1 SEE ALSO

perldata, perlref.

=cut
[download]