Permalink
Browse files

First release of Text::Abbrev for Perl 6

  • Loading branch information...
0 parents commit 0acbcf61f836aa4d15dedaea087bad15fff88917 GlitchMr committed Jul 20, 2012
Showing with 123 additions and 0 deletions.
  1. +22 −0 LICENSE
  2. +7 −0 META.info
  3. +41 −0 README.md
  4. +21 −0 lib/Text/Abbrev.pm
  5. +32 −0 t/00-basic.t
22 LICENSE
@@ -0,0 +1,22 @@
+Copyright (c) 2012, GlitchMr
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+1. Redistributions of source code must retain the above copyright notice, this
+ list of conditions and the following disclaimer.
+2. Redistributions in binary form must reproduce the above copyright notice,
+ this list of conditions and the following disclaimer in the documentation
+ and/or other materials provided with the distribution.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR
+ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
+(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
+ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
7 META.info
@@ -0,0 +1,7 @@
+{
+ "name" : "Text::Abbrev",
+ "version" : "0.1.0",
+ "description" : "Create an abbreviation table from a list",
+ "depends" : [],
+ "source-url" : "git://github.com/GlitchMr/perl6-Text-Abbrev.git"
+}
41 README.md
@@ -0,0 +1,41 @@
+Text::Abbrev - create an abbreviation table from a list.
+
+# Synopsis
+
+```perl
+use Text::Abbrev;
+
+# You can say "y" or "n" too
+my $option = abbrev(<yes no>){lc prompt "Y/N? "};
+if $option {
+ say "You have said {$option.titlecase}.";
+}
+else {
+ say "Sorry, unknown option.";
+}
+```
+
+# Functions
+
+## `abbrev`
+
+The only function exported by this module which will return unambigous
+truncations of every option in list. For example, when you will call
+`abbrev <break brick>` you will get following hash.
+
+```perl
+(
+ # break
+ "break" => "break",
+ "brea" => "break",
+ "bre" => "break",
+ # brick
+ "brick" => "brick",
+ "bric" => "brick",
+ "bri" => "brick",
+)
+```
+
+# Author
+
+GlitchMr <glitchmr@myopera.com>
21 lib/Text/Abbrev.pm
@@ -0,0 +1,21 @@
+module Abbrev;
+multi sub abbrev (*@words) is export {
+ my %seen;
+ my %result;
+ for @words {
+ loop (my $len = .chars; $len > 0; --$len) {
+ my $abbrev = .substr(0, $len);
+ if %seen{$abbrev} {
+ %result.delete: $abbrev;
+ }
+ else {
+ %seen{$abbrev} = 1;
+ %result{$abbrev} = $_;
+ }
+ }
+ }
+ for @words {
+ %result{$_} = $_;
+ }
+ return %result;
+}
32 t/00-basic.t
@@ -0,0 +1,32 @@
+use v6;
+use Test;
+plan 6;
+use Text::Abbrev;
+
+pass "Loaded Text::Abbrev";
+
+is_deeply(
+ abbrev(<ab bc>),
+ (a => 'ab', ab => 'ab', b => 'bc', bc => 'bc').hash,
+ 'Basic test',
+);
+is_deeply(
+ abbrev(<ins img>),
+ (in => 'ins', ins => 'ins', im => 'img', img => 'img').hash,
+ 'Shortcuts shared by two or more options should be removed' ,
+);
+is_deeply(
+ abbrev(<ab abc abcd>),
+ (ab => 'ab', abc => 'abc', abcd => 'abcd').hash,
+ "Values on list shouldn't be removed",
+);
+is_deeply(
+ abbrev([1, 2], [1, 3]),
+ ('1 2' => [1, 2], '1 3' => [1, 3]).hash,
+ 'Non stringy arguments should be stringified.',
+);
+is_deeply(
+ abbrev,
+ ().hash,
+ 'Empty list should return empty list',
+);

0 comments on commit 0acbcf6

Please sign in to comment.