CPAN::Groonga

 @_;
	return match { return $_ ~~ $match for $sub->() };
}

sub any {
	my @possibilities = @_;
	return match {
		for my $candidate (@possibilities) {
			return 1 if $_ ~~ $candidate;
		}
		return;
	};

rn match { scalar hash and [ sort keys %{$_} ] ~~ [ sort keys %{$hash} ] };
}

sub value {
	my $value = shift;
	return $value if blessed($value);
	given (ref $value) {
		when ('') {
			return $value;

 NAME

Smart::Match - Smart matching utilities

=head1 VERSION

version 0.008

=head1 SYNOPSIS

 given ($foo) {
     say "We've got a positive number" when positive;
     say "We've got an array" when

                               ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< ~~
                                 $role_reqs
.

	format INHERIT_POD =
=head1 NAME

@*
$mycl

<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< ~~
                                                               $handles
.

	format ATTR_NARROW

        $handles
             ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< ~~
             $handles

.
	format ATTRHEAD_POD =
=head1 ATTRIBUTES

.
	format ATTR_POD =

$self->mins} ~~ @{$setObj->mins} and @{$self->maxs} ~~ @{$setObj->maxs});
}

# 判断两个集合是否不相等
sub notEqual {
    my ($self, $setObj) = @_;
    return !(@{$self->mins} ~~ @{$setObj->

mins} and @{$self->maxs} ~~ @{$setObj->maxs});
}

# 判断当前集合是否包含另一个集合（包含相等情况）
sub isContain {
    my ($self, $setObj) = @_;
    if ($self->isEqual($setObj))

                               ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< ~~
                                 $role_reqs
.

    format INHERIT_POD =
=head1 NAME

@*
$myclass

<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< ~~
                                                               $handles
.

    format ATTR_NARROW 

         $handles
             ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< ~~
             $handles

.
    format ATTRHEAD_POD =
=head1 ATTRIBUTES

.
    format ATTR_POD =

=he

007'; # VERSION

my $text = <<'MARKDOWN';
**About smart match**

Smart matching, via the operator `~~`, was introduced in perl 5.10 (released
2007). It's inspired by Perl 6 (now called Raku)'s `given/

) more. Interesting things begin when the left/right hand
side is an array/hash/code/object. `$str ~~ @ary_of_strs`, probably the most
common use-case for smart matching, can do value-in-array checkin

lent
to `grep { $str eq $_ } @ary_of_strs` but with short-circuiting capability. Then
there's `$re ~~ @ary_of_strs` which can perform regex matching over the elements
of array. Now what about when the

opy(d);
	}
	else
		d = &PL_sv_undef;

	assert(e);
	if (SvGMAGICAL(e))
		e = sv_mortalcopy(e);

	/* ~~ undef */
	if (!SvOK(e)) {
		return !SvOK(d);
	}
	else if (SvROK(e)) {
		/* First of all, handle ov

rt_amg, AMGf_noleft);
#else
			HV* stash = SvSTASH(SvRV(e));
			GV* gv = gv_fetchmeth_pvn(stash, "(~~", 3, -1, 0);

			if (gv) {
				UNOP myop = {
					.op_flags   = OPf_STACKED | OPf_WANT_SCALAR,
			

K;
				POPSTACK;
				CATCH_SET(oldcatch);
			}
#endif
			if (sv)
				return SvTRUEx(sv);
		}

		/* ~~ qr// */
		if (SvTYPE(SvRV(e)) == SVt_REGEXP) {
			dSP;
			REGEXP* re = (REGEXP*)SvRV(e);
			PMOP* 

 if ($in ~~ Array && $in.elems > 0) {
        $type ~= $in.list[0].WHAT.gist;
        $type ~~ s{")("} = " of ";
        }
    my Str $s-in = sprintf "%-16s %s", $type, $in.gist;
    $s-in ~~ s:g{\n} 

> $csv),  "Sub/Obj { s-in ($in) }");
    }

# Test supported "out" formats
my $datn = $data; $datn ~~ s:g{ "\r\n" } = "\n";
for in () -> $in {
    is (csv (in => $in, out => Str, :!quote-space), $data

te @pure_statements;
    @pure_statements = ();
    state $VALIDATE_PURE_GIVEN = qr{
        \A  given (?<GIVEN>  (?<ws_post_kw>   $OWS    )  \(
                             (?<ws_pre_expr>  $OWS    )

    return !defined $left;
    }

    # 2. Objects on the RHS can't be handled (at all, because no ~~ overloading available)...
    croak 'Smart matching an object breaks encapsulation'
        if $ri

removed in this version of Perl

    use Switch::Back;   # But this module brings them back

    given ($some_value) {

        when (1)   { say 1; }

        when ('a') { say 'a'; continue; }

      

y ($self, $type) = @_;
	
	given ($type) {
		when (STORED) { $self->{type} ~~ ATTR_STORED }
		when (CACHED) { $self->{type} ~~ ATTR_CACHED }
		when (KEY)    { $self->{type} ~~ ATTR_KEY    }
		when (ANY

y ($self, $type) = @_;
	
	given ($type) {
		when (STORED) { $self->{type} ~~ ATTR_STORED }
		when (CACHED) { $self->{type} ~~ ATTR_CACHED }
		when (KEY)    { $self->{type} ~~ ATTR_KEY    }
		when (ANY

 {
    return $_[0]->{postfix} // q~~ if !defined $_[1];
    $_[0]->{postfix} = $_[1];
    return $_[0]->{postfix};
}

sub prefix {
    return $_[0]->{prefix} // q~~ if !defined $_[1];
    $_[0]->{pre

fix} = $_[1];
    return $_[0]->{prefix};
}

sub template {
    return $_[0]->{template} // q~~ if !defined $_[1];
    $_[0]->{template} = $_[1];
    return $_[0]->{template};
}

sub handle_entry {
  

        'eq'    => sub{ &_op_overload( @_, 'IS' ) },
        # Full Text Search operator
        '~~'    => sub{ &_op_overload( @_, '@@' ) },
        fallback => 1,
    );
    use Wanted;
    our $VE

are overloaded:

    +, -, *, /, %, <, <=, >, >=, !=, <<, >>, lt, gt, le, ge, ne, &, |, ^, ==, eq, ~~

Thus a field named "dummy" could be used like:

    $f + 10

which would become:

    dummy + 10

ceholder in:

    $f == "'JPY'"

Simply provide:

    $f == '?'

You can use the search operator C<~~> for SQL Full Text Search and it would be converted into C<@@>:

Let's imagine a table C<articles>

my $fh  = open "test.csv", :r, chomp => False;
 while (my @row = $csv.getline($fh)) {
     @row[2] ~~ m/pattern/ or next; # 3rd field should match
     @rows.push: @row;
     }
 $fh.close;

 # and wri

cept and C<False>
for records to reject.

 csv (in => "file.csv", filter => {
            $^row[2] ~~ /a/ &&  # third field should contain an "a"
            $^row[4].chars > 4  # length of the 5th fi

at have no visible data

This filter is a shortcut for

 filter => { $^row.first: { .defined && $_ ~~ /\S/ }}

This filter rejects all lines that I<not> have at least one field that does
not evaluate 

sep, ",", "Sep = ,");

for < , ; > -> $sep {
    my Str $data = "bAr,foo\n1,2\n3,4,5\n";
    $data ~~ s:g{ "," } = $sep;

    $csv.column-names (False);
    {   my $fh = IO::String.new: $data;
	ok (my

,", ";" ];
for ",", ";", "|", "\t" -> $sep {
    my Str $data = "bAr,foo\n1,2\n3,4,5\n";
    $data ~~ s:g{ "," } = $sep;

    $csv.column-names (False);
    {   my $fh = IO::String.new: $data;
	ok (my

>], "Headers");
    }

for < , ; > -> $sep {
    my Str $data = "bAr,foo\n1,2\n3,4,5\n";
    $data ~~ s:g{ "," } = $sep;

    $csv.column-names (False);
    {   my $fh = IO::String.new: $data;
	ok (my

         eq | ne | lt | le | gt | ge
          | == | != | <  | <= | >  | >=
          | =~ | !~ | ~~
          ) \Z }x;

    my $expected_code = $test_code;
    my ($got_code, $comparator);
    for m

ed[0];
    ok  $result eq $expected[0];
    ok  $result == $expected->[0]->{a}[0];
    ok  $result ~~ $expected[0];
    ok  $result !~ $expected[0];
    ok  $result >  twice($expected{'half'});


=hea

$result                --> 1
    #       $expected->[0]->{a}[0] --> undef
    #
    ok 4 - $result ~~ $expected[0]
    not ok 5 - $result !~ $expected[0]
    #   Failed test at demo/ts_ok-er.pl line 1

 /^ ( (?: (?: ~~ )*+ ~ \[ | [^\[] )++ ) /x;
        $raw //= '';
		if (length $raw) {
			$text =~ s/^ ( (?: (?: ~~ )*+ ~ \[ | [^\[] )++ ) //gx;
			# Fix up escapes
			$raw =~ s/(?:~~)*+\K~\[/[/g;

			$raw =~ s/(?:~~)*+\K~,/,/g;
			$raw =~ s/~~/~/g;
			
			# Escape stuff for perl
			$raw =~ s/\\/\\\\/g;
			$raw =~ s/'/\\'/g;
			
			$sub .= ", '$raw'";
		}
		
		last unless length $tex

		$method =~ s/ \[ \s* (.*?) \s* \] /$1/x;
		
		# sort out ~, and ~~
		$method =~ s/(?:~~)*+\K~,/\x{00}/g;
		$method =~ s/~~/~/g;
		($method, my @params) = split /,/, $method;
		
		# if $is_p

meta = $Aion::META{$pkg};
    my $extends = $meta->{extends} // return "";

    return 1 if $class ~~ $extends;
    for my $extender (@$extends) {
        return 1 if $extender->isa($class);
    }

  

elf;
	my $meta = $Aion::META{$pkg};
	my $does = $meta->{with} // return "";

    return 1 if $role ~~ $does;
    for my $doeser (@$does) {
        return 1 if $doeser->can("does") && $doeser->does($ro

output items; if item is a reference, will print dump
=cut
sub debug {
	my $layer = $_[0] && $_[0] ~~ @Layer_const ? shift : DefaultLayer;

	# drop the layer prefix to print in a config-fasion manner

tput OFF
=cut
sub _verbose {
	my $layer = shift;

	my $conf = Crop->C->{debug};
	return 1 unless $conf->{output} eq 'On';
	
	return unless exists $conf->{layer};
	
	$layer ~~ @{$conf->{layer}};
}

1;

output items; if item is a reference, will print dump
=cut
sub debug {
	my $layer = $_[0] && $_[0] ~~ @Layer_const ? shift : DefaultLayer;

	# drop the layer prefix to print in a config-fasion manner

tput OFF
=cut
sub _verbose {
	my $layer = shift;

	my $conf = Crop->C->{debug};
	return 1 unless $conf->{output} eq 'On';
	
	return unless exists $conf->{layer};
	
	$layer ~~ @{$conf->{layer}};
}

1;

 {
    return $_[0]->{postfix} // q~~ if !defined $_[1];
    $_[0]->{postfix} = $_[1];
    return $_[0]->{postfix};
}

sub prefix {
    return $_[0]->{prefix} // q~~ if !defined $_[1];
    $_[0]->{pre