view release on metacpan or  search on metacpan

Hierarchy.pm  view on Meta::CPAN

    push @ancestors, '' if exists $hash->{''};

    # Special case the root.
    return @ancestors if $path eq '';

    my @parts = split m{\Q$self->{sep}}, $path;
    # Remove empty string at the front.
    my $current = '';
    unless (length $parts[0]) {
	shift @parts;
	$current .= $self->{sep};

 view release on metacpan or  search on metacpan

Makefile.PL  view on Meta::CPAN

        return $_[1];
    };
}

{
    map { my ($pk, $vr) = split m/\s/; build_requires $pk => $vr || 0 } grep { ! /^\s*#/ } split m/\n/, <<_END_;
Test::Most
Directory::Scratch
_END_

    map { my ($pk, $vr) = split m/\s/; requires $pk => $vr || 0 } grep { ! /^\s*#/ } split m/\n/, <<_END_;
BerkeleyDB
BerkeleyDB::Manager
Carp::Clan::Share
Data::TUID
Moose
Path::Class
_END_
}

if (-e 'inc/.author') {
    my $all_from = join '/', 'lib', split m/-/, name . '.pm';
    `perldoc -tF $all_from > README` if ! -e 'README' || (stat $all_from)[9] > (stat 'README')[9];
}

auto_install;

 view release on metacpan or  search on metacpan

lib/Data/Object/String.pm  view on Meta::CPAN

=head2 split

  split(RegexpRef $arg1, Num $arg2) : ArrayRef

The split method returns an arrayref by splitting on the argument.

=over 4

=item split example #1

 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

bench/benchmark.pl  view on Meta::CPAN

# Pure Perl implementation for comparison
sub pp_path_get {
    my ($data, $path) = @_;
    return $data if $path eq '';
    die "Invalid path" unless $path =~ s{^/}{};
    for my $p (split m{/}, $path, -1) {
        return undef unless ref $data;
        if (ref $data eq 'HASH') {
            return undef unless exists $data->{$p};
            $data = $data->{$p};
        } elsif (ref $data eq 'ARRAY') {

bench/benchmark.pl  view on Meta::CPAN

sub pp_path_exists {
    my ($data, $path) = @_;
    return 1 if $path eq '';
    die "Invalid path" unless $path =~ s{^/}{};
    for my $p (split m{/}, $path, -1) {
        return 0 unless ref $data;
        if (ref $data eq 'HASH') {
            return 0 unless exists $data->{$p};
            $data = $data->{$p};
        } elsif (ref $data eq 'ARRAY') {

bench/benchmark.pl  view on Meta::CPAN

sub pp_path_set {
    my ($data, $path, $value) = @_;
    die "Cannot set root" if $path eq '';
    die "Invalid path" unless $path =~ s{^/}{};
    my @parts = split m{/}, $path, -1;
    my $last = pop @parts;
    for my $p (@parts) {
        if (ref $data eq 'HASH') {
            $data->{$p} //= {};
            $data = $data->{$p};

 view release on metacpan or  search on metacpan

lib/Data/PcAxis.pm  view on Meta::CPAN

    close $fh;

    # join broken lines (e.g. TITLE="...Very Long"\n"Title")
    $meta =~ s/""/ /g;

    # split metadata string into array
    my @meta = split ';;', $meta;

    # initialise Text::CSV objects for parsing options and values
    my $csv_opt = Text::CSV->new({binary=>1}) or die Text::CSV->error_diag();
    my $csv_val = Text::CSV->new({binary=>1}) or die Text::CSV->error_diag();

 view release on metacpan or  search on metacpan

Peek.pm  view on Meta::CPAN

    return $dump;
    } # _DDump

sub DDump {
    my $down = @_ > 1 ? $_[1] : 0;
    my @dump = split m/[\r\n]+/, _DDump (@_ ? $_[0] : $_, wantarray || $down) or return;

    if (wantarray) {
	my %hash;
	($hash{'sv'} = $dump[0]) =~ s/^SV\s*=\s*//;
	m/^\s+(\w+)\s*=\s*(.*)/ and $hash{$1} = $2 for @dump;

	if (exists $hash{'FLAGS'}) {
	    $hash{'FLAGS'} =~ tr/()//d;
	    $hash{'FLAGS'} = { map {( $_ => 1 )} split m/,/ => $hash{'FLAGS'} };
	    }

	$down && ref $_[0] and
	    $hash{'RV'} = _DDump_ref ($_[0], $down - 1) || $_[0];
	return %hash;

 view release on metacpan or  search on metacpan

Makefile.PL  view on Meta::CPAN

        return $_[1];
    };
}

{
    map { my ($pk, $vr) = split m/\s/; build_requires $pk => $vr || 0 } grep { ! /^\s*#/ } split m/\n/, <<_END_;
Test::Most
_END_

    map { my ($pk, $vr) = split m/\s/; requires $pk => $vr || 0 } grep { ! /^\s*#/ } split m/\n/, <<_END_;
Carp::Clan::Share
List::Enumerator
Moose
MooseX::AttributeHelpers
Scalar::Util
_END_
}

if (-e 'inc/.author') {
    my $all_from = join '/', 'lib', split m/-/, name . '.pm';
    `perldoc -tF $all_from > README` if ! -e 'README' || (stat $all_from)[9] > (stat 'README')[9];
}


auto_install;

 view release on metacpan or  search on metacpan

t/lib/Test/RxTester.pm  view on Meta::CPAN

      my $input  = $self->_decode_json("[ $test_spec->{input} ]")->[0];

      my $method = @{ $test_spec->{errors} } ? 'assert_fail' : 'assert_pass';

      TODO: {
        my ($source, $entry) = split m{/}, $test_name, 2;
        my $reason = fudge_reason($spec_name, $source, $entry);

        local our $TODO = $reason if $reason;
        $self->$method({
          schema      => $schema,

 view release on metacpan or  search on metacpan

lib/Data/SCS/DefParser.pm  view on Meta::CPAN

method include_file ($file) {
  $archive_has_entry{$file} or croak
    sprintf "Couldn't find file '%s' in: %s", $file, join ", ", @mounts;
  my $inc = $archive->read_entry($file);
  utf8::decode($inc);
  my @inc = grep {$_} map {trim $_} split m/\n/, $inc;
  return @inc;
}


method parse_sii ($file) {
  utf8::decode my $sii = $archive->read_entry($file);
  my ($magic, $unit) = parse_block $sii;
  $magic =~ m/^ \N{ BYTE ORDER MARK }? SiiNunit $/x or die
    sprintf "Expected SiiNunit, found '%s' in %s", $magic, $file;
  my @input = grep {$_} map {trim $_} split m/\n/, $unit;
  my @lines;
  while (my $line = shift @input) {
    if (my ($inc) = $line =~ m/^\@include\s+"([^"]+)"$/) {
      my $inc_path = path("/$file")->parent->relative("/")->child($inc);
      unshift @input, $self->include_file($inc_path);

lib/Data/SCS/DefParser.pm  view on Meta::CPAN

    return 'Inf' if lc $1 eq '7f7fffff';  # max finite value / no data marker
    return sprintf '%.9g', unpack 'f', pack 'h8', scalar reverse $1;
    # 9 significant digits are sufficient to represent any 32-bit float.
  }
  if ( $value =~ m/^\(([^()]+)\)$/ ) {
    return join ', ', map { parse_sui_data_value( trim $_ ) } split m/,/, $1;
  }
  if ( $value =~ m/^"([^"]+)"$/ ) {
    my $str = $1 =~ s{ \\x( [0-9A-Fa-f]{2} ) }{ chr hex $1 }egrx;
    utf8::decode $str;
    return $str;

lib/Data/SCS/DefParser.pm  view on Meta::CPAN

      $key = undef;
      $block--;
      next;
    }
    if ($block && $lines[$i] !~ m/"/ && $lines[$i] =~ m/:/) {  # parse Reforma one-liners
      push @raw, split m/(?<=[a-z])\s+/, $lines[$i];
      next;
    }
    if ($block) {
      push @raw, $lines[$i];
      next;

 view release on metacpan or  search on metacpan

Changes  view on Meta::CPAN

0.32    2014-12-10  Released-By: PERLANCAR

	- No functional changes.

	- Use new name of renamed/split module SHARYANTO::String::Util ->
	  String::LineNumber & String::Indent.


0.31     2014-11-07  Released-By: PERLANCAR

 view release on metacpan or  search on metacpan

lib/Data/Show.pm  view on Meta::CPAN

    # Any 'to' arg must be a filehandle, filename, or scalar ref (and open it if necessary)...
    $opt{to} = _open_target( $opt{to} // $DEFAULT_TARGET, $file, $line, $opt{warnings} ne 'off' );

    # Unpack fallback arguments into an arrayref...
    $opt{fallback} = [ split m{ \s*,\s* }x, $opt{fallback} ];

    # Resolve style options according to terminal background (i.e. dark or light)
    for my $option (@opt{ grep /\A.+style\z/, keys %opt}) {
        $option = [split /\s*,\s*/, $option]->[$IS_LIGHT_BG ? -1 : 0];
    }

 view release on metacpan or  search on metacpan

lib/Data/Table/Text.pm  view on Meta::CPAN

sub removeDuplicatePrefixes($)                                                  # Remove duplicated leading directory names from a file name.
 {my ($file) = @_;                                                              # File name
  return $file unless $file =~ m(/)s;                                           # No path to deduplicate
  return $file if $file =~ m(\A[/.]);                                           # Later
  my ($p, @p) = split m(/), $file;
  shift @p while @p && $p[0] eq $p;
  join "/", $p, @p;
 } # removeDuplicatePrefixes

sub containingFolderName($)                                                     # The name of a folder containing a file.
 {my ($file) = @_;                                                              # File name
  my @p = split m(/), $file;
  return $p[-2] if @p > 1;
  confess "No folder name provided";
 } # containingFolderName
#D2 Position                                                                    # Position in the file system.

lib/Data/Table/Text.pm  view on Meta::CPAN

 {renormalizeFolderName(getcwd)
 } # currentDirectory

sub currentDirectoryAbove                                                       # Get the path to the folder above the current working folder.
 {my $path = currentDirectory;
  my @path = split m(/)s, $path;
  shift @path if @path and $path[0] =~ m/\A\s*\Z/;
  @path or confess "No directory above\n:".currentDirectory, "\n";
  pop @path;
  my $r = shift @path;
  filePathDir("/$r", @path);

lib/Data/Table/Text.pm  view on Meta::CPAN

sub hashifyFolderStructure(@)                                                   # Hashify a list of file names to get the corresponding folder structure.
 {my (@files) = @_;                                                             # File names
  my %h;
  for my $f(@files)                                                             # Map each file
   {my @f = split m(/), $f;
    my $s = join '', map {q({).dump($_).q(})} @f;                               # Hashify directory structure
    my $c = "\$h$s = ".dump($f);                                                # Load targets
    eval $c;
    confess $@ if $@;
   }

lib/Data/Table/Text.pm  view on Meta::CPAN

  if ($r =~ m(syntax OK)si)
   {my $t = fpf(q(/usr/lib/cgi-bin/), $file);
    say STDERR qx(sudo mv $s $t; chmod o+rx $t);
   }
  else
   {my @data = map {[$_]} split m/\n/, $data;
    say STDERR formatTable([@data]);
    confess "Perl error:\n$r\n";
   }
  unlink $s;
 }

lib/Data/Table/Text.pm  view on Meta::CPAN

 }

sub nameFromFolder($)                                                           # Create a name from the last folder in the path of a file name.  Return undef if the file does not have a path.
 {my ($file) = @_;                                                              # File name
  my $p = fp $file;
  my @p = onWindows ? split m(\\), $p : split m(/), $p;
  return $p[-1] if @p;
  undef
 }

sub copyBinaryFile($$)                                                          # Copy the binary file B<$source> to a file named <%target> and return the target file name,.

lib/Data/Table/Text.pm  view on Meta::CPAN

  my %paths;                                                                    # Path to each character in each string
  my %sizes;                                                                    # Size associate with each path
  for my $string(sort keys %Sizes)                                              # Create a path of hashes with single character keys
   {my $size = $Sizes{$string};                                                 # Size associated with the string
    my $paths = '';
    my @s = split m(), $string;                                                 # String as single characters
    while(@s)                                                                   # Shorten path
     {my $k = join '', map {qq({'$_'})} @s;                                     # Path of hashes with single character keys
      $paths .= qq(\$paths$k //= {};\n);                                        # Auto vivify
      my $d =  join '', @s;                                                     # Path name
      $sizes{$d} += $size;                                                      # Aggregate size

lib/Data/Table/Text.pm  view on Meta::CPAN

   {return (undef, undef) unless defined $columnTitles;                         # No titles
    if (my $r = reftype $columnTitles)                                          # Array of column titles
     {return (undef, $columnTitles) if $r =~ m(\Aarray\Z)si;
     }
    return (q(), q()) unless $columnTitles;                                     # Column titles are not required for hash of hashes
    my @c = map {[split m(\s+), $_, 2]} split "\n", $columnTitles;              # Column definitions
    my $s = &formatTable(\@c, [qw(Column Description)]);                        # Column definitions descriptions table
   ($s, [map {$$_[0]} @c])
   }->();

  my ($a, $h, $o) = (0, 0, 0);                                                  # Check structure of input data tttt

lib/Data/Table/Text.pm  view on Meta::CPAN

  if (my $columns = $options{columns})                                          # Column headers
   {ref($columns) and confess <<END;                                            # Describe column option
Expected one line per column wiith the forst weor dbeing teh column name and
the remainder being a comment describing the comment.
END
    my @c = map {[split m(\s+), $_, 2]} split "\n", $columns;                   # Parse column headers
    $cl = join '', q(<tr><th>), join q(<th>),
      map {my ($c, $d) = @$_; qq(<span title="$d">$c</span>)} @c;               # Column line with tool tips
    $ct = join "\n", q(<p><pre>), formatTableBasic([@c]), qq(</pre></p>\n);     # Column format
   }

lib/Data/Table/Text.pm  view on Meta::CPAN

  sha256_hex $string;                                                           # Sha256 of string assuming it is ascii only
 }

sub indentString($$)                                                            # Indent lines contained in a string or formatted table by the specified string.
 {my ($string, $indent) = @_;                                                   # The string of lines to indent, the indenting string
  join "\n", map {$indent.$_} split m(\n+), (ref($string) ? $$string  : $string)
 }

sub replaceStringWithString($$$)                                                # Replace all instances in B<$string> of B<$source> with B<$target>.
 {my ($string, $source, $target) = @_;                                          # String in which to replace substrings, the string to be replaced, the replacement string
  for(1..(1+length($string) / (length($source)+1)))                             # Avoid too much recursive expansion

lib/Data/Table/Text.pm  view on Meta::CPAN

      last if $s eq $string;
     }
   }

  my @f;
  my @w = split m/\s+/, $string;                                                # Parse string into words
  for my $w(@w)                                                                 # Bold B<string>
   {if (!$f[-1]) {push @f, $w}
    else
     {my $l = $f[-1].qq( $w);
      if (length($l) > $width)

lib/Data/Table/Text.pm  view on Meta::CPAN

  my $accept = sub                                                              # Accept a word or string
   {push @r, $r; $s = 0;
   };

  for my $c(split m//, $string)                                                 # Each character in the string
   {next if $s == 0 and $c =~ m(\s);                                            # Skip spaces while looking for a word or string

    if ($s == 0)                                                                # String
     {if    ($c =~ m('))                                                        # Single quoted ' string
       {$r = ''; $s = 2;

lib/Data/Table/Text.pm  view on Meta::CPAN

 {my ($folderOrFile, %options) = @_;                                            # Source on S3 - which will be truncated to a folder name, options
  my ($bucket, $folder) = parseS3BucketAndFolderName($folderOrFile);            # Parse an L<s3> bucket/folder name into a bucket and a folder name removing any initial s3://.
  my $profile = s3Profile(%options);                                            # Add profile if specified
  my $getCmd  = qq(aws s3 ls s3://$bucket/$folder $profile --recursive);        # Command to get the sizes of the files to download
  my $files   = qx($getCmd);                                                    # Get the sizes of the files to download
  my @files   = map {my @a = split m/\s+/, $_, 4; [@a[-1, -2, 0, 1]]}           # Files and sizes
                split m/\n/, $files;
  {map {q(s3://).fpf($bucket, $$_[0]) => $_} @files}                            # Hash {file=>[name, size, modified date, modified time]}
 }

sub s3FileExists($%)                                                            # Return (name, size, date, time) for a B<$file> that exists on S3 else () using the specified B<%options> if any.
 {my ($file, %options) = @_;                                                    # File on S3 - which will be truncated to a folder name, options

lib/Data/Table/Text.pm  view on Meta::CPAN

  my $dir   = $options{target}  // fpd qw(lib Silicon Chip);                    # Target folder for images
  my $imgs  = fpd $home, $dir;                                                  # Images source folder
     $imgs  = $home if $ENV{GITHUB_TOKEN};                                      # Change folders for github
  my $svg   = fpd $imgs, qw(svg);                                               # Svg folder
  my $png   = fpd $imgs, qw(png);                                               # Png folder
  my ($user, $repo) =  split m(/), $ENV{GITHUB_REPOSITORY}//'';                 # Userid and repo from github

  makePath($png);                                                               # Make png folder

  my @f = searchDirectoryTreesForMatchingFiles $svg, qw(.svg);                  # Svg files from which we make png files

lib/Data/Table/Text.pm  view on Meta::CPAN

  my $profile = $Profile ? qq( --profile $Profile) : q();                       # Add profile if specified
  $options  //= q();                                                            # Default options

  my $getCmd  = qq(aws s3 ls s3://$bucket/$folder $profile --recursive);        # Command to get the sizes of the files to download
  my $files   = qx($getCmd);                                                    # Get the sizes of the files to download
  my @files   = map {my @a = split m/\s+/, $_, 4; [@a[-1, -2]]}                 # Files and sizes
                split m/\n/, $files;
  return unless @files;                                                         # No files to download

  call sub                                                                      # Partition likely to cause a lot of memory fragmentation
   {my %partition = partitionStringsOnPrefixBySize($maxSize, map {@$_} @files); # Partition the download into collections no larger than the specified size

lib/Data/Table/Text.pm  view on Meta::CPAN

  if ($rest =~ m(\A\./)s)                                                       # File#./id
   {return ($file, $TopicId || q(), $rest =~ s(\A\./) ()r)
   }

  my ($topicId, $id) = split m(/), $rest, 2;
  $topicId = $topicId || $TopicId || q();
  $topicId = $TopicId if $TopicId and $topicId =~ m(\A(\s*|\.)\Z);
  $id    ||= q();

  ($file, $topicId, $id)

lib/Data/Table/Text.pm  view on Meta::CPAN

sub expandWellKnownWordsAsUrlsInMdFormat($)                                     # Expand words found in a string using the md url to supply a definition of that word.
 {my ($string)  = @_;                                                           # String containing url names to expand
  my $wellKnown = wellKnownUrls;                                                # Well known urls to expand

  my @s = split m/```/, $string;                                                # Separate code from text
  my $i = 0;

  for my $s(@s)
   {next  unless ++$i % 2;                                                      # Code is in odd sections
    for my $w(sort keys %$wellKnown)                                            # Expand well known words (lowercased) as html links

lib/Data/Table/Text.pm  view on Meta::CPAN

     {my $text = shift @text;

      if ($text =~ m(\A\s*def\s+(.*?)\((.*?)\)\s*:.*?#(\w*)\s+(.*))i)           # Def  function(parameter1 =1, parameter2 = 2) :  # first, second
       {my ($def, $parameters, $attributes, $parameterDefinitions) = @{^CAPTURE};

        my @p = split m/\s*,\s*/, $parameters;
        my @d = split m/\s*,\s*/, $parameterDefinitions;
        my $p = @p; my $d = @d;
        if ($p != $d)
         {my $l = currentLine;
          error qq(Number of parameters specified: $d does not equal),
                qq(number of parameters documented: $d on line: $l)

lib/Data/Table/Text.pm  view on Meta::CPAN

       }
      elsif ($text =~ m(\A\s*def\s+(.*?)\((.*?)\)\s*:)i)                        # Def  function(parameter1 =1, parameter2 = 2) :
       {my ($def, $parameters) = @{^CAPTURE};
        my $doc = $comments{$class}{$def} = getDocString;

        my @p = split m/\s*,\s*/, $parameters;                                  # Parameters defined by a Python subroutine
        my %p;

        for my $line(split m/\n/, $doc)                                         # Check for parameter definitions
         {if ($line =~ m(\A\s*:\s*param\s*(.*?)\s*:\s*(.*?)\s*\Z))
           {my ($parm, $comment) = @{^CAPTURE};
            push $parameters{$class}{$def}->@*, [$parm, $comment];
            $parm =~ s(\A\s*(bool|str)\s*) ()s;                                 # Remove parameter type when present to get parameter name
            $p{$parm} = $comment;

lib/Data/Table/Text.pm  view on Meta::CPAN

     [summarizeColumn([map {[$_]} qw(A B D B C D C D A C D C B B D)], 0)],  # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲

     [[5, "D"], [4, "B"], [4, "C"], [2, "A"]];

    ok nws(formatTable
     ([map {[split m//, $_]} qw(AA CB CD BC DC DD CD AD AA DC CD CC BB BB BD)],
      [qw(Col-1 Col-2)],
       summarize=>1)) eq nws(<<'END');

  Summary_of_column                - Count of unique values found in each column                     Use the Geany flick capability by placing your cursor on the first word
  Comma_Separated_Values_of_column - Comma separated list of the unique values found in each column  of these lines and pressing control + down arrow to see each sub report.

lib/Data/Table/Text.pm  view on Meta::CPAN

  createEmptyFile($f);                                                          #TcheckFile
  ok matchPath($d) eq $d;                                                       #TmatchPath
  ok  eval{checkFile($d)};                                                      #TcheckFile
  ok  eval{checkFile($f)};                                                      #TcheckFile
  ok !eval {checkFile($F)};
  my @m = split m/\n/, $@;
  ok $m[1] eq prefferedFileName "a/b/c/";
  unlink $f;
  ok !-e $f;
  while(@d)                                                                     # Remove path
   {my $d = filePathDir(@d);

lib/Data/Table/Text.pm  view on Meta::CPAN

  is_deeply
   [summarizeColumn([map {[$_]} qw(A B D B C D C D A C D C B B D)], 0)],
   [[5, "D"], [4, "B"], [4, "C"], [2, "A"]];

  ok nws(formatTable
   ([map {[split m//, $_]} qw(AA CB CD BC DC DD CD AD AA DC CD CC BB BB BD)],
    [qw(Col-1 Col-2)],
     summarize=>1)) eq nws(<<'END');

Summary_of_column                - Count of unique values found in each column                     Use the Geany flick capability by placing your cursor on the first word
Comma_Separated_Values_of_column - Comma separated list of the unique values found in each column  of these lines and pressing control + down arrow to see each sub report.

 view release on metacpan or  search on metacpan

lib/Data/Tubes/Plugin/Parser.pm  view on Meta::CPAN

   my $format = $args{format};
   LOGDIE "parser of type 'format' needs a definition"
     unless defined $format;

   my @items = split m{(\W+)}, $format;
   return parse_single(key => $items[0]) if @items == 1;

   my ($keys, $separators) = unzip(\@items);

   # all keys MUST be different, otherwise some fields are just trumping

 view release on metacpan or  search on metacpan

Changes  view on Meta::CPAN

        - No functional changes.

        - Use new name of renamed module SHARYANTO::Number::Util to
          Number::Format::Metric, fix Rinci metadata. Use the new renamed module
          SHARYANTO::Package::Util -> Package::MoreUtil. Use new split module
          SHARYANTO::String::Util -> String::Pad.


1.47    2014-06-12  Released-By: SHARYANTO

 view release on metacpan or  search on metacpan

lib/Data/Validate/Sanctions/Fetcher.pm  view on Meta::CPAN

                my @other_names;
                push @other_names, $other_names_raw if $other_names_raw && $other_names_raw ne '-';

                my @passports;
                @passports = map { trim($_) } split m{/}, $passport_raw if $passport_raw && $passport_raw ne '-';

                my @ids;
                push @ids, $id_number if $id_number && $id_number ne '-';

                _process_sanction_entry(

 view release on metacpan or  search on metacpan

lib/Data/Validation.pm  view on Meta::CPAN

   my $label = $self->fields->{ $id }->{label} // $id;

   for my $methods (grep { $_ ne 'compare' } $_get_methods->( $valids )) {
      my @fails;

      for my $method (split m{ [|] }mx, $methods) {
         my $constraint = Data::Validation::Constraints->new_from_method
            ( { %{ $params }, method => $method, } );
        (my $class = $method) =~ s{ \A is }{}mx;

         if ($constraint->validate( $v )) { @fails = (); last }

 view release on metacpan or  search on metacpan

t/50-fs.t  view on Meta::CPAN

	while (defined (my $x= $iter->())) {
		push @actual, $x->resolved_canonical_path;
		$iter->skip_dir
			if @{$x->path_dirents} >= 6 && $x->type eq 'dir';
	}
	@expected= grep { (split m|/|, $_) <= 6 } @expected;
	is_deeply( \@actual, \@expected, 'iteration skipped properly' )
		or diag "Expected: ".join(' ', @expected)."\nActual: ".join(' ', @actual);
	
	done_testing;
};

 view release on metacpan or  search on metacpan

lib/Date/Holidays/EnglandWales.pm  view on Meta::CPAN

sub is_holiday { goto &is_uk_holiday; }

sub is_uk_holiday {
    my ($year, $month, $day) = @_;
    ($year, $month, $day) = split m{[-/]}, $year unless $month;
    
    my $dt = DateTime->new(year => $year, month => $month, day => $day)
        or die "Failed to create DateTime object for $year-$month-$day"
            . " - invalid date?";

 view release on metacpan or  search on metacpan

internal/unicode  view on Meta::CPAN

    my $word = shift;

    my %total_code_points_by;
    my $blocks = '';

    for my $character (split m//, $word) {
        my $block = charblock(ord $character);

        $total_code_points_by{$block}++;
    }

 view release on metacpan or  search on metacpan

t/01-parse.t  view on Meta::CPAN

test_date_parser($parser, $_) foreach (split "\n", $fixtures);

sub test_date_parser {
    my($parser, $fixture) = @_;

    my($date, $string) = split m{\s*:\s*}, $fixture, 2;
    my($d, $m, $y) = split m{\s*/\s*}, $date;
    $parser->parse($string);
    if($parser->parsed) {
        ok($date ne '', "parsed, as expected: $string");
        is($parser->day, $d, "Extracted day '$d': $string");
        is($parser->month, $m, "Extracted month '$m': $string");

 view release on metacpan or  search on metacpan

t/lib/helper.pm  view on Meta::CPAN

    {
        my ( $line ) = $_ =~ m{([^\n]+)};
        next if not $line;
        next if $line =~ m{\A\#}mx; # skip comments
        next if $line =~ m{\A\z}mx; # skip blank lines
        my ( $given , $wanted , $tz ) = split m{\s+=>\s+}mx , $line;
        compare( $given , $wanted , $tz, $opts );
    }
}

sub run_tests_time_parse_date

 view release on metacpan or  search on metacpan

lib/DateTime/TimeZone/ICal/Parsing.pm  view on Meta::CPAN

    FLOAT        => sub {
        my ($x) = ($_[1] =~ /^\s*([+-]?\d+(?:\.\d+))\s*$/); $x },
    INTEGER      => sub {
        my ($x) = ($_[1] =~ /^\s*([+-]?\d+)\s*$/); $x },
    PERIOD       => sub {
        my ($start, $end) = split m!\s*/+\s*!, $_[1];
        $start = DateTime::Format::ICal->parse_datetime($start);
        if ($end =~ /^[Pp]/) {
            $end = DateTime::Format::ICal->parse_duration($end);
            $end = $start + $end;
        }

 view release on metacpan or  search on metacpan

t/03-parse.t  view on Meta::CPAN

use DateTimeX::Easy;

my $yyy = (localtime(time))[5] + 1900;

for (split m/\n/, <<_END_) {
1994-06-16T07:29:35 @ -0600 | Wed, 16 Jun 94 07:29:35 CST
1994-10-13T10:13:13 @ -0700 | Thu, 13 Oct 94 10:13:13 -0700
1994-11-09T09:50:32 @ -0500 | Wed, 9 Nov 1994 09:50:32 -0500 (EST)
$yyy-12-21T17:05:00 | 21 dec 17:05
$yyy-12-21T17:05:00 | 21-dec 17:05

t/03-parse.t  view on Meta::CPAN

1993-12-21T17:05:00 | 21/dec/93 17:05
1999-01-01T10:02:18 | 1999 10:02:18 "GMT"
1994-11-16T22:28:20 @ -0800 | 16 Nov 94 22:28:20 PST
_END_
    next if m/^\s*#/;
    my ($want, $from) = split m/\s*\|\s*/, $_, 2;
    my ($want_dt, $want_tz) = split m/\s*\@\s*/, $want, 2;
    $want_tz ||= "+0000";

    my $dt = DateTimeX::Easy->new($from);
    is($dt, $want_dt);
    is($dt->strftime(q{%z}), $want_tz);

 view release on metacpan or  search on metacpan

lib/Decl/Template.pm  view on Meta::CPAN

sub parse_spanning_command {
   my $piece = shift;
   
   $piece =~ s/^[+\.] *//;
   split m[ +], $piece, 2;
}

=head2 handle_spanning_command

Given a parsed spanning command and the value object and valuator function to be used, express the command.  This is really just

 view release on metacpan or  search on metacpan

DC/Protocol.pm  view on Meta::CPAN

         if $changed;

      $self->have_tile ($face->{id}, delete $face->{data});

   } elsif ($face->{type} & 1) {
      # split metadata case, FT_MUSIC, FT_SOUND
      if ($changed) { # new data
         my ($meta, $data) = unpack "(w/a*)*", $face->{data};
         $face->{data} = $meta;

         # rely on strict ordering here and also on later fetch

 view release on metacpan or  search on metacpan

lib/Devel/Comments.pm  view on Meta::CPAN

#            - otherwise the variable is split on space or (space
#              surrounded) colons.
sub _handle_sc_env {
    my $env = shift;
    if ( $env !~ m{\A \s* 1 \s* \Z}xms ) {
        return [ split m{\s+|\s*:\s*}xms, $env ];
    }
    return [];
}

######## /_handle_sc_env ########

 view release on metacpan or  search on metacpan

lib/Devel/Cover/Report/OwnServer.pm  view on Meta::CPAN

   my ($branch) =  grep { m{ \A \* }mx } split "\n", $run->( 'git branch' );
       $branch  =~ s{ \A \* \s* }{}mx;
   my $remotes  =  [ map    { my ($name, $url) = split q( ), $_;
                              +{ name => $name, url => $url } }
                     split m{ \n }mx, $run->( 'git remote -v' ) ];

   return { author_name     => $run->( 'git log -1 --pretty=format:"%aN"' ),
            author_email    => $run->( 'git log -1 --pretty=format:"%ae"' ),
            branch          => $branch,
            commit          => $run->( 'git log -1 --pretty=format:"%H"' ),

 view release on metacpan or  search on metacpan

lib/Devel/Cover/DB.pm  view on Meta::CPAN

        }
      }
      # e.g.: count:1 | count:2,5 | count:1,4..7
      my $c = qr/\d+(?:\.\.\d+)?/;
      $count = $1 if $info =~ /count:($c(?:,$c)*)/;
      my @counts = map { m/^(\d+)\.\.(\d+)$/ ? ($1 .. $2) : $_ } split m/,/,
        $count;
      $class = $1 if $info =~ /class:(\w+)/;
      $note  = $1 if $info =~ /note:(.+)/;

      for my $c (@counts) {

 view release on metacpan or  search on metacpan

lib/Devel/CoverReport.pm  view on Meta::CPAN

    if (-d $basedir .q{/.svn}) {
        $vcs = 'SVN';
    }

    # Probe for Git
    my @dir_parts = split m{/}, $basedir;
    while (1) {
        my $tmp_path = join q{/}, @dir_parts, q{.git};

        if (-d $tmp_path) {
            $vcs = 'Git';