#!/usr/bin/perl

# aul, bul, cul, dul, pul - plaintext underline helpers
# [abcd]ul use some fixed underline character,
# pul uses its first argument as pattern

use strict;
use warnings;
use integer;
use File::Basename qw(basename);

$0 = basename($0);
my $pat =
   {qw(a - b = c ~ d ^)}->{substr($0, 0, 1)} || shift;
die "usage: $0 pattern [file]...\n"
   if !defined($pat) || '' eq $pat;
my $len  = length($pat);

while (<>) {
   print;
   s/\S/x/g;                   # underline non-whitespace
   1 while s/x (?= *x)/xx/;    # and inner blanks
   if (1 == $len) {            # finally apply texture
      s/x/$pat/g;
   }
   else {
      s{(x+)}{substr(
         $pat x (length($1)/$len+1), 0, length($1)
      )}ge;
   }
   print;
}