user-tools/a8e

   1 #!/usr/bin/env perl
   2
   3 =pod
   4
   5 =head1 NAME
   6
   7 a8e - Abbreviate words in the input stream
   8
   9 =head1 SYNOPSIS
  10
  11 a8e [I<OPTIONS>]
  12
  13 Abbreviate words by leaving the first and last letter of them
  14 and replace internal letters by the number indicating how many were they.
  15 Like l10n, i18n, and a11y the conventional abbreviation of
  16 localization, internationalization, and accessibility respectively.
  17
  18 =head1 OPTIONS
  19
  20 =over 4
  21
  22 =item -m, --minlength I<N>
  23
  24 Abbreviate words at least I<N> (default 4) char long.
  25 Useful to be greater than the boundary letters kept (see B<-l>, B<-t>, and B<-k>) plus one.
  26
  27 =item -l, --leading-letters I<N>
  28
  29 =item -t, --trailing-letters I<N>
  30
  31 =item -k, --keep-letters I<N>
  32
  33 Set how many letter to keep at the beginning of words by B<-l>,
  34 or at the end by B<-t>, or set both at once by B<-k>
  35 (default is 1 for both)
  36
  37 =item -r, --word-pattern I<REGEX>
  38
  39 What counts as a word? (default B<[a-zA-Z]+>)
  40
  41 =back
  42
  43 =cut
  44
  45 use Getopt::Long qw/:config no_ignore_case no_bundling no_getopt_compat/;
  46 use Pod::Usage;
  47
  48 $min_length = 4;
  49 $keep_leading_letters = 1;
  50 $keep_trailing_letters = 1;
  51 $word_pattern = qr/[a-zA-Z]+/;
  52
  53 GetOptions(
  54         'm|minlength=i' => \$min_length,
  55         'l|leading-letters=i' => \$keep_leading_letters,
  56         't|trailing-letters=i' => \$keep_trailing_letters,
  57         'k|keep-letters=i' => sub{ $keep_leading_letters = $keep_trailing_letters = $_[1]; },
  58         'r|word-pattern=s' => \$word_pattern,
  59 ) or pod2usage(-exitval=>2, -verbose=>99);
  60
  61
  62 while(<STDIN>)
  63 {
  64         while(s/(.*?)($word_pattern)//)
  65         {
  66                 my ($pre, $word) = ($1, $2);
  67                 print $pre;
  68                 if(length $word >= $min_length)
  69                 {
  70                         my $abbrev = substr($word, 0, $keep_leading_letters) . (length($word)-$keep_leading_letters-$keep_trailing_letters) . substr($word, -$keep_trailing_letters);
  71                         print $abbrev;
  72                 }
  73                 else
  74                 {
  75                         print $word;
  76                 }
  77         }
  78         print;
  79 }