The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
use 5.008001;
use strict;
use warnings;

package BSON::Regex;
# ABSTRACT: BSON type wrapper for regular expressions

use version;
our $VERSION = 'v1.2.1';

use Carp ();

use Moo;

#pod =attr pattern
#pod
#pod A B<string> containing a PCRE regular expression pattern (not a C<qr> object
#pod and without slashes).  Default is the empty string.
#pod
#pod =cut

#pod =attr flags
#pod
#pod A string with regular expression flags.  Flags will be sorted and
#pod duplicates will be removed during object construction.  Supported flags
#pod include C<imxlsu>.  Invalid flags will cause an exception.
#pod Default is the empty string.
#pod
#pod =cut

has [qw/pattern flags/] => (
    is => 'ro'
);

use namespace::clean -except => 'meta';

my %ALLOWED_FLAGS = map { $_ => 1 } qw/i m x l s u/;

sub BUILD {
    my $self = shift;

    $self->{pattern} = '' unless defined($self->{pattern});
    $self->{flags} = '' unless defined($self->{flags});

    if ( length $self->{flags} ) {
        my %seen;
        my @flags = grep { !$seen{$_}++ } split '', $self->{flags};
        foreach my $f (@flags) {
            Carp::croak("Regex flag $f is not supported")
              if not exists $ALLOWED_FLAGS{$f};
        }

        # sort flags
        $self->{flags} = join '', sort @flags;
    }

}

#pod =method try_compile
#pod
#pod     my $qr = $regexp->try_compile;
#pod
#pod Tries to compile the C<pattern> and C<flags> into a reference to a regular
#pod expression.  If the pattern or flags can't be compiled, a
#pod exception will be thrown.
#pod
#pod B<SECURITY NOTE>: Executing a regular expression can evaluate arbitrary
#pod code if the L<re> 'eval' pragma is in force.  You are strongly advised
#pod to read L<re> and never to use untrusted input with C<try_compile>.
#pod
#pod =cut

sub try_compile {
    my ($self) = @_;
    my ( $p, $f ) = @{$self}{qw/pattern flags/};
    my $re = length($f) ? eval { qr/(?$f:$p)/ } : eval { qr/$p/ };
    Carp::croak("error compiling regex 'qr/$p/$f': $@")
      if $@;
    return $re;
}

#pod =method TO_JSON
#pod
#pod If the C<BSON_EXTJSON> option is true, returns a hashref compatible with
#pod MongoDB's L<extended JSON|https://docs.mongodb.org/manual/reference/mongodb-extended-json/>
#pod format, which represents it as a document as follows:
#pod
#pod     {"$regex" : "<pattern>", "$options" : "<flags>"}
#pod
#pod If the C<BSON_EXTJSON> option is false, an error is thrown, as this value
#pod can't otherwise be represented in JSON.
#pod
#pod =cut

sub TO_JSON {
    if ( $ENV{BSON_EXTJSON} ) {
        return { '$regex' => $_[0]->{pattern}, '$options' => $_[0]->{flags} };
    }

    Carp::croak( "The value '$_[0]' is illegal in JSON" );
}


1;

=pod

=encoding UTF-8

=head1 NAME

BSON::Regex - BSON type wrapper for regular expressions

=head1 VERSION

version v1.2.1

=head1 SYNOPSIS

    use BSON::Types ':all';

    $regex = bson_regex( $pattern );
    $regex = bson_regex( $pattern, $flags );

=head1 DESCRIPTION

This module provides a BSON type wrapper for a PCRE regular expression and
optional flags.

=head1 ATTRIBUTES

=head2 pattern

A B<string> containing a PCRE regular expression pattern (not a C<qr> object
and without slashes).  Default is the empty string.

=head2 flags

A string with regular expression flags.  Flags will be sorted and
duplicates will be removed during object construction.  Supported flags
include C<imxlsu>.  Invalid flags will cause an exception.
Default is the empty string.

=head1 METHODS

=head2 try_compile

    my $qr = $regexp->try_compile;

Tries to compile the C<pattern> and C<flags> into a reference to a regular
expression.  If the pattern or flags can't be compiled, a
exception will be thrown.

B<SECURITY NOTE>: Executing a regular expression can evaluate arbitrary
code if the L<re> 'eval' pragma is in force.  You are strongly advised
to read L<re> and never to use untrusted input with C<try_compile>.

=head2 TO_JSON

If the C<BSON_EXTJSON> option is true, returns a hashref compatible with
MongoDB's L<extended JSON|https://docs.mongodb.org/manual/reference/mongodb-extended-json/>
format, which represents it as a document as follows:

    {"$regex" : "<pattern>", "$options" : "<flags>"}

If the C<BSON_EXTJSON> option is false, an error is thrown, as this value
can't otherwise be represented in JSON.

=for Pod::Coverage BUILD

=head1 AUTHORS

=over 4

=item *

David Golden <david@mongodb.com>

=item *

Stefan G. <minimalist@lavabit.com>

=back

=head1 COPYRIGHT AND LICENSE

This software is Copyright (c) 2016 by Stefan G. and MongoDB, Inc.

This is free software, licensed under:

  The Apache License, Version 2.0, January 2004

=cut

__END__


# vim: set ts=4 sts=4 sw=4 et tw=75: