pastebin - collaborative debugging

pastebin is a collaborative debugging tool allowing you to share and modify code snippets while chatting on IRC, IM or a message board.

This site is developed to XHTML and CSS2 W3C standards. If you see this paragraph, your browser does not support those standards and you need to upgrade. Visit WaSP for a variety of options.

Perl pastebin - collaborative debugging tool View Help


Posted by Karthik Chikmagalur on Sat 6 Jun 20:15
report abuse | download | new post

  1. #!/usr/bin/perl -w
  2. ###################################################################
  3. #morseblink.pl --- blinks a text file in morse on keyboard leds
  4. #
  5. #Quick and dirty hack to read text files in morse by flashing a
  6. #keyboard LED. (Default is the scroll-lock LED) Inspired by the novel
  7. #*Cryptonomicon* by Neal Stephenson.
  8. #
  9. #Copyright (C) Karthik Chikmagalur (2007-09)
  10. #<karthik[dot]chikmagalur@gmail.com>
  11. #
  12. #Version: 0.0.1
  13. #
  14. #This program is free software; you can redistribute it and/or modify
  15. #it under the terms of the GNU General Public License as published by
  16. #the Free Software Foundation; either version 2, or (at your option)
  17. #any later version.
  18. #
  19. #This program is distributed in the hope that it will be useful, but
  20. #WITHOUT ANY WARRANTY; without even the implied warranty of
  21. #MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
  22. #General Public License for more details.
  23. #
  24. ###################################################################
  25. #USAGE: perl morseblink.pl [options] [File1 File2 ... | STDIN]
  26. #options: -do[t] n -da[sh] n -g[ap] n -v[erbose] -e[ncode]
  27. #         -l[ed] [1-32]
  28. #
  29. #         dot:     dot duration (float, seconds)
  30. #         dash:    dash duration (float, seconds)
  31. #         gap:     gap between letters (float, seconds)
  32. #         verbose: report bits being flashed at STDOUT
  33. #         encode:  encode and print, do not flash LED
  34. #         led:     led number from 1-32. Scrollock is 3.
  35. #
  36. #REQUIREMENTS: perl v. 5.8 or higher, Any *NIX with Xorg will do.  
  37. ###################################################################
  38.  
  39. use Getopt::Long;
  40. use Time::HiRes qw( usleep );
  41.  
  42. my ($dot, $dash, $gap, $wordsep, $led) = (0.4, 1, 0.6, 1, 3);
  43. my ($pointer, $verbose, $encode, $cipher);
  44. our $linesep = 1;
  45.  
  46. GetOptions(
  47.     'dot=f'=>\$dot,
  48.     'dash=f'=>\$dash,
  49.     'gap=f'=>\$gap,
  50.     'wordsep=i'=> \$wordsep,
  51.     'linesep=i'=> \$linesep,
  52.     'verbose+'=> \$verbose,
  53.     'led=i' => \$led,
  54.     'encode' => \$encode);
  55.  
  56. $wordsep = ' ' x $wordsep;
  57. $linesep = ' ' x $linesep;
  58. our %morse = (  
  59.     '\"' => '.-..-.',
  60.     '$' => '...-..-',
  61.     '(' => '-.--.',
  62.     ')' => '-.--.-',
  63.     '+' => '.-.-.',
  64.     ',' => '--..--',
  65.     '-' => '-....-',
  66.     '.' => '.-.-.-',
  67.     '/' => '-..-.',
  68.     '0' => '-----',
  69.     '1' => '.----',
  70.     '2' => '..---',
  71.     '3' => '...--',
  72.     '4' => '....-',
  73.     '5' => '.....',
  74.     '6' => '-....',
  75.     '7' => '--...',
  76.     '8' => '---..',
  77.     '9' => '----.',
  78.     ':' => '---...',
  79.     ';' => '-.-.-.',
  80.     '=' => '-...-',
  81.     '?' => '..--..',
  82.     'A' => '.-',
  83.     'B' => '-...',
  84.     'C' => '-.-.',
  85.     'D' => '-..',
  86.     'E' => '.',
  87.     'F' => '..-.',
  88.     'G' => '--.',
  89.     'H' => '....',
  90.     'I' => '..',
  91.     'J' => '.---',
  92.     'K' => '-.-',
  93.     'L' => '.-..',
  94.     'M' => '--',
  95.     'N' => '-.',
  96.     'O' => '---',
  97.     'P' => '.--.',
  98.     'Q' => '--.-',
  99.     'R' => '.-.',
  100.     'S' => '...',
  101.     'T' => '-',
  102.     'U' => '..-',
  103.     'V' => '...-',
  104.     'W' => '.--',
  105.     'X' => '-..-',
  106.     'Y' => '-.--',
  107.     'Z' => '--..',
  108.     '_' => '..--.-',
  109.     '\'' => '.----.',
  110.     ' ' => $wordsep);
  111.  
  112. sub encode {
  113.     #encodes a string to morse given a file object
  114.     our (%morse, $linesep);
  115.     my $file = shift;
  116.     my ($line, @letters, $result);
  117.  
  118.     while (<$file>) {
  119.         chomp;
  120.         @letters = split "", uc;
  121.         foreach (@letters) {
  122.             $_ = '0' if (not exists $morse{$_});
  123.             $result = $result . "$morse{$_} ";
  124.         }
  125.         $result = $result . $linesep;
  126.     }
  127.    
  128.     return $result;
  129. }
  130.  
  131. sub flash {
  132.     #Flash LED given a morse string (. and -)
  133.     my $message = shift;
  134.     my ($dot, $dash, $gap, $led, $verbose) = @_;
  135.     my $i;
  136.  
  137.     chomp $message;
  138.     my @bits = split "", $message;
  139.     foreach (@bits) {
  140.         $i++;
  141.         print "bit $i: \"$_\"\n" if ($verbose);
  142.  
  143.         m/\./ and do { system("xset", "led", $led);
  144.                        usleep $dot*1e6;
  145.                        system("xset", "-led", $led);};
  146.         m/-/  and do { system("xset", "led", $led);
  147.                        usleep $dash*1e6;
  148.                        system("xset", "-led", $led);};
  149.         m/ /  and do { usleep $gap*1e6; };
  150.         usleep $gap*1e6;
  151.     }
  152. }
  153.  
  154. $cipher = main::encode STDIN if not @ARGV;
  155. while (@ARGV) {
  156.     my $file = shift;
  157.     if (not -e $file) {
  158.         print "File \"$file\" does not exist. Skipping. \n";
  159.         next;}
  160.     open $pointer, $file;
  161.     $cipher = $cipher . encode $pointer;
  162. }
  163.  
  164. if (defined $encode) {print "$cipher\n";}
  165. else {main::flash $cipher, $dot, $dash, $gap, $led, $verbose;}

Submit a correction or amendment below (click here to make a fresh posting)
After submitting an amendment, you'll be able to view the differences between the old and new posts easily.

Syntax highlighting:

To highlight particular lines, prefix each line with @@


Remember me so that I can delete my post