# Check if a token is a known SQL keyword.
sub _is_keyword {
my ($self, $token) = @_;
return ~~ grep { $_ eq uc($token) } @{$self->{keywords}};
}
# Add new keywords to highlight.
sub add_keywo
b help {
say <<'OUT';
usage:
install
upgrade
current-version
OUT
}
help unless $ARGV[0];
given ( $ARGV[0] ) {
when ('install') { install() }
when ('prepare-install') {
6_re \z }xms;
};
our @Boolean = qw(0 1);
subtype "${PKG}::Boolean"
=> as "Bool"
=> where {
$_ ~~ @Boolean;
};
coerce "${PKG}::Boolean"
=> from "Bool"
=> via { $_ ? 1 : 0 };
coerce "${PKG}::Dol
@AccountingAction = qw(Credit Debit);
subtype "${PKG}::token_OTHERS"
=> as "Str",
=> where { $_ ~~ @AccountingAction };
enum "${PKG}::DomainWriteAction" =>
qw(DomainCreate DomainUpdate);
enum "$
#!/usr/bin/perl -w
use FindBin qw($Bin);
use lib "$Bin/../lib";
$ARGV[0] ~~ m/select ([\w,]+) FROM ([^\s]+) WHERE ([^;]+);/i;
my @vars = split /,/, $1;
my $ont = $2;
my $code = $3;
foreach (@vars)
=> [ qw/match/ ],
},
};
use 5.010;
{
package SmartMatch::Sugar::Overloaded;
use overload '~~' => sub { $_[0]->(@_) };
}
sub match (&) { bless $_[0], "SmartMatch::Sugar::Overloaded" }
use co
ch friendly tests.
=head1 SYNOPSIS
use SmartMatch::Sugar;
if ( $data ~~ non_empty_array ) {
@$data;
}
if ( $object ~~ inv_isa("Class") {
}
=head1 DESCRIPTION
This module provides simple
d object in a smart match will cause an error
unless C<fallback> is true or the object overloads C<~~>, in which case the
matcher sub will not get a chance to work anyway.
=item stringifies
Returns
tries, so that we can allow self-reference
foreach my $dep (@deps) {
unless(grep { $dep->name ~~ $_->name } @pending, @existing, $entity) {
logError("%s unresolved (pending %s, deps %s for %s
n(',', @deps), $entity->name);
die "Dependency error";
}
}
my @unsatisfied = grep { $_ ~~ [ map { $_->name } @deps ] } @pendingNames;
if(@unsatisfied) {
logInfo("%s has %d unsatisfied
lt();
}
before 'run' => sub {
my ($self) = @_;
return unless ($self->auto_scale);
given (Scalar::Util::blessed($self)) {
when ('Hobocamp::Menu') {
$self->menu_height
_id;
return $self->{job_id};
}
=head2 job_status
Sends RESTful request for job status of a given (known) job_id
Sets status of the job in the client object after response is returned
=cut
sub
if ( $attr->has_value($instance) ) {
if ( $attr->get_value($instance) ~~ $params->{$match_attr} ) {
$match++;
}
{$_}{count} > $min_count; } keys %tags;
foreach (keys %tags) {
delete $tags{$_} unless @keepers ~~ /$_/;
}
my @ordered = sort { $tags{$a}{count} <=> $tags{$b}{count} } keys %tags;
my $high = $t
the following:
# $string =~ /abc/;
# into:
# $string ~~ /abc/;
push @items, {
text => Wx::gettext('Use ~~ for pattern matching'),
listener => sub {
#Replace fir
my $line_text = $editor->GetTextRange( $line_start, $line_end );
$line_text =~ s/\=\~/~~/;
$editor->SetSelection( $line_start, $line_end );
$editor->ReplaceSelection($line_tex
nto:
# $string !~~ /abc/;
push @items, {
text => Wx::gettext('Use !~~ for negated pattern matching'),
listener => sub {
#Replace first '!~' with '!~~' in the current line
ut this way if the C< := > operator meant 'alias
the lhs to the rhs':
abbrev 'abc', 'xyz' ~~ $h{abc} = 'abc'
$h{ab} := $h{abc}
$h{
nite strings in
parallel, though that seems a bit scary.
[Update: The C<=~> operator is renamed C<~~>, and it doesn't automatically
"any-fy" an array anymore, so we could pretty easily make it work o
backtrack over C<< <cut> >>, the entire match
will fail.)
[Update: Now we can just say C<<@lines ~~ s/^.*? \n**{2...} //>>.]
=head2 RFC 110: counting matches
I think we can avoid using any options
ingly, that can also be written:
/ <( _/\d+/ =~ 1..10 )> /
[Update: That'd be C<< <?{ ~/\d+/ ~~ 1..10 }> >> these days.]
=head2 RFC 198: Boolean Regexes
Again, I'm not much in favor of inventi
will return 0 and issue
a warning.
=item pack
our buf8 multi pack( *@items where { all(@items) ~~ Pair } )
our buf8 multi pack( Str $template, *@items )
C<pack> takes a list of pairs and formats
me,0,1);
Optionally, you can use substr on the left hand side of an assignment
like so:
$string ~~ /(barney)/;
substr($string, $0.from, $0.to) = "fred";
If the replacement string is longer or sho
of C<@array>, in order.
If C<$indextest> is provided, only elements whose indices match
C<$index ~~ $indextest> are iterated. (To select on values use C<grep>.)
What is returned at each element of
as C<%hash> doesn't change.
If C<$keytest> is provided, only elements whose keys evaluate
C<$key ~~ $keytest> as true are iterated.
What is returned at each element of the iteration varies with fun
as literals
[Update: C<< <> >> is no longer the input operator. And C<=~> has been
replaced by C<~~>.]
which in Perl 5 we'd have to write as:
# Perl 5
my $target = <>;
<appendline>+
{ @$appendline =~ s/<in_marker>/</;
[Update: Smartmatch is now C<~~>.]
@$deleteline =~ s/<out_marker>/>/;
let $0 := "${to}c${from}\n"
$str =~ m{ /\* .*? \*/ }xs;
# Perl 6
$str =~ m{ /\* .*? \*/ };
[Update: Use C<~~> now.]
=item Remove leading qualifiers from a Perl identifier
# Perl 5
$ident =
my $value = shift;
my @values = split( m{\s+}, $value );
my %values;
given ( $#values ) {
when ( 0 ) {
# top/bottom/left/right shorthand
for
my $self = shift;
my $url = shift;
my $provider = $self->get_http_provider();
given ( $provider ) {
when ( 'lite' ) { return $self->get_url_lite( $url ); }
when ( 'l
ttp->{'timeout'} = $self->get_http_timeout;
my $code = $http->request( $url );
given ( $code ) {
when ( 200 ) { return $http->body(); }
when ( 301 || 302 || 303 || 30
t_http_timeout );
my $resp = $http->get( $url );
my $code = $resp->code();
given ( $code ) {
when ( 200 ) { return $resp->decoded_content(); }
default { retu
ecute_build
$dist->execute_build('install');
Executes a Module::Build script with the options given (which can be
empty).
=cut
sub execute_build {
my $self = shift;
my @params = @_;
$self->
t->execute_make('install');
Executes a ExtUtils::MakeMaker-generated makefile with the options given
(which can be empty) using the C<dmake> being installed.
=cut
sub execute_make {
my $self =
$self->_delay_upgrade($module) ) {
unshift @delayed_modules, $module;
next MODULE;
}
given ( $module->cpan_file() ) {
when (m{/Net-Ping-\d}msx) {
# Net::Ping seems to require that
$release_testing = 0;
my $overwritable = 0;
my $force = $default_force;
given ($dist) {
when (/Scalar-List-Util/msx) {
# Does something weird with tainting
$force