view release on metacpan or search on metacpan
lib/CPAN/InGit/MutableTree.pm view on Meta::CPAN
sub set_path($self, $path, $data, %opts) {
# Two modes: we can be writing to the working directory and index, or be building a new tree
# (which may or may not be connected to a branch)
my $repo= $self->git_repo;
my $mode= $opts{mode} // 0100644;
my @path= split m{/+}, $path;
my $basename= pop @path;
if ($self->use_workdir) {
my $fullpath= $self->git_repo->workdir;
# create missing directories
for (@path) {
view release on metacpan or search on metacpan
t/lib/Local/localserver.pm view on Meta::CPAN
require HTTP::Status;
my $d = HTTP::Daemon->new( LocalPort => $port ) or exit;
CONNECTION: while (my $c = $d->accept) {
REQUEST: while (my $r = $c->get_request) {
my $file = (split m|/|, $r->uri->path)[-1] // 'index.html';
my $path = catfile 't', 'html', $file;
if ($r->method eq 'GET') {
if( -e $path ) {
$c->send_file_response( catfile 't', 'html', $file);
view release on metacpan or search on metacpan
lib/CPAN/Mini/Live.pm view on Meta::CPAN
my ($uri) = $body =~ /href="(.+?)"/;
my $path = $uri;
my $remote = $self->{remote};
$path =~ s/^$remote//;
my $local_file
= File::Spec->catfile( $self->{local}, split m{/}, $path );
$self->trace("live [$action] [$path]\n");
if ( $action eq 'mirror_file' ) {
$self->mirror_file($path);
} elsif ( $action eq 'clean_file' ) {
view release on metacpan or search on metacpan
lib/CPAN/Mini.pm view on Meta::CPAN
my $self = shift;
$self->_make_index_dirs($self->_scratch_dir);
for my $path ($self->_fixed_mirrors) {
my $local_file = File::Spec->catfile($self->{local}, split m{/}, $path);
my $scratch_file = File::Spec->catfile(
$self->_scratch_dir,
split(m{/}, $path),
);
lib/CPAN/Mini.pm view on Meta::CPAN
$self->{dirmode},
$self->{log_level} eq 'debug',
);
for my $file ($self->_fixed_mirrors) {
my $local_file = File::Spec->catfile($self->{local}, split m{/}, $file);
unlink $local_file;
File::Copy::copy(
File::Spec->catfile($self->_scratch_dir, split m{/}, $file),
$local_file,
);
$self->{mirrored}{$local_file} = 1;
}
lib/CPAN/Mini.pm view on Meta::CPAN
: URI->new_abs($path, $self->{remote})->as_string;
# native absolute file
my $local_file = File::Spec->catfile(
$arg->{to_scratch} ? $self->_scratch_dir : $self->{local},
split m{/}, $path
);
my $checksum_might_be_up_to_date = 1;
if ($skip_if_present and -f $local_file) {
view release on metacpan or search on metacpan
lib/CPAN/Mirror/Server/HTTP.pm view on Meta::CPAN
}
my $parent;
{
my @segs = split m#/#, $uri->path;
if ( scalar @segs ) {
pop @segs;
if ( grep { $_ } @segs ) {
$parent = join('/', @segs);
}
view release on metacpan or search on metacpan
lib/CPAN/PackageDetails.pm view on Meta::CPAN
my @missing;
my( $entries ) = $packages->as_unique_sorted_list;
foreach my $entry ( @$entries ) {
my $path = $entry->path;
my $native_path = catfile( $cpan_path, split m|/|, $path );
push @missing, $path unless -e $native_path;
}
return \@missing;
lib/CPAN/PackageDetails.pm view on Meta::CPAN
my( $entries ) = $packages->as_unique_sorted_list;
foreach my $entry ( @$entries ) {
my $path = $entry->path;
my $native_path = catfile( $cpan_path, split m|/|, $path );
delete $files{$native_path};
}
[ keys %files ];
}
view release on metacpan or search on metacpan
lib/CPAN/Packager/Builder/RPM/Spec.pm view on Meta::CPAN
$noarch = 0 if grep {/\.(xs|c|cc|C)$/} @files;
}
my %prefixes;
foreach (@files) {
my @path_components = split m[/], $_;
$prefixes{ $path_components[0] }++;
if ( $path_components[-1] eq 'META.yml' ) {
my $tar = new Archive::Tar;
$tar->read( "$tmpdir/$tarball", 1 );
view release on metacpan or search on metacpan
lib/CPAN/Perl/Releases.pm view on Meta::CPAN
my $lvers;
{
my $tvers = $vers;
$tvers =~ s!\-?(TRIAL|RC)\d*!!g;
$tvers =~ s!_!.!g;
my @parts = split m!\.!, $tvers;
push @parts, 0 if scalar @parts < 3;
$lvers = sprintf("%d.%03d%03d",@parts);
}
my $foo = { };
$foo->{'tar.gz'} = "$path/$perl.tar.gz" unless $onlybz2;
view release on metacpan or search on metacpan
lib/CPAN/Recent/Uploads.pm view on Meta::CPAN
next RECENT unless $recent->{path} =~ /\.(tar\.gz|tgz|tar\.bz2|zip)$/;
if ( $recent->{type} eq 'new' ) {
( my $bar = $recent->{path} ) =~ s#^id/##;
next RECENT if $recent->{epoch} < $epoch;
{
my @parts = split m!/!, $bar;
next RECENT if $parts[3] =~ m!Perl6!i;
}
$data{ $bar } = $recent->{epoch};
}
else {
view release on metacpan or search on metacpan
t/06perms.t view on Meta::CPAN
$perms->set_perms( $module, $pauseid, $modules->{$module} );
}
}
my $content = $perms->generate_content;
my @lines = split m{\n}, $content;
my @expected
= ( 'Acme::Perms,FOOBAR,m', 'Baz::Qux,FOOBAR,f', 'Thing::One,BARFOO,c' );
is_deeply( [ @lines[ -3 .. -1 ] ], \@expected, 'rows are on newlines' );
view release on metacpan or search on metacpan
lib/CPAN/Site/Index.pm view on Meta::CPAN
$ua ||= LWP::UserAgent->new;
while(my $line = $fh->getline)
{ my ($pkg, $version, $dist) = split ' ', $line;
delete $need{$pkg} or next;
my $to = catfile $auth, split m#/#, $dist;
if(-f $to)
{ trace __x"package {pkg} present in distribution {dist}"
, pkg => $pkg, dist => $dist;
next;
}
view release on metacpan or search on metacpan
lib/CPAN/Testers/ParseReport.pm view on Meta::CPAN
s/GID:\s+\$\(/\$GID/
)
}
if (my($left,$right) = /^\s{4}(\S+)\s*=\s*(.*)$/) {
if ($left eq '$UID/$EUID') {
my($uid,$euid) = split m{\s*/\s*}, $right;
$extract{'env:$UID'} = $uid;
$extract{'env:$EUID'} = $euid;
} elsif ($left =~ /GID/) {
for my $xgid (uniq split " ", $right) {
$extract{"env:$left∋$xgid"} = "true";
view release on metacpan or search on metacpan
examples/scan-meta-files.pl view on Meta::CPAN
$dist{has_meta_yml} = -e 'META.yml' ? 1 : 0;
$dist{has_meta_json} = -e 'META.json' ? 1 : 0;
$dist{has_dist_ini} = -e 'dist.ini' ? 1 : 0;
$dist{distfile} = $job->{distfile};
($dist{author}) = split m{/}, $job->{distfile};
my ($data) = eval { YAML::Tiny->read('META.yml')->[0] };
if ($data) {
$dist{meta_spec} = eval { $data->{'meta-speak'}{version} };
$dist{meta_generator} = $data->{generated_by};
examples/scan-meta-files.pl view on Meta::CPAN
$dist{meta_gen_package} = $1;
$dist{meta_gen_version} = $2;
}
} else {
my $error = $@;
($error) = split m{$}m, $error;
$dist{meta_error} = $error;
}
$csv->print($csv_fh, [ @dist{ @cols } ]);
say "completed $total / $count";
view release on metacpan or search on metacpan
t/02_CPANPLUS-Dist-Build.t view on Meta::CPAN
sub find_module {
my $module = shift;
### Don't add the .pm yet, in case it's a packlist or something
### like ExtUtils::xsubpp.
my $file = File::Spec->catfile( split m/::/, $module );
my $candidate;
foreach (@INC) {
if (-e ($candidate = File::Spec->catfile($_, $file))
or
-e ($candidate = File::Spec->catfile($_, "$file.pm"))
view release on metacpan or search on metacpan
inc/bundle/File/Spec/OS2.pm view on Meta::CPAN
}
sub splitdir {
my ($self,$directories) = @_ ;
split m|[\\/]|, $directories, -1;
}
sub catpath {
my ($self,$volume,$directory,$file) = @_;
view release on metacpan or search on metacpan
t/10liftk.t view on Meta::CPAN
my $product;
$kmul->( 2, 3, sub { $product = shift } );
is( $product, 6, 'liftk on \&func' );
sub splitwords { split m/\s+/, $_[0] };
my $ksplitwords = liftk \&splitwords;
my @words;
$ksplitwords->( "my message here", sub { @words = @_ } );
view release on metacpan or search on metacpan
Compressor.pm view on Meta::CPAN
$RE_ALPHA_FILTER,
) = map +(
join '' => map m![a-zA-Z]!
? '['.ucfirst($_).lc($_).']'
: '\\'.$_,
split m//
) => qw[
background-position
moz-transform-origin
ms-transform-origin
o-transform-origin
view release on metacpan or search on metacpan
lib/CSS/Prepare.pm view on Meta::CPAN
my $stylesheet = basename( $file );
my $directory = dirname( $file );
my @blocks;
my $path;
foreach my $section ( split m{/}, $directory ) {
$path .= "${section}/";
my $target = "${base}${path}${stylesheet}";
my @file_blocks = $self->parse_file( $target );
push @blocks, @file_blocks
lib/CSS/Prepare.pm view on Meta::CPAN
my $stylesheet = basename( $file );
my $directory = dirname( $file );
my @blocks;
my $path;
foreach my $section ( split m{/}, $directory ) {
$path .= "${section}/";
my $target = "${base}${path}${stylesheet}";
my @file_blocks = $self->parse_url( $target );
push @blocks, @file_blocks
view release on metacpan or search on metacpan
ANSIColor.pm view on Meta::CPAN
sub _split_selector {
my ($self, $selector) = @_;
my @selector;
if ($selector =~ m/\s+/ms) {
@selector = split m/\s+/ms, $selector;
} else {
@selector = $selector;
}
my $ret_selector;
view release on metacpan or search on metacpan
lib/CTK/Plugin/File.pm view on Meta::CPAN
=item B<COUNT>
Current number of file in sequence (for fcopy and fmove methods)
For fsplit method please use perl mask %i
=item B<TIME>
Current time value (unix-time format, time())
view release on metacpan or search on metacpan
- parser.pm add branches rule in grammar
- cvs_current : add Branch report
- cvs_revbytag : new
0.09 Wed Sep 1 18:30:00 2004
- split module in 4
0.08 Tue Mar 30 18:30:00 2004
- add option -o (output)
- add a cache (.cvs_log.pl)
- add 2 new CGI scripts: cgi_cvs_evolq, cgi_cvs_evolr
view release on metacpan or search on metacpan
lib/Cache/Memcached/Managed.pm view on Meta::CPAN
my %result;
foreach my $cache ($self->data,$self->directory) {
foreach my $host ( $self->servers ) {
next unless exists $todo{$host} and not exists $result{$host};
$result{$host} = {
map {s#^STAT ##; split m#\s+#}
$self->_morelines( $cache,$host,"stats" )
};
}
}
view release on metacpan or search on metacpan
lib/Carp/Clan/Share.pm view on Meta::CPAN
shift @arguments; # Get rid of the package name
$caller =~ s/::Carp$//; # If the user already named it Carp, use the parent of that.
unshift @arguments, "^${caller}::";
my $package = "${caller}::Carp";
my $pm = join("/", split m/::/, $package) . ".pm";
$INC{$pm} = 1;
eval "package $package;";
my $exporter;
{
view release on metacpan or search on metacpan
lib/Catalyst/Action/REST.pm view on Meta::CPAN
# localise stuff so we can dispatch the action 'as normal, but get
# different stats shown, and different code run.
# Also get the full path for the action, and make it look like a forward
local $self->{code} = $code;
my @name = split m{/}, $self->reverse;
$name[-1] = $name;
local $self->{reverse} = "-> " . join('/', @name);
$c->execute( $self->class, $self, @{ $req->args } );
}
view release on metacpan or search on metacpan
t/live_http11_request_pipelined.t view on Meta::CPAN
last unless $n;
$pipebuf .= $buf2;
}
my $count = 2;
for my $resp ( split m{HTTP/1.1 200 OK}, $pipebuf ) {
next unless $resp;
$resp = 'HTTP/1.1 200 OK' . $resp;
my $response = HTTP::Response->parse($resp);
view release on metacpan or search on metacpan
my ($kind) = $href =~ m/\.([^.]+)$/;
if ($kind eq "js") {
push @content, SCRIPT({ type => "text/javascript", src => $href, _ => "" });
}
elsif ($kind =~ m/^css\b/) {
my ($type, $media) = split m/-/, $kind;
push @content, LINK({ rel => "stylesheet", type => "text/css", href => $href });
}
}
elsif (ref $_[0] eq "ARRAY") {
my ($kind, $content) = @{ shift() };
if ($kind eq "js") {
push @content, SCRIPT({ type => "text/javascript", _ => "\n$content" });
}
elsif ($kind =~ m/^css\b/) {
my ($type, $media) = split m/-/, $kind;
push @content, STYLE({ type => "text/css", _ => "\n$content" });
}
}
else {
die "Don't understand: @_";
view release on metacpan or search on metacpan
lib/Catalyst/Plugin/AutoCRUD/Controller/AJAX.pm view on Meta::CPAN
update => 'update_allowed',
'delete' => 'delete_allowed',
dumpmeta => 'dumpmeta_allowed',
dumpmeta_html => 'dumpmeta_allowed',
};
my $action = [split m{/}, $c->action]->[-1];
my $acl = $acl_for->{ $action } or return;
if ($c->stash->{cpac}->{c}->{$db}->{t}->{$table}->{$acl} ne 'yes') {
my $msg = "Access forbidden by configuration to [$site]->[$db]->[$table]->[$action]";
$c->log->debug($msg) if $c->debug;
view release on metacpan or search on metacpan
lib/Catalyst/Plugin/Flavour.pm view on Meta::CPAN
}
$c->flavour( Catalyst::Plugin::Flavour::Data->new );
$c->req->real_uri( $c->req->uri->clone );
my @path = split m!/+!, $c->req->path || '';
shift @path unless @path and $path[0];
push @path, '' if ( $c->req->path || '' ) =~ m!/$!;
my $config = $c->config->{flavour};
view release on metacpan or search on metacpan
lib/Catalyst/Plugin/I18N/PathPrefix.pm view on Meta::CPAN
my $valid_language_codes = $config->{_valid_language_codes};
my $req_path = $c->req->path;
if ($req_path !~ $config->{language_independent_paths}) {
my ($prefix, $path) = split m{/}, $req_path, 2;
$prefix = lc $prefix if defined $prefix;
$path = '' if !defined $path;
if (defined $prefix && exists $valid_language_codes->{$prefix}) {
$language_code = $prefix;
view release on metacpan or search on metacpan
lib/Catalyst/Plugin/I18N/PathPrefixGeoIP.pm view on Meta::CPAN
my $valid_language_codes = $config->{_valid_language_codes};
my $req_path = $c->req->path;
if ($req_path !~ $config->{language_independent_paths}) {
my ($prefix, $path) = split m{/}, $req_path, 2;
$prefix = lc $prefix if defined $prefix;
$path = '' if !defined $path;
if (defined $prefix && exists $valid_language_codes->{$prefix}) {
$language_code = $prefix;