#! c:/perl/bin -w
use strict;
# vars
use vars qw( $aphor $new @new $max $min $splBRK $rest $subscript);
$aphor = ""; # the selected "fortune"
$new = ""; # $aphor after $splBRKs are s///to '\n\t'
$max = 65; # var for position inside substr at which breaking is more strongly needed than at $min
$min = 52; # $min, which is actually used for s///
$splBRK="~~"; # char pair in aphor.asc to mark positions of mandatory newlines (ie, at the end of each
# quote in aphor.asc that needs, on rendering, to be set off with a newline
$rest ="";
my $aphor1 = "This is a short line ~~ with a splBRK.";
my $aphor2 = "Q: How many shrinks does it take to change a lightbulb?~~A: One ...but the lightbulb has to want to change.";
my $aphor3 = "This is a short line followed by space-dbltilde-space ~~ This should be printed on a newline.";
my $aphor4 = "Test line with double-tilde here~~and more stuff that is more than var_max chars in length so that we also get a test of the line splitting after approx 60 characters after which there's some left over.";
my $aphor5 = "Variant with space-double-tilde (after the space) ~~and enuf more chars that the total length is more than var_max chars in length so that we also get a test of the line splitting after approx 60 characters after which there's some left over.";
my $aphor6 = "No splBRKs in this: Now is the time for all good men to come to the aid of their country while the quick red fox jumps over the lazy brown dog's back and the fork runs away with the spoon.";
my $aphor7 = "This is a short line (but more than min) with no splBRKs.";
# main
if ( $ARGV[0] && ( $ARGV[0] > 0 ) && ($ARGV[0] < 8 ) ) {
$subscript = $ARGV[0];
print "\nSELECTING \$aphor$subscript \n";
} else {
die "No ARGV or ARGV out of range! Useage: perl cli2.pl 1..7";
}
if ($subscript == 1) {
$aphor = $aphor1
} elsif ($subscript == 2) {
$aphor = $aphor2
} elsif ($subscript == 3) {
$aphor = $aphor3
} elsif ($subscript == 4) {
$aphor = $aphor4
} elsif ($subscript == 5) {
$aphor = $aphor5
} elsif ($subscript == 6) {
$aphor = $aphor6
} elsif ($subscript == 7) {
$aphor = $aphor7
} else {
die "ARGV out of range"; # belt & suspenders
}
if (length($aphor) > ($max+6) || $aphor =~ /~~/ ) { # plus six is an ARBITRARY ALLOWED OVERRUN
&splBRK;
}
else {
$new = "\n\t" . $aphor;
&out;
exit(58);
}
####
# sub splBRK -- breaks a line of undefined length by replacing each $splBRK with a \n\t
#
# BUT the split /$splBRK/... (with or w/o parens) is NOT removing all splBRKs
# NOR does it work with "/~~/" sted "/$splBRK/"
sub splBRK {
$_ = $aphor;
if (/$splBRK/) { # are there any $splBRK???
print "\n\tFrom sub_splBRK: splBRK found\n"; # DEBUG stmnt
} else {
print "\n\n\t NO splBRK found\n";
&shortenlines;
exit(75);
}
my @sect = split /$splBRK/;
$new= join "\n\t", @sect;
&shortenlines;
}
####
# SUB shortenlines -- breaks a line of undefined length by replacing
# a space with a \n at least every $max chars
# Match is not yet capable of dealing correctly w/the likes of "...yakity yak (blah, blah.)"
sub shortenlines {
use vars qw($post);
$rest = "\n\t" . $aphor;
@new = $rest =~ m/\G(.{$min,$max}[\x20.])?/gsx;
if ($') {
$post=$';
$new[$#new] = $post;
}
print "\n\n\t----- 100 (after splt and jn) --------\n\n";
foreach my $item (@new) {
if ($item) {
print "\t$item \n";
}
}
print "\n\n\t------------------------------------\n\n";
exit(108);
}
# SUB out
# alternate print for short lines w/no splBRKs
sub out {
print "\n\n\t----- SUB OUT 116---------------------\n\n";
print "$new";
print "\n\n\t ---- DONE: FROM SUB out ---------- \n";
exit(121);
}