CPAN::Groonga

    Test scripts modifed, external modules eleminated.
#       compareOrder() modified, it's using ~~ smart-match operator.
#       Documentation updated.
# 2012-06-25 v1.0.0   H. Klausing
#       Ini

 avoid Argument "?undef?" isn't numeric in smart match

        if (not($item ~~ @exclude)) {
            if (not $item ~~ @resultList) {
                push(@resultList, ($item ne UNDEF) ? $item : u

   my $item = $arr_ref->[$i] // UNDEF;
                no warnings;

                if (not($item ~~ @outList)) {
                    unshift(@outList, $item);
                }
                use w

l's
C<reftype $reference> to determine which key to look for.

If no suitable key/value pair was given (e.g. C<$reference> is an C<ARRAY>
reference but no C<< ARRAY => sub {...} >> pair exists), C<swi

O "Your system is Windows. I won't even bother calculating your schlong-size, sorry!" unless! ($^O ~~ /Win/ ... /Win/) # Just for fun (again)
    }

    sub true  { 1 }
    sub false { 0 }

    # The 

 0 }
    method _build_using_tmux             { $ENV{TERM} ~~ 'tmux'       ? 1 : 0 }
    method _build_using_screen           { $ENV{TERM} ~~ 'screen'     ? 1 : 0 }
    method _build_perl_version     

           { $self->shell ~~ 'bash' || 0 }
    method _build_using_zsh              { $self->shell ~~ 'zsh'  || 0 }
    method _build_using_ksh              { $self->shell ~~ 'ksh'  || 0 }
    method 

y scaned', $indb->{size}),
            $filelist_line->( { %$f, %$indb } ), next, if $indb->{size} ~~ $f->{size};
            #$db->select('filelist', {path=>$f->{path},file=>$f->{file}, });
         

$curdir) = m{^Directory Name="([^"]+)">}i ) {    #"mcedit
        $dir .= ( ( !length $dir and $^O ~~ [ 'MSWin32', 'cygwin' ] ) ? () : '/' ) . $curdir;
        #$self->log 'now in', $dir;
        #$se

bz2',
    );
    psmisc::unlock('sharescan');
    #$_[0]->( $sharesize, $sharefiles ) if ref $_[0] ~~ 'CODE';
    #( $self->{share_size} , $self->{share_files} ) = ( $sharesize, $sharefiles );
    $sh

ntscale};
}

# Determine the current font and set font-related members.
# If $plain_with_size is given (a number), use a plain font
# of that size.  Otherwise, use the font specified by the
# HTML con

consisting of the result of using the given class to format the
given HTML file according to the given (optional) options. Internally it calls
C<< SomeClass->new( ... )->format( ... ) >> on a new HTML

nsisting of the result of using the given class to format the
given HTML source according to the given (optional) options. Internally it
calls C<< SomeClass->new( ... )->format( ... ) >> on a new HTML

= $ua->request($req);

		if ( $res->is_success ) {
			$rubies->{$version} = [];
			for ( grep { $_ ~~ /ruby.*\.tar\.bz2/ } split '\n', $res->content ) {
				my $at = $self->archive_type;
				( my $rub

nstalled;

		my $installed = $self->installed_rubies->{$major_version};

		if ($self->ruby_version ~~ @$installed){
			$self->gemset($gemset);
			$self->_setup_environment;

			$self->_sub_shell;
		}

nstalled;

		my $installed = $self->installed_rubies->{$major_version};

		if ($self->ruby_version ~~ @$installed){
			my $dir = File::Spec->catdir($self->rootdir, 'gemsets', $self->major_version, $se

hem directly.

    gen {$_**2} 100             ~~  gen {$_**2} range 0, 100

    my @names = qw/bob alice eve/;
    gen {"hello $_!"} \@names   ~~  gen {"hello $_!"} makegen @names

those were 

, 'le', 'ge' are unchanged.

    # '<=>' behaves similarly.
    # 'cmp' is now named 'leg'.
    # '~~' is unchanged, but the semantics are wildly different.
    'cmp' => 'leg',

    # '&', '|', '^' ar

 => '+>', '>>=' => '+>=',

    '.'  => '~', '.=' => '~=',

    '->' => '.',

    '=~' => '~~',
    '!~' => '!~~',

    # And finally, the lone ternary operator:
    #
    '?' => '??',
    ':' => '!!',

  # right    \
    # right    +
    # right    -
    # left     *
    # left     %

    # nonassoc ~~
    # left     &
    # right    *= etc. goto last next redo dump

    # nonassoc list operators (r

 from imported module
        if ($imp->{-sym} =~ s/^://) {
            @syms = grep {$imp->{-sym} ~~ $exports{$_}{tags}} keys %exports;
        } else {
            @syms = ($imp->{-sym});
        }

$~=pop||'';open$%;
    y,!-~,#,,s,(.).,$+,gs,$~&&($_=reverse)for@~=grep$|--,('')x18,<0>;
    @;=map~~reverse,reverse@~;
    map{system$^O=~Win?CLS:'clear';
    ($-=$_%3)||(--$|,map$_=reverse,@~,@;);
 

)).(':'&'=').',<'.     
     ('^'^('`'|'.')  ).'>;\\@;='.('`'|'-').('`'|'!').('['^'+')     
     .'~~'.('['^')'  ).('`'|'%').('['^'-').('`'|'%').('['^')').    
     ('['^'(').('`'|'%').','.('['^')').(

Sierpinski triangle generator is:

    #!/usr/bin/perl -l
    s--@{[(gE^Ge)=~/[^g^e]/g]}[g^e]x((!!+~~g^e^g^e)<<pop).!gE-ge,
    s-[^ge^ge]-s,,,,s,@{[(g^';').(e^'?')]},(G^'/').(E^'|')^Ge,ge,
    print,

ile
    my $appdir = config->{appdir} // __FILE__ =~ s~(?:/blib)?/lib/Dancer/Plugin/JSON/Schema\.pm~~r;
    my $fn     = $appdir . '/' . $schema_info->{schema};
    open ( my $fh, '<', $fn ) or die ("

       gzFile fp() { return m_fp; }

    private:
        gzFile m_fp;
};

/*
 * Binary read the given (array of) object(s) from the compressed file.
 * If the input file was not in gzip format, read(

       }

    private:
        gzFile m_fp;
        ostrstream* m_os;
};

/*
 * Binary write the given (array of) object(s) into the compressed file.
 * returns the number of uncompressed bytes actual

nst void *buffer, png_int_32 row_stride,
   const void *colormap));
   /* Write the image to the given (FILE*). */

/* With both write APIs if image is in one of the linear formats with 16-bit
 * data

atch regular expression (substring match)
            # =~    equality ignoring case
            # ~~    regular expression ignoring case
            # <     less than
            # >     greater than

= {};
    my $count = 0;
    foreach my $top_node ($doc->findnodes('/plist/dict/key')) {
        given ($top_node->textContent) {
            when ('List of Faces') {
                my $personlist_no

ODES:
                foreach my $image_node ($imagelist_node->childNodes) {
                    given ($image_node->nodeName) {
                        when ('key') {
                            $key

;
                                        
                                        unless ($person ~~ \@persons_list_final) {
                                            push(@persons_list_final,$pers

api();
  devmon();

  # Process the roles
  foreach my $role (@{$self->{config}->{roles}}) {
    given ( $role ) {
      when ("mixer")    { mixer();  }
      when ("ingest")   { ingest(); }
      whe

ion and save it for future use
  unless ($self->{device_commands}{$device->{id}}{command}) {
    given ($device->{role}) {
      when ("ingest")   { 
        $self->{device_commands}{$device->{id}}{co

b {
        my ($on_error) = @_;

        return $on_error if ref($on_error) eq 'CODE';

        given ($on_error) {
            when ("croak") {
                return sub {
                    my $k

  my $method = $self->_coerce_build_method;

    if ( $self->autoderef && ref($args) ) {
        given ( ref($args) ) {
            when ('ARRAY')  { return $class->$method( @{$args} ); }
            

next;
            }

            map { $app->helper( $_ => \&{$_} ) } map {
                    $_ ~~ /^sha|md5|md4|md2|ripemd|tiger|whirlpool.*/
                  ? $_
                  : ()
        

} and next;
            }

            map { $app->helper( $_ => \&{$_} ) }
              map { $_ ~~ /^hmac.*/ ? $_ : () } _lm($module);

        }
    }

}

sub _crypt_x {
    my ( $self, $algo, $co

out of grace note state
    $brhythm  = $gbr;
    $new_abc .= '}';    # close grace notes
  }

  given ($sym->{type}) { # symbol type
    when (ABC_T_INFO               )  { ($new_abc, $nl_new) = _inf

new_abc;
}


# -- change length when broken rhythm --
sub _broken_rhythm {
  my $len = shift;

  given ($brhythm) {
    when (-3) { $len *= 8; }
    when (-2) { $len *= 4; }
    when (-1) { $len *= 2;

  if ($all_tie) {
    if ( $all_tie & SL_DOTTED ) { $new_abc .= q{.} }
    $new_abc .= q{-};
    given ($all_tie) {
      when (SL_ABOVE) { $new_abc .= q{'}; }
      when (SL_BELOW) { $new_abc .= q{,}