File Coverage

bin/nl

Criterion	Covered	Total	%
statement	105	136	77.2
branch	37	68	54.4
condition	4	11	36.3
subroutine	11	12	91.6
pod			n/a
total	157	227	69.1

#!/usr/bin/env perl
#
# nl - line numbering filter
#
# 2020.10.25 v1.00 jul : first public release

=begin metadata

Name: nl
Description: line numbering filter
Author: jul, [e-mail]
License: artistic2

=end metadata

=cut

use strict;
use warnings;
use utf8;

use Getopt::Std qw(getopts);
use File::Basename qw(basename);
use Pod::Usage qw(pod2usage);

use constant EX_SUCCESS => 0;
use constant EX_FAILURE => 1;

our $VERSION = '1.3';
my $program  = basename($0);

# options
$Getopt::Std::STANDARD_HELP_VERSION = 1;
my %options = ();
getopts('b:d:f:h:i:n:ps:v:w:', \%options) or pod2usage(EX_FAILURE);
my $file = shift;
$file = '-' unless defined $file;
pod2usage(EX_FAILURE) if @ARGV;

my $type_b      = $options{b} || "t";
my $delim       = $options{d} || '\:';
my $type_f      = $options{f} || "n";
my $type_h      = $options{h} || "n";
my $incr        = $options{i};
my $format      = $options{n};
my $single_page = $options{p};
my $sep         = exists $options{'s'} ? $options{'s'} : "\t";
my $startnum    = $options{v};
my $width       = $options{w};
if (defined $format) {
	my %expect = (
		'ln' => 1,
		'rn' => 1,
		'rz' => 1,
	);
	unless ($expect{$format}) {
		warn "$program: invalid line number format: '$format'\n";
		exit EX_FAILURE;
	}
}
else {
	$format = 'rn';
}

if (defined $width) {
	if ($width !~ m/\A\+?[0-9]+\Z/ || $width == 0) {
		warn "$program: invalid line number field width: '$width'\n";
		exit EX_FAILURE;
	}
	$width = int $width; # strip '+'
}
else {
	$width = 6;
}

if (defined $startnum) {
	if ($startnum !~ m/\A[\+\-]?[0-9]+\Z/) {
		warn "$program: invalid starting line number: '$startnum'\n";
		exit EX_FAILURE;
	}
}
else {
	$startnum = 1;
}

if (defined $incr) {
	if ($incr !~ m/\A[\+\-]?[0-9]+\Z/) {
		warn "$program: invalid line number increment: '$incr'\n";
		exit EX_FAILURE;
	}
}
else {
	$incr = 1;
}

sub VERSION_MESSAGE {
	print "$program version $VERSION\n";
	exit EX_SUCCESS;
}

# options -b -f -h
my $regex_b = "";
my $regex_f = "";
my $regex_h = "";

($type_b, $regex_b) = split //, $type_b, 2;
($type_f, $regex_f) = split //, $type_f, 2;
($type_h, $regex_h) = split //, $type_h, 2;

my @type = ($type_h, $type_b, $type_f,); # don't change order
for (@type) {
	my %expect = (
		'a' => 1,
		't' => 1,
		'n' => 1,
		'p' => 1,
		'e' => 1,
	);
	unless ($expect{$_}) {
		warn "$program: invalid numbering style: '$_'\n";
		pod2usage(EX_FAILURE);
	}
}

my @regex = ($regex_h, $regex_b, $regex_f); # don't change order

# options -d
my $delim_std = '\:';
substr($delim_std, 0, length($delim), $delim);
$delim = quotemeta(substr($delim_std, 0, 2)); # max 2 chars, backslash escaped

# options -n -w
my $format_str	= '%';
$format_str .= '-' if $format eq "ln";
$format_str .= '0' if $format eq "rz";
$format_str .= $width;
$format_str .= 'd';

# options -v
my $number = $startnum;

my $section = 1;
my $new_section = 1;

exit (do_file($file) ? EX_FAILURE : EX_SUCCESS);

###############
# SUBROUTINES #
###############

sub print_number {

	my $match = shift;

	if ($match)
	{
		printf($format_str, $number);
		$number += $incr;
	}
	else
	{
		print ' ' x $width;
	}

	print $sep;
}

sub print_line {

	my $line  = shift;
	my $type  = shift;
	my $regex = shift;

	if ($type eq 'a')
	{
		print_number(1);
	}
	elsif ($type eq 't')
	{
		my $match = $line =~ /\A\Z/ ? 0 : 1;
		print_number($match);
	}
	elsif ($type eq 'n')
	{
		print_number(0);
	}
	elsif ($type eq 'p')
	{
		my $match = $line =~ /$regex/ ? 1 : 0;
		print_number($match);
	}
	elsif ($type eq 'e')
	{
		my $match = $line =~ /$regex/ ? 0 : 1;
		print_number($match);
	}
	else
	{
		warn "$program: invalid type '$type'\n";
		pod2usage(EX_FAILURE);
	}

	print $line;
}

sub do_file {
	my $name = shift;
	my ($fh, $line);

	if ($name eq '-')
	{
		$fh = *STDIN;
	}
	else
	{
		if (-d $name)
		{
			warn "$program: '$name': is a directory\n";
			return 1;
		}
		unless (open $fh, '<', $name)
		{
			warn "$program: '$name': $!\n";
			return 1;
		}
	}

	while ($line = <$fh>)
	{
		if ($line =~ /^($delim)($delim)?($delim)?$/)
		{
			if    ($3) {$new_section = 0} # header
			elsif ($2) {$new_section = 1} # body
			else       {$new_section = 2} # footer

			# change page
			if ($new_section <= $section)
			{
				$number = $startnum unless $single_page;
			}

			$section = $new_section;
		}
		else
		{
			print_line($line, $type[$section], $regex[$section]);
		}
	}
	unless (close $fh)
	{
		warn "$program: cannot close '$name': $!\n";
		return 1;
	}

	return 0;
}

__END__