up; $i++) {
my @mm = split /,/, $group->[$i][3];
next unless $user ~~ @mm || $group->[$i][0] eq $user;
if (!$detail) {
push @rows, $
return undef unless $res->[0] == 200;
my @mm = split /,/, $res->[2]{members};
return $user ~~ @mm ? 1:0;
}
$SPEC{get_max_uid} = {
v => 1.1,
summary => 'Get maximum UID used',
args
for ($min_gid .. $max_gid) {
do { $gid = $_; last } unless $_ ~~ @gids;
}
return [412, "Can't find available GID"]
r term is expected
# next.
if ( $rsquare_bracket_type->[$square_bracket_depth] eq '~~' ) {
$tok = $rsquare_bracket_type->[$square_bracket_depth];
}
if ( $s
'||=' => undef,
## '//=' => undef,
## '~' => undef,
## '~~' => undef,
## '!~~' => undef,
};
# ---------------------------------------------------------
|| >= != mm *= => .. !~ == && |= .= pp -= =~ += <= %= ^= x= ~~ ** << /=
&= // >> ~. &. |. ^.
... **= <<= >>= &&= ||= //= <=> !~~ &.= |.= ^.= <<~
#;
push @q, ',';
push @q, '('
] ~~ [];
# [ ["foo"], ["bar"] ] ~~ [ qr/o/, qr/a/ ];
# [ qr/o/, qr/a/ ] ~~ [ ["foo"], ["bar"] ];
# [ "foo", "bar" ] ~~ [ qr/o/, qr/a/ ];
# [ qr/o/, qr/a/ ] ~~ [ "foo", "bar" ];
# $deep1 ~~ $deep1;
# So we will use two thresholds.
my $nmin_mono = $depth + 2;
he same left side patterns, so we will align the equals.
# my $orig = my $format = "^<<<<< ~~\n";
# my $abc = "abc";
# But these have a different left pattern so they will not be
@_;
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
ngWithMoo3>.
=head2 Type::Tiny and Smart Match
Perl 5.10 introduced the smart match operator C<< ~~ >>, which has since
been deprecated because though the general idea is fairly sound, the details
w
qw( Str Int );
given ( $value ) {
when ( Int ) { ... }
when ( Str ) { ... }
}
This will do what you wanted:
use Types::Standard qw( is_Str is_Int );
given ( $value ) {
when
^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< ~~
$role_reqs
.
format INHERIT_POD =
=head1 NAME
@*
$mycl
<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< ~~
$handles
.
format ATTR_NARROW
$handles
^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< ~~
$handles
.
format ATTRHEAD_POD =
=head1 ATTRIBUTES
.
format ATTR_POD =
^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< ~~
$role_reqs
.
format INHERIT_POD =
=head1 NAME
@*
$myclass
<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< ~~
$handles
.
format ATTR_NARROW
$handles
^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< ~~
$handles
.
format ATTRHEAD_POD =
=head1 ATTRIBUTES
.
format ATTR_POD =
=he
] = $retfile;
print RETBLOCK "$retfile\n";
if ( not ($retfile ~~ @retcases ) )
{
push ( @retcases, $retfile );
} @miditers = Sim::OPT::washn( @miditers );
if ( not ( $retfile ~~ @{ $notecases[ $countcase ][ $countblock ][ $counttool ][ $countinstance ] } ) )
es = uniq( @retcases );
my $retfile = $resfile;
if ( not ($retfile ~~ @retcases ) )
{
push ( @retcases, $retfile );
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
esfile, $shortflfile );
#if ( ( $dowhat{simulate} eq "y")
# and ( ( ( not ( $to{cleanto} ~~ ( @trieds ) ) ) or ( not ( $precious eq "" ) ) )
# or ( ( $gaproc eq "yes" ) and ( $fire eq
";
if ( ( not ( $resfile ~~ @simcases ) ) and ( not ( -e $resfile ) ) and ( $dowhat{simulate} eq "y")
and ( not ( $to{cleanto} ~~ ( @trieds ) ) ) )
{
print SIMBLOCK "$resfile\n";
}
if ( ( not ( $resfile ~~ @retcases ) ) and ( not ( -e $resfile ) ) )
{
push ( @simcases, $res
blockelts_r };
foreach my $key ( sort ( keys %varns ) )
{
if ( not( $key ~~ @blockelts ) )
{
$varns{$key} = 1;
}
}
return( %va
{
foreach my $key ( sort ( keys( %varnums ) ) )
{
if ( not( $key ~~ @blockelts ) )
{
$modhs{$key} = $varnums{$key};
$torecover
foreach my $instance ( @{ $vehicles{cumulateall} } )
{
if ( $instance->{is} ~~ @reds )
{
my @instancees;
push( @instancees, $instance );
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 {
$self->mins} ~~ @{$setObj->mins} and @{$self->maxs} ~~ @{$setObj->maxs});
}
sub notEqual {
my ($self, $setObj) = @_;
return !(@{$self->mins} ~~ @{$setObj->mins} and @{$self->maxs} ~~ @{$setObj->m
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