Subliminal linking script

nYES, another insane slithering Perl horror!

I am so sorry. This is silly. It just happened. It was our destiny.

Verily, this text will shall not have any subliminal links attached to it. It just can't have any. You know that. It just will not happen. The whole concept is patently absurd and I refuse to negotiate about this whole thing. You must stop talking of this, because the whole thing is so laughable.

I was inspired by Jurph's writeup in Rain of Frogs, so I made this little Perl script for added insanity! Usage is simple:

sublimilink "Some words" "Link Target" (files...)

It accepts the input from standard input, of course. The link target is optional. The output is very similar to the above (in fact, it was created with the script - never mind about the content, the message and the link targets =)

Technically, there's nothing in the script that requires Perl 5.6, but you really should upgrade anyway. If it's not possible, You Know What To Edit. =)

Also, this script has only two regular expressions and both of them are null regexs! Yes, you can write "comprehensible" code in Perl, it's only a matter of good coding style... (Uh, I later added that space-cleaner-thing, I didn't remember that - but surprisingly few regexs nevertheless =)

Without further ado, here's the script:

#!/usr/bin/perl
#
# Subliminal linker for Everything2
# Written by Weyfour WWWWolf <wwwwolf@iki.fi>, 2001-10-20
# Do whatever you want with this script, as long as you
# acknowledge me as the original author. No warranty.
#
# $Id: sublimilink.pl,v 1.0 2001/10/20 19:53:58 wwwwolf Exp wwwwolf $
#
# Notes: - HTML tags are not considered!
#        - Only E2 link format is supported (add getopt support?)

require v5.6.0;

use strict;
use warnings;

our ($line, $words, $target, @wordchars);

# Get the words from command line
$words = shift;
# Get (optional) link target from command line.
$target = shift;
# It's optional... so of that's a file name, return it to the array.
if(-e $target) {
  unshift(@ARGV, $target);
  undef $target;
}
if(!$words) {
  die "sublimilink: Usage: $0 \"Words and words\" \"Target\" textfiles [...] ".
      "(or use stdin)\n";
}

# Clean the words of extra characters.
$words =~ s/[\s]//g;

# Split the words to characters.
@wordchars = split(//, $words);

# Process the input.
while($line = <>) {
  my $processed = "";

  # Have we run out of characters?
  if(scalar(@wordchars) <= 0) {
    # Just print and get the next line.
    print $line;
    next;
  }

  # Split the read line to individual characters
  my @linechars = split(//, $line);

  # Loop over each character in the line
  while(scalar(@linechars) > 0) {
    # Get the next character from read line.
    my $origchar = shift(@linechars);

    # Get the next character from our word.
    my $wordchar = shift(@wordchars);

    # No characters left?
    if(!defined $wordchar) {
      # Nothing can match a letter that doesn't exist.
      $processed .= $origchar;
      next;
    }

    # Yes, we had a character left.
    if($origchar eq $wordchar) {
      # Verily, this letter is in our word.
      # Put the linked letter to the processed string.
      $processed .= "[" . (defined $target ? "$target|":"") . $origchar . "]";
    } else {
      # Not the right one?
      # Put it back.
      unshift(@wordchars, $wordchar);
      # And put the original character to the processed string.
      $processed .= $origchar;
    }
  }
  print $processed;
}