mixword

   1 #!/usr/bin/env perl
   2
   3 #=======================================================================
   4 # $Id$
   5 # Mixes the letters in words, except the first and last letter. Just an
   6 # experiment.
   7 #
   8 # Character set: UTF-8
   9 # ©opyleft 2006– Øyvind A. Holm <sunny@sunbase.org>
  10 # License: GNU General Public License, see end of file for legal stuff.
  11 #=======================================================================
  12
  13 use strict;
  14 use warnings;
  15 use Getopt::Long;
  16
  17 $| = 1;
  18
  19 our $Debug = 0;
  20
  21 our %Opt = (
  22     'debug' => 0,
  23     'help' => 0,
  24     'version' => 0,
  25     'xml' => 0
  26 );
  27
  28 our $progname = $0;
  29 $progname =~ s#^.*/(.*?)$#$1#;
  30
  31 my $rcs_id = '$Id$';
  32 my $id_date = $rcs_id;
  33 $id_date =~ s/^.*?\d+ (\d\d\d\d-.*?\d\d:\d\d:\d\d\S+).*/$1/;
  34
  35 Getopt::Long::Configure("bundling");
  36 GetOptions(
  37     "debug" => \$Opt{'debug'},
  38     "help|h" => \$Opt{'help'},
  39     "version" => \$Opt{'version'},
  40     "xml|x" => \$Opt{'xml'}
  41 ) || die("$progname: Option error. Use -h for help.\n");
  42
  43 $Opt{'debug'} && ($Debug = 1);
  44 $Opt{'help'} && usage(0);
  45 $Opt{'version'} && print_version();
  46
  47 while (<>) {
  48     s/(\W?\w)(\w{2,})(\w\W?)/join("", $1, mix_word($2), $3)/ge;
  49     print;
  50 }
  51
  52 sub mix_word {
  53     my $Word = shift;
  54     D("mix_word(\"$Word\")");
  55     my @Array = split(//, $Word);
  56     D("Array = (\"" . join("\", \"", @Array) . "\")");
  57     mix_array(\@Array);
  58     return(join("", @Array));
  59 }
  60
  61 sub mix_array {
  62         # {{{
  63         my $array = shift;
  64     D("mix_array(\"$array\")");
  65         my $i;
  66         for ($i = @$array; --$i; ) {
  67                 my $j = int rand ($i+1);
  68                 next if $i == $j;
  69                 @$array[$i,$j] = @$array[$j,$i];
  70         }
  71         # }}}
  72 } # mix_array()
  73
  74 sub print_version {
  75     # Print program version {{{
  76     xml_print("$rcs_id\n");
  77     exit(0);
  78     # }}}
  79 } # print_version()
  80
  81 sub xml_print {
  82     # Print out some text, using DocBook if --xml is specified {{{
  83     my $Txt = shift;
  84     my ($xml_start, $xml_end) =
  85        (        "",       "");
  86
  87     if ($Opt{'xml'}) {
  88         $xml_start = <<END;
  89 <?xml version="1.0" encoding="UTF-8"?>
  90 <!DOCTYPE article PUBLIC "-//OASIS//DTD DocBook XML V4//EN" "http://docbook.org/xml/4.3/docbookx.dtd">
  91 <article>
  92   <screen>
  93 END
  94         $xml_end = <<END;
  95 </screen>
  96 </article>
  97 END
  98     }
  99
 100     printf("%s%s%s",
 101         $xml_start,
 102         $Opt{'xml'} ? txt_to_xml($Txt) : "\n$Txt\n",
 103         $xml_end
 104     );
 105     # }}}
 106 } # xml_print()
 107
 108 sub usage {
 109     # Send the help message to stdout {{{
 110     my $Retval = shift;
 111
 112     xml_print(<<END);
 113 $rcs_id
 114
 115 Mixes the letters in words, except the first and last letter. Just an
 116 experiment.
 117
 118 Usage: $progname [options] [file [files [...]]]
 119
 120 Options:
 121
 122   -h, --help
 123     Show this help.
 124   --version
 125     Print version information.
 126   -x, --xml
 127     Create XML output.
 128   --debug
 129     Print debugging messages.
 130 END
 131     exit($Retval);
 132     # }}}
 133 } # usage()
 134
 135 sub D {
 136     # Print a debugging message {{{
 137     $Debug || return;
 138     my @call_info = caller;
 139     chomp(my $Txt = shift);
 140     my $File = $call_info[1];
 141     $File =~ s#\\#/#g;
 142     $File =~ s#^.*/(.*?)$#$1#;
 143     if ($Opt{'xml'}) {
 144         printf(STDERR "<debug> <pid>%s</pid> <file>%s</file> <line>%s</line> <msg>%s</msg> </debug>\n",
 145             txt_to_xml($$),
 146             txt_to_xml($File),
 147             txt_to_xml($call_info[2]),
 148             txt_to_xml($Txt)
 149         );
 150     } else {
 151         print(STDERR "$File:$call_info[2] $$ $Txt\n");
 152     }
 153     return("");
 154     # }}}
 155 } # D()
 156
 157 sub txt_to_xml {
 158     # Return a XML-safe version of a string {{{
 159     my $Txt = shift;
 160
 161     $Txt =~ s/&/&amp;/gs;
 162     $Txt =~ s/</&lt;/gs;
 163     $Txt =~ s/>/&gt;/gs;
 164     return($Txt);
 165     # }}}
 166 } # txt_to_xml()
 167
 168 __END__
 169
 170 # Plain Old Documentation (POD) {{{
 171
 172 =pod
 173
 174 =head1 NAME
 175
 176 mixword
 177
 178 =head1 REVISION
 179
 180 $Id$
 181
 182 =head1 SYNOPSIS
 183
 184 mixword [options] [file [files [...]]]
 185
 186 =head1 DESCRIPTION
 187
 188 Mixes the letters in words, except the first and last letter. Just an
 189 experiment.
 190
 191 =head1 OPTIONS
 192
 193 =over 4
 194
 195 =item B<-h>, B<--help>
 196
 197 Print a brief help summary.
 198
 199 =item B<--version>
 200
 201 Print version information.
 202
 203 =item B<-x>, B<--xml>
 204
 205 Create XML output.
 206
 207 =item B<--debug>
 208
 209 Print debugging messages.
 210
 211 =back
 212
 213 =head1 BUGS
 214
 215
 216
 217 =head1 AUTHOR
 218
 219 Made by Øyvind A. Holm S<E<lt>sunny@sunbase.orgE<gt>>.
 220
 221 =head1 COPYRIGHT
 222
 223 Copyleft © Øyvind A. Holm &lt;sunny@sunbase.org&gt;
 224 This is free software; see the file F<COPYING> for legalese stuff.
 225
 226 =head1 LICENCE
 227
 228 This program is free software; you can redistribute it and/or modify it
 229 under the terms of the GNU General Public License as published by the
 230 Free Software Foundation; either version 2 of the License, or (at your
 231 option) any later version.
 232
 233 This program is distributed in the hope that it will be useful, but
 234 WITHOUT ANY WARRANTY; without even the implied warranty of
 235 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 236 See the GNU General Public License for more details.
 237
 238 You should have received a copy of the GNU General Public License along
 239 with this program; if not, write to the Free Software Foundation, Inc.,
 240 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 241
 242 =head1 SEE ALSO
 243
 244 =cut
 245
 246 # }}}
 247
 248 # vim: set fenc=UTF-8 ft=perl fdm=marker ts=4 sw=4 sts=4 et fo+=w :
 249 # End of file $Id$