Initial Commit
This commit is contained in:
86
database/perl/vendor/lib/ExtUtils/Helpers/Unix.pm
vendored
Normal file
86
database/perl/vendor/lib/ExtUtils/Helpers/Unix.pm
vendored
Normal file
@@ -0,0 +1,86 @@
|
||||
package ExtUtils::Helpers::Unix;
|
||||
$ExtUtils::Helpers::Unix::VERSION = '0.026';
|
||||
use strict;
|
||||
use warnings FATAL => 'all';
|
||||
|
||||
use Exporter 5.57 'import';
|
||||
our @EXPORT = qw/make_executable detildefy/;
|
||||
|
||||
use Carp qw/croak/;
|
||||
use Config;
|
||||
|
||||
my $layer = $] >= 5.008001 ? ":raw" : "";
|
||||
|
||||
sub make_executable {
|
||||
my $filename = shift;
|
||||
my $current_mode = (stat $filename)[2] + 0;
|
||||
if (-T $filename) {
|
||||
open my $fh, "<$layer", $filename;
|
||||
my @lines = <$fh>;
|
||||
if (@lines and $lines[0] =~ s{ \A \#! \s* (?:/\S+/)? perl \b (.*) \z }{$Config{startperl}$1}xms) {
|
||||
open my $out, ">$layer", "$filename.new" or croak "Couldn't open $filename.new: $!";
|
||||
print $out @lines;
|
||||
close $out;
|
||||
rename $filename, "$filename.bak" or croak "Couldn't rename $filename to $filename.bak";
|
||||
rename "$filename.new", $filename or croak "Couldn't rename $filename.new to $filename";
|
||||
unlink "$filename.bak";
|
||||
}
|
||||
}
|
||||
chmod $current_mode | oct(111), $filename;
|
||||
return;
|
||||
}
|
||||
|
||||
sub detildefy {
|
||||
my $value = shift;
|
||||
# tilde with optional username
|
||||
for ($value) {
|
||||
s{ ^ ~ (?= /|$)} [ $ENV{HOME} || (getpwuid $>)[7] ]ex or # tilde without user name
|
||||
s{ ^ ~ ([^/]+) (?= /|$) } { (getpwnam $1)[7] || "~$1" }ex; # tilde with user name
|
||||
}
|
||||
return $value;
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
# ABSTRACT: Unix specific helper bits
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=encoding UTF-8
|
||||
|
||||
=head1 NAME
|
||||
|
||||
ExtUtils::Helpers::Unix - Unix specific helper bits
|
||||
|
||||
=head1 VERSION
|
||||
|
||||
version 0.026
|
||||
|
||||
=for Pod::Coverage make_executable
|
||||
split_like_shell
|
||||
detildefy
|
||||
|
||||
=head1 AUTHORS
|
||||
|
||||
=over 4
|
||||
|
||||
=item *
|
||||
|
||||
Ken Williams <kwilliams@cpan.org>
|
||||
|
||||
=item *
|
||||
|
||||
Leon Timmermans <leont@cpan.org>
|
||||
|
||||
=back
|
||||
|
||||
=head1 COPYRIGHT AND LICENSE
|
||||
|
||||
This software is copyright (c) 2004 by Ken Williams, Leon Timmermans.
|
||||
|
||||
This is free software; you can redistribute it and/or modify it under
|
||||
the same terms as the Perl 5 programming language system itself.
|
||||
|
||||
=cut
|
||||
117
database/perl/vendor/lib/ExtUtils/Helpers/VMS.pm
vendored
Normal file
117
database/perl/vendor/lib/ExtUtils/Helpers/VMS.pm
vendored
Normal file
@@ -0,0 +1,117 @@
|
||||
package ExtUtils::Helpers::VMS;
|
||||
$ExtUtils::Helpers::VMS::VERSION = '0.026';
|
||||
use strict;
|
||||
use warnings FATAL => 'all';
|
||||
|
||||
use Exporter 5.57 'import';
|
||||
our @EXPORT = qw/make_executable detildefy/;
|
||||
|
||||
use File::Copy qw/copy/;
|
||||
|
||||
sub make_executable {
|
||||
my $filename = shift;
|
||||
my $batchname = "$filename.com";
|
||||
copy($filename, $batchname);
|
||||
ExtUtils::Helpers::Unix::make_executable($batchname);
|
||||
return;
|
||||
}
|
||||
|
||||
sub detildefy {
|
||||
my $arg = shift;
|
||||
|
||||
# Apparently double ~ are not translated.
|
||||
return $arg if ($arg =~ /^~~/);
|
||||
|
||||
# Apparently ~ followed by whitespace are not translated.
|
||||
return $arg if ($arg =~ /^~ /);
|
||||
|
||||
if ($arg =~ /^~/) {
|
||||
my $spec = $arg;
|
||||
|
||||
# Remove the tilde
|
||||
$spec =~ s/^~//;
|
||||
|
||||
# Remove any slash following the tilde if present.
|
||||
$spec =~ s#^/##;
|
||||
|
||||
# break up the paths for the merge
|
||||
my $home = VMS::Filespec::unixify($ENV{HOME});
|
||||
|
||||
# In the default VMS mode, the trailing slash is present.
|
||||
# In Unix report mode it is not. The parsing logic assumes that
|
||||
# it is present.
|
||||
$home .= '/' unless $home =~ m#/$#;
|
||||
|
||||
# Trivial case of just ~ by it self
|
||||
if ($spec eq '') {
|
||||
$home =~ s#/$##;
|
||||
return $home;
|
||||
}
|
||||
|
||||
my ($hvol, $hdir, $hfile) = File::Spec::Unix->splitpath($home);
|
||||
if ($hdir eq '') {
|
||||
# Someone has tampered with $ENV{HOME}
|
||||
# So hfile is probably the directory since this should be
|
||||
# a path.
|
||||
$hdir = $hfile;
|
||||
}
|
||||
|
||||
my ($vol, $dir, $file) = File::Spec::Unix->splitpath($spec);
|
||||
|
||||
my @hdirs = File::Spec::Unix->splitdir($hdir);
|
||||
my @dirs = File::Spec::Unix->splitdir($dir);
|
||||
|
||||
unless ($arg =~ m#^~/#) {
|
||||
# There is a home directory after the tilde, but it will already
|
||||
# be present in in @hdirs so we need to remove it by from @dirs.
|
||||
|
||||
shift @dirs;
|
||||
}
|
||||
my $newdirs = File::Spec::Unix->catdir(@hdirs, @dirs);
|
||||
|
||||
$arg = File::Spec::Unix->catpath($hvol, $newdirs, $file);
|
||||
}
|
||||
return $arg;
|
||||
}
|
||||
|
||||
# ABSTRACT: VMS specific helper bits
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=encoding UTF-8
|
||||
|
||||
=head1 NAME
|
||||
|
||||
ExtUtils::Helpers::VMS - VMS specific helper bits
|
||||
|
||||
=head1 VERSION
|
||||
|
||||
version 0.026
|
||||
|
||||
=for Pod::Coverage make_executable
|
||||
detildefy
|
||||
|
||||
=head1 AUTHORS
|
||||
|
||||
=over 4
|
||||
|
||||
=item *
|
||||
|
||||
Ken Williams <kwilliams@cpan.org>
|
||||
|
||||
=item *
|
||||
|
||||
Leon Timmermans <leont@cpan.org>
|
||||
|
||||
=back
|
||||
|
||||
=head1 COPYRIGHT AND LICENSE
|
||||
|
||||
This software is copyright (c) 2004 by Ken Williams, Leon Timmermans.
|
||||
|
||||
This is free software; you can redistribute it and/or modify it under
|
||||
the same terms as the Perl 5 programming language system itself.
|
||||
|
||||
=cut
|
||||
70
database/perl/vendor/lib/ExtUtils/Helpers/Windows.pm
vendored
Normal file
70
database/perl/vendor/lib/ExtUtils/Helpers/Windows.pm
vendored
Normal file
@@ -0,0 +1,70 @@
|
||||
package ExtUtils::Helpers::Windows;
|
||||
$ExtUtils::Helpers::Windows::VERSION = '0.026';
|
||||
use strict;
|
||||
use warnings FATAL => 'all';
|
||||
|
||||
use Exporter 5.57 'import';
|
||||
our @EXPORT = qw/make_executable detildefy/;
|
||||
|
||||
use Config;
|
||||
use Carp qw/carp croak/;
|
||||
use ExtUtils::PL2Bat 'pl2bat';
|
||||
|
||||
sub make_executable {
|
||||
my $script = shift;
|
||||
if (-T $script && $script !~ / \. (?:bat|cmd) $ /x) {
|
||||
pl2bat(in => $script, update => 1);
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
sub detildefy {
|
||||
my $value = shift;
|
||||
$value =~ s{ ^ ~ (?= [/\\] | $ ) }[$ENV{USERPROFILE}]x if $ENV{USERPROFILE};
|
||||
return $value;
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
# ABSTRACT: Windows specific helper bits
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=encoding UTF-8
|
||||
|
||||
=head1 NAME
|
||||
|
||||
ExtUtils::Helpers::Windows - Windows specific helper bits
|
||||
|
||||
=head1 VERSION
|
||||
|
||||
version 0.026
|
||||
|
||||
=for Pod::Coverage make_executable
|
||||
split_like_shell
|
||||
detildefy
|
||||
|
||||
=head1 AUTHORS
|
||||
|
||||
=over 4
|
||||
|
||||
=item *
|
||||
|
||||
Ken Williams <kwilliams@cpan.org>
|
||||
|
||||
=item *
|
||||
|
||||
Leon Timmermans <leont@cpan.org>
|
||||
|
||||
=back
|
||||
|
||||
=head1 COPYRIGHT AND LICENSE
|
||||
|
||||
This software is copyright (c) 2004 by Ken Williams, Leon Timmermans.
|
||||
|
||||
This is free software; you can redistribute it and/or modify it under
|
||||
the same terms as the Perl 5 programming language system itself.
|
||||
|
||||
=cut
|
||||
Reference in New Issue
Block a user