#!/usr/bin/env perl
our
$VERSION
=
'1.3'
;
my
$program
= basename($0);
$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
;
}
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;
}
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
,);
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
);
my
$delim_std
=
'\:'
;
substr
(
$delim_std
, 0,
length
(
$delim
),
$delim
);
$delim
=
quotemeta
(
substr
(
$delim_std
, 0, 2));
my
$format_str
=
'%'
;
$format_str
.=
'-'
if
$format
eq
"ln"
;
$format_str
.=
'0'
if
$format
eq
"rz"
;
$format_str
.=
$width
;
$format_str
.=
'd'
;
my
$number
=
$startnum
;
my
$section
= 1;
my
$new_section
= 1;
exit
(do_file(
$file
) ? EX_FAILURE : EX_SUCCESS);
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}
elsif
($2) {
$new_section
= 1}
else
{
$new_section
= 2}
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;
}