Plaintext underlining tool (martin)

Plaintext underlining tool

martin

created: 2006-01-28 16:41:16

perlmonks

node
author

prlmnks

node
author

Here is a small tool I use to underline plaintext. It has a little bit more logic than the vi idiom yyp:s/./-/g built into it in that it can generate underlining patterns of more than one character (like o=o=o=o) and it copys indentation and bigspace (i.e. whitespace containing tabs) as-is from the original text.

To minimize typing overhead I install it under 5 different names (using links) and let it use its name as a parameter. The names aul, bul, cul and dul give me four standard line types, while pul takes an arbitrary line pattern as its first argument.

#!/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;
}

Re: Plaintext underlining tool

chanio

created: 2006-01-28 18:32:45

perlmonks

prlmnks

Nice!

I did this example that I call 'the Pine Tree' pattern...

cat <<'EOF'| perl pul.pl '/*\*'
> Kernel-disk plus a disk containing the initial ramdisk, which will be
> prompted for at boottime.
>
> If you wish to remaster the CD, please don't forget to specify
>         -no-emul-boot -boot-load-size 4 -boot-info-table \
>         -b boot/isolinux/isolinux.bin -c boot/isolinux/boot.cat
> as option to mkisofs. Otherwise your CD won't be bootable.
> EOF
Kernel-disk plus a disk containing the initial ramdisk, which will be
/*\*/*\*/*\*/*\*/*\*/*\*/*\*/*\*/*\*/*\*/*\*/*\*/*\*/*\*/*\*/*\*/*\*/
prompted for at boottime.
/*\*/*\*/*\*/*\*/*\*/*\*/


If you wish to remaster the CD, please don't forget to specify
/*\*/*\*/*\*/*\*/*\*/*\*/*\*/*\*/*\*/*\*/*\*/*\*/*\*/*\*/*\*/*
        -no-emul-boot -boot-load-size 4 -boot-info-table \
        /*\*/*\*/*\*/*\*/*\*/*\*/*\*/*\*/*\*/*\*/*\*/*\*/*
        -b boot/isolinux/isolinux.bin -c boot/isolinux/boot.cat
        /*\*/*\*/*\*/*\*/*\*/*\*/*\*/*\*/*\*/*\*/*\*/*\*/*\*/*\
as option to mkisofs. Otherwise your CD won't be bootable.
/*\*/*\*/*\*/*\*/*\*/*\*/*\*/*\*/*\*/*\*/*\*/*\*/*\*/*\*/*

I still can't understand the use of having different names for the same script. Where are you keeping the default patterns?

Landlords production is only eaten by landlords...
[http://knopper.net/knoppix/index-en.html|Wherever I lay my KNOPPIX disk, a new FREE LINUX nation could be established]

Re^2: Plaintext underlining tool

martin

created: 2006-01-29 02:46:35

perlmonks

prlmnks

chanio asked:

I still can't understand the use of having different names for the same script. Where are you keeping the default patterns?

The default patterns are hard coded into the script, namely:

-----
=====
~~~~~
^^^^^

The idea of scripts or binaries using the name they are called by as a parameter is not altogether uncommon in a Unix-like environment, a prominent example being your login shell that knows it is a login shell rather than an ordinary subshell from the fact that what appears to be its name starts with a dash.

In such an environment the Perl function exec lets you choose the name argument (which will end up as $0 in the called program) independently of the program's actual filename (using the indirect object syntax).

The easiest way to take advantage of a $0-aware script from the command line, however, is to make it accessible via appropriate different filenames. Just link (or copy) your pul.pl file to aul.pl and see what happens if you call that (N.B. without a pattern argument).

Re^3: Plaintext underlining tool

chanio

created: 2006-01-30 19:27:08

perlmonks

prlmnks

{qw(a - b = c ~ d ^)}->{substr($0, 0, 1)} || shift;

It is amazing!

Linux & Perl always have a new surprise for me!

Thank you!

Landlords production is only eaten by landlords...
[http://knopper.net/knoppix/index-en.html|Wherever I lay my KNOPPIX disk, a new FREE LINUX nation could be established]