Mercurial Mercurial > utils / comparison
summary | shortlog | changelog | graph | tags | bookmarks | branches | files | changeset | file | latest | revisions | annotate | diff | comparison | raw | help
Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
perlgrok.pl
changeset 10 72f6df1085b7
parent 9 f1cb959b4603
child 11 5c38653bd7e7
equal deleted inserted replaced
9:f1cb959b4603 10:72f6df1085b7 
     1 #!/usr/bin/perl
 
     1 #!/usr/bin/perl
 
     2 # $Id: perlgrok.pl,v d6e64daafdc1 2021/09/29 23:46:59 grin $
 
     2 # $Id: perlgrok.pl,v 87c55c058b6a 2021/09/30 14:00:47 grin $
 
     3 #
 
     3 #
 
     4 # grok parser in perl
 
     4 # grok parser in perl
 
     5 #
 
     5 #
 
     6 # (c)Peter 'grin' Gervai, 2021; CC_BY-SA-4.0 / GPLv3+
 
     6 # (c)Peter 'grin' Gervai, 2021; CC_BY-SA-4.0 / GPLv3+
 
     7 # grin*grin.hu
 
     7 # grin*grin.hu
 
    37     "pattern=s"     => \@fn_patterns,
 
    37     "pattern=s"     => \@fn_patterns,
 
    38     "top=s"         => \$top,
 
    38     "top=s"         => \$top,
 
    39     "parsed=s"      => \$fn_parsed,
 
    39     "parsed=s"      => \$fn_parsed,
 
    40     "failed=s"      => \$fn_fail,
 
    40     "failed=s"      => \$fn_fail,
 
    41     "debug=i"       => \$DEBUG,
 
    41     "debug=i"       => \$DEBUG,
 
    42     "retrace!"      => \$re_trace,
 
       
    43     "help"          => \$help,
 
    42     "help"          => \$help,
 
    44 ) or die "error in command line arguments";
 
    43 ) or die "error in command line arguments";
 
    45 
    44 
    46 if( $help ) {
 
    45 if( $help ) {
 
    47     my $VER = '$Id: perlgrok.pl,v d6e64daafdc1 2021/09/29 23:46:59 grin $';
 
    46     my $VER = '$Id: perlgrok.pl,v 87c55c058b6a 2021/09/30 14:00:47 grin $';
 
    48     print "$0 $VER (c) Peter 'grin' Gervai, 2021\n\n";
 
    47     print "$0 $VER (c) Peter 'grin' Gervai, 2021\n\n";
 
    49     print "Usage: $0 [--input input_file] [--pattern pattern_file] [--pattern another] [--top final_macro] \n";
 
    48     print "Usage: $0 [--input input_file] [--pattern pattern_file] [--pattern another] [--top final_macro] \n";
 
    50     print "          [--parsed parsed_outfile] [--failed failed_lines_file] [--debug n] [--noretrace] [--help]\n";
 
    49     print "          [--parsed parsed_outfile] [--failed failed_lines_file] [--debug n] [--help]\n";
 
    51     print "        input:   input file to be processed; default stdin\n";
 
    50     print "       defaults are stdin, stdout, 'patterns' as patternfile and 'TEST' as final macro.\n\n";
 
    52     print "        pattern: input grok-style pattern file; default patterns (name space pattern) (multiple possible)\n";
 
       
    53     print "        top:     name of the pattern to match; default TEST\n";
 
       
    54     print "        parsed:  output filename for parsed data; default stdout\n";
 
       
    55     print "        failed:  output filename for lines not matched; default none\n";
 
       
    56     print "        debug:   debug level 0 (none), 1 (error), 3 (warning), 7 (debug), 9 (trace)\n";
 
       
    57     print "        notrace: disable regexp syntax check per pattern\n";
 
       
    58     print "\n\n";
 
       
    59     exit;
 
    51     exit;
 
    60 }
 
    52 }
 
    61 
    53 
    62 if( $#fn_patterns < 0 ) {
 
    54 if( $#fn_patterns < 0 ) {
 
    63     push @fn_patterns, "patterns";
 
    55     push @fn_patterns, "patterns";
 
    91 
    83 
    92 my $res = $input{$top};
 
    84 my $res = $input{$top};
 
    93 &d(9, "RESULT\n========\n${top} = $res" );
 
    85 &d(9, "RESULT\n========\n${top} = $res" );
 
    94 &d(9, "Pattern length=" . length($res) );
 
    86 &d(9, "Pattern length=" . length($res) );
 
    95 
    87 
       
    88 ## test final pattern
 
    96 eval {
 
    89 eval {
 
    97     my $test = "abc123";
 
    90     my $test = qr($res);
 
    98     $test =~ /$res/;
 
       
    99 };
 
    91 };
 
   100 if( $@ ) {
 
    92 if( $@ ) {
 
   101     print "ERR: $@\n\n";
 
    93     print "ERR: $@\n\n";
 
   102     exit;
 
    94     exit;
 
   103 }
 
    95 }
 
   174     $input{$key} = $data;
 
   166     $input{$key} = $data;
 
   175     &d(7, "RESOLVED '$key'! Result=/$data/");
 
   167     &d(7, "RESOLVED '$key'! Result=/$data/");
 
   176 
   168 
   177     if( $re_trace ) {
 
   169     if( $re_trace ) {
 
   178         # die if regexp is bad
 
   170         # die if regexp is bad
 
   179         "abc" =~ /$data/;
 
   171         my $test = qr($data);
 
   180     }
 
   172     }
 
   181 
   173 
   182     # release loop protection for $key
 
   174     # release loop protection for $key
 
   183     delete $processing{$key};
 
   175     delete $processing{$key};
 
   184 }
 
   176 }
utils