some.pl

#!/depot/perl-5.8.3/bin/perl

#
# Mahesh Asolkar (c) 2006
# Reference : http://en.wikipedia.org/wiki/Morse_code
#

use strict;
use warnings;
use Getopt::Long;

my $to = 1;
my $from = 0;

#
# Get options and arguments
#
my $correct_usage = GetOptions ('from' => \$from,
                                'to' => \$to);

$to = 0 if ($from);

my $morse = { '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'                 => '--..'   ,
              '0'                 => '-----'  ,
              '1'                 => '.----'  ,
              '2'                 => '..---'  ,
              '3'                 => '...--'  ,
              '4'                 => '....-'  ,
              '5'                 => '.....'  ,
              '6'                 => '-....'  ,
              '7'                 => '--...'  ,
              '8'                 => '---..'  ,
              '9'                 => '----.'  ,
              '.'                 => '.-.-.-' ,
              ','                 => '--..--' ,
              '?'                 => '..--..' ,
              'intra_char_gap'    => ''       ,
              'intra_letter_gap'  => ' '      ,
              'intra_word_gap'    => '  '     ,
              ' '                 => '  '     ,
              'intra_scent_gap'   => '   '    };

my $unmorse = { '.-'      => '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'  ,
                '-----'   => '0'  ,
                '.----'   => '1'  ,
                '..---'   => '2'  ,
                '...--'   => '3'  ,
                '....-'   => '4'  ,
                '.....'   => '5'  ,
                '-....'   => '6'  ,
                '--...'   => '7'  ,
                '---..'   => '8'  ,
                '----.'   => '9'  ,
                '.-.-.-'  => '.'  ,
                '--..--'  => ','  ,
                '..--..'  => '?'  ,
                ''        => ''   ,
                ' '       => ''   ,
                '  '      => ' '  ,
                '  '      => ' '  ,
                '   '     => '. ' };

if ($to) {
  my $msg = uc(join (' ', @ARGV));

  my @chars = split (//, $msg);

  print "$msg is:\n";

  foreach my $char (@chars) {
    print $morse->{$char};
    print $morse->{'intra_letter_gap'};
  }
} else {
  my @chars = @ARGV;
  my $msg = join ($morse->{'intra_letter_gap'}, @ARGV);

  print "$msg is:\n";

  foreach my $char (@chars) {
    print $unmorse->{$char};
  }
}

print "\n";