. You can download a tarball at
Anyway, I am somewhat proud of this, and would really like your suggestions/comments/criticism as always, whether it be stylical or whatever. Pretty soon, when i complete Morse::Sound and Morse::Fancy, I'll upload this to cpan, at which time my real name might be revealed.(I'm not sure if they'll let me upload with just my initials).
The module itself works in Object and Objectless mode, as is noted in the pod. Please read the pod. Initially I was gonna post this in Craft, but didn't like the automatic formatting, and didn't feel this was quite complete for the Code Catacombs, so it's here, in CUFP
##### 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