#!perl -w # Morse::Code # # Provides for translating between text and morsecode. # Author: crazyinsomniac at perlmonks.org(10277) aka crazyinsomniac @ yahoo.com # $Id: Morse::Code.pm,v 0.1 2001/04/14 07:28:35 crazyinsomniac Exp $ # the above $Id statement i emulated from zzamboni at perlmonks.org package Morse::Code; require 5; # modified to work without the keyword our use strict; use warnings; BEGIN # why in a begin block, I saw it in perlmod { require Exporter; my ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS); # set the version for version checking $VERSION = 0.01; # if using RCS/CVS, this may be preferred $VERSION = do { my @r = (q$Revision: 0.01 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; # must be all one line, for MakeMaker @ISA = qw(Exporter); # need to inherit from Exporter # This allows declaration use Morse::Code ':all'; # If you do not need this, moving things directly into @EXPORT or @EXPORT_OK # will save memory. %EXPORT_TAGS = ('all'=>[ qw(&debug &morsify &toMorse &toText $DEFAULTS &resetDefaults) ]); @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } ); } # our @EXPORT_OK; # i don't remember why i had to include this after BEGIN, so i'm not anymore #### ##### exported package globals go here # # the default settings hash reference, the only exprted global variable 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 are set $DEFAULTS->{INPUT_AS_TEXT}=''; # just take a look at toText and/or toMorse $DEFAULTS->{INPUT_AS_MORSE}=''; # it's pretty obvious from there my ($GODLY_DEFAULTS) = {%{$DEFAULTS}}; # the untouchable hardcoded defaults, that you might wanna revert to sometime # 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_package_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 passed 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.plover.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 you # will get unwanted results, and feel like an arse MIN_PER_CENT => 70 # the comparison value for morsify, in deciding what to call }; $Morse::Code::DEFAULTS = $defaults_href; print &morsify("oy"); &resetDefaults(); # resets $Morse::Code::DEFAULTS to GODLY_DEFAULTS, a private variable 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 to 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), http://www.crazyinsomniac.f2s.com/ I http://www.perlmonks.org/index.pl?node=crazyinsomniac =end html =head1 SEE ALSO perldata, perlref. =cut