view release on metacpan or  search on metacpan

lib/Tree/File.pm  view on Meta::CPAN

  $id && $id =~ s|\A/+||;
  my $rest;

  croak "get called on $self without property identifier" unless defined $id;

  ($id, $rest) = split m|/|, $id, 2;
  if ($rest) {
    my $head = $self->get($id, $autovivify);
    return $self->_not_found($id, $self->{root}) unless $head;
    return $head->get($rest, $autovivify);
  }

lib/Tree/File.pm  view on Meta::CPAN

  $root = $id unless $root;
  my $rest;

  croak "set called on $self without property identifier" unless defined $id;

  ($id, $rest) = split m|/|, $id, 2;
  if ($rest) { return $self->get($id, 1)->set($rest, $value, $root); }

  return $self->{data}{$id} =
    $self->_new_node($root, $value);
}

lib/Tree/File.pm  view on Meta::CPAN

  $id && $id =~ s|\A/+||;
  my $rest;

  croak "delete called on $self without property identifier" unless defined $id;

  ($id, $rest) = split m|/|, $id, 2;
  if ($rest) { return $self->get($id)->delete($rest); }

  return delete $self->{data}{$id};
}

lib/Tree/File.pm  view on Meta::CPAN

=cut

sub basename {
  my ($self) = @_;
  my @parts = split m{/}, $self->path();
  return $parts[-1];
}

sub _handoff {
  my $self = shift;

 view release on metacpan or  search on metacpan

GiST/GiST.cpp  view on Meta::CPAN

	if(!entry->IsEqual(*actual)) {
		int pos=entry->Position();

		P->DeleteEntry(pos);
		P->InsertBefore(*actual, pos);
		// A split may be necessary.
		// XXX: should we do Forced Reinsert here too?
		if(P->IsOverFull(*store)) {
			Split(parent, *actual);

			GiSTpage page=node->Path().Page();

 view release on metacpan or  search on metacpan

lib/Tree/Navigator/Node.pm  view on Meta::CPAN

  # $self is its own descendent if $path is empty
  return $self if ($path // '') eq ''; # NOTE : '0' is a valid nonempty path!

  # otherwise, find the child from initial path segment, and then recurse
  my ($child_name, $subpath) = split m{/}, $path, 2;
  my $child = $self->child($child_name)
    or die "no such child: $child_name";
  return $child->descendent($subpath);
}

 view release on metacpan or  search on metacpan

lib/TreePath.pm  view on Meta::CPAN

  croak "path must be start by '/' !: $!\n" if ( $path !~ m|^/| );

  my $search_key = $self->_get_key_name('search', { source => $source});

  my $nodes = [ split m%/%, $path ];
  $$nodes[0] = '/';

  my $not_found = 0;
  my (@found, @not_found);
  foreach my $node ( @$nodes ) {

 view release on metacpan or  search on metacpan

lib/Treex/PML/Instance.pm  view on Meta::CPAN

  }
  return \@r;
}

sub __split_path {
  my @p =  split m{/}, $_[0];
  if (@p>0 and length($p[0])==0) { shift @p; }
  return \@p;
}

sub for_each_match {

 view release on metacpan or  search on metacpan

ext/Tripletail-HtmlFilter/HtmlFilter.pm  view on Meta::CPAN

    }
    elsif (ref $html) {
		die __PACKAGE__."#set: ARG[1] is a Ref.\n";
    }

    #@{$this->[HTML]} = split m/(<.+?>)/s, $html;
    # ↑では、<!-- <hoge> -->を正しく解析できない。真面目にパーズする必要がある
    # しかし、perlで真面目にパーザを書くのは非常に面倒なので正規表現で誤魔化す
    # NB: 他にも、正しく解析できないパターンが存在するかも
    @{$this->[HTML]} = split m/((?:<!--.*?-->)|(?:<.+?>))/s, $html;
    @{$this->[OUTPUT]} = ();
    $this;
}

sub toStr {

 view release on metacpan or  search on metacpan

t/chars.t  view on Meta::CPAN

        # repair last line without \n
        ok(
            ! ( $text =~ s{([^\x0D\x0A]) \z}{$1\x0D\x0A}xms ),
            "$file_name has newline at EOF",
        );
        @lines = split m{\x0A}, $text;
    }

    my $find_line_numbers = sub {
        my ($test_description, $test_reason, $regex, $regex_negation) = @_;
        my $line_number = 0;

 view release on metacpan or  search on metacpan

lib/Pod/Simple/Wiki/Twiki/Upload.pm  view on Meta::CPAN

}


sub localize_dir_path {
	my ($path) = @_;
	return File::Spec->catdir( split m{/}, $path );
}


sub rscan_dir {
	my ($dir, $pattern) = @_;

 view release on metacpan or  search on metacpan

lib/UI/KeyboardLayout.pm  view on Meta::CPAN

sub parse_add_configstring ($$$) {		# Trailing whitespace is ignored, whitespace about "=" is not
  my ($self, $s, $vv, @KEYS) = (shift, shift, shift);
  $s =~ s/[^\S\n]+$//gm;
  $s =~ s/^\x{FEFF}//;			# BOM are not stripped by Perl from UTF-8 files with -C31
  (my $pre, my %f) =  split m(^\[((?:visual\s*->\s*)?[\w/]*)\]\s*$ \n?)mx, $s;	# //x is needed to avoid $\
  warn "Part before the first section in configfile ignored: `$pre'" if length $pre;
  for my $k (sort keys %f) {
# warn "Section `$k'";
    my($v, $V, @V) = $f{$k};
    if ($k =~ s{^visual\s*->\s*}{[unparsed]/}) {		# Make sure that prefixes do not allow visual line to be confused with a config
      $v =~ s[(^(?!#|[/\@+]?\w+=).*)]//ms;			# find non-comment non-assignment
      @V = "unparsed_data=$1";
    }
# warn "xxx: @V";
    push @KEYS, $k;
    my @k = split m(/), $k;
    @k = () if "@k" eq '';				# root
    for my $l ((grep !/^#/, split(/\n/, $v)), @V) {
      die "unrecognized config file line: `$l' in `$s'"
        unless my($arr, $at, $slash, $kk, $vvv) = ($l =~ m[^((?:(\@)|(/)|\+)?)(\w+)=(.*)]s);
      my $spl = $at ? qr/,/ : ( $slash ? qr[/] : qr[(?!)] );

lib/UI/KeyboardLayout.pm  view on Meta::CPAN

#  @k
}	# -> list of chars

sub process_key ($$$$$$;$) {		# $sep may appear only in a beginning of the first key chunk
  my ($self, $k, $limit, $sep, $ln, $l_off, $sep2, @tr)  = (shift, shift, shift, shift, shift, shift, shift);
  my @k = split m((?!^)\Q$sep), $k;
  die "Key descriptor `$k' separated by `$sep' has too many parts: expected $limit, got ", scalar @k
    if @k > $limit;
  defined $k[$_] and $k[$_] =~ s/^--(?=.)/\0/ and $tr[$_]++ for 0..$#k;
  $k[0] = '' if $k[0] eq '--';		# Allow a filler (multi)-chunk
  map [$self->process_key_chunk( $ln->[$l_off+$_], $tr[$_], (defined($k[$_]) ? $k[$_] : ''), $sep2)], 0..$#k;

lib/UI/KeyboardLayout.pm  view on Meta::CPAN

sub fill_kbd_layers ($$) {			# We do not do deep processing here...
  my($self, $h, %o, %c, %O) = (shift, shift);
  my @K = grep m(^\[unparsed]/(KBD|RECT)\b), @{$h->{'[keys]'}};
#  my $H = $h->{'[unparsed]'};
  for my $k (@K) {
    my (@parts, @h) = split m(/), $k;
    ref $self and push @h, $self->get_deep($self, @parts[1..$_]) || {} for 0..$#parts;
    push @h, $self->get_deep($h, @parts[1..$_]) || {} for 0..$#parts;		# Drop [unparsed]/ prefix...
    push @h, $self->get_deep($h,    @parts[0..$_]) || {} for -1..$#parts;
    my ($in, $counts, $offsets) = ($k =~ m(^\[unparsed]/KBD\b) ? $self->decode_kbd_layers( reverse @h )
    							       : $self->decode_rect_layers( reverse @h ) );

lib/UI/KeyboardLayout.pm  view on Meta::CPAN

		      output_layers_WIN output_layers_XKB skip_extra_layers_WIN Prefix_Base_Altern Prefix_Force_Altern
    		      layers_modifiers layers_mods_keys mods_keys_KBD AltGrInv_AltGr_as_Ctrl
		      ComposeKey_Show AltGr_Invert_Show Apple_Override Apple_Duplicate Apple_HexInput 
    		      ComposeKey Explicit_AltGr_Invert Auto_Diacritic_Start CapsLOCKoverride
    		      WindowsEmitDeadkeyDescrREX ExtraChars modkeys_vk) ) {
      $self->{faces}{$f}{"[$key]"} = $self->get_deep_via_parents($self, undef, 'faces', (split m(/), $f), $key);
    }
    $self->{faces}{$f}{'[char2key_prefer_first]'}{$_}++ 		# Make a hash
      for @{ $self->{faces}{$f}{char2key_prefer_first} || [] } ;
    $self->{faces}{$f}{'[char2key_prefer_last]'}{$_}++ 			# Make a hash
      for @{ $self->{faces}{$f}{char2key_prefer_last} || [] } ;
    $self->{faces}{$f}{'[AltGrInv_AltGr_as_Ctrl]'} = 1 unless defined $self->{faces}{$f}{'[AltGrInv_AltGr_as_Ctrl]'};

    my $idx = $self->get_deep($self, 'faces', (split m(/), $f), 'MetaData_Index');
    # defined $self->{faces}{$f}{"[$_]"} and not ref $self->{faces}{$f}{"[$_]"}
    #  or
    $self->{faces}{$f}{"[$_]"} = $self->get_deep_via_parents($self, $idx, 'faces', (split m(/), $f), $_)
        for qw(LRM_RLM ALTGR SHIFTLOCK NOALTGR);

    my %R = qw(ComposeKey_Show ⎄    AltGr_Invert_Show ⤨);		# On Apple only
    defined $self->{faces}{$f}{"[$_]"} or $self->{faces}{$f}{"[$_]"} = $R{$_} for keys %R;
    $self->{faces}{$f}{"[ComposeKey_Show]"}[0] = '⎄'			# Make a safe default

lib/UI/KeyboardLayout.pm  view on Meta::CPAN

    s/^\s+//, s/\s+$//, $_ = $self->stringHEX2string($_) for @{ $self->{faces}{$f}{Import_Prefix_Keys} || []};
    my %h = @{ $self->{faces}{$f}{Import_Prefix_Keys} || []};
    $self->{faces}{$f}{'[imported2key]'} = \%h if %h;
    my ($l0, $c);
    unless ($c = $self->{layer_counts}{$l0 = $self->{faces}{$f}{layers}[0]}) {
      $l0 = $self->get_deep_via_parents($self, undef, 'faces', (split m(/), $f), 'geometry_via_layer');
      $c = $self->{layer_counts}{$l0} if defined $l0;
    }
    my $o = $self->{layer_offsets}{$l0} if defined $l0;
    $self->{faces}{$f}{'[geometry]'} = $c if $c;
    $self->{faces}{$f}{'[g_offsets]'} = $o if $o;

lib/UI/KeyboardLayout.pm  view on Meta::CPAN

}

sub massage_hash_values($) {
  my($self) = (shift);
  for my $K ( @{$self->{'[keys]'}} ) {
    my $h = $self->get_deep($self, split m(/), $K);
    $_ = $self->charhex2key($_) for @{ $h->{char2key_prefer_first} || []}, @{ $h->{char2key_prefer_last} || []};
  }

}
#use Dumpvalue;

lib/UI/KeyboardLayout.pm  view on Meta::CPAN

  my($self, $h, @process, @to) = (shift, shift);
  my @K = grep m(^\[unparsed]/DEADKEYS\b), @{$h->{'[keys]'}};
# warn "Found deadkey sections `@K'";
#  my $H = $h->{'[unparsed]'};
  for my $k (@K) {
    push @process, $self->get_deep($h, (split m(/), $k), 'unparsed_data');
    (my $k1 = $k) =~ s(^\[unparsed]/)();
    push @to, $k1
  }
  @K = grep m(^DEADKEYS\b), @{$h->{'[keys]'}};
  for my $k (@K) {
    my $slot = $self->get_deep($h, split m(/), $k);
    next unless exists $slot->{klc_filename};
    open my $fh, '< :encoding(UTF-16)', $slot->{klc_filename}
      or die "open of <klc_filename>=`$slot->{klc_filename}' failed: $!";
    local $/;
    my $in = <$fh>;

lib/UI/KeyboardLayout.pm  view on Meta::CPAN

  for my $k1 (@to) {
#warn "DK sec `$k' -> `$v', <", join('> <', keys %{$h->{'[unparsed]'}{DEADKEYS}{la_ru}}), ">";
#warn "DK sec `$k' -> `$v', <$h->{'[unparsed]'}{DEADKEYS}{la_ru}{unparsed_data}>";
    my $v = shift @process; 
    my($o,$d,$t) = $self->read_deadkeys_win($v);	# Translation tables, names, rest of input
    my (@parts, @h) = split m(/), $k1;
    my %seen = (%$o, %$d);
    for my $kk (keys %seen) {
#warn "DK sec `$k1', deadkey `$kk'. Map: ", $self->array2string( [%{$o->{$kk} || {}}] );
      my $slot = $self->get_deep($h, @parts, $kk);
      warn "Deadkey `$kk' defined for `$k1' conflicts with previous definition" 

lib/UI/KeyboardLayout.pm  view on Meta::CPAN

		     CANCEL	=> [["\cC", "\cC"], ["\cC"]],
		   );

sub get_VK ($$) {
  my ($self, $f) = (shift, shift);
  $self->get_deep_via_parents($self, undef, 'faces', (split m(/), $f), 'VK') || {}
#  $self->{faces}{$f}{VK} || {}
}

my $min_sec;
sub last_pre_funckeys($$) {

lib/UI/KeyboardLayout.pm  view on Meta::CPAN

	# Exception: translator with all_layers: takes a ref to a key (array of arrays of chars); returns array of arrays.
	# There is a possibility to redirect the translation to another key; see $cvt (usually combined with 'all_layers').
  my ($self, $name, $deadkey, $face, $N, $used_deadkey) = (shift, shift, shift || 0, shift, shift, '');	# $deadkey used eg for diagnostics
  die "Undefined recipe in a translator for face `$face', layer $N on deadkey `$deadkey'" unless defined $name;
  if ($name =~ /^Imported\[([\/\w]+)(?:,([\da-fA-F]{4,}))?\]$/) {
    my($d, @sec) = (($2 ? "$2" : undef), split m(/), "$1");
    $d = $deadkey, $used_deadkey ="/$deadkey" unless defined $d;
    my $fromKBDD = $self->get_deep($self, 'DEADKEYS', @sec, lc $d, 'map')	# DEADKEYS/bepo with 00A4 ---> DEADKEYS/bepo/00a4
      or die "DEADKEYS section for `$d' with parts `@sec' not found";
	# indexed by lc hex
    return sub { my $cc=my $c=shift; return $c unless defined $c; $c = $c->[0] if 'ARRAY' eq ref $c; defined($c = $fromKBDD->{$self->key2hex($c)}) or return $c; $self->document_char(chr hex $c, $name, $cc) }, '';

lib/UI/KeyboardLayout.pm  view on Meta::CPAN

    }
    return sub ($$$$) { (undef, my ($L, $k, $shift)) = @_; return undef if $L or $shift or $k >= $tot; $self->document_char($chars[$c{$k}], "ByColumn[$c{$k}]") }, '';
  }
  if ($name =~ /^ByRows\[(.+)\]$/) {
    s(^\s+(?!\s|///\s+))(), s((?<!\s)(?<!\s///)\s+$)() for my $recipes = $1;
    my (@recipes, @subs) = split m(\s+///\s+), $recipes;
    my $LL = $#{ $self->{faces}{$face}{layers} };		# Since all_layers, we are called only for layer 0; subrecipes may need more
    for my $rec (@recipes) {
      push(@subs, sub {return undef}), next unless length $rec;
#warn "recipe=`$rec'; face=`$face'; N=$N; deadkey=`$deadkey'; last_layer=$LL";
      my ($tr) = $self->make_translator_for_layers( $rec, $deadkey, $face, [0..$LL] );

lib/UI/KeyboardLayout.pm  view on Meta::CPAN

        = $self->document_char($Map{$_}, 'explicit flat tuneup') for keys %Map;
      $used_deadkey = "/$deadkey";
    }
    return sub ($) { my $c = shift; defined $c or return $c; $c = $c->[0] if 'ARRAY' eq ref $c; $self->document_char($Map{$c}, 'explicit tuneup') }, $used_deadkey;
  }
  my $map = $self->get_deep($self, 'DEADKEYS', split m(/), $name);
  die "Can't resolve character map `$name'" unless defined $map;
  unless (exists $map->{map}) {{
    my($k1) = keys %$map;
    die "Character map `$name' does not contain HEX: `$k1'" if %$map and not $k1 =~ /^[0-9a-f]{4,}$/;
    die "Character map is a parent-type map, but no deadkey to use specified" unless defined $deadkey;

lib/UI/KeyboardLayout.pm  view on Meta::CPAN

}

sub massage_translated_layers ($$$$;$) {
  my ($self, $in, $face, $NN, $deadkey) = (shift, shift, shift, shift, shift, '');
#warn "Massaging `$deadkey' for `$face':$N";
  return $in unless my $r = $self->get_deep($self, 'faces', (my @p = split m(/), $face), '[Diacritic_if_undef]');
  $r =~ s/^\s+//;
#warn "	-> end recipe `$r'";
	warn "  mk_tr_lyrs 6" if debug_stacking_ord;
  my $post = $self->make_translated_layers($r, $face, $NN, $deadkey);
	warn "  mk_tr_lyrs_st 1" if debug_stacking_ord;

lib/UI/KeyboardLayout.pm  view on Meta::CPAN

  my ($self, %h, $expl) = (shift);
#Dumpvalue->new()->dumpValue($self);
  my @F = grep m(^faces(/.*)?$), @{$self->{'[keys]'}};
  for my $FF (@F) {
    (my $F = $FF) =~ s(^faces/?)();
    my(@FF, @HH) = split m(/), $FF;
    next if @FF == 1 or $FF[-1] eq 'VK';
    my @FF1 = @FF;
    push(@HH, $self->get_deep($self, @FF1)), pop @FF1 while @FF1;	# All the parents
    my $H = $HH[0];
    next if $H->{PartialFace};

lib/UI/KeyboardLayout.pm  view on Meta::CPAN

sub create_prefix_chains ($) {
  my ($self, %h, $expl) = (shift);
  my @F = grep m(^faces(/.*)?$), @{$self->{'[keys]'}};
  for my $FF (@F) {
    (my $F = $FF) =~ s(^faces/?)();
    my(@FF, @HH) = split m(/), $FF;
    next if @FF == 1 or $FF[-1] eq 'VK';
    push(@HH, $self->get_deep($self, @FF)), pop @FF while @FF;
    my($H, %KK) = $HH[0];
    for my $chain ( @{ $H->{'[PrefixChains]'} || [] } ) {
      (my $c = $chain) =~ s/^\s+//;

lib/UI/KeyboardLayout.pm  view on Meta::CPAN

sub link_composite_layers ($) {		# as above, but finish 
  my ($self, %h, $expl) = (shift);
  my @F = grep m(^faces(/.*)?$), @{$self->{'[keys]'}};
  for my $FF (@F) {
    (my $F = $FF) =~ s(^faces/?)();
    my(@FF, @HH) = split m(/), $FF;
    next if @FF == 1 or $FF[-1] eq 'VK';
    push(@HH, $self->get_deep($self, @FF)), pop @FF while @FF;
    my $H = $HH[0];
    for my $new_facename (sort values %{$H->{'[deadkeyFace]'}}) {
#warn "Joining <$F>, <$new_facename>";

lib/UI/KeyboardLayout.pm  view on Meta::CPAN

  my $self = shift;
  my @F = grep m(^faces(/.*)?$), @{$self->{'[keys]'}};
  my (@Fok, @Fok0, @Fnok);
  for my $FF (@F) {
    (my $F = $FF) =~ s(^faces/?)();
    my(@FF, @HH, @FokF) = split m(/), $FF;
    next if @FF == 1 or $FF[-1] eq 'VK';
    push @Fok, $F;				# Assumed base faces
    my($H) = $self->get_deep($self, @FF);
    my $Cov = $H->{'[coverageExtraInclPrefix]'};
##    warn join ',', sort keys %$Cov;

 view release on metacpan or  search on metacpan

lib/UI/Various/PoorTerm/Listbox.pm  view on Meta::CPAN

		    }
		}
	    }
	    else
	    {
		foreach (split m/,\s*/, $_)
		{
		    $_ > 0  or  next;
		    $i = $self->{first} + $_ - 1;
		    $self->{_selected}[$i] =
			$self->{_selected}[$i] eq ' ' ? '*' : ' ';

 view release on metacpan or  search on metacpan

lib/URI/AnyService.pm  view on Meta::CPAN

        next if $line =~ /^#/;
        $line =~ s/#.*$//;
        next unless ($line // '') =~ /^$URI::scheme_re\s+/;

        my ($service, $port_proto, @other_services) = split /\s+/, $line;
        my ($port, $proto) = split m!/!, $port_proto;
        $SERVICE_PORTS{$service}        = $port;
        $SERVICE_PORTS{@other_services} = $port if @other_services;
    }
    close $fh;
}

 view release on metacpan or  search on metacpan

lib/URI/PathAbstract.pm  view on Meta::CPAN

=cut

    no strict 'refs';

    for my $method (grep { ! /^\s*#/ } split m/\n/, <<_END_) {
scheme
fragment
as_string
canonical
eq

lib/URI/PathAbstract.pm  view on Meta::CPAN

=head2 ->parent

=cut

    for my $method (grep { ! /^\s*#/ } split m/\n/, <<_END_) {
child
parent
_END_
        *$method = sub {
            my $self = shift;

lib/URI/PathAbstract.pm  view on Meta::CPAN

=head2 ->to_branch

=cut

    for my $method (grep { ! /^\s*#/ } split m/\n/, <<_END_) {
up
pop
down
push
to_tree

lib/URI/PathAbstract.pm  view on Meta::CPAN

=head2 ->is_branch

=cut

    for my $method (grep { ! /^\s*#/ } split m/\n/, <<_END_) {
#get
list
first
last
is_empty

 view release on metacpan or  search on metacpan

lib/URI/Title/Image.pm  view on Meta::CPAN

    ($x, $y, $title) = pnginfo(\$data);
  }
  else {
    ($x, $y) = imgsize(\$data);
  }
  $title ||= ( split m{/}, $url )[-1];
  return $x && $y
    ? "$title ($type ${x}x${y})"
    : "$title ($type)";
}

 view release on metacpan or  search on metacpan

lib/URI/cpan.pm  view on Meta::CPAN

    if $self->query;

  Carp::croak "invalid cpan URI: non-empty fragment string not supported"
    if $self->fragment;

  my (undef, @path_parts) = split m{/}, $self->path;
  my $type = $path_parts[0];

  Carp::croak "invalid cpan URI: do not understand path " . $self->path
    unless my $new_class = $type_class{ $type };

 view release on metacpan or  search on metacpan

lib/URI/imap.pm  view on Meta::CPAN

package URI::imap;
# $Id: imap.pm,v 1.1 2004/08/07 19:17:46 cwest Exp $
use strict;

use vars qw[$VERSION];
$VERSION = sprintf "%d.%02d", split m/\./, (qw$Revision: 1.1 $)[1];

use base qw[URI::_server];

sub default_port { 143 }

 view release on metacpan or  search on metacpan

lib/URI/pack.pm  view on Meta::CPAN

	if ($part_uri =~ m{/ \z}msx) {
		croak 'A part URI shall not have a forward slash as the last character [M1.5]';
	}

	# Split the part URI into segments
	my @segments = split m{/}msx, $part_uri;

	# Remove the first empty segment
	if ($segments[0] eq q{}) {
		shift @segments;
	}

 view release on metacpan or  search on metacpan

Checkout.pm  view on Meta::CPAN

        my $api = $1 if $url =~ s{^\w+://([^/]+)/+}{};	
	$url =~ s{^(public/+)?sources?/+}{};
	my $rev = $1 if $url =~ s{[\?&]rev=(\w+)}{};
	$url =~ s{\?.*}{};
	$url =~ s{:/}{:}g;
	my @pp = split m{/+}, $url;

	my @cmd = (@{$m->{osc}}, '-A', "https://$api", @{$m->{co}});
	push @cmd, '-r', $rev if defined $rev;
	## -S aka --server-side-source-service-files, what an ugly name!
	return [ shell_quote(@cmd, '-S', @pp), shell_quote(@cmd, @pp)];

 view release on metacpan or  search on metacpan

t/URLprocessor.t  view on Meta::CPAN

# Test private methods:
print "\nTest split method\n";
_test_split_url($url2);

print "\nTest parse global part method\n";
_test_parse_global_part($url2);

 view release on metacpan or  search on metacpan

lib/Eutf2.pm  view on Meta::CPAN

                }
                die __FILE__, ": Can't find string terminator anywhere before EOF\n";
            }
        }

# split m//
        elsif (/\G \b (m) \b /oxgc) {
            if (/\G (\#) ((?:$qq_char)*?) (\#) ([cgimosxpadlunbB]*) /oxgc)                        { return e_split  ($e.'qr',$1,$3,$2,$4);   } # m# #  --> qr # #
            else {
                while (not /\G \z/oxgc) {
                    if    (/\G ((?>\s+)|\#.*)                                              /oxgc) { $e .= $1; }

 view release on metacpan or  search on metacpan

unqlite/unqlite.c  view on Meta::CPAN

	if( rc != UNQLITE_OK ){
		/* Check for a free block to hold a single cell only (without payload) */
		rc = lhAllocateSpace(pPage,L_HASH_CELL_SZ,&nOfft);
		if( rc != UNQLITE_OK ){
			if( !auto_append ){
				/* A split must be done */
				return UNQLITE_FULL;
			}else{
				/* Store this record in a slave page */
				rc = lhSlaveStore(pPage,pKey,nKeyLen,pData,nDataLen,nHash);
				return rc;

 view release on metacpan or  search on metacpan

memmap_common.c  view on Meta::CPAN

UJ_UINT16 const* g_eu2a2s_table;
int              g_eu2a2s_size;


/* ----------------------------------------------------------------------------
 * split mapping table.
 */
void
do_memmap_set(const char* mmap_pmfile, int mmap_pmfile_size)
{
  HV* hv_table;

 view release on metacpan or  search on metacpan

lib/POD2/JA/Unicode/LineBreak.pod  view on Meta::CPAN

    my $url = qr{http://[\x21-\x7E]+}i;
    sub breakurl {
        my $self = shift;
        my $str = shift;
        return split m{(?<=[/]) (?=[^/]) |
                       (?<=[^-.]) (?=[-~.,_?\#%=&]) |
        	       (?<=[=&]) (?=.)}x, $str;
    }
    my $lb = Unicode::LineBreak->new(Prep => [$url, \&breakurl]);
    $output = $lb->break($string);

 view release on metacpan or  search on metacpan

lib/Unicode/Stringprep.pm  view on Meta::CPAN

  no warnings 'utf8';
  $string =~ tr/\x{2F868}\x{2F874}\x{2F91F}\x{2F95F}\x{2F9BF}/\x{2136A}\x{5F33}\x{43AB}\x{7AAE}\x{4D57}/;

  ## only normalize runs of assigned characters
  ##
  my @s = split m/($is_Unassigned+)/o, $string;

  for( my $i = 0; $i <= $#s ; $i+=2 ) { # skips delimiters == is_Unassigned
    no warnings 'utf8';
    $s[$i] = Unicode::Normalize::NFKC($s[$i]);
  }

 view release on metacpan or  search on metacpan

script/uniwc  view on Meta::CPAN

    if ($charcount = length($_)) {
	#$wordcount = 0;
	$wordcount++ while /\P{Space}+/g;

	#$wordcount = eval { @words = split m{ \p{Space}+  }x }; 
	#yuck "error splitting words: $@" if $@;

	#$linecount = 0;
	$linecount++ while /\R/g;

	#$linecount = eval { @lines = split m{ \R     }x }; 
	#yuck "error splitting lines: $@" if $@;

	#$grafcount = 0;
	$grafcount++ while /\X/g;

	#$grafcount = eval { @lines = split m{ \R     }x }; 
	#yuck "error splitting lines: $@" if $@;

	$paracount = 0;
	$paracount++ while /\R{2,}/g;

 view release on metacpan or  search on metacpan

lib/Unix/Mgt.pm  view on Meta::CPAN

		if (my $member_str = $group{'members'}) {
			my (%members);
			
			# parse out members
			$member_str = crunch($member_str);
			@members{split m|\s+|, $member_str} = ();
			
			# if this user is in the membership
			if (exists $members{$user->{'name'}})
				{ $groups{$group{'name'}} = 1 }
		}

lib/Unix/Mgt.pm  view on Meta::CPAN

	$members_str = $group->entry->{'members'};
	defined($members_str) or return ();
	
	# loop through members
	NAME_LOOP:
	foreach my $name (split m|\s+|s, $members_str) {
		if (hascontent $name) {
			my $user = Unix::Mgt::User->get($name);
			$members{$user->{'name'}} = 1;
		}
	}

 view release on metacpan or  search on metacpan

lib/V.pm  view on Meta::CPAN

sub all_installed {
    my ($proto, $name, @inc) = @_;
    my $class = ref $proto || $proto;

    @inc or @inc = @INC;
    my $file = File::Spec->catfile (split m/::/ => $name) . ".pm";

    my @modules;
    foreach my $dir (@inc) {
	# Skip the new code ref in @INC feature.
	ref $dir and next;

 view release on metacpan or  search on metacpan

SCCS.pm  view on Meta::CPAN

	my @delta;

	my ($l_ins, $l_del, $l_unc) = map { $_ + 0 } $1, $2, $3;

	{   local $/ = "\cAe\n";
	    @delta = split m/\n/, scalar <$fh>;
	    }

	my ($type, $vsn, $v_r, $v_l, $v_b, $v_s,
		   $date, $y, $m, $d, $time, $H, $M, $S,
		   $user, $rev, $prv) =

SCCS.pm  view on Meta::CPAN

	$_ = <$fh>;
	}

    # Body
    local $/ = undef;
    $sccs{body} = [ split m/\n/, $_ . <$fh> ];
    close $fh;

    return bless \%sccs, $class;
    } # new

SCCS.pm  view on Meta::CPAN

#	printf STDERR "%2d.%04d/%s: %-29.29s |%s\n", $r, scalar @body, $want, $v->(), $_;
	}

    if ($self->{flags}{e} && @body && $body[0] =~ m/^[\x20-\x60]{1,61}$/) {
	my $body = unpack "u" => join "\n" => @body;
	$body and @body = split m/\n/ => $body;
	}

    return wantarray ? @body : join "\n", @body, "";
    } # body

 view release on metacpan or  search on metacpan

lib/Validate/CodiceFiscale.pm  view on Meta::CPAN

      X => 23,
      Y => 24,
      Z => 25,
     };
   state $checksums_for = [$odd_checksums, $even_checksums];
   my @chars = split m{}mxs, substr($cf, 0, 15);    # no checksum
   my $sum = sum map { $checksums_for->[$_ % 2]{$chars[$_]} } 0 .. $#chars;
   chr(ord('A') + ($sum % 26));
} ## end sub _cf_checksum

sub _normalized_string ($string, @positions) {

lib/Validate/CodiceFiscale.pm  view on Meta::CPAN

sub _normalized_birthplace ($place) { _normalized_string($place, 1 .. 3) }
sub _normalized_birthdate ($date) { _normalized_string($date, 0, 1, 3, 4) }

sub _expand_date ($date, $opts) {
   state $mlf       = [split m{}mxs, 'ABCDEHLMPRST'];
   state $month_for = {map { $mlf->[$_] => $_ } 0 .. $mlf->$#*};

   $date = _normalized_birthdate($date);
   my ($y, $mc, $d) = $date =~ m{\A(\d\d)([ABCDEHLMPRST])(\d\d)\z}mxs
     or return;

lib/Validate/CodiceFiscale.pm  view on Meta::CPAN

sub _is_valid_cf_date ($y, $m, $d) {
   return !!(eval { timegm(30, 30, 12, $d, $m - 1, $y); 1 });
}

sub _compact_birthdates ($birthdate) {
   state $month_letter_for = ['', split m{}mxs, 'ABCDEHLMPRST'];
   my ($y, $m, $d) = split m{\D}mxs, $birthdate;
   ($y, $d) = ($d, $y) if $d > 31;
   $y %= 100;
   $m = $month_letter_for->[$m + 0];
   map { sprintf '%02d%s%02d', $y, $m, $_ } ($d, $d + 40);
} ## end sub _compact_birthdates

lib/Validate/CodiceFiscale.pm  view on Meta::CPAN

   return join '', @retval[0 .. 2];
} ## end sub _compact_name

sub _consonants_and_vowels ($string) {
   my (@consonants, @vowels);
   for my $char (grep { m{[A-Z]}mxs } split m{}mxs, uc($string)) {
      if   ($char =~ m{[AEIOU]}mxs) { push @vowels,     $char }
      else                          { push @consonants, $char }
   }
   return (\@consonants, \@vowels);
} ## end sub _consonants_and_vowels

 view release on metacpan or  search on metacpan

lib/Venus/Range.pm  view on Meta::CPAN

=head2 split

  split(number $index) (tuple[arrayref, arrayref])

The split method splits the elements into two sets of elements at the index
specific and returns a tuple of two arrayrefs. The first arrayref will include
everything L<"before"|/before> the index provided, and the second tuple will
include everything L<"after"|/after> the index provided. This operation will
always exclude the element at the index the elements are split on. See
L</partition> for an inclusive split operation.

 view release on metacpan or  search on metacpan

Parser/VParseBison.y  view on Meta::CPAN

fexprLvalue<str>:		// For use as first part of statement (disambiguates <=)
		BISONPRE_COPY(exprLvalue,{s/~f~/f/g})	// {copied}
	;

exprScope<str>:			// scope and variable for use to inside an expression
	// 			// Here we've split method_call_root | implicit_class_handle | class_scope | package_scope
	//			// from the object being called and let expr's "." deal with resolving it.
	//			// (note method_call_root was simplified to require a primary in 1800-2009)
	//
	//			// IEEE: [ implicit_class_handle . | class_scope | package_scope ] hierarchical_identifier select
	//			// Or method_call_body without parenthesis