#!/usr/bin/env perl
################################################################################
## MARK -- emphasizes part matching a pattern
##
## - It behaves like the filter program.
## - The back and forth 5 lines are displayed in default.
##
## - $Revision: 2.23 $
##
## - Author: 2006-2026, tomyama
## - Intended primarily for personal use, but BSD license permits redistribution.
##
## BSD 2-Clause License:
## Copyright (c) 2006-2026, tomyama
## All rights reserved.
################################################################################

use 5.014_000;
use strict;                         # first released with perl 5
use warnings;                       # first released with perl v5.6.0
use File::Basename qw();            # first released with perl 5
use Getopt::Long qw();              # first released with perl 5
use Fcntl;                          # first released with perl 5
use Errno qw();                     # first released with perl 5.005

##########
## スクリプトのエントリポイント
sub pl_main( @ )
{

    ## 初期化処理
    init_script();

    ## 引数解析
    if( parse_arg( @_ ) ){
        return 1;
    }

    ## デバッグ用 : パラメータ出力
    if( $main::debug ){
        prt_param();
    }

    if( $main::help || $main::version ){
        if( $main::help ){
            $main::help = 0;
            usage( 0 );
        }
        if( $main::version ){
            $main::version = 0;
            PrintVersion();
        }
        return 0;
    }

    sub print_line( $$$$$$ )
    {
        my( $line, $nr, $ref_nr_of_last_output, $num_char_disp_area, $opn_fname, $ref_is_skipping ) = @_;
        if( $nr <= $$ref_nr_of_last_output ){
            return;
        }

        ## 必要に応じてファイル名を出力
        my $fn_str = '';
        if( $main::prt_fname ){
            $fn_str = sprintf( "%-*s:", $num_char_disp_area, $opn_fname );
        }
        ## 必要に応じて行番号を出力
        my $nr_str = '';
        if( $main::numbering ){
            $nr_str = sprintf( "%7d:", $nr );
        }
        ## 出力する
        print( "$fn_str$nr_str$line\n" );

        $$ref_is_skipping = 0;

        $$ref_nr_of_last_output = $nr;
        return;
    }

    my $file_num = scalar( @main::fi_in );
    my $file_name_len_max = 0;
    my $num_char_disp_area = 8;
    if( $main::prt_fname ){
        for( my $file_idx=0; $file_idx<$file_num; $file_idx++ ){
            my $cur_len = length( $main::fi_in[ $file_idx ] );
            $file_name_len_max = ( $cur_len > $file_name_len_max ? $cur_len : $file_name_len_max );
        }
        $num_char_disp_area = ( ( ( int( $file_name_len_max / 8 ) ) + 1 ) * 8 ) - 1;
    }
    for( my $file_idx=0; $file_idx<$file_num; $file_idx++ ){
        my $opn_fname = $main::fi_in[ $file_idx ];

        if( $main::multiple_input_files ){
            print( qq{ ***** [ $opn_fname ] *****\n});
        }

        open( FI_IN, "<$opn_fname" ) ||
            die( qq{$main::appname: error: "$opn_fname": could not open file: $!\n} );
        my $flag_filter = $main::flag_filter;
        my $re_flag = '';
        $re_flag .= 'i' if( $main::ignorecase );
        #print( qq{\$re_flag="$re_flag"\n} );
        my $nr_first_eof = -1;
        my $nr_of_last_output = 0;
        my $is_skipping = 0;
        for( my $nr=1; 1; $nr++ ){
            my $mybuff = '';
            my $len = read_one_line( \*FI_IN, \$mybuff );
            my $cancel_match_check = 0;
            if( $len < 0 ){
                $nr--;
                if( $main::flag_head_tail && $nr_first_eof < 0 ){
                    $cancel_match_check = 1;
                }else{
                    last;
                }
            }elsif( $len == 0 ){
                $nr--;
                if( $main::flag_head_tail && $nr_first_eof < 0 ){
                    $cancel_match_check = 1;
                }else{
                    next;
                }
            }

            $mybuff =~ s/\r?\n$//o;

            ## マーキングする
            my $match_flg = 0;
            if( $cancel_match_check ){
                $nr_first_eof = $nr;
                $cancel_match_check = 1;
                if( scalar( @main::pre_buffer ) ){
                    $mybuff = pop( @main::pre_buffer );
                }
                #print( qq{\$nr=$nr, \$nr_first_eof=$nr_first_eof\n} );
            }else{
                if( defined( $main::re ) ){
                    if( $main::bUseAnsiEscSeqColor ){
                        # インライン修飾子 (?imsx) を埋め込んだ正規表現
                        if( $mybuff =~ s/(?$re_flag)($main::re)/\033[1m$1\033[0m/g ){
                            $match_flg = 1;
                        }
                    }else{
                        # インライン修飾子 (?imsx) を埋め込んだ正規表現
                        if( $mybuff =~ m/(?$re_flag)$main::re/g ){
                            $match_flg = 1;
                        }
                    }
                }
            }

            my $post_buffer_counter_wait = 0;
            if( $main::flag_head_tail ){
                if( $nr == 1 ){
                    if( $match_flg == 0 ){
                        $post_buffer_counter_wait = -1;
                        $match_flg = 1;
                    }
                }elsif( $nr == $nr_first_eof ){
                    $match_flg = 1;
                }
            }

            if( $flag_filter ){

                ## 読み易いように、snip...を出力
                #print( qq{\$nr=$nr, \$nr_of_last_output=$nr_of_last_output\n} );
                if( ( $nr - $main::buffer_pre - $nr_of_last_output ) == 2 ){
                    if( $is_skipping == 0 ){
                        $is_skipping = 1;
                        if( $main::bUseAnsiEscSeqColor ){
                            print( "        \033[34m*** (filtered) ***\033[0m\n" );
                        }else{
                            print( "        *** (filtered) ***\n" );
                        }
                    }
                }

                ## マッチしていなかったら
                if( $match_flg == 0 ){

                    ## 後方行の出力
                    $main::post_buffer_counter--;
                    if( $main::post_buffer_counter < 0 ){
                        $main::post_buffer_counter = 0;

                        ## 前方行をバッファに溜めておく
                        ## buffer_pre=0 の場合はバッファは必要無し
                        if( $main::buffer_pre ){
                            ## バッファが満杯であれば整理しておく
                            if( scalar( @main::pre_buffer ) >= $main::buffer_pre ){
                                shift( @main::pre_buffer );
                            }

                            ## バッファに溜める
                            push( @main::pre_buffer, $mybuff );
                        }

                        next;
                    }

                ## マッチしていたら
                }else{
                    ## バッファを吐き出す
                    my $pre_buffer_size = scalar( @main::pre_buffer );
                    my $nr_first = $nr - $pre_buffer_size;
                    for( my $pre_buffer_idx=0; $pre_buffer_idx<$pre_buffer_size; $pre_buffer_idx++ ){
                        print_line(
                            $main::pre_buffer[ $pre_buffer_idx ],
                            $nr_first + $pre_buffer_idx,
                            \$nr_of_last_output,
                            $num_char_disp_area, $opn_fname,
                            \$is_skipping );
                    }
                    @main::pre_buffer = ();

                    ## 後方行出力用のカウンタをセットする
                    $main::post_buffer_counter = $main::buffer_post + $post_buffer_counter_wait;

                    if( $cancel_match_check ){
                        $flag_filter = 0;
                    }
                }
            }

            print_line( $mybuff, $nr, \$nr_of_last_output, $num_char_disp_area, $opn_fname, \$is_skipping );
        }
        close( FI_IN );
    }

    return 0;
}

##########
## 初期化処理
## Revision: 1.3
sub init_script()
{
    my $exec_file = $0;
    $exec_file =~ s!^.*tests/(.*)\.t$!$1!;

    ### GLOBAL ###
    $main::apppath = File::Basename::dirname( $exec_file );
    $main::appname = File::Basename::basename( $exec_file );
    $main::argc = 0;
    $main::debug = 0;
    $main::numbering = 0;
    $main::prt_fname = undef;
    $main::help = 0;
    $main::version = 0;
    $main::flag_head_tail = 0;
    $main::flag_filter = 0;
    $main::buffer_pre  = 5;
    $main::buffer_post = 5;
    @main::pre_buffer = ();
    $main::post_buffer_counter = 0;
    $main::ignorecase = 0;
    $main::re = undef;
    @main::fi_in = ();
    $main::syscall_act = 0;
    $main::multiple_input_files = 0;
    ## ［ANSIエスケープシーケンス］を使うか否かの判定で使う
    $main::bUseAnsiEscSeqColor = -t STDOUT;
    ##############
}

##########
## デバッグ用 : パラメータ出力
sub prt_param()
{
    printf STDERR ( qq{ ***** PARAMETER *****\n} .
                   qq{\$main::apppath = "$main::apppath"\n} .
                   qq{\$main::appname = "$main::appname"\n} .
                   qq{\$main::argc = $main::argc\n} .
                   qq{\$main::debug = $main::debug\n} .
                   qq{\$main::bUseAnsiEscSeqColor = $main::bUseAnsiEscSeqColor\n} .
                   qq{\$main::numbering = $main::numbering\n} .
                   qq{\$main::prt_fname = %s\n} .
                   qq{\$main::flag_head_tail = $main::flag_head_tail\n} .
                   qq{\$main::flag_filter = $main::flag_filter\n} .
                   qq{\$main::buffer_pre = $main::buffer_pre\n} .
                   qq{\$main::buffer_post = $main::buffer_post\n} .
                   qq{scalar( \@main::pre_buffer ) = %d\n} .
                   qq{\$main::post_buffer_counter = $main::post_buffer_counter\n} .
                   qq{\$main::ignorecase = $main::ignorecase\n} .
                   qq{\$main::re = %s\n} .
                   qq{\@main::fi_in = (%s)\n} .
                   qq{\$main::syscall_act = 0x%02X\n} .
                   qq{\$main::multiple_input_files = $main::multiple_input_files\n},
                   defined( $main::prt_fname ) ? qq{"$main::prt_fname"} : 'undef',
                   scalar( @main::pre_buffer ),
                   defined( $main::re ) ? qq{"$main::re"} : 'undef',
                   array_to_str( @main::fi_in ),
                   $main::syscall_act );
}

sub array_to_str( @ )
{
    return q{ '} . join( q{', '}, @_ ) . q{' } if( scalar( @_ ) > 0 );
    return '';
}

##########
## 引数解析
sub parse_arg( @ )
{
    @main::argv = @_;
    $main::argc = scalar( @main::argv );

    # Getopt::Long が動くように局所的に変更して騙す
    local @ARGV = @main::argv;

    # 設定: ショートオプションのまとめ指定（バンドリング）を有効化
    Getopt::Long::Configure("bundling");

    Getopt::Long::GetOptions(
        'debug|d'   => \$main::debug,
        'head-tail' => sub{
            $main::flag_head_tail = 1;
            $main::flag_filter = 1;
        },
        'f:s' => sub{
            my( $optname, $arg ) = @_;
            $main::flag_filter = 1;
            #print( qq{f arg: "$arg"\n} );

            if( $arg =~ m/^(\d+)(?:,(\d+))?$/o ){
                $main::buffer_pre  = $1;
                $main::buffer_post = $1;
                if( defined( $2 ) ){
                    $main::buffer_post = $2;
                }
            }else{
                push( @ARGV, $arg );
            }
        },
        'with-filename|H' => \$main::prt_fname,
        'no-filename|h' => sub{ $main::prt_fname = 0; },
        'help'          => \$main::help,
        'version|v'     => \$main::version,
        'ignore-case|i' => \$main::ignorecase,
        'line-number|n' => \$main::numbering,
        'force-color|c' => \$main::bUseAnsiEscSeqColor,
        'NON-EXISTENT-FILE' => sub{ push( @main::fi_in, 'NON-EXISTENT-FILE' ) },
        'syscall-act=o' => \$main::syscall_act,
    ) || die( qq{parse_arg(): error: Failed to parse option switches.\n} );

    if( $main::help || $main::version ){
        return 0;
    }

    while( my $myparam = shift( @ARGV ) ){
        #print( qq{\$myparam = "$myparam"\n} );
        if( $myparam eq '-' ){
            my $fi_in_len = scalar( @main::fi_in );
            for( my $idx=0; $idx<$fi_in_len; $idx++ ){
                if( $main::fi_in[ $idx ] eq '-' ){
                    myerr( qq{"STDIN(-)" cannot be specified more than once.\n} );
                    return 1;
                }
            }
            push( @main::fi_in, $myparam );
        }elsif( -f $myparam ){
            push( @main::fi_in, $myparam );
        }else{
            if( defined( $main::re ) ){
                myerr( qq{"$myparam": <PATTERN> has already been specified as "$main::re".\n} );
                return 1;
            }else{
                $main::re = $myparam;
            }
        }
    }

    my $fi_in_nums = scalar( @main::fi_in );

    if( ( !defined( $main::re ) ) && ( $main::flag_head_tail == 0 ) ){
        if( $fi_in_nums > 0 ){
            $main::re = shift( @main::fi_in );
            $fi_in_nums--;
        }else{
            myerr( qq{Please specify <PATTERN>.\n} );
            usage( 1 );
            return 1;
        }
    }

    if( $fi_in_nums == 0 ){
        push( @main::fi_in, '-' );
        $fi_in_nums++;
    }
    if( !defined( $main::prt_fname ) ){
        if( $fi_in_nums > 1 ){
            $main::prt_fname = 1;
        }else{
            $main::prt_fname = 0;
        }
    }
    if( $fi_in_nums > 1 ){
        $main::multiple_input_files = 1;
    }

    return 0;
}

# https://perldoc.jp/func/fcntl
sub _fcntl( *$$ )
{
    my( $filehandle, $function, $val ) = @_;
    if( $function == F_GETFL ){
        if( $main::syscall_act & 0x01 ){
            $main::syscall_act &= ~0x01;
            #printf( qq{\$main::syscall_act = 0x%02X\n}, $main::syscall_act );
            $! = Errno::EACCES;
            return 0;
        }
    }else{  # ( $function == F_SETFL )
        if( $val & O_NONBLOCK ){
            if( $main::syscall_act & 0x08 ){
                $main::syscall_act &= ~0x08;
                $! = Errno::EACCES;
                return 0;
            }
        }else{
            if( $main::syscall_act & 0x10 ){
                $main::syscall_act &= ~0x10;
                $! = Errno::EACCES;
                return 0;
            }
        }
    }
    return fcntl( $filehandle, $function, $val );
}

# https://perldoc.jp/func/select
sub _select( $$$$ )
{
    my( $rbits, $wbits, $ebits, $timeout ) = @_;
    if( $main::syscall_act & 0x02 ){
        $main::syscall_act &= ~0x02;
        $! = Errno::EPIPE;
        return -1;
    }elsif( $main::syscall_act & 0x04 ){
        $main::syscall_act &= ~0x04;
        $! = Errno::EAGAIN;
        return 0;
    }
    return select( $rbits, $wbits, $ebits, $timeout );
}

# https://perldoc.jp/func/sysread
sub _sysread( *$$ )
{
    my( $filehandle, $ref_buf, $length ) = @_;
    if( $main::syscall_act & 0x20 ){
        $main::syscall_act &= ~0x20;
        $! = Errno::EACCES;
        return undef;
    }
    return sysread( $filehandle, $$ref_buf, $length );
}

sub read_one_line( *$ )
{
    my( $fh, $ref_buff ) = @_;

    my $old_status = $fh->autoflush( 1 );
    my $old_flags = _fcntl( $fh, F_GETFL, 0 ) ||
        die( "fcntl F_GETFL failure: $!" );

    # vec(ビットベクトル)を作成
    my $rin = '';
    vec( $rin, fileno( $fh ), 1 ) = 1;

    my $line = '';
    my $len = 0;
    my $errmsg = undef;
    while( 1 ){

        # select(読込待ちベクトル, 書込待ち, 例外待ち, タイムアウト秒)
#        my $nfound = _select( my $rout = $rin, undef, undef, 1.0 );
        my $nfound = _select( my $rout = $rin, undef, undef, 0.1 );
        if( $nfound < 0 ){  # -1
            $errmsg = sprintf( "error: select(): %d: $!", __LINE__ );
            $len = -256;
            last;
        }elsif( $nfound == 0 ){
            $len = 0;
            last;
        }else{              # ( $nfound > 0 )

            # --- 【超重要】ファイルハンドル を非ブロックモードに設定 ---
            _fcntl( $fh, F_SETFL, $old_flags | O_NONBLOCK ) ||
                die( "fcntl F_SETFL: Failed to set NONBLOCK: $!" );
            # --------------------------------------------------

            # バッファリングしない sysread を使う
            my $char;
            my $bytes = _sysread( $fh, \$char, 1 );

            # --- 【超重要】ファイルハンドル を元のブロックモードに復元 ---
            _fcntl( $fh, F_SETFL, $old_flags ) ||
                die( "fcntl F_SETFL: Failed to restore the original mode: $!" );
            # --------------------------------------------------

            if( !defined( $bytes ) ){
                $errmsg = sprintf( "error: sysread(): %d: $!", __LINE__ );
                $len = -128;
                last;
            }else{
                if( $bytes > 0 ){
                    # 1文字ずつ $line に蓄積していく
                    $line .= $char;
                    $len += $bytes;

                    if( $char eq "\n" ){
                        # 末尾のキャリッジリターン（\r）は削る
                        if( $line =~ s/\r$//o ){
                            $len--;
                        }
                        last;   # 1行の読み込みが完了
                    }
                }else{  # 0 byte
                    # パイプが閉じられた
                    $len = -1;
                    last;
                }
            }
        }

    }

    $fh->autoflush( $old_status );

    $$ref_buff = $line;

    if( defined( $errmsg ) ){
        die( $errmsg );
    }

    return $len;
}

#sub mywarn()
#{
#    warn( qq{$main::appname: warn: }, @_ );
#}

sub myerr()
{
    warn( qq{$main::appname: error: }, @_ );
}

## Revision: 1.2
sub PrintVersion()
{
    my $ver = GetVersion();
    my $v = qq{Version: $ver\n} .
            qq{   Perl: $^V\n};
    print( $v );
}
sub GetVersion()
{
    my $rev = GetRevision();

    my $major = 1;
    my( $minor, $revision ) = split( /\./, $rev );
    my $version = sprintf( '%d.%02d.%03d', $major, $minor, $revision );

    return $version;
}
sub GetRevision()
{
    my $rev = q{$Revision: 2.23 $};
    $rev =~ s!^\$[R]evision: (\d+\.\d+) \$$!$1!o;
    return $rev;
}

##########
## 書式表示
## Revision: 1.2
sub usage( $ )
{
    my $msg = "Usage:\n" .
        qq{  $main::appname [<OPTIONS...>] <PATTERN> [<FILE...>]\n} .
        qq{  $main::appname --head-tail [<OPTIONS...>] [<PATTERN>] [<FILE...>]\n} .
        qq{\n} .
        qq{The "mark" utility behaves like a marker pen.\n} .
        qq{It searches for the specified PATTERN and emphasizes matching text.\n} .
        qq{\n} .
        qq{<PATTERN>: A Perl-compatible regular expression (PCRE).\n} .
        qq{<FILE>   : Input file name. Use "-" for standard input (stdin).\n} .
        qq{\n} .
        qq{<OPTIONS>\n} .
        qq{  -f [before[,after]]:\n} .
        qq{    Filter mode. Displays context lines before and after the match.\n} .
        qq{    Defaults to 5 lines before and after if values are omitted.\n} .
        qq{    If 0 is specified, only the matching lines are displayed.\n} .
        qq{\n} .
        qq{  --head-tail\n} .
        qq{    Display mode. Shows only the beginning and end of the file.\n} .
        qq{    Automatically enables filter mode (-f). The number of lines displayed\n} .
        qq{    at the top and bottom of the file (or around matches) can be customized\n} .
        qq{    using the '-f' option (e.g., -f 2,3).\n} .
        qq{    When using this option, providing a <PATTERN> is optional.\n} .
        qq{\n} .
        qq{  -h, --no-filename:\n} .
        qq{    Suppress the prefixing of filenames on output when multiple files are searched.\n} .
        qq{  -H, --with-filename:\n} .
        qq{    Print the filename for each match.\n} .
        qq{  -i, --ignore-case:\n} .
        qq{    Ignore case distinctions in the <PATTERN>.\n} .
        qq{  -n, --line-number:\n} .
        qq{    Prefix each line of output with its line number within the file.\n} .
        qq{  -c, --force-color:\n} .
        qq{    Enable highlighting even if STDOUT is not a TTY (e.g., pipes, redirects).\n} .
        qq{  -v, --version:\n} .
        qq{    Print the version of this script and Perl, then exit.\n} .
        qq{  --help:\n} .
        qq{    Display this help and exit.\n} .
        qq{\n} .
        qq{Try "perldoc $main::apppath/$main::appname" for more information.\n};

    if( $_[0] ){
        print STDERR ( $msg );
    }else{
        print STDOUT ( $msg );
    }

    return 0;
}

# uncoverable branch false
exit( pl_main( @ARGV ) ) unless caller();

__END__

=pod

=encoding utf8

=head1 NAME

MARK - emphasizes part matching a pattern

=head1 DESCRIPTION

The "B<mark>" utility behaves like a marker pen.
It searches for the specified I<PATTERN> and emphasizes matching text.

=head1 SYNOPSIS

$ mark [I<OPTIONS...>] I<PATTERN> [I<FILE...>]

$ mark --head-tail [I<OPTIONS...>] [I<PATTERN>] [I<FILE...>]

=head2 I<PATTERN>

A Perl-compatible regular expression (PCRE).

=head2 I<FILE>

Input file name. Use B<-> for standard input (stdin).

=head2 I<OPTIONS>

=over 4

=item -d, --debug

Debugging mode is on.

=item -f [I<before>[,I<after>]]

Filter mode. Displays context lines I<before> and I<after> the match.
Defaults to 5 lines I<before> and I<after> if values are omitted.
If 0 is specified, only the matching lines are displayed.

=item --head-tail

Display mode. Shows only the beginning and end of the file.
Automatically enables filter mode (C<-f>). The number of lines displayed
at the top and bottom of the file (or around matches) can be customized
using the C<-f> option (e.g., C<-f 2,3>).
When using this option, providing a I<PATTERN> is optional.

=item -h, --no-filename

Suppress the prefixing of filenames on output when multiple files are searched.

=item -H, --with-filename

Print the filename for each match.

=item -i, --ignore-case

Ignore case distinctions in the I<PATTERN>.

=item -n, --line-number

Prefix each line of output with its line number within the file.

=item -c, --force-color

Enable highlighting even if STDOUT is not a TTY (e.g., pipes, redirects).

=item -v, --version

Print the version of this script and Perl, then exit.

=item --help

Display simple help and exit.

=back

=head1 ADVANCED USAGE

  $ rpm -qa | mark '-[0-9]+[a-z]?\..+$'

  $ mark '\b\d{1,3}(?:\.\d{1,3}){3}\b' /var/log/maillog

  $ mark -nf 5,0 '(ServerName|DocumentRoot|Log)\s+.*$' /etc/httpd/conf/httpd.conf

  $ mark -iHnf 0,10 '^[^\s].*$' *.{c,h}

  $ mark -ni '</?(table|tr|th|td)[^>]*>' index.html | S<less -R>

  $ man perlfunc | mark -nf 5,10 -i 'regular expr' | S<less -R>

  $ man awk | perl -ne 's/.\010//go; print' | S<mark -nf 0,3 '^[A-Z]'>

  $ tail -f /var/log/httpd/access_log | S<mark -f 0 '"(GET|POST) /(?:\S+(?:\.html|\.htm|/))? [^"]+"'>

  $ ls -tr /var/log/messages.?.gz | xargs gzip -dc | mark -ihf 10 'error' - /var/log/messages > /tmp/report.txt

=head1 DEPENDENCIES

The minimum version of Perl required to run this script is Perl 5.14.0 or later.
If run on an older version, it will terminate safely with an error (specifically, a compilation error).

This script uses only B<core Perl modules>. No external modules from CPAN are required.

=head2 Core Modules Used

=over 4

=item * L<Errno> - first released with perl 5.005

=item * L<Fcntl> - first released with perl 5

=item * L<File::Basename> — first included in perl 5

=item * L<Getopt::Long> - first released with perl 5

=item * L<strict> — first included in perl 5

=item * L<warnings> — first included in perl v5.6.0

=back

=head2 Survey methodology

=over 4

=item 1. Preparation

Define the script name:

  $ target_script=mark

=item 2. Extract used modules

Generate a list of modules from C<use> statements:

  $ grep '^use ' $target_script | sed 's!^use \([^ ;{][^ ;{]*\).*$!\1!' | \
      sort | uniq | tee ${target_script}.uselist

=item 3. Check core module status

Run C<corelist> for each module to find the first Perl version it appeared in:

  $ cat ${target_script}.uselist | while read line; do
      corelist $line
    done

=back

=head1 SEE ALSO

When you want to examine the regular expression,
please refer to an online manual of B<Perl>.

=over 4

=item L<C<perlre(1)>>

Perl regular expressions

=item L<C<perlrequick(1)>>

Perl regular expressions quick start

=item L<C<perlreref(1)>>

Perl Regular Expressions Reference

=item L<C<perlretut(1)>>

Perl regular expressions tutorial

=item L<C<perlfaq6(1)>>

Regular Expressions

=item L<C<regex(7)>>

POSIX 1003.2 regular expressions

=back

Other more basic references

=over 4

=item L<C<perl(1)>>

=item L<C<grep(1)>>

=back

=head1 AUTHOR

2006-2026, tomyama

=head1 LICENSE

Copyright (c) 2006-2026, tomyama

All rights reserved.

Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:

1. Redistributions of source code must retain the above copyright notice,
   this list of conditions and the following disclaimer.

2. Redistributions in binary form must reproduce the above copyright notice,
   this list of conditions and the following disclaimer in the documentation
   and/or other materials provided with the distribution.

3. Neither the name of tomyama nor the names of its contributors
   may be used to endorse or promote products derived from this software
   without specific prior written permission.

THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

=cut