Commit f886ec31 authored by Jacques's avatar Jacques
Browse files

Initial commit with basic code untested

parents
Pipeline #507757828 failed with stages
Revision history for Perl module Regexp::Common::Apache2
v0.1.0 Sat Jan 30 15:37:11 2021
- original version; created by ExtUtils::ModuleMaker 0.63
This diff is collapsed.
MANIFEST
README
LICENSE
Todo
Changes
Makefile.PL
lib/Regexp/Common/Apache2.pm
t/001_load.t
\ No newline at end of file
use ExtUtils::MakeMaker;
use strict;
use warnings;
# Call 'perldoc ExtUtils::MakeMaker' for details of how to influence
# the contents of the Makefile that is written.
my %WriteMakefileArgs = (
NAME => 'Regexp::Common::Apache2',
AUTHOR => 'Jacques Deguest (jack@deguest.jp)',
VERSION_FROM => 'lib/Regexp/Common/Apache2.pm',
ABSTRACT_FROM => 'lib/Regexp/Common/Apache2.pm',
INSTALLDIRS => ($] < 5.011 ? 'perl' : 'site'),
PREREQ_PM => {
'strict' => 0,
'warnings' => 0,
'parent' => 0,
'Regexp::Common'=> '2017060201',
},
TEST_REQUIRES =>
{
'Test::More' => '1.302162',
'Test::Pod' => '1.52',
},
LICENSE => 'perl_5',
MIN_PERL_VERSION => 'v5.22.1',
dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', },
clean => { FILES => 'Regexp-Common-Apache2-*' },
( eval { ExtUtils::MakeMaker->VERSION(6.46) } ? ( META_MERGE => {
'meta-spec' => { version => 2 },
dynamic_config => 1,
resources => {
# homepage => undef,
repository => {
url => 'git@git.deguest.jp:jack/Regexp-Common-Apache2.git',
web => 'https://git.deguest.jp/jack/Regexp-Common-Apache2',
type => 'git',
},
bugtracker => {
web => 'https://git.deguest.jp/jack/Regexp-Common-Apache2/issues',
},
license => [ 'http://dev.perl.org/licenses/' ],
},
}) : ()),
);
WriteMakefile(%WriteMakefileArgs);
pod2text Regexp::Common::Apache2.pm > README
If this is still here it means the programmer was too lazy to create the readme file.
You can create it now by using the command shown above from this directory.
At the very least you should be able to use this set of instructions
to install the module...
perl Makefile.PL
make
make test
make install
If you are on a windows box you should use 'nmake' rather than 'make'.
package Regexp::Common::Apache2;
BEGIN
{
use strict;
use warnings;
use warnings::register;
use Regexp::Common qw( pattern );
our $VERSION = 'v0.1.0';
## Ref: <http://httpd.apache.org/docs/trunk/en/expr.html>
our $UNARY_OP = qr/\-[a-zA-Z]/;
our $DIGIT = qr/[0-9]/;
our $REGPATTERN = qr/(?>\\[^[:cntrl:]|[^[:cntrl:]\/])*+/;
our $REGFLAGS = qr/[i|s|m|g]+/;
our $REGSEP = qr/[\/\#\$\%\^\|\?\!\'\"\,\;\:\.\_\-]/;
our $FUNCNAME = qr/[a-zA-Z_]\w*/;
our $VARNAME = qr/[a-zA-Z_]\w*/;
our $TEXT = qr/[^[:cntrl:]]/;
our $REGEXP =
{
unary_op => $UNARY_OP,
## <any US-ASCII digit "0".."9">
digit => $DIGIT,
## 1*(DIGIT)
digits => qr/${DIGIT}{1,}/,
## "$" DIGIT
## As per Apache apr_expr documentation, regular expression back reference go from 1 to 9 with 0 containing the entire regexp
rebackref => qr/\$${DIGIT}/,
## cstring ; except enclosing regsep
regpattern => $REGPATTERN,
## 1*("i" | "s" | "m" | "g")
regflags => $REGFLAGS,
## "/" | "#" | "$" | "%" | "^" | "|" | "?" | "!" | "'" | '"' | "," | ";" | ":" | "." | "_" | "-"
regsep => $REGSEP,
## "/" regpattern "/" [regflags]
## | "m" regsep regpattern regsep [regflags]
regex => qr/
(?<regex>
(?:\/(?<regpattern>${REGPATTERN})\/(?<regflags>${REGFLAGS})?)
|
(?:m(?<regsep>${REGSEP})(?<regpattern>(?>\\\g{regsep}|(?!\g{regsep}).)*+)\g{regsep}(?<regflags>${REGFLAGS})?)
)/x,
funcname => $FUNCNAME,
varname => $VARNAME,
## <any OCTET except CTLs>
text => $TEXT,
## 0*(TEXT)
cstring => qr/$TEXT*/,
};
## "%{" varname "}"
## | "%{" funcname ":" funcargs "}"
## | "%{:" word ":}"
## | "%{:" cond ":}"
## | rebackref
$REGEXP->{variable} = qr/
(?<variable>
(?:\%\{${VARNAME}\})
|
(?:\%\{${FUNCNAME}\:(?>\\\}|[^\}])*+\})
|
(?:\%\{\:(??{$REGEXP->{word}})\:\}) # Delay compilation until execution phase due to need for recursion
|
(?:\%\{\:(??{$REGEXP->{cond}})\:\}) # Ditto
|
$REGEXP->{rebackref}
)/x;
## cstring
## | variable
$REGEXP->{substring} = qr/$REGEXP->{cstring}|$REGEXP->{variable}/;
## substring
## | string substring
$REGEXP->{string} = qr/$REGEXP->{substring}|(?R)[[:blank:]\h]*$REGEXP->{substring}/;
## "s" regsep regpattern regsep string regsep [regflags]
$REGEXP->{regsub} = qr/
(?<regsub>
s(?<regsep>${REGSEP})
(?<regpattern>${REGPATTERN})
\g{regsep}
(?<regstring>$REGEXP->{string})
\g{regsep}
(?<regflags>${REGFLAGS})?
)/x;
## digits
## | "'" string "'"
## | '"' string '"'
## | word "." word
## | variable
## | sub
## | join
## | function
## | "(" word ")"
$REGEXP->{word} = qr/
(?:
$REGEXP->{digits}
|
(?:\'$REGEXP->{string}\')
|
(?:\"$REGEXP->{string}\")
|
(?:(?R)\.(?R)) # Recursive regular expression. See perlre
|
$REGEXP->{variable}
|
(?:sub\($REGEXP->{regsub}\,(?R)\)) # Regular expression for sub (see below)
|
(??{$REGEXP->{join}}) # Defer compilation until execution. Slower but unavoidable to enable recursion
|
(?: # Regular expression for function (see below)
[a-zA-Z\_]\w+
\(
( # Regular expression for words (see below)
(?R)
|
(?R)\,
( # Regular expression for list (see below)
split
|
[a-zA-Z\_]\w+\((?-2)\) # Recursive reference back to the WORDS Regex
|
\{(?R)\}
|
\((?-1)\) # Recursive reference back to the LIST Regex
)
)
\)
)
|
(?:\((?R)\))
)/x;
## regex | regsub
$REGEXP->{regany} = qr/(?<regany>$REGEXP->{regex}|$REGEXP->{regsub})/;
## "sub" ["("] regsub "," word [")"]
$REGEXP->{sub} = qr/(?<sub>sub\($REGEXP->{regsub}\,$REGEXP->{word}\))/;
## listfuncname "(" words ")"
## Use recursion at execution phase for words because it contains dependencies -> list -> listfunc
$REGEXP->{listfunc} = qr/(?<listfunc>[a-zA-Z\_]\w+\((??{$REGEXP->{words}})\))/;
## word "==" word
## | word "!=" word
## | word "<" word
## | word "<=" word
## | word ">" word
## | word ">=" word
$REGEXP->{stringcomp} = qr/
(?<stringcomp>
(?<stringcomp_worda>$REGEXP->{word})
[[:blank:]\h]+
(?:\=\=|\!\=|\<|\<\=|\>|\>\=)
[[:blank:]\h]+
(?<stringcomp_wordb>$REGEXP->{word})
)/x;
## word "-eq" word | word "eq" word
## | word "-ne" word | word "ne" word
## | word "-lt" word | word "lt" word
## | word "-le" word | word "le" word
## | word "-gt" word | word "gt" word
## | word "-ge" word | word "ge" word
$REGEXP->{integercomp} = qr/
(?<integercomp>
(?<integercomp_worda>$REGEXP->{word})
[[:blank:]\h]+
\-?(?:eq|ne|lt|le|gt|ge)
[[:blank:]\h]+
(?<integercomp_wordb>$REGEXP->{word})
)/x;
## split
## | listfunc
## | "{" words "}"
## | "(" list ")"
$REGEXP->{list} = qr/
(?<list>
split
|
$REGEXP->{listfunc}
|
(?:\{(??{$REGEXP->{words}})\}) # Because this depends on words which comes later, we defer recursion until execution phase
|
(?:\((?R)\))
)/x;
## stringcomp
## | integercomp
## | unaryop word
## | word binaryop word
## | word "in" listfunc
## | word "=~" regex
## | word "!~" regex
## | word "in" "{" list "}"
## Ref:
## <http://httpd.apache.org/docs/trunk/en/expr.html#unnop>
## <http://httpd.apache.org/docs/trunk/en/expr.html#binop>
$REGEXP->{comp} = qr/
(?<comp>
$REGEXP->{stringcomp}
|
$REGEXP->{integercomp}
|
(?:
\-(?<unaryop>[d|e|f|s|L|h|F|U|A|n|z|T|R])
[[:blank:]\h]+
$REGEXP->{word}
)
|
(?:
$REGEXP->{word}
[[:blank:]\h]+
(?:
(?<binaryop>\=\=|\=|\!\=|\<|\<\=|\>|\>\=)
|
\-(?<binaryop>ipmatch|strmatch|strcmatch|fnmatch)
)
[[:blank:]\h]+
$REGEXP->{word}
)
|
(?:
$REGEXP->{word}
[[:blank:]\h]+
in
[[:blank:]\h]+
$REGEXP->{listfunc}
)
|
(?:
$REGEXP->{word}
[[:blank:]\h]+
[\=|\!]\~
[[:blank:]\h]+
$REGEXP->{regex}
)
|
(?:
$REGEXP->{word}
[[:blank:]\h]+
in
[[:blank:]\h]+
\{
[[:blank:]\h]*
$REGEXP->{list}
[[:blank:]\h]*
\}
)
)/x;
## "true"
## | "false"
## | "!" cond
## | cond "&&" cond
## | cond "||" cond
## | comp
## | "(" cond ")"
$REGEXP->{cond} = qr/
(?<cond>
true
|
false
|
(?:\![[:blank:]\h]*(?R)) # Recurring the entire COND expression
|
(?:(?R)[[:blank:]\h]*\&\&[[:blank:]\h]*(?R))
|
(?:(?R)[[:blank:]\h]*\|\|[[:blank:]\h]*(?R))
|
$REGEXP->{comp}
|
(?:\([[:blank:]\h]*(?R)[[:blank:]\h]*\))
)/xi;
## word
## | word "," list
$REGEXP->{words} = qr/
$REGEXP->{word}
|
(?:(?:$REGEXP->{word})[[:blank:]\h]*\,[[:blank:]\h]*$REGEXP->{list})
/x;
## funcname "(" words ")"
## -> Same as LISTFUNC
$REGEXP->{function} = qr/[a-zA-Z\_]\w+\($REGEXP->{words}\)/;
## "join" ["("] list [")"]
## | "join" ["("] list "," word [")"]
$REGEXP->{join} = qr/
(?:join\($REGEXP->{list}\))
|
(?:join\($REGEXP->{list}\,$REGEXP->{word}\))
/x;
## cond
## | string
$REGEXP->{expr} = qr/$REGEXP->{cond}|$REGEXP->{string}/;
## Legacy regular expression
## <http://httpd.apache.org/docs/trunk/en/mod/mod_include.html#legacyexpr>
our $REGEXP_EXT = {};
## Here is the addition to be compliant with expression from 2.3.12 and before,
## ie old fashioned variable such as $REQUEST_URI instead of the modern version %{REQUEST_URI}
$REGEXP_EXT->{variable} = qr/
(?<variable>
(?:\$(?:[a-zA-Z\_]\w*))
|
(?:\%\{${VARNAME}\})
|
(?:\%\{${FUNCNAME}\:(?>\\\}|[^\}])*+\})
|
(?:\%\{\:(??{$REGEXP->{word}})\:\}) # Delay compilation until execution phase due to need for recursion
|
(?:\%\{\:(??{$REGEXP->{cond}})\:\}) # Ditto
|
$REGEXP->{rebackref}
)/x;
$REGEXP_EXT->{comp} = qr/
(?<comp>
$REGEXP->{stringcomp}
|
$REGEXP->{integercomp}
|
(?:
\-(?<unaryop>[d|e|f|s|L|h|F|U|A|n|z|T|R])
[[:blank:]\h]+
$REGEXP->{word}
)
|
(?:
$REGEXP->{word}
[[:blank:]\h]+
(?:
(?<binaryop>\=\=|\=|\!\=|\<|\<\=|\>|\>\=)
|
\-(?<binaryop>ipmatch|strmatch|strcmatch|fnmatch)
)
[[:blank:]\h]+
$REGEXP->{word}
)
|
(?:
$REGEXP->{word}
[[:blank:]\h]+
in
[[:blank:]\h]+
$REGEXP->{listfunc}
)
|
(?:
$REGEXP->{word}
[[:blank:]\h]+
[\=|\!]\~
[[:blank:]\h]+
$REGEXP->{regex}
)
|
## Here we allow regular expression to be writen like: expression = //, ie without the ~
(?:
$REGEXP->{word}
[[:blank:]\h]+
[\=\=|\=|\!\=]
[[:blank:]\h]+
$REGEXP->{regex}
)
|
(?:
$REGEXP->{word}
[[:blank:]\h]+
in
[[:blank:]\h]+
\{
[[:blank:]\h]*
$REGEXP->{list}
[[:blank:]\h]*
\}
)
)/x;
};
pattern name => [qw( Markdown -legacy=1 ) ],
create => sub
{
my( $self, $flags ) = @_;
my %re = %$REGEXP;
## Override vanilla regular expressions by the extended ones
if( $flags->{'-legacy'} )
{
my @k = keys( %$REGEXP_LEGACY );
@re{ @k } = @$REGEXP_LEGACY{ @k };
}
my $pat = join( '|' => values( %re ) );
return( "(?k:$pat)" );
};
pattern name => [qw( Apache2 Regexp ) ],
create => $REGEXP->{regex};
pattern name => [qw( Apache2 Variable ) ],
create => $REGEXP->{variable};
pattern name => [qw( Apache2 Substring ) ],
create => $REGEXP->{substring};
pattern name => [qw( Apache2 String ) ],
create => $REGEXP->{string};
pattern name => [qw( Apache2 Regsub ) ],
create => $REGEXP->{regsub};
pattern name => [qw( Apache2 Word ) ],
create => $REGEXP->{word};
pattern name => [qw( Apache2 Regany ) ],
create => $REGEXP->{regany};
pattern name => [qw( Apache2 Sub ) ],
create => $REGEXP->{sub};
pattern name => [qw( Apache2 ListFunc ) ],
create => $REGEXP->{listfunc};
pattern name => [qw( Apache2 StringComp ) ],
create => $REGEXP->{stringcomp};
pattern name => [qw( Apache2 IntegerComp ) ],
create => $REGEXP->{integercomp};
pattern name => [qw( Apache2 List ) ],
create => $REGEXP->{list};
pattern name => [qw( Apache2 Comp ) ],
create => $REGEXP->{comp};
pattern name => [qw( Apache2 Cond ) ],
create => $REGEXP->{cond};
pattern name => [qw( Apache2 Words ) ],
create => $REGEXP->{words};
pattern name => [qw( Apache2 Function ) ],
create => $REGEXP->{function};
pattern name => [qw( Apache2 Join ) ],
create => $REGEXP->{join};
pattern name => [qw( Apache2 Expression ) ],
create => $REGEXP->{expr};
pattern name => [qw( Apache2 Expression ) ],
create => $REGEXP->{expr};
pattern name => [qw( Apache2 LegacyVariable ) ],
create => $REGEXP_LEGACY->{variable};
pattern name => [qw( Apache2 LegacyComp ) ],
create => $REGEXP_LEGACY->{comp};
1;
__END__
=encoding utf-8
=pod
=head1 NAME
Regexp::Common::Markdown - Apache2 Expressions
=head1 SYNOPSIS
use Regexp::Common qw( Markdown );
while( <> )
{
my $pos = pos( $_ );
/\G$RE{Markdown}{Header}/gmc and print "Found a header at pos $pos\n";
/\G$RE{Markdown}{Bold}/gmc and print "Found bold text at pos $pos\n";
}
=head1 VERSION
v0.1.5
=head1 DESCRIPTION
=head1 APACHE2 EXPRESSION
=head1 LEGACY
=head1 CHANGES & CONTRIBUTIONS
Feel free to reach out to the author for possible corrections, improvements, or suggestions.
=head1 AUTHOR
Jacques Deguest E<lt>F<jack@deguest.jp>E<gt>
=head1 CREDITS
Credits to L<Michel Fortin|https://michelf.ca/projects/php-markdown> and L<John Gruber|http://six.pairlist.net/pipermail/markdown-discuss/2006-June/000079.html> for their test units.
Credits to Firas Dib for his online L<regular expression test tool|https://regex101.com>.
=head1 COPYRIGHT & LICENSE
Copyright (c) 2020 DEGUEST Pte. Ltd.
You can use, copy, modify and redistribute this package and associated
files under the same terms as Perl itself.
=cut
# -*- perl -*-
BEGIN
{
use Test::More tests => 1;
use_ok( 'Regexp::Common::Apache2' );
}
#!/usr/local/bin/perl
BEGIN
{
use Test::More qw( no_plan );
use_ok( 'Regexp::Common::Apache2' ) || BAIL_OUT( "Unable to load Regexp::Common::Apache2" );
use lib './lib';
use Regexp::Common qw( Apache2 );
require( "./t/functions.pl" ) || BAIL_OUT( "Unable to find library \"functions.pl\"." );
};
my $tests =
[
{
bold_all => "***test test***",
bold_text => "*test test*",
bold_type => "**",
test => "***test test***",
},
{
bold_all => "___test test___",
bold_text => "_test test_",
bold_type => "__",
test => "___test test___",
},
{
bold_all => "**test***",
bold_text => "test*",
bold_type => "**",
test => "*test **test***",
},
{
bold_all => "**test *test***",