#!/usr/bin/perl -w

#####################################################################
# Test regexp matching
#
# > perl -MDevel::NYTProf=savesrc=1 optimize_regexp.pl
# > nytprofhtml
#####################################################################
use strict;
use warnings;

use Cwd;
use Readonly;
use Path::Class qw(file dir);
use Date::Calc qw(Today_and_Now);
use Fcntl qw(O_WRONLY O_CREAT O_TRUNC O_RDONLY);

#####################################################################
##
##  CONSTANTS
##
#####################################################################
Readonly my $EMPTY          => q{};
Readonly my $TOOL_ROOT      => getcwd;
Readonly my $TEMP_FILE_NAME => 'temp_file.txt';
Readonly my $TEMP_FILE_SIZE => 1000000;

#####################################################################
##
##  MAIN
##
#####################################################################
my $l_line      = $EMPTY;
my $l_temp_file = $EMPTY;
my $l_file_h    = $EMPTY;

# Create temporary file that is read for tests.
$l_temp_file = file($TOOL_ROOT, $TEMP_FILE_NAME);
create_temp_file($l_temp_file);

#####################################################################
# Readonly constant in match operator - regcomp avg 6µs/call
#####################################################################
Readonly my $REGEXP_READONLY => '999986';
$l_file_h = IO::File->new($l_temp_file, O_RDONLY);
while( $l_line = $l_file_h->getline() ) {
  if( $l_line =~ m/$REGEXP_READONLY/ ) {
    # 5.78s - 1000001 calls to main::CORE:regcomp, avg 6µs/call
    # 4.88s - 1000001 calls to IO::Handle::getline, avg 5µs/call
    # 1.83s - 1000001 calls to Readonly::Scalar::FETCH, avg 2µs/call
    # 909ms - 1000001 calls to main::CORE:match, avg 859ns/call
    chomp $l_line;
    LOG("Regexp 01 - matched line ($l_line)");
  }
}
$l_file_h->close();

#####################################################################
# Use constant in match operator - regcomp avg 721ns/call
#####################################################################
use constant REGEXP_CONSTANT => '999986';
$l_file_h = IO::File->new($l_temp_file, O_RDONLY);
while( $l_line = $l_file_h->getline() ) {
  if( $l_line =~ m/${\REGEXP_CONSTANT}/ ) {
    # 4.83s - 1000001 calls to IO::Handle::getline, avg 5µs/call
    # 745ms - 1000001 calls to main::CORE:match, avg 729ns/call
    # 735ms - 1000001 calls to main::CORE:regcomp, avg 721ns/call
    chomp $l_line;
    LOG("Regexp 02 - matched line ($l_line)");
  }
}
$l_file_h->close();

#####################################################################
# No constant in match operator - no regcomp called
#####################################################################
$l_file_h = IO::File->new($l_temp_file, O_RDONLY);
while( $l_line = $l_file_h->getline() ) {
  if( $l_line =~ m/999986/ ) {
    # spent 4.78s - 1000001 calls to IO::Handle::getline, avg 5µs/call
    # spent 838ms - 1000001 calls to main::CORE:match, avg 838ns/call
    chomp $l_line;
    LOG("Regexp 03 - matched line ($l_line)");
  }
}
$l_file_h->close();

#####################################################################
# Readonly constant with /o option - regcomp, avg 675ns/call
#####################################################################
$l_file_h = IO::File->new($l_temp_file, O_RDONLY);
while( $l_line = $l_file_h->getline() ) {
  if( $l_line =~ m/$REGEXP_READONLY/o ) {
    # 4.84s - 1000001 calls to IO::Handle::getline, avg 5µs/call
    # 754ms - 1000001 calls to main::CORE:match, avg 754ns/call
    # 732ms - 1000001 calls to main::CORE:regcomp, avg 675ns/call
    # 0s    - 2 calls to Readonly::Scalar::FETCH, avg 0s/call
    chomp $l_line;
    LOG("Regexp 04 - matched line ($l_line)");
  }
}
$l_file_h->close();

#####################################################################
# Precompiled regexp - regcomp, avg 1µs/call
#####################################################################
my $l_search_r = qr/$REGEXP_READONLY/;
$l_file_h = IO::File->new($l_temp_file, O_RDONLY);
while( $l_line = $l_file_h->getline() ) {
  if( $l_line =~ $l_search_r ) {
    # 4.77s - 1000001 calls to IO::Handle::getline, avg 5µs/call
    # 1.33s - 1000001 calls to main::CORE:regcomp, avg 1µs/call
    # 776ms - 1000001 calls to main::CORE:match, avg 776ns/call
    chomp $l_line;
    LOG("Regexp 05 - matched line ($l_line)");
  }
}
$l_file_h->close();

#####################################################################
# Regexp match operator with local variable - regcomp, avg 718ns/call
#####################################################################
my $l_search = $REGEXP_READONLY;
$l_file_h = IO::File->new($l_temp_file, O_RDONLY);
while( $l_line = $l_file_h->getline() ) {
  if( $l_line =~ m/$l_search/ ) {
    # 4.73s - 1000001 calls to IO::Handle::getline, avg 5µs/call
    # 759ms - 1000001 calls to main::CORE:match, avg 766ns/call
    # 741ms - 1000001 calls to main::CORE:regcomp, avg 718ns/call
    chomp $l_line;
    LOG("Regexp 06 - matched line ($l_line)");
  }
}
$l_file_h->close();

#####################################################################
# Regexp match with variable and /o option - regcomp, avg 690ns/call
#####################################################################
$l_search = $REGEXP_READONLY;
$l_file_h = IO::File->new($l_temp_file, O_RDONLY);
while( $l_line = $l_file_h->getline() ) {
  if( $l_line =~ m/$l_search/o ) {
    # 4.86s - 1000001 calls to IO::Handle::getline, avg 5µs/call
    # 758ms - 1000001 calls to main::CORE:match, avg 758ns/call
    # 690ms - 1000001 calls to main::CORE:regcomp, avg 690ns/call
    chomp $l_line;
    LOG("Regexp 07 - matched line ($l_line)");
  }
}
$l_file_h->close();

exit 0;

#####################################################################
##
##  SUBROUTINES
##
#####################################################################
sub create_temp_file{
  my $p_file                  = shift;
  
  my $l_file_h                = $EMPTY;
  
  LOG("print file ($p_file)");
  $l_file_h = IO::File->new($p_file, O_WRONLY|O_TRUNC|O_CREAT);
  for( 0 .. $TEMP_FILE_SIZE ) {
    print {$l_file_h} 'Line number is = ' . $_ . "\n";
  }
  $l_file_h->close();
 
  return; 
}

sub LOG{

    my $l_time = [Today_and_Now()];
    my $l_string = sprintf('%d-%02d-%02d %02d:%02d:%02d', @{$l_time});
    $l_string = $l_string . q{ - } . $_[0];
    print sprintf("%s\n", $l_string);

    return;
}