#!/usr/bin/env perl # This chunk of stuff was generated by App::FatPacker. To find the original # file's code, look for the end of this BEGIN block or the string 'FATPACK' BEGIN { my %fatpacked; $fatpacked{"CPAN/Meta/Requirements.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CPAN_META_REQUIREMENTS'; use 5.006; # keep at v5.6 for CPAN.pm use strict; use warnings; package CPAN::Meta::Requirements; # ABSTRACT: a set of version requirements for a CPAN dist our $VERSION = '2.140'; #pod =head1 SYNOPSIS #pod #pod use CPAN::Meta::Requirements; #pod #pod my $build_requires = CPAN::Meta::Requirements->new; #pod #pod $build_requires->add_minimum('Library::Foo' => 1.208); #pod #pod $build_requires->add_minimum('Library::Foo' => 2.602); #pod #pod $build_requires->add_minimum('Module::Bar' => 'v1.2.3'); #pod #pod $METAyml->{build_requires} = $build_requires->as_string_hash; #pod #pod =head1 DESCRIPTION #pod #pod A CPAN::Meta::Requirements object models a set of version constraints like #pod those specified in the F or F files in CPAN distributions, #pod and as defined by L; #pod It can be built up by adding more and more constraints, and it will reduce them #pod to the simplest representation. #pod #pod Logically impossible constraints will be identified immediately by thrown #pod exceptions. #pod #pod =cut use Carp (); # To help ExtUtils::MakeMaker bootstrap CPAN::Meta::Requirements on perls # before 5.10, we fall back to the EUMM bundled compatibility version module if # that's the only thing available. This shouldn't ever happen in a normal CPAN # install of CPAN::Meta::Requirements, as version.pm will be picked up from # prereqs and be available at runtime. BEGIN { eval "use version ()"; ## no critic if ( my $err = $@ ) { eval "use ExtUtils::MakeMaker::version" or die $err; ## no critic } } # Perl 5.10.0 didn't have "is_qv" in version.pm *_is_qv = version->can('is_qv') ? sub { $_[0]->is_qv } : sub { exists $_[0]->{qv} }; # construct once, reuse many times my $V0 = version->new(0); #pod =method new #pod #pod my $req = CPAN::Meta::Requirements->new; #pod #pod This returns a new CPAN::Meta::Requirements object. It takes an optional #pod hash reference argument. Currently, only one key is supported: #pod #pod =for :list #pod * C -- if provided, when a version cannot be parsed into #pod a version object, this code reference will be called with the invalid #pod version string as first argument, and the module name as second #pod argument. It must return a valid version object. #pod #pod All other keys are ignored. #pod #pod =cut my @valid_options = qw( bad_version_hook ); sub new { my ($class, $options) = @_; $options ||= {}; Carp::croak "Argument to $class\->new() must be a hash reference" unless ref $options eq 'HASH'; my %self = map {; $_ => $options->{$_}} @valid_options; return bless \%self => $class; } # from version::vpp sub _find_magic_vstring { my $value = shift; my $tvalue = ''; require B; my $sv = B::svref_2object(\$value); my $magic = ref($sv) eq 'B::PVMG' ? $sv->MAGIC : undef; while ( $magic ) { if ( $magic->TYPE eq 'V' ) { $tvalue = $magic->PTR; $tvalue =~ s/^v?(.+)$/v$1/; last; } else { $magic = $magic->MOREMAGIC; } } return $tvalue; } # safe if given an unblessed reference sub _isa_version { UNIVERSAL::isa( $_[0], 'UNIVERSAL' ) && $_[0]->isa('version') } sub _version_object { my ($self, $module, $version) = @_; my ($vobj, $err); if (not defined $version or (!ref($version) && $version eq '0')) { return $V0; } elsif ( ref($version) eq 'version' || ( ref($version) && _isa_version($version) ) ) { $vobj = $version; } else { # hack around version::vpp not handling <3 character vstring literals if ( $INC{'version/vpp.pm'} || $INC{'ExtUtils/MakeMaker/version/vpp.pm'} ) { my $magic = _find_magic_vstring( $version ); $version = $magic if length $magic; } # pad to 3 characters if before 5.8.1 and appears to be a v-string if ( $] < 5.008001 && $version !~ /\A[0-9]/ && substr($version,0,1) ne 'v' && length($version) < 3 ) { $version .= "\0" x (3 - length($version)); } eval { local $SIG{__WARN__} = sub { die "Invalid version: $_[0]" }; # avoid specific segfault on some older version.pm versions die "Invalid version: $version" if $version eq 'version'; $vobj = version->new($version); }; if ( my $err = $@ ) { my $hook = $self->{bad_version_hook}; $vobj = eval { $hook->($version, $module) } if ref $hook eq 'CODE'; unless (eval { $vobj->isa("version") }) { $err =~ s{ at .* line \d+.*$}{}; die "Can't convert '$version': $err"; } } } # ensure no leading '.' if ( $vobj =~ m{\A\.} ) { $vobj = version->new("0$vobj"); } # ensure normal v-string form if ( _is_qv($vobj) ) { $vobj = version->new($vobj->normal); } return $vobj; } #pod =method add_minimum #pod #pod $req->add_minimum( $module => $version ); #pod #pod This adds a new minimum version requirement. If the new requirement is #pod redundant to the existing specification, this has no effect. #pod #pod Minimum requirements are inclusive. C<$version> is required, along with any #pod greater version number. #pod #pod This method returns the requirements object. #pod #pod =method add_maximum #pod #pod $req->add_maximum( $module => $version ); #pod #pod This adds a new maximum version requirement. If the new requirement is #pod redundant to the existing specification, this has no effect. #pod #pod Maximum requirements are inclusive. No version strictly greater than the given #pod version is allowed. #pod #pod This method returns the requirements object. #pod #pod =method add_exclusion #pod #pod $req->add_exclusion( $module => $version ); #pod #pod This adds a new excluded version. For example, you might use these three #pod method calls: #pod #pod $req->add_minimum( $module => '1.00' ); #pod $req->add_maximum( $module => '1.82' ); #pod #pod $req->add_exclusion( $module => '1.75' ); #pod #pod Any version between 1.00 and 1.82 inclusive would be acceptable, except for #pod 1.75. #pod #pod This method returns the requirements object. #pod #pod =method exact_version #pod #pod $req->exact_version( $module => $version ); #pod #pod This sets the version required for the given module to I the given #pod version. No other version would be considered acceptable. #pod #pod This method returns the requirements object. #pod #pod =cut BEGIN { for my $type (qw(maximum exclusion exact_version)) { my $method = "with_$type"; my $to_add = $type eq 'exact_version' ? $type : "add_$type"; my $code = sub { my ($self, $name, $version) = @_; $version = $self->_version_object( $name, $version ); $self->__modify_entry_for($name, $method, $version); return $self; }; no strict 'refs'; *$to_add = $code; } } # add_minimum is optimized compared to generated subs above because # it is called frequently and with "0" or equivalent input sub add_minimum { my ($self, $name, $version) = @_; # stringify $version so that version->new("0.00")->stringify ne "0" # which preserves the user's choice of "0.00" as the requirement if (not defined $version or "$version" eq '0') { return $self if $self->__entry_for($name); Carp::confess("can't add new requirements to finalized requirements") if $self->is_finalized; $self->{requirements}{ $name } = CPAN::Meta::Requirements::_Range::Range->with_minimum($V0, $name); } else { $version = $self->_version_object( $name, $version ); $self->__modify_entry_for($name, 'with_minimum', $version); } return $self; } #pod =method add_requirements #pod #pod $req->add_requirements( $another_req_object ); #pod #pod This method adds all the requirements in the given CPAN::Meta::Requirements #pod object to the requirements object on which it was called. If there are any #pod conflicts, an exception is thrown. #pod #pod This method returns the requirements object. #pod #pod =cut sub add_requirements { my ($self, $req) = @_; for my $module ($req->required_modules) { my $modifiers = $req->__entry_for($module)->as_modifiers; for my $modifier (@$modifiers) { my ($method, @args) = @$modifier; $self->$method($module => @args); }; } return $self; } #pod =method accepts_module #pod #pod my $bool = $req->accepts_module($module => $version); #pod #pod Given an module and version, this method returns true if the version #pod specification for the module accepts the provided version. In other words, #pod given: #pod #pod Module => '>= 1.00, < 2.00' #pod #pod We will accept 1.00 and 1.75 but not 0.50 or 2.00. #pod #pod For modules that do not appear in the requirements, this method will return #pod true. #pod #pod =cut sub accepts_module { my ($self, $module, $version) = @_; $version = $self->_version_object( $module, $version ); return 1 unless my $range = $self->__entry_for($module); return $range->_accepts($version); } #pod =method clear_requirement #pod #pod $req->clear_requirement( $module ); #pod #pod This removes the requirement for a given module from the object. #pod #pod This method returns the requirements object. #pod #pod =cut sub clear_requirement { my ($self, $module) = @_; return $self unless $self->__entry_for($module); Carp::confess("can't clear requirements on finalized requirements") if $self->is_finalized; delete $self->{requirements}{ $module }; return $self; } #pod =method requirements_for_module #pod #pod $req->requirements_for_module( $module ); #pod #pod This returns a string containing the version requirements for a given module in #pod the format described in L or undef if the given module has no #pod requirements. This should only be used for informational purposes such as error #pod messages and should not be interpreted or used for comparison (see #pod L instead). #pod #pod =cut sub requirements_for_module { my ($self, $module) = @_; my $entry = $self->__entry_for($module); return unless $entry; return $entry->as_string; } #pod =method structured_requirements_for_module #pod #pod $req->structured_requirements_for_module( $module ); #pod #pod This returns a data structure containing the version requirements for a given #pod module or undef if the given module has no requirements. This should #pod not be used for version checks (see L instead). #pod #pod Added in version 2.134. #pod #pod =cut sub structured_requirements_for_module { my ($self, $module) = @_; my $entry = $self->__entry_for($module); return unless $entry; return $entry->as_struct; } #pod =method required_modules #pod #pod This method returns a list of all the modules for which requirements have been #pod specified. #pod #pod =cut sub required_modules { keys %{ $_[0]{requirements} } } #pod =method clone #pod #pod $req->clone; #pod #pod This method returns a clone of the invocant. The clone and the original object #pod can then be changed independent of one another. #pod #pod =cut sub clone { my ($self) = @_; my $new = (ref $self)->new; return $new->add_requirements($self); } sub __entry_for { $_[0]{requirements}{ $_[1] } } sub __modify_entry_for { my ($self, $name, $method, $version) = @_; my $fin = $self->is_finalized; my $old = $self->__entry_for($name); Carp::confess("can't add new requirements to finalized requirements") if $fin and not $old; my $new = ($old || 'CPAN::Meta::Requirements::_Range::Range') ->$method($version, $name); Carp::confess("can't modify finalized requirements") if $fin and $old->as_string ne $new->as_string; $self->{requirements}{ $name } = $new; } #pod =method is_simple #pod #pod This method returns true if and only if all requirements are inclusive minimums #pod -- that is, if their string expression is just the version number. #pod #pod =cut sub is_simple { my ($self) = @_; for my $module ($self->required_modules) { # XXX: This is a complete hack, but also entirely correct. return if $self->__entry_for($module)->as_string =~ /\s/; } return 1; } #pod =method is_finalized #pod #pod This method returns true if the requirements have been finalized by having the #pod C method called on them. #pod #pod =cut sub is_finalized { $_[0]{finalized} } #pod =method finalize #pod #pod This method marks the requirements finalized. Subsequent attempts to change #pod the requirements will be fatal, I they would result in a change. If they #pod would not alter the requirements, they have no effect. #pod #pod If a finalized set of requirements is cloned, the cloned requirements are not #pod also finalized. #pod #pod =cut sub finalize { $_[0]{finalized} = 1 } #pod =method as_string_hash #pod #pod This returns a reference to a hash describing the requirements using the #pod strings in the L specification. #pod #pod For example after the following program: #pod #pod my $req = CPAN::Meta::Requirements->new; #pod #pod $req->add_minimum('CPAN::Meta::Requirements' => 0.102); #pod #pod $req->add_minimum('Library::Foo' => 1.208); #pod #pod $req->add_maximum('Library::Foo' => 2.602); #pod #pod $req->add_minimum('Module::Bar' => 'v1.2.3'); #pod #pod $req->add_exclusion('Module::Bar' => 'v1.2.8'); #pod #pod $req->exact_version('Xyzzy' => '6.01'); #pod #pod my $hashref = $req->as_string_hash; #pod #pod C<$hashref> would contain: #pod #pod { #pod 'CPAN::Meta::Requirements' => '0.102', #pod 'Library::Foo' => '>= 1.208, <= 2.206', #pod 'Module::Bar' => '>= v1.2.3, != v1.2.8', #pod 'Xyzzy' => '== 6.01', #pod } #pod #pod =cut sub as_string_hash { my ($self) = @_; my %hash = map {; $_ => $self->{requirements}{$_}->as_string } $self->required_modules; return \%hash; } #pod =method add_string_requirement #pod #pod $req->add_string_requirement('Library::Foo' => '>= 1.208, <= 2.206'); #pod $req->add_string_requirement('Library::Foo' => v1.208); #pod #pod This method parses the passed in string and adds the appropriate requirement #pod for the given module. A version can be a Perl "v-string". It understands #pod version ranges as described in the L. For #pod example: #pod #pod =over 4 #pod #pod =item 1.3 #pod #pod =item >= 1.3 #pod #pod =item <= 1.3 #pod #pod =item == 1.3 #pod #pod =item != 1.3 #pod #pod =item > 1.3 #pod #pod =item < 1.3 #pod #pod =item >= 1.3, != 1.5, <= 2.0 #pod #pod A version number without an operator is equivalent to specifying a minimum #pod (C=>). Extra whitespace is allowed. #pod #pod =back #pod #pod =cut my %methods_for_op = ( '==' => [ qw(exact_version) ], '!=' => [ qw(add_exclusion) ], '>=' => [ qw(add_minimum) ], '<=' => [ qw(add_maximum) ], '>' => [ qw(add_minimum add_exclusion) ], '<' => [ qw(add_maximum add_exclusion) ], ); sub add_string_requirement { my ($self, $module, $req) = @_; unless ( defined $req && length $req ) { $req = 0; $self->_blank_carp($module); } my $magic = _find_magic_vstring( $req ); if (length $magic) { $self->add_minimum($module => $magic); return; } my @parts = split qr{\s*,\s*}, $req; for my $part (@parts) { my ($op, $ver) = $part =~ m{\A\s*(==|>=|>|<=|<|!=)\s*(.*)\z}; if (! defined $op) { $self->add_minimum($module => $part); } else { Carp::confess("illegal requirement string: $req") unless my $methods = $methods_for_op{ $op }; $self->$_($module => $ver) for @$methods; } } } #pod =method from_string_hash #pod #pod my $req = CPAN::Meta::Requirements->from_string_hash( \%hash ); #pod my $req = CPAN::Meta::Requirements->from_string_hash( \%hash, \%opts ); #pod #pod This is an alternate constructor for a CPAN::Meta::Requirements #pod object. It takes a hash of module names and version requirement #pod strings and returns a new CPAN::Meta::Requirements object. As with #pod add_string_requirement, a version can be a Perl "v-string". Optionally, #pod you can supply a hash-reference of options, exactly as with the L #pod method. #pod #pod =cut sub _blank_carp { my ($self, $module) = @_; Carp::carp("Undefined requirement for $module treated as '0'"); } sub from_string_hash { my ($class, $hash, $options) = @_; my $self = $class->new($options); for my $module (keys %$hash) { my $req = $hash->{$module}; unless ( defined $req && length $req ) { $req = 0; $class->_blank_carp($module); } $self->add_string_requirement($module, $req); } return $self; } ############################################################## { package CPAN::Meta::Requirements::_Range::Exact; sub _new { bless { version => $_[1] } => $_[0] } sub _accepts { return $_[0]{version} == $_[1] } sub as_string { return "== $_[0]{version}" } sub as_struct { return [ [ '==', "$_[0]{version}" ] ] } sub as_modifiers { return [ [ exact_version => $_[0]{version} ] ] } sub _reject_requirements { my ($self, $module, $error) = @_; Carp::confess("illegal requirements for $module: $error") } sub _clone { (ref $_[0])->_new( version->new( $_[0]{version} ) ) } sub with_exact_version { my ($self, $version, $module) = @_; $module = 'module' unless defined $module; return $self->_clone if $self->_accepts($version); $self->_reject_requirements( $module, "can't be exactly $version when exact requirement is already $self->{version}", ); } sub with_minimum { my ($self, $minimum, $module) = @_; $module = 'module' unless defined $module; return $self->_clone if $self->{version} >= $minimum; $self->_reject_requirements( $module, "minimum $minimum exceeds exact specification $self->{version}", ); } sub with_maximum { my ($self, $maximum, $module) = @_; $module = 'module' unless defined $module; return $self->_clone if $self->{version} <= $maximum; $self->_reject_requirements( $module, "maximum $maximum below exact specification $self->{version}", ); } sub with_exclusion { my ($self, $exclusion, $module) = @_; $module = 'module' unless defined $module; return $self->_clone unless $exclusion == $self->{version}; $self->_reject_requirements( $module, "tried to exclude $exclusion, which is already exactly specified", ); } } ############################################################## { package CPAN::Meta::Requirements::_Range::Range; sub _self { ref($_[0]) ? $_[0] : (bless { } => $_[0]) } sub _clone { return (bless { } => $_[0]) unless ref $_[0]; my ($s) = @_; my %guts = ( (exists $s->{minimum} ? (minimum => version->new($s->{minimum})) : ()), (exists $s->{maximum} ? (maximum => version->new($s->{maximum})) : ()), (exists $s->{exclusions} ? (exclusions => [ map { version->new($_) } @{ $s->{exclusions} } ]) : ()), ); bless \%guts => ref($s); } sub as_modifiers { my ($self) = @_; my @mods; push @mods, [ add_minimum => $self->{minimum} ] if exists $self->{minimum}; push @mods, [ add_maximum => $self->{maximum} ] if exists $self->{maximum}; push @mods, map {; [ add_exclusion => $_ ] } @{$self->{exclusions} || []}; return \@mods; } sub as_struct { my ($self) = @_; return 0 if ! keys %$self; my @exclusions = @{ $self->{exclusions} || [] }; my @parts; for my $tuple ( [ qw( >= > minimum ) ], [ qw( <= < maximum ) ], ) { my ($op, $e_op, $k) = @$tuple; if (exists $self->{$k}) { my @new_exclusions = grep { $_ != $self->{ $k } } @exclusions; if (@new_exclusions == @exclusions) { push @parts, [ $op, "$self->{ $k }" ]; } else { push @parts, [ $e_op, "$self->{ $k }" ]; @exclusions = @new_exclusions; } } } push @parts, map {; [ "!=", "$_" ] } @exclusions; return \@parts; } sub as_string { my ($self) = @_; my @parts = @{ $self->as_struct }; return $parts[0][1] if @parts == 1 and $parts[0][0] eq '>='; return join q{, }, map {; join q{ }, @$_ } @parts; } sub _reject_requirements { my ($self, $module, $error) = @_; Carp::confess("illegal requirements for $module: $error") } sub with_exact_version { my ($self, $version, $module) = @_; $module = 'module' unless defined $module; $self = $self->_clone; unless ($self->_accepts($version)) { $self->_reject_requirements( $module, "exact specification $version outside of range " . $self->as_string ); } return CPAN::Meta::Requirements::_Range::Exact->_new($version); } sub _simplify { my ($self, $module) = @_; if (defined $self->{minimum} and defined $self->{maximum}) { if ($self->{minimum} == $self->{maximum}) { if (grep { $_ == $self->{minimum} } @{ $self->{exclusions} || [] }) { $self->_reject_requirements( $module, "minimum and maximum are both $self->{minimum}, which is excluded", ); } return CPAN::Meta::Requirements::_Range::Exact->_new($self->{minimum}) } if ($self->{minimum} > $self->{maximum}) { $self->_reject_requirements( $module, "minimum $self->{minimum} exceeds maximum $self->{maximum}", ); } } # eliminate irrelevant exclusions if ($self->{exclusions}) { my %seen; @{ $self->{exclusions} } = grep { (! defined $self->{minimum} or $_ >= $self->{minimum}) and (! defined $self->{maximum} or $_ <= $self->{maximum}) and ! $seen{$_}++ } @{ $self->{exclusions} }; } return $self; } sub with_minimum { my ($self, $minimum, $module) = @_; $module = 'module' unless defined $module; $self = $self->_clone; if (defined (my $old_min = $self->{minimum})) { $self->{minimum} = (sort { $b cmp $a } ($minimum, $old_min))[0]; } else { $self->{minimum} = $minimum; } return $self->_simplify($module); } sub with_maximum { my ($self, $maximum, $module) = @_; $module = 'module' unless defined $module; $self = $self->_clone; if (defined (my $old_max = $self->{maximum})) { $self->{maximum} = (sort { $a cmp $b } ($maximum, $old_max))[0]; } else { $self->{maximum} = $maximum; } return $self->_simplify($module); } sub with_exclusion { my ($self, $exclusion, $module) = @_; $module = 'module' unless defined $module; $self = $self->_clone; push @{ $self->{exclusions} ||= [] }, $exclusion; return $self->_simplify($module); } sub _accepts { my ($self, $version) = @_; return if defined $self->{minimum} and $version < $self->{minimum}; return if defined $self->{maximum} and $version > $self->{maximum}; return if defined $self->{exclusions} and grep { $version == $_ } @{ $self->{exclusions} }; return 1; } } 1; # vim: ts=2 sts=2 sw=2 et: __END__ =pod =encoding UTF-8 =head1 NAME CPAN::Meta::Requirements - a set of version requirements for a CPAN dist =head1 VERSION version 2.140 =head1 SYNOPSIS use CPAN::Meta::Requirements; my $build_requires = CPAN::Meta::Requirements->new; $build_requires->add_minimum('Library::Foo' => 1.208); $build_requires->add_minimum('Library::Foo' => 2.602); $build_requires->add_minimum('Module::Bar' => 'v1.2.3'); $METAyml->{build_requires} = $build_requires->as_string_hash; =head1 DESCRIPTION A CPAN::Meta::Requirements object models a set of version constraints like those specified in the F or F files in CPAN distributions, and as defined by L; It can be built up by adding more and more constraints, and it will reduce them to the simplest representation. Logically impossible constraints will be identified immediately by thrown exceptions. =head1 METHODS =head2 new my $req = CPAN::Meta::Requirements->new; This returns a new CPAN::Meta::Requirements object. It takes an optional hash reference argument. Currently, only one key is supported: =over 4 =item * C -- if provided, when a version cannot be parsed into a version object, this code reference will be called with the invalid version string as first argument, and the module name as second argument. It must return a valid version object. =back All other keys are ignored. =head2 add_minimum $req->add_minimum( $module => $version ); This adds a new minimum version requirement. If the new requirement is redundant to the existing specification, this has no effect. Minimum requirements are inclusive. C<$version> is required, along with any greater version number. This method returns the requirements object. =head2 add_maximum $req->add_maximum( $module => $version ); This adds a new maximum version requirement. If the new requirement is redundant to the existing specification, this has no effect. Maximum requirements are inclusive. No version strictly greater than the given version is allowed. This method returns the requirements object. =head2 add_exclusion $req->add_exclusion( $module => $version ); This adds a new excluded version. For example, you might use these three method calls: $req->add_minimum( $module => '1.00' ); $req->add_maximum( $module => '1.82' ); $req->add_exclusion( $module => '1.75' ); Any version between 1.00 and 1.82 inclusive would be acceptable, except for 1.75. This method returns the requirements object. =head2 exact_version $req->exact_version( $module => $version ); This sets the version required for the given module to I the given version. No other version would be considered acceptable. This method returns the requirements object. =head2 add_requirements $req->add_requirements( $another_req_object ); This method adds all the requirements in the given CPAN::Meta::Requirements object to the requirements object on which it was called. If there are any conflicts, an exception is thrown. This method returns the requirements object. =head2 accepts_module my $bool = $req->accepts_module($module => $version); Given an module and version, this method returns true if the version specification for the module accepts the provided version. In other words, given: Module => '>= 1.00, < 2.00' We will accept 1.00 and 1.75 but not 0.50 or 2.00. For modules that do not appear in the requirements, this method will return true. =head2 clear_requirement $req->clear_requirement( $module ); This removes the requirement for a given module from the object. This method returns the requirements object. =head2 requirements_for_module $req->requirements_for_module( $module ); This returns a string containing the version requirements for a given module in the format described in L or undef if the given module has no requirements. This should only be used for informational purposes such as error messages and should not be interpreted or used for comparison (see L instead). =head2 structured_requirements_for_module $req->structured_requirements_for_module( $module ); This returns a data structure containing the version requirements for a given module or undef if the given module has no requirements. This should not be used for version checks (see L instead). Added in version 2.134. =head2 required_modules This method returns a list of all the modules for which requirements have been specified. =head2 clone $req->clone; This method returns a clone of the invocant. The clone and the original object can then be changed independent of one another. =head2 is_simple This method returns true if and only if all requirements are inclusive minimums -- that is, if their string expression is just the version number. =head2 is_finalized This method returns true if the requirements have been finalized by having the C method called on them. =head2 finalize This method marks the requirements finalized. Subsequent attempts to change the requirements will be fatal, I they would result in a change. If they would not alter the requirements, they have no effect. If a finalized set of requirements is cloned, the cloned requirements are not also finalized. =head2 as_string_hash This returns a reference to a hash describing the requirements using the strings in the L specification. For example after the following program: my $req = CPAN::Meta::Requirements->new; $req->add_minimum('CPAN::Meta::Requirements' => 0.102); $req->add_minimum('Library::Foo' => 1.208); $req->add_maximum('Library::Foo' => 2.602); $req->add_minimum('Module::Bar' => 'v1.2.3'); $req->add_exclusion('Module::Bar' => 'v1.2.8'); $req->exact_version('Xyzzy' => '6.01'); my $hashref = $req->as_string_hash; C<$hashref> would contain: { 'CPAN::Meta::Requirements' => '0.102', 'Library::Foo' => '>= 1.208, <= 2.206', 'Module::Bar' => '>= v1.2.3, != v1.2.8', 'Xyzzy' => '== 6.01', } =head2 add_string_requirement $req->add_string_requirement('Library::Foo' => '>= 1.208, <= 2.206'); $req->add_string_requirement('Library::Foo' => v1.208); This method parses the passed in string and adds the appropriate requirement for the given module. A version can be a Perl "v-string". It understands version ranges as described in the L. For example: =over 4 =item 1.3 =item >= 1.3 =item <= 1.3 =item == 1.3 =item != 1.3 =item > 1.3 =item < 1.3 =item >= 1.3, != 1.5, <= 2.0 A version number without an operator is equivalent to specifying a minimum (C=>). Extra whitespace is allowed. =back =head2 from_string_hash my $req = CPAN::Meta::Requirements->from_string_hash( \%hash ); my $req = CPAN::Meta::Requirements->from_string_hash( \%hash, \%opts ); This is an alternate constructor for a CPAN::Meta::Requirements object. It takes a hash of module names and version requirement strings and returns a new CPAN::Meta::Requirements object. As with add_string_requirement, a version can be a Perl "v-string". Optionally, you can supply a hash-reference of options, exactly as with the L method. =for :stopwords cpan testmatrix url annocpan anno bugtracker rt cpants kwalitee diff irc mailto metadata placeholders metacpan =head1 SUPPORT =head2 Bugs / Feature Requests Please report any bugs or feature requests through the issue tracker at L. You will be notified automatically of any progress on your issue. =head2 Source Code This is open source software. The code repository is available for public review and contribution under the terms of the license. L git clone https://github.com/Perl-Toolchain-Gang/CPAN-Meta-Requirements.git =head1 AUTHORS =over 4 =item * David Golden =item * Ricardo Signes =back =head1 CONTRIBUTORS =for stopwords Ed J Karen Etheridge Leon Timmermans robario =over 4 =item * Ed J =item * Karen Etheridge =item * Leon Timmermans =item * robario =back =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2010 by David Golden and Ricardo Signes. 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 CPAN_META_REQUIREMENTS $fatpacked{"Devel/InnerPackage.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DEVEL_INNERPACKAGE'; package Devel::InnerPackage; use strict; use base qw(Exporter); use vars qw($VERSION @EXPORT_OK); use if $] > 5.017, 'deprecate'; $VERSION = '0.4'; @EXPORT_OK = qw(list_packages); =pod =head1 NAME Devel::InnerPackage - find all the inner packages of a package =head1 SYNOPSIS use Foo::Bar; use Devel::InnerPackage qw(list_packages); my @inner_packages = list_packages('Foo::Bar'); =head1 DESCRIPTION Given a file like this package Foo::Bar; sub foo {} package Foo::Bar::Quux; sub quux {} package Foo::Bar::Quirka; sub quirka {} 1; then list_packages('Foo::Bar'); will return Foo::Bar::Quux Foo::Bar::Quirka =head1 METHODS =head2 list_packages Return a list of all inner packages of that package. =cut sub list_packages { my $pack = shift; $pack .= "::" unless $pack =~ m!::$!; no strict 'refs'; my @packs; my @stuff = grep !/^(main|)::$/, keys %{$pack}; for my $cand (grep /::$/, @stuff) { $cand =~ s!::$!!; my @children = list_packages($pack.$cand); push @packs, "$pack$cand" unless $cand =~ /^::/ || !__PACKAGE__->_loaded($pack.$cand); # or @children; push @packs, @children; } return grep {$_ !~ /::(::ISA::CACHE|SUPER)/} @packs; } ### XXX this is an inlining of the Class-Inspector->loaded() ### method, but inlined to remove the dependency. sub _loaded { my ($class, $name) = @_; no strict 'refs'; # Handle by far the two most common cases # This is very fast and handles 99% of cases. return 1 if defined ${"${name}::VERSION"}; return 1 if @{"${name}::ISA"}; # Are there any symbol table entries other than other namespaces foreach ( keys %{"${name}::"} ) { next if substr($_, -2, 2) eq '::'; return 1 if defined &{"${name}::$_"}; } # No functions, and it doesn't have a version, and isn't anything. # As an absolute last resort, check for an entry in %INC my $filename = join( '/', split /(?:'|::)/, $name ) . '.pm'; return 1 if defined $INC{$filename}; ''; } =head1 AUTHOR Simon Wistow =head1 COPYING Copyright, 2005 Simon Wistow Distributed under the same terms as Perl itself. =head1 BUGS None known. =cut 1; DEVEL_INNERPACKAGE $fatpacked{"Devel/PatchPerl.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DEVEL_PATCHPERL'; package Devel::PatchPerl; $Devel::PatchPerl::VERSION = '2.08'; # ABSTRACT: Patch perl source a la Devel::PPPort's buildperl.pl use strict; use warnings; use File::pushd qw[pushd]; use File::Spec; use IO::File; use Devel::PatchPerl::Hints qw[hint_file]; use MIME::Base64 qw[decode_base64]; use Module::Pluggable search_path => ['Devel::PatchPerl::Plugin']; use vars qw[@ISA @EXPORT_OK]; use constant CERTIFIED => 5.033005; # Anything less than this use constant HINTSCERT => 5.033004; # Hints certified to this @ISA = qw(Exporter); @EXPORT_OK = qw(patch_source); my $patch_exe = _can_run('gpatch') || _can_run('patch'); my @patch = ( { perl => [ qw/ 5.005 /, ], subs => [ [ \&_patch_5_005, 1 ], ], }, { perl => [ qw/ 5.005_01 /, ], subs => [ [ \&_patch_5_005_01, 1 ], ], }, { perl => [ qw/ 5.005_02 /, ], subs => [ [ \&_patch_5_005_02, 1 ], ], }, { perl => [ qr/^5\.00[2345]/, qw/ 5.001n /, ], subs => [ [ \&_patch_handy, 1 ], ], }, { perl => [ qw/ 5.005 5.005_01 5.005_02 5.005_03 5.005_04 /, ], subs => [ [ \&_replace_makedepend, 1 ], ], }, { perl => [ qr/^5\.00[01234]/, qw/ 5.005 5.005_01 5.005_02 5.005_03 /, ], subs => [ [ \&_patch_db, 1 ], ], }, { perl => [ qr/^5\.6\.[1-2]$/, qr/^5\.7\.[0-1]$/, ], subs => [ [ \&_patch_makefile_sh_phony ], ], }, { perl => [ qw/ 5.6.0 5.6.1 5.7.0 5.7.1 5.7.2 5.7.3 5.8.0 /, ], subs => [ [ \&_patch_db, 3 ], ], }, { perl => [ qr/^5\.004_0[1234]$/, ], subs => [ [ \&_patch_doio ], ], }, { perl => [ qw/ 5.005 5.005_01 5.005_02 /, ], subs => [ [ \&_patch_sysv, old_format => 1 ], ], }, { perl => [ qw/ 5.005_03 5.005_04 /, qr/^5\.6\.[0-2]$/, qr/^5\.7\.[0-3]$/, qr/^5\.8\.[0-8]$/, qr/^5\.9\.[0-5]$/ ], subs => [ [ \&_patch_sysv, old_format => 0 ], ], }, { perl => [ qr/^5\.004_05$/, qr/^5\.005(?:_0[1-4])?$/, qr/^5\.6\.[01]$/, ], subs => [ [ \&_patch_configure ], [ \&_patch_makedepend_lc ], ], }, { perl => [ qr/^5\.6\.[0-2]$/, ], subs => [ [ \&_patch_conf_gconvert ], [ \&_patch_sort_N ], ], }, { perl => [ '5.8.0', ], subs => [ [ \&_patch_makedepend_lc ], ], }, { perl => [ qr/.*/, ], subs => [ [ \&_patch_conf_solaris ], [ \&_patch_bitrig ], [ \&_patch_patchlevel ], [ \&_patch_develpatchperlversion ], [ \&_patch_errno_gcc5 ], [ \&_patch_conf_fwrapv ], [ \&_patch_utils_h2ph ], [ \&_patch_lib_h2ph ], [ \&_patch_sdbm_file_c ], [ \&_patch_mmaix_pm ], [ \&_patch_time_local_t ], [ \&_patch_pp_c_libc ], [ \&_patch_conf_gcc10 ], [ \&_patch_dynaloader_mac ], [ \&_patch_eumm_darwin ], ], }, { perl => [ qr/^5\.6\.[0-2]$/, qr/^5\.7\.[0-3]$/, qr/^5\.8\.[0-8]$/, qr/^5\.9\.[0-4]$/, ], subs => [ [ \&_patch_makedepend_SH ], ], }, { perl => [ qr/^5\.1[0-2]/, ], subs => [ [ \&_patch_archive_tar_tests ], [ \&_patch_odbm_file_hints_linux ], ], }, { perl => [ qr/^5.1([24].\d+|0.1)/, ], subs => [ [ \&_patch_make_ext_pl ], ], }, { perl => [ qr/^5\.8\.9$/, ], subs => [ [ \&_patch_589_perlio_c ], ], }, { perl => [ qr/^5\.8\.[89]$/ ], subs => [ [ \&_patch_hsplit_rehash_58 ] ], }, { perl => [ qr/^5\.10\.1$/, qr/^5\.12\.5$/, ], subs => [ [ \&_patch_hsplit_rehash_510 ] ], }, { perl => [ qr/^5\.18\.0$/, ], subs => [ [ \&_patch_regmatch_pointer_5180 ] ], }, { perl => [ qr/^5\.20\.0$/, ], subs => [ [ \&_patch_cow_speed ] ], }, { perl => [ qr/^5\.6\.[012]$/, qr/^5\.8\.[89]$/, qr/^5\.10\.[01]$/, ], subs => [ [ \&_patch_preprocess_options ] ], }, { perl => [ qr/^5\.18\.3$/, ], subs => [ [ \&_patch_5183_metajson ] ], }, { perl => [ qr/^5\.24\.[012]$/, ], subs => [ [ \&_patch_time_hires ] ], }, { perl => [ qr/^5\.24\.3$/, qr/^5\.25\.(?:[4-9]|10)$/, qr/^5\.26\.[01]$/, qr/^5\.27\.[0-4]$/, ], subs => [ [ \&_patch_fp_class_denorm ] ], }, { perl => [ qr/^5\.28\.[01]$/, ], subs => [ [ \&_patch_useshrplib ] ], }, ); sub patch_source { my $vers = shift; $vers = shift if eval { $vers->isa(__PACKAGE__) }; my $source = shift || '.'; if ( !$vers ) { $vers = _determine_version($source); if ( $vers ) { warn "Auto-guessed '$vers'\n"; } else { die "You didn't provide a perl version and I don't appear to be in a perl source tree\n"; } } my $normver = _norm_ver( $vers ); $source = File::Spec->rel2abs($source); if ( $normver < HINTSCERT ) { my $dir = pushd( $source ); _patch_hints(); } if ( $normver >= CERTIFIED ) { warn "Nothing else to do, '$vers' is fine\n"; return; } { my $dir = pushd( $source ); for my $p ( grep { _is( $_->{perl}, $vers ) } @patch ) { for my $s (@{$p->{subs}}) { my($sub, @args) = @$s; push @args, $vers unless scalar @args; $sub->(@args); } } _process_plugin( version => $vers, source => $source, patchexe => $patch_exe ); } } sub _process_plugin { my %args = @_; return unless my $possible = $ENV{PERL5_PATCHPERL_PLUGIN}; my ($plugin) = grep { $possible eq $_ or /\Q$possible\E$/ } __PACKAGE__->plugins; unless ( $plugin ) { warn "# You specified a plugin '", $ENV{PERL5_PATCHPERL_PLUGIN}, "' that isn't installed, just thought you might be interested.\n"; return; } { local $@; eval "require $plugin"; if ($@) { die "# I tried to load '", $ENV{PERL5_PATCHPERL_PLUGIN}, "' but it didn't work out. Here is what happened '$@'\n"; } } { local $@; eval { $plugin->patchperl( %args, ); }; if ($@) { warn "# Warnings from the plugin: '$@'\n"; } } return 1; } sub _can_run { my $command = shift; # a lot of VMS executables have a symbol defined # check those first if ( $^O eq 'VMS' ) { require VMS::DCLsym; my $syms = VMS::DCLsym->new; return $command if scalar $syms->getsym( uc $command ); } require File::Spec; require ExtUtils::MakeMaker; my @possibles; if( File::Spec->file_name_is_absolute($command) ) { return MM->maybe_command($command); } else { for my $dir ( File::Spec->path, File::Spec->curdir ) { next if ! $dir || ! -d $dir; my $abs = File::Spec->catfile( $^O eq 'MSWin32' ? Win32::GetShortPathName( $dir ) : $dir, $command); push @possibles, $abs if $abs = MM->maybe_command($abs); } } return @possibles if wantarray; return shift @possibles; } sub _is { my($s1, $s2) = @_; defined $s1 != defined $s2 and return 0; ref $s2 and ($s1, $s2) = ($s2, $s1); if (ref $s1) { if (ref $s1 eq 'ARRAY') { _is($_, $s2) and return 1 for @$s1; return 0; } return $s2 =~ $s1; } return $s1 eq $s2; } sub _patch_b64 { my($base64) = @_; my $patch = decode_base64( $base64 ); _patch( $patch ); } sub _patch { my($patch) = @_; my %mode; for my $file ($patch =~ /^\+{3}\s+(\S+)/gm) { print "patching $file\n"; # some filesystems (e.g., Lustre) will kill this process if there # is an attempt to write to a file that is 0444, so make these # files writable for the duration of the patch if (-r $file and not -w _) { my $mode = (stat $file)[2]; $mode{$file} = $mode; # save for chmod back chmod $mode | 0200, $file; } } my $diff = 'tmp.diff'; _write_or_die($diff, $patch); die "No patch utility found\n" unless $patch_exe; local $ENV{PATCH_GET} = 0; # I can't reproduce this at all, but meh. _run_or_die("$patch_exe -f -s -p0 <$diff"); unlink $diff or die "unlink $diff: $!\n"; # put back ro to 0444 for my $file (sort keys %mode) { chmod $mode{$file}, $file; } } sub _write_or_die { my($file, $data) = @_; my $fh = IO::File->new(">$file") or die "$file: $!\n"; $fh->print($data); } sub _run_or_die { # print "[running @_]\n"; die unless system( @_ ) == 0; } sub determine_version { my $src = shift; $src = shift if eval { $src->isa(__PACKAGE__) }; $src = '.' unless $src; _determine_version($src); } sub _determine_version { my ($source) = @_; my $patchlevel_h = File::Spec->catfile($source, 'patchlevel.h'); return unless -e $patchlevel_h; my $version; { my %defines; open my $fh, '<', $patchlevel_h; my @vers; while (<$fh>) { chomp; next unless /^#define/; my ($foo,$bar) = ( split /\s+/ )[1,2]; $defines{$foo} = $bar; } if ( my @wotsits = grep { defined $defines{$_} } qw(PERL_REVISION PERL_VERSION PERL_SUBVERSION) ) { $version = join '.', map { $defines{$_} } @wotsits; } elsif ( my @watsits = grep { defined $defines{$_} } qw(PATCHLEVEL SUBVERSION) ) { $version = sprintf '5.%03d_%02d', map { $defines{$_} } @watsits; } else { return; } } return $version; } sub _patchperl_version { return $Devel::PatchPerl::VERSION || "(unreleased)"; } # adapted from patchlevel.h for use with perls that predate it sub _patch_patchlevel { return if -d '.git' and !$ENV{PERL5_PATCHPERL_PATCHLEVEL}; my $dpv = $Devel::PatchPerl::VERSION || "(unreleased)"; open my $plin, "patchlevel.h" or die "Couldn't open patchlevel.h : $!"; open my $plout, ">patchlevel.new" or die "Couldn't write on patchlevel.new : $!"; my $seen=0; while (<$plin>) { if (/\t,NULL/ and $seen) { print {$plout} qq{\t,"Devel::PatchPerl $dpv"\n}; } $seen++ if /local_patches\[\]/; print {$plout} $_; } close $plout or die "Couldn't close filehandle writing to patchlevel.new : $!"; close $plin or die "Couldn't close filehandle reading from patchlevel.h : $!"; unlink "patchlevel.bak" or warn "Couldn't unlink patchlevel.bak : $!" if -e "patchlevel.bak"; rename "patchlevel.h", "patchlevel.bak" or die "Couldn't rename patchlevel.h to patchlevel.bak : $!"; rename "patchlevel.new", "patchlevel.h" or die "Couldn't rename patchlevel.new to patchlevel.h : $!"; } sub _patch_hints { my @os; push @os, $^O; push @os, 'linux' if $^O eq 'gnukfreebsd'; # kfreebsd uses linux hints foreach my $os ( @os ) { return unless my ($file,$data) = hint_file( $os ); my $path = File::Spec->catfile( 'hints', $file ); warn "Patching '$path'\n"; if ( -e $path ) { chmod 0644, $path or die "$!\n"; } open my $fh, '>', $path or die "$!\n"; print $fh $data; close $fh; } return 1; } sub _patch_db { my $ver = shift; for my $file ('ext/DB_File/DB_File.xs', 'Configure') { print "patching $file\n"; _run_or_die($^X, '-pi.bak', '-e', "s///", $file); unlink "$file.bak" if -e "$file.bak"; } } sub _patch_doio { _patch(<<'END'); --- doio.c.org 2004-06-07 23:14:45.000000000 +0200 +++ doio.c 2003-11-04 08:03:03.000000000 +0100 @@ -75,6 +75,16 @@ # endif #endif +#if _SEM_SEMUN_UNDEFINED +union semun +{ + int val; + struct semid_ds *buf; + unsigned short int *array; + struct seminfo *__buf; +}; +#endif + bool do_open(gv,name,len,as_raw,rawmode,rawperm,supplied_fp) GV *gv; END } sub _patch_sysv { my %opt = @_; # check if patching is required return if $^O ne 'linux' or -f '/usr/include/asm/page.h'; if ($opt{old_format}) { _patch(<<'END'); --- ext/IPC/SysV/SysV.xs.org 1998-07-20 10:20:07.000000000 +0200 +++ ext/IPC/SysV/SysV.xs 2007-08-12 10:51:06.000000000 +0200 @@ -3,9 +3,6 @@ #include "XSUB.h" #include -#ifdef __linux__ -#include -#endif #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM) #include #ifdef HAS_MSG END } else { _patch(<<'END'); --- ext/IPC/SysV/SysV.xs.org 2007-08-11 00:12:46.000000000 +0200 +++ ext/IPC/SysV/SysV.xs 2007-08-11 00:10:51.000000000 +0200 @@ -3,9 +3,6 @@ #include "XSUB.h" #include -#ifdef __linux__ -# include -#endif #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM) #ifndef HAS_SEM # include END } } sub _patch_configure { _patch(<<'END'); --- Configure +++ Configure @@ -3380,6 +3380,18 @@ test "X$gfpthkeep" != Xy && gfpth="" EOSC +# gcc 3.1 complains about adding -Idirectories that it already knows about, +# so we will take those off from locincpth. +case "$gccversion" in +3*) + echo "main(){}">try.c + for incdir in `$cc -v -c try.c 2>&1 | \ + sed '1,/^#include <\.\.\.>/d;/^End of search list/,$d;s/^ //'` ; do + locincpth=`echo $locincpth | sed s!$incdir!!` + done + $rm -f try try.* +esac + : What should the include directory be ? echo " " $echo $n "Hmm... $c" END } sub _patch_makedepend_lc { _patch(<<'END'); --- makedepend.SH +++ makedepend.SH @@ -58,6 +58,10 @@ case $PERL_CONFIG_SH in ;; esac +# Avoid localized gcc/cc messages +LC_ALL=C +export LC_ALL + # We need .. when we are in the x2p directory if we are using the # cppstdin wrapper script. # Put .. and . first so that we pick up the present cppstdin, not END } sub _patch_makedepend_SH { my $perl = shift; SWITCH: { # If 5.6.0 if ( $perl eq '5.6.0' ) { _patch(<<'BADGER'); --- makedepend.SH.org 2000-03-02 18:12:26.000000000 +0000 +++ makedepend.SH 2010-09-01 10:13:37.000000000 +0100 @@ -1,5 +1,5 @@ #! /bin/sh -case $CONFIGDOTSH in +case $PERL_CONFIG_SH in '') if test -f config.sh; then TOP=.; elif test -f ../config.sh; then TOP=..; @@ -29,6 +29,13 @@ !GROK!THIS! $spitshell >>makedepend <<'!NO!SUBS!' +if test -d .depending; then + echo "$0: Already running, exiting." + exit 0 +fi + +mkdir .depending + # This script should be called with # sh ./makedepend MAKE=$(MAKE) case "$1" in @@ -37,7 +44,7 @@ export PATH || (echo "OOPS, this isn't sh. Desperation time. I will feed myself to sh."; sh \$0; kill \$\$) -case $CONFIGDOTSH in +case $PERL_CONFIG_SH in '') if test -f config.sh; then TOP=.; elif test -f ../config.sh; then TOP=..; @@ -51,6 +58,11 @@ ;; esac +# Avoid localized gcc messages +case "$ccname" in + gcc) LC_ALL=C ; export LC_ALL ;; +esac + # We need .. when we are in the x2p directory if we are using the # cppstdin wrapper script. # Put .. and . first so that we pick up the present cppstdin, not @@ -58,6 +70,10 @@ PATH=".$path_sep..$path_sep$PATH" export PATH +case "$osname" in +amigaos) cat=/bin/cat ;; # must be absolute +esac + $cat /dev/null >.deptmp $rm -f *.c.c c/*.c.c if test -f Makefile; then @@ -67,7 +83,6 @@ # to be out of date. I don't know if OS/2 has touch, so do this: case "$osname" in os2) ;; - netbsd) ;; *) $touch $firstmakefile ;; esac fi @@ -99,25 +114,20 @@ $echo *.c | $tr ' ' $trnl | $egrep -v '\*' >.clist) for file in `$cat .clist`; do # for file in `cat /dev/null`; do - if [ "$osname" = uwin ]; then - uwinfix="-e s,\\\\\\\\,/,g -e s,\\([a-zA-Z]\\):/,/\\1/,g" - else - if [ "$osname" = os2 ]; then - uwinfix="-e s,\\\\\\\\,/,g" - else - if [ "$archname" = cygwin ]; then - uwinfix="-e s,\\\\\\\\,/,g" - else - uwinfix= - fi - fi - fi + case "$osname" in + uwin) uwinfix="-e s,\\\\\\\\,/,g -e s,\\([a-zA-Z]\\):/,/\\1/,g" ;; + os2) uwinfix="-e s,\\\\\\\\,/,g" ;; + cygwin) uwinfix="-e s,\\\\\\\\,/,g" ;; + posix-bc) uwinfix="-e s/\\*POSIX(\\(.*\\))/\\1/" ;; + vos) uwinfix="-e s/\#/\\\#/" ;; + *) uwinfix="" ;; + esac case "$file" in *.c) filebase=`basename $file .c` ;; *.y) filebase=`basename $file .y` ;; esac case "$file" in - */*) finc="-I`echo $file | sed 's#/[^/]*$##`" ;; + */*) finc="-I`echo $file | sed 's#/[^/]*$##'`" ;; *) finc= ;; esac $echo "Finding dependencies for $filebase$_o." @@ -130,22 +140,45 @@ -e 's|\\$||' \ -e p \ -e '}' ) >UU/$file.c + if [ "$osname" = os390 -a "$file" = perly.c ]; then $echo '#endif' >>UU/$file.c fi - $cppstdin $finc -I. $cppflags $cppminus /d' \ - -e '/^#.*"-"/d' \ - -e 's#\.[0-9][0-9]*\.c#'"$file.c#" \ - -e 's/^[ ]*#[ ]*line/#/' \ - -e '/^# *[0-9][0-9]* *[".\/]/!d' \ - -e 's/^.*"\(.*\)".*$/'$filebase'\$(OBJ_EXT): \1/' \ - -e 's/^# *[0-9][0-9]* \(.*\)$/'$filebase'\$(OBJ_EXT): \1/' \ - -e 's|: \./|: |' \ - -e 's|\.c\.c|.c|' $uwinfix | \ - $uniq | $sort | $uniq >> .deptmp + + if [ "$osname" = os390 ]; then + $cppstdin $finc -I. $cppflags $cppminus /d' \ + -e '/^#.*"-"/d' \ + -e 's#\.[0-9][0-9]*\.c#'"$file.c#" \ + -e 's/^[ ]*#[ ]*line/#/' \ + -e '/^# *[0-9][0-9]* *[".\/]/!d' \ + -e 's/^.*"\(.*\)".*$/'$filebase'\$(OBJ_EXT): \1/' \ + -e 's/^# *[0-9][0-9]* \(.*\)$/'$filebase'\$(OBJ_EXT): \1/' \ + -e 's|: \./|: |' \ + -e 's|\.c\.c|.c|' $uwinfix | \ + $uniq | $sort | $uniq >> .deptmp + else + $cppstdin $finc -I. $cppflags $cppminus .cout 2>.cerr + $sed \ + -e '1d' \ + -e '/^#.*/d' \ + -e '/^#.*/d' \ + -e '/^#.*/d' \ + -e '/^#.*/d' \ + -e '/^#.*/d' \ + -e '/^#.*"-"/d' \ + -e '/^#.*"\/.*\/"/d' \ + -e '/: file path prefix .* never used$/d' \ + -e 's#\.[0-9][0-9]*\.c#'"$file.c#" \ + -e 's/^[ ]*#[ ]*line/#/' \ + -e '/^# *[0-9][0-9]* *[".\/]/!d' \ + -e 's/^.*"\(.*\)".*$/'$filebase'\$(OBJ_EXT): \1/' \ + -e 's/^# *[0-9][0-9]* \(.*\)$/'$filebase'\$(OBJ_EXT): \1/' \ + -e 's|: \./|: |' \ + -e 's|\.c\.c|.c|' $uwinfix .cout .cerr| \ + $uniq | $sort | $uniq >> .deptmp + fi done $sed <$mf >$mf.new -e '1,/^# AUTOMATICALLY/!d' @@ -177,6 +210,10 @@ $echo "Updating $mf..." $echo "# If this runs make out of memory, delete /usr/include lines." \ >> $mf.new + if [ "$osname" = vos ]; then + $sed 's|.incl.c|.h|' .deptmp >.deptmp.vos + mv -f .deptmp.vos .deptmp + fi $sed 's|^\(.*\$(OBJ_EXT):\) *\(.*/.*\.c\) *$|\1 \2; '"$defrule \2|" .deptmp \ >>$mf.new else @@ -208,7 +245,8 @@ $cp $mf.new $mf $rm $mf.new $echo "# WARNING: Put nothing here or make depend will gobble it up!" >> $mf -$rm -rf .deptmp UU .shlist .clist .hlist .hsed +$rm -rf .deptmp UU .shlist .clist .hlist .hsed .cout .cerr +rmdir .depending !NO!SUBS! $eunicefix makedepend BADGER last SWITCH; } # If 5.6.1 if ( $perl eq '5.6.1' ) { _patch(<<'BADGER'); --- makedepend.SH.org 2001-03-19 07:33:17.000000000 +0000 +++ makedepend.SH 2010-09-01 10:14:47.000000000 +0100 @@ -1,5 +1,5 @@ #! /bin/sh -case $CONFIGDOTSH in +case $PERL_CONFIG_SH in '') if test -f config.sh; then TOP=.; elif test -f ../config.sh; then TOP=..; @@ -29,6 +29,13 @@ !GROK!THIS! $spitshell >>makedepend <<'!NO!SUBS!' +if test -d .depending; then + echo "$0: Already running, exiting." + exit 0 +fi + +mkdir .depending + # This script should be called with # sh ./makedepend MAKE=$(MAKE) case "$1" in @@ -37,7 +44,7 @@ export PATH || (echo "OOPS, this isn't sh. Desperation time. I will feed myself to sh."; sh \$0; kill \$\$) -case $CONFIGDOTSH in +case $PERL_CONFIG_SH in '') if test -f config.sh; then TOP=.; elif test -f ../config.sh; then TOP=..; @@ -51,6 +58,11 @@ ;; esac +# Avoid localized gcc messages +case "$ccname" in + gcc) LC_ALL=C ; export LC_ALL ;; +esac + # We need .. when we are in the x2p directory if we are using the # cppstdin wrapper script. # Put .. and . first so that we pick up the present cppstdin, not @@ -58,6 +70,10 @@ PATH=".$path_sep..$path_sep$PATH" export PATH +case "$osname" in +amigaos) cat=/bin/cat ;; # must be absolute +esac + $cat /dev/null >.deptmp $rm -f *.c.c c/*.c.c if test -f Makefile; then @@ -67,7 +83,6 @@ # to be out of date. I don't know if OS/2 has touch, so do this: case "$osname" in os2) ;; - netbsd) ;; *) $touch $firstmakefile ;; esac fi @@ -99,29 +114,20 @@ $echo *.c | $tr ' ' $trnl | $egrep -v '\*' >.clist) for file in `$cat .clist`; do # for file in `cat /dev/null`; do - if [ "$osname" = uwin ]; then - uwinfix="-e s,\\\\\\\\,/,g -e s,\\([a-zA-Z]\\):/,/\\1/,g" - else - if [ "$osname" = os2 ]; then - uwinfix="-e s,\\\\\\\\,/,g" - else - if [ "$archname" = cygwin ]; then - uwinfix="-e s,\\\\\\\\,/,g" - else - if [ "$osname" = posix-bc ]; then - uwinfix="-e s/\\*POSIX(\\(.*\\))/\\1/" - else - uwinfix= - fi - fi - fi - fi + case "$osname" in + uwin) uwinfix="-e s,\\\\\\\\,/,g -e s,\\([a-zA-Z]\\):/,/\\1/,g" ;; + os2) uwinfix="-e s,\\\\\\\\,/,g" ;; + cygwin) uwinfix="-e s,\\\\\\\\,/,g" ;; + posix-bc) uwinfix="-e s/\\*POSIX(\\(.*\\))/\\1/" ;; + vos) uwinfix="-e s/\#/\\\#/" ;; + *) uwinfix="" ;; + esac case "$file" in *.c) filebase=`basename $file .c` ;; *.y) filebase=`basename $file .y` ;; esac case "$file" in - */*) finc="-I`echo $file | sed 's#/[^/]*$##`" ;; + */*) finc="-I`echo $file | sed 's#/[^/]*$##'`" ;; *) finc= ;; esac $echo "Finding dependencies for $filebase$_o." @@ -134,10 +140,12 @@ -e 's|\\$||' \ -e p \ -e '}' ) >UU/$file.c + + if [ "$osname" = os390 -a "$file" = perly.c ]; then + $echo '#endif' >>UU/$file.c + fi + if [ "$osname" = os390 ]; then - if [ "$file" = perly.c ]; then - $echo '#endif' >>UU/$file.c - fi $cppstdin $finc -I. $cppflags $cppminus /d' \ @@ -151,18 +159,24 @@ -e 's|\.c\.c|.c|' $uwinfix | \ $uniq | $sort | $uniq >> .deptmp else - $cppstdin $finc -I. $cppflags $cppminus .cout 2>.cerr $sed \ -e '1d' \ -e '/^#.*/d' \ + -e '/^#.*/d' \ + -e '/^#.*/d' \ + -e '/^#.*/d' \ + -e '/^#.*/d' \ -e '/^#.*"-"/d' \ + -e '/^#.*"\/.*\/"/d' \ + -e '/: file path prefix .* never used$/d' \ -e 's#\.[0-9][0-9]*\.c#'"$file.c#" \ -e 's/^[ ]*#[ ]*line/#/' \ -e '/^# *[0-9][0-9]* *[".\/]/!d' \ -e 's/^.*"\(.*\)".*$/'$filebase'\$(OBJ_EXT): \1/' \ -e 's/^# *[0-9][0-9]* \(.*\)$/'$filebase'\$(OBJ_EXT): \1/' \ -e 's|: \./|: |' \ - -e 's|\.c\.c|.c|' $uwinfix | \ + -e 's|\.c\.c|.c|' $uwinfix .cout .cerr| \ $uniq | $sort | $uniq >> .deptmp fi done @@ -196,6 +210,10 @@ $echo "Updating $mf..." $echo "# If this runs make out of memory, delete /usr/include lines." \ >> $mf.new + if [ "$osname" = vos ]; then + $sed 's|.incl.c|.h|' .deptmp >.deptmp.vos + mv -f .deptmp.vos .deptmp + fi $sed 's|^\(.*\$(OBJ_EXT):\) *\(.*/.*\.c\) *$|\1 \2; '"$defrule \2|" .deptmp \ >>$mf.new else @@ -227,7 +245,8 @@ $cp $mf.new $mf $rm $mf.new $echo "# WARNING: Put nothing here or make depend will gobble it up!" >> $mf -$rm -rf .deptmp UU .shlist .clist .hlist .hsed +$rm -rf .deptmp UU .shlist .clist .hlist .hsed .cout .cerr +rmdir .depending !NO!SUBS! $eunicefix makedepend BADGER last SWITCH; } # If 5.6.2 if ( $perl eq '5.6.2' ) { _patch(<<'BADGER'); --- makedepend.SH.org 2003-07-30 23:46:59.000000000 +0100 +++ makedepend.SH 2010-09-01 10:15:47.000000000 +0100 @@ -1,5 +1,5 @@ #! /bin/sh -case $CONFIGDOTSH in +case $PERL_CONFIG_SH in '') if test -f config.sh; then TOP=.; elif test -f ../config.sh; then TOP=..; @@ -29,6 +29,13 @@ !GROK!THIS! $spitshell >>makedepend <<'!NO!SUBS!' +if test -d .depending; then + echo "$0: Already running, exiting." + exit 0 +fi + +mkdir .depending + # This script should be called with # sh ./makedepend MAKE=$(MAKE) case "$1" in @@ -37,7 +44,7 @@ export PATH || (echo "OOPS, this isn't sh. Desperation time. I will feed myself to sh."; sh \$0; kill \$\$) -case $CONFIGDOTSH in +case $PERL_CONFIG_SH in '') if test -f config.sh; then TOP=.; elif test -f ../config.sh; then TOP=..; @@ -63,6 +70,10 @@ PATH=".$path_sep..$path_sep$PATH" export PATH +case "$osname" in +amigaos) cat=/bin/cat ;; # must be absolute +esac + $cat /dev/null >.deptmp $rm -f *.c.c c/*.c.c if test -f Makefile; then @@ -72,7 +83,6 @@ # to be out of date. I don't know if OS/2 has touch, so do this: case "$osname" in os2) ;; - netbsd) ;; *) $touch $firstmakefile ;; esac fi @@ -104,29 +114,20 @@ $echo *.c | $tr ' ' $trnl | $egrep -v '\*' >.clist) for file in `$cat .clist`; do # for file in `cat /dev/null`; do - if [ "$osname" = uwin ]; then - uwinfix="-e s,\\\\\\\\,/,g -e s,\\([a-zA-Z]\\):/,/\\1/,g" - else - if [ "$osname" = os2 ]; then - uwinfix="-e s,\\\\\\\\,/,g" - else - if [ "$archname" = cygwin ]; then - uwinfix="-e s,\\\\\\\\,/,g" - else - if [ "$osname" = posix-bc ]; then - uwinfix="-e s/\\*POSIX(\\(.*\\))/\\1/" - else - uwinfix= - fi - fi - fi - fi + case "$osname" in + uwin) uwinfix="-e s,\\\\\\\\,/,g -e s,\\([a-zA-Z]\\):/,/\\1/,g" ;; + os2) uwinfix="-e s,\\\\\\\\,/,g" ;; + cygwin) uwinfix="-e s,\\\\\\\\,/,g" ;; + posix-bc) uwinfix="-e s/\\*POSIX(\\(.*\\))/\\1/" ;; + vos) uwinfix="-e s/\#/\\\#/" ;; + *) uwinfix="" ;; + esac case "$file" in *.c) filebase=`basename $file .c` ;; *.y) filebase=`basename $file .y` ;; esac case "$file" in - */*) finc="-I`echo $file | sed 's#/[^/]*$##`" ;; + */*) finc="-I`echo $file | sed 's#/[^/]*$##'`" ;; *) finc= ;; esac $echo "Finding dependencies for $filebase$_o." @@ -139,10 +140,12 @@ -e 's|\\$||' \ -e p \ -e '}' ) >UU/$file.c + + if [ "$osname" = os390 -a "$file" = perly.c ]; then + $echo '#endif' >>UU/$file.c + fi + if [ "$osname" = os390 ]; then - if [ "$file" = perly.c ]; then - $echo '#endif' >>UU/$file.c - fi $cppstdin $finc -I. $cppflags $cppminus /d' \ @@ -156,21 +159,24 @@ -e 's|\.c\.c|.c|' $uwinfix | \ $uniq | $sort | $uniq >> .deptmp else - $cppstdin $finc -I. $cppflags $cppminus .cout 2>.cerr $sed \ -e '1d' \ -e '/^#.*/d' \ - -e '/^#.*/d' \ - -e '/^#.*/d' \ - -e '/^#.*/d' \ + -e '/^#.*/d' \ + -e '/^#.*/d' \ + -e '/^#.*/d' \ + -e '/^#.*/d' \ -e '/^#.*"-"/d' \ + -e '/^#.*"\/.*\/"/d' \ + -e '/: file path prefix .* never used$/d' \ -e 's#\.[0-9][0-9]*\.c#'"$file.c#" \ -e 's/^[ ]*#[ ]*line/#/' \ -e '/^# *[0-9][0-9]* *[".\/]/!d' \ -e 's/^.*"\(.*\)".*$/'$filebase'\$(OBJ_EXT): \1/' \ -e 's/^# *[0-9][0-9]* \(.*\)$/'$filebase'\$(OBJ_EXT): \1/' \ -e 's|: \./|: |' \ - -e 's|\.c\.c|.c|' $uwinfix | \ + -e 's|\.c\.c|.c|' $uwinfix .cout .cerr| \ $uniq | $sort | $uniq >> .deptmp fi done @@ -204,6 +210,10 @@ $echo "Updating $mf..." $echo "# If this runs make out of memory, delete /usr/include lines." \ >> $mf.new + if [ "$osname" = vos ]; then + $sed 's|.incl.c|.h|' .deptmp >.deptmp.vos + mv -f .deptmp.vos .deptmp + fi $sed 's|^\(.*\$(OBJ_EXT):\) *\(.*/.*\.c\) *$|\1 \2; '"$defrule \2|" .deptmp \ >>$mf.new else @@ -235,7 +245,8 @@ $cp $mf.new $mf $rm $mf.new $echo "# WARNING: Put nothing here or make depend will gobble it up!" >> $mf -$rm -rf .deptmp UU .shlist .clist .hlist .hsed +$rm -rf .deptmp UU .shlist .clist .hlist .hsed .cout .cerr +rmdir .depending !NO!SUBS! $eunicefix makedepend BADGER last SWITCH; } # If 5.7.0 if ( $perl eq '5.7.0' ) { _patch(<<'BADGER'); --- makedepend.SH.org 2000-08-13 19:35:04.000000000 +0100 +++ makedepend.SH 2010-09-01 10:47:14.000000000 +0100 @@ -1,5 +1,5 @@ #! /bin/sh -case $CONFIGDOTSH in +case $PERL_CONFIG_SH in '') if test -f config.sh; then TOP=.; elif test -f ../config.sh; then TOP=..; @@ -29,6 +29,13 @@ !GROK!THIS! $spitshell >>makedepend <<'!NO!SUBS!' +if test -d .depending; then + echo "$0: Already running, exiting." + exit 0 +fi + +mkdir .depending + # This script should be called with # sh ./makedepend MAKE=$(MAKE) case "$1" in @@ -37,7 +44,7 @@ export PATH || (echo "OOPS, this isn't sh. Desperation time. I will feed myself to sh."; sh \$0; kill \$\$) -case $CONFIGDOTSH in +case $PERL_CONFIG_SH in '') if test -f config.sh; then TOP=.; elif test -f ../config.sh; then TOP=..; @@ -51,6 +58,11 @@ ;; esac +# Avoid localized gcc messages +case "$ccname" in + gcc) LC_ALL=C ; export LC_ALL ;; +esac + # We need .. when we are in the x2p directory if we are using the # cppstdin wrapper script. # Put .. and . first so that we pick up the present cppstdin, not @@ -58,6 +70,10 @@ PATH=".$path_sep..$path_sep$PATH" export PATH +case "$osname" in +amigaos) cat=/bin/cat ;; # must be absolute +esac + $cat /dev/null >.deptmp $rm -f *.c.c c/*.c.c if test -f Makefile; then @@ -67,7 +83,6 @@ # to be out of date. I don't know if OS/2 has touch, so do this: case "$osname" in os2) ;; - netbsd) ;; *) $touch $firstmakefile ;; esac fi @@ -99,25 +114,20 @@ $echo *.c | $tr ' ' $trnl | $egrep -v '\*' >.clist) for file in `$cat .clist`; do # for file in `cat /dev/null`; do - if [ "$osname" = uwin ]; then - uwinfix="-e s,\\\\\\\\,/,g -e s,\\([a-zA-Z]\\):/,/\\1/,g" - else - if [ "$osname" = os2 ]; then - uwinfix="-e s,\\\\\\\\,/,g" - else - if [ "$archname" = cygwin ]; then - uwinfix="-e s,\\\\\\\\,/,g" - else - uwinfix= - fi - fi - fi + case "$osname" in + uwin) uwinfix="-e s,\\\\\\\\,/,g -e s,\\([a-zA-Z]\\):/,/\\1/,g" ;; + os2) uwinfix="-e s,\\\\\\\\,/,g" ;; + cygwin) uwinfix="-e s,\\\\\\\\,/,g" ;; + posix-bc) uwinfix="-e s/\\*POSIX(\\(.*\\))/\\1/" ;; + vos) uwinfix="-e s/\#/\\\#/" ;; + *) uwinfix="" ;; + esac case "$file" in *.c) filebase=`basename $file .c` ;; *.y) filebase=`basename $file .y` ;; esac case "$file" in - */*) finc="-I`echo $file | sed 's#/[^/]*$##`" ;; + */*) finc="-I`echo $file | sed 's#/[^/]*$##'`" ;; *) finc= ;; esac $echo "Finding dependencies for $filebase$_o." @@ -130,10 +140,12 @@ -e 's|\\$||' \ -e p \ -e '}' ) >UU/$file.c + + if [ "$osname" = os390 -a "$file" = perly.c ]; then + $echo '#endif' >>UU/$file.c + fi + if [ "$osname" = os390 ]; then - if [ "$file" = perly.c ]; then - $echo '#endif' >>UU/$file.c - fi $cppstdin $finc -I. $cppflags $cppminus /d' \ @@ -147,18 +159,24 @@ -e 's|\.c\.c|.c|' $uwinfix | \ $uniq | $sort | $uniq >> .deptmp else - $cppstdin $finc -I. $cppflags $cppminus .cout 2>.cerr $sed \ -e '1d' \ -e '/^#.*/d' \ + -e '/^#.*/d' \ + -e '/^#.*/d' \ + -e '/^#.*/d' \ + -e '/^#.*/d' \ -e '/^#.*"-"/d' \ + -e '/^#.*"\/.*\/"/d' \ + -e '/: file path prefix .* never used$/d' \ -e 's#\.[0-9][0-9]*\.c#'"$file.c#" \ -e 's/^[ ]*#[ ]*line/#/' \ -e '/^# *[0-9][0-9]* *[".\/]/!d' \ -e 's/^.*"\(.*\)".*$/'$filebase'\$(OBJ_EXT): \1/' \ -e 's/^# *[0-9][0-9]* \(.*\)$/'$filebase'\$(OBJ_EXT): \1/' \ -e 's|: \./|: |' \ - -e 's|\.c\.c|.c|' $uwinfix | \ + -e 's|\.c\.c|.c|' $uwinfix .cout .cerr| \ $uniq | $sort | $uniq >> .deptmp fi done @@ -192,6 +210,10 @@ $echo "Updating $mf..." $echo "# If this runs make out of memory, delete /usr/include lines." \ >> $mf.new + if [ "$osname" = vos ]; then + $sed 's|.incl.c|.h|' .deptmp >.deptmp.vos + mv -f .deptmp.vos .deptmp + fi $sed 's|^\(.*\$(OBJ_EXT):\) *\(.*/.*\.c\) *$|\1 \2; '"$defrule \2|" .deptmp \ >>$mf.new else @@ -223,7 +245,8 @@ $cp $mf.new $mf $rm $mf.new $echo "# WARNING: Put nothing here or make depend will gobble it up!" >> $mf -$rm -rf .deptmp UU .shlist .clist .hlist .hsed +$rm -rf .deptmp UU .shlist .clist .hlist .hsed .cout .cerr +rmdir .depending !NO!SUBS! $eunicefix makedepend BADGER last SWITCH; } # If 5.7.1 if ( $perl eq '5.7.1' ) { _patch(<<'BADGER'); --- makedepend.SH.org 2001-03-11 16:30:08.000000000 +0000 +++ makedepend.SH 2010-09-01 10:44:54.000000000 +0100 @@ -1,5 +1,5 @@ #! /bin/sh -case $CONFIGDOTSH in +case $PERL_CONFIG_SH in '') if test -f config.sh; then TOP=.; elif test -f ../config.sh; then TOP=..; @@ -29,6 +29,13 @@ !GROK!THIS! $spitshell >>makedepend <<'!NO!SUBS!' +if test -d .depending; then + echo "$0: Already running, exiting." + exit 0 +fi + +mkdir .depending + # This script should be called with # sh ./makedepend MAKE=$(MAKE) case "$1" in @@ -37,7 +44,7 @@ export PATH || (echo "OOPS, this isn't sh. Desperation time. I will feed myself to sh."; sh \$0; kill \$\$) -case $CONFIGDOTSH in +case $PERL_CONFIG_SH in '') if test -f config.sh; then TOP=.; elif test -f ../config.sh; then TOP=..; @@ -51,6 +58,11 @@ ;; esac +# Avoid localized gcc messages +case "$ccname" in + gcc) LC_ALL=C ; export LC_ALL ;; +esac + # We need .. when we are in the x2p directory if we are using the # cppstdin wrapper script. # Put .. and . first so that we pick up the present cppstdin, not @@ -58,6 +70,10 @@ PATH=".$path_sep..$path_sep$PATH" export PATH +case "$osname" in +amigaos) cat=/bin/cat ;; # must be absolute +esac + $cat /dev/null >.deptmp $rm -f *.c.c c/*.c.c if test -f Makefile; then @@ -67,7 +83,6 @@ # to be out of date. I don't know if OS/2 has touch, so do this: case "$osname" in os2) ;; - netbsd) ;; *) $touch $firstmakefile ;; esac fi @@ -99,29 +114,20 @@ $echo *.c | $tr ' ' $trnl | $egrep -v '\*' >.clist) for file in `$cat .clist`; do # for file in `cat /dev/null`; do - if [ "$osname" = uwin ]; then - uwinfix="-e s,\\\\\\\\,/,g -e s,\\([a-zA-Z]\\):/,/\\1/,g" - else - if [ "$osname" = os2 ]; then - uwinfix="-e s,\\\\\\\\,/,g" - else - if [ "$archname" = cygwin ]; then - uwinfix="-e s,\\\\\\\\,/,g" - else - if [ "$osname" = posix-bc ]; then - uwinfix="-e s/\\*POSIX(\\(.*\\))/\\1/" - else - uwinfix= - fi - fi - fi - fi + case "$osname" in + uwin) uwinfix="-e s,\\\\\\\\,/,g -e s,\\([a-zA-Z]\\):/,/\\1/,g" ;; + os2) uwinfix="-e s,\\\\\\\\,/,g" ;; + cygwin) uwinfix="-e s,\\\\\\\\,/,g" ;; + posix-bc) uwinfix="-e s/\\*POSIX(\\(.*\\))/\\1/" ;; + vos) uwinfix="-e s/\#/\\\#/" ;; + *) uwinfix="" ;; + esac case "$file" in *.c) filebase=`basename $file .c` ;; *.y) filebase=`basename $file .y` ;; esac case "$file" in - */*) finc="-I`echo $file | sed 's#/[^/]*$##`" ;; + */*) finc="-I`echo $file | sed 's#/[^/]*$##'`" ;; *) finc= ;; esac $echo "Finding dependencies for $filebase$_o." @@ -134,10 +140,12 @@ -e 's|\\$||' \ -e p \ -e '}' ) >UU/$file.c + + if [ "$osname" = os390 -a "$file" = perly.c ]; then + $echo '#endif' >>UU/$file.c + fi + if [ "$osname" = os390 ]; then - if [ "$file" = perly.c ]; then - $echo '#endif' >>UU/$file.c - fi $cppstdin $finc -I. $cppflags $cppminus /d' \ @@ -151,18 +159,24 @@ -e 's|\.c\.c|.c|' $uwinfix | \ $uniq | $sort | $uniq >> .deptmp else - $cppstdin $finc -I. $cppflags $cppminus .cout 2>.cerr $sed \ -e '1d' \ -e '/^#.*/d' \ + -e '/^#.*/d' \ + -e '/^#.*/d' \ + -e '/^#.*/d' \ + -e '/^#.*/d' \ -e '/^#.*"-"/d' \ + -e '/^#.*"\/.*\/"/d' \ + -e '/: file path prefix .* never used$/d' \ -e 's#\.[0-9][0-9]*\.c#'"$file.c#" \ -e 's/^[ ]*#[ ]*line/#/' \ -e '/^# *[0-9][0-9]* *[".\/]/!d' \ -e 's/^.*"\(.*\)".*$/'$filebase'\$(OBJ_EXT): \1/' \ -e 's/^# *[0-9][0-9]* \(.*\)$/'$filebase'\$(OBJ_EXT): \1/' \ -e 's|: \./|: |' \ - -e 's|\.c\.c|.c|' $uwinfix | \ + -e 's|\.c\.c|.c|' $uwinfix .cout .cerr| \ $uniq | $sort | $uniq >> .deptmp fi done @@ -196,6 +210,10 @@ $echo "Updating $mf..." $echo "# If this runs make out of memory, delete /usr/include lines." \ >> $mf.new + if [ "$osname" = vos ]; then + $sed 's|.incl.c|.h|' .deptmp >.deptmp.vos + mv -f .deptmp.vos .deptmp + fi $sed 's|^\(.*\$(OBJ_EXT):\) *\(.*/.*\.c\) *$|\1 \2; '"$defrule \2|" .deptmp \ >>$mf.new else @@ -227,7 +245,8 @@ $cp $mf.new $mf $rm $mf.new $echo "# WARNING: Put nothing here or make depend will gobble it up!" >> $mf -$rm -rf .deptmp UU .shlist .clist .hlist .hsed +$rm -rf .deptmp UU .shlist .clist .hlist .hsed .cout .cerr +rmdir .depending !NO!SUBS! $eunicefix makedepend BADGER last SWITCH; } # If 5.7.2 if ( $perl eq '5.7.2' ) { _patch(<<'BADGER'); --- makedepend.SH.org 2001-07-09 15:11:05.000000000 +0100 +++ makedepend.SH 2010-09-01 10:45:32.000000000 +0100 @@ -18,10 +18,6 @@ */*) cd `expr X$0 : 'X\(.*\)/'` ;; esac -case "$osname" in -amigaos) cat=/bin/cat ;; # must be absolute -esac - echo "Extracting makedepend (with variable substitutions)" rm -f makedepend $spitshell >makedepend <>makedepend <<'!NO!SUBS!' +if test -d .depending; then + echo "$0: Already running, exiting." + exit 0 +fi + +mkdir .depending + # This script should be called with # sh ./makedepend MAKE=$(MAKE) case "$1" in @@ -55,6 +58,11 @@ ;; esac +# Avoid localized gcc messages +case "$ccname" in + gcc) LC_ALL=C ; export LC_ALL ;; +esac + # We need .. when we are in the x2p directory if we are using the # cppstdin wrapper script. # Put .. and . first so that we pick up the present cppstdin, not @@ -62,6 +70,10 @@ PATH=".$path_sep..$path_sep$PATH" export PATH +case "$osname" in +amigaos) cat=/bin/cat ;; # must be absolute +esac + $cat /dev/null >.deptmp $rm -f *.c.c c/*.c.c if test -f Makefile; then @@ -71,7 +83,6 @@ # to be out of date. I don't know if OS/2 has touch, so do this: case "$osname" in os2) ;; - netbsd) ;; *) $touch $firstmakefile ;; esac fi @@ -103,29 +114,20 @@ $echo *.c | $tr ' ' $trnl | $egrep -v '\*' >.clist) for file in `$cat .clist`; do # for file in `cat /dev/null`; do - if [ "$osname" = uwin ]; then - uwinfix="-e s,\\\\\\\\,/,g -e s,\\([a-zA-Z]\\):/,/\\1/,g" - else - if [ "$osname" = os2 ]; then - uwinfix="-e s,\\\\\\\\,/,g" - else - if [ "$archname" = cygwin ]; then - uwinfix="-e s,\\\\\\\\,/,g" - else - if [ "$osname" = posix-bc ]; then - uwinfix="-e s/\\*POSIX(\\(.*\\))/\\1/" - else - uwinfix= - fi - fi - fi - fi + case "$osname" in + uwin) uwinfix="-e s,\\\\\\\\,/,g -e s,\\([a-zA-Z]\\):/,/\\1/,g" ;; + os2) uwinfix="-e s,\\\\\\\\,/,g" ;; + cygwin) uwinfix="-e s,\\\\\\\\,/,g" ;; + posix-bc) uwinfix="-e s/\\*POSIX(\\(.*\\))/\\1/" ;; + vos) uwinfix="-e s/\#/\\\#/" ;; + *) uwinfix="" ;; + esac case "$file" in *.c) filebase=`basename $file .c` ;; *.y) filebase=`basename $file .y` ;; esac case "$file" in - */*) finc="-I`echo $file | sed 's#/[^/]*$##`" ;; + */*) finc="-I`echo $file | sed 's#/[^/]*$##'`" ;; *) finc= ;; esac $echo "Finding dependencies for $filebase$_o." @@ -138,10 +140,12 @@ -e 's|\\$||' \ -e p \ -e '}' ) >UU/$file.c + + if [ "$osname" = os390 -a "$file" = perly.c ]; then + $echo '#endif' >>UU/$file.c + fi + if [ "$osname" = os390 ]; then - if [ "$file" = perly.c ]; then - $echo '#endif' >>UU/$file.c - fi $cppstdin $finc -I. $cppflags $cppminus /d' \ @@ -155,18 +159,24 @@ -e 's|\.c\.c|.c|' $uwinfix | \ $uniq | $sort | $uniq >> .deptmp else - $cppstdin $finc -I. $cppflags $cppminus .cout 2>.cerr $sed \ -e '1d' \ -e '/^#.*/d' \ + -e '/^#.*/d' \ + -e '/^#.*/d' \ + -e '/^#.*/d' \ + -e '/^#.*/d' \ -e '/^#.*"-"/d' \ + -e '/^#.*"\/.*\/"/d' \ + -e '/: file path prefix .* never used$/d' \ -e 's#\.[0-9][0-9]*\.c#'"$file.c#" \ -e 's/^[ ]*#[ ]*line/#/' \ -e '/^# *[0-9][0-9]* *[".\/]/!d' \ -e 's/^.*"\(.*\)".*$/'$filebase'\$(OBJ_EXT): \1/' \ -e 's/^# *[0-9][0-9]* \(.*\)$/'$filebase'\$(OBJ_EXT): \1/' \ -e 's|: \./|: |' \ - -e 's|\.c\.c|.c|' $uwinfix | \ + -e 's|\.c\.c|.c|' $uwinfix .cout .cerr| \ $uniq | $sort | $uniq >> .deptmp fi done @@ -200,6 +210,10 @@ $echo "Updating $mf..." $echo "# If this runs make out of memory, delete /usr/include lines." \ >> $mf.new + if [ "$osname" = vos ]; then + $sed 's|.incl.c|.h|' .deptmp >.deptmp.vos + mv -f .deptmp.vos .deptmp + fi $sed 's|^\(.*\$(OBJ_EXT):\) *\(.*/.*\.c\) *$|\1 \2; '"$defrule \2|" .deptmp \ >>$mf.new else @@ -231,7 +245,8 @@ $cp $mf.new $mf $rm $mf.new $echo "# WARNING: Put nothing here or make depend will gobble it up!" >> $mf -$rm -rf .deptmp UU .shlist .clist .hlist .hsed +$rm -rf .deptmp UU .shlist .clist .hlist .hsed .cout .cerr +rmdir .depending !NO!SUBS! $eunicefix makedepend BADGER last SWITCH; } # If 5.7.3 if ( $perl eq '5.7.3' ) { _patch(<<'BADGER'); --- makedepend.SH.org 2002-03-05 01:10:22.000000000 +0000 +++ makedepend.SH 2010-09-01 10:46:13.000000000 +0100 @@ -18,10 +18,6 @@ */*) cd `expr X$0 : 'X\(.*\)/'` ;; esac -case "$osname" in -amigaos) cat=/bin/cat ;; # must be absolute -esac - echo "Extracting makedepend (with variable substitutions)" rm -f makedepend $spitshell >makedepend <>makedepend <<'!NO!SUBS!' +if test -d .depending; then + echo "$0: Already running, exiting." + exit 0 +fi + +mkdir .depending + # This script should be called with # sh ./makedepend MAKE=$(MAKE) case "$1" in @@ -55,6 +58,11 @@ ;; esac +# Avoid localized gcc messages +case "$ccname" in + gcc) LC_ALL=C ; export LC_ALL ;; +esac + # We need .. when we are in the x2p directory if we are using the # cppstdin wrapper script. # Put .. and . first so that we pick up the present cppstdin, not @@ -62,6 +70,10 @@ PATH=".$path_sep..$path_sep$PATH" export PATH +case "$osname" in +amigaos) cat=/bin/cat ;; # must be absolute +esac + $cat /dev/null >.deptmp $rm -f *.c.c c/*.c.c if test -f Makefile; then @@ -71,7 +83,6 @@ # to be out of date. I don't know if OS/2 has touch, so do this: case "$osname" in os2) ;; - netbsd) ;; *) $touch $firstmakefile ;; esac fi @@ -116,7 +127,7 @@ *.y) filebase=`basename $file .y` ;; esac case "$file" in - */*) finc="-I`echo $file | sed 's#/[^/]*$##`" ;; + */*) finc="-I`echo $file | sed 's#/[^/]*$##'`" ;; *) finc= ;; esac $echo "Finding dependencies for $filebase$_o." @@ -129,6 +140,11 @@ -e 's|\\$||' \ -e p \ -e '}' ) >UU/$file.c + + if [ "$osname" = os390 -a "$file" = perly.c ]; then + $echo '#endif' >>UU/$file.c + fi + if [ "$osname" = os390 ]; then $cppstdin $finc -I. $cppflags $cppminus > .deptmp else - $cppstdin $finc -I. $cppflags $cppminus &1 | + $cppstdin $finc -I. $cppflags $cppminus .cout 2>.cerr $sed \ -e '1d' \ -e '/^#.*/d' \ -e '/^#.*/d' \ + -e '/^#.*/d' \ -e '/^#.*/d' \ + -e '/^#.*/d' \ -e '/^#.*"-"/d' \ + -e '/^#.*"\/.*\/"/d' \ -e '/: file path prefix .* never used$/d' \ -e 's#\.[0-9][0-9]*\.c#'"$file.c#" \ -e 's/^[ ]*#[ ]*line/#/' \ @@ -157,7 +176,7 @@ -e 's/^.*"\(.*\)".*$/'$filebase'\$(OBJ_EXT): \1/' \ -e 's/^# *[0-9][0-9]* \(.*\)$/'$filebase'\$(OBJ_EXT): \1/' \ -e 's|: \./|: |' \ - -e 's|\.c\.c|.c|' $uwinfix | \ + -e 's|\.c\.c|.c|' $uwinfix .cout .cerr| \ $uniq | $sort | $uniq >> .deptmp fi done @@ -191,6 +210,10 @@ $echo "Updating $mf..." $echo "# If this runs make out of memory, delete /usr/include lines." \ >> $mf.new + if [ "$osname" = vos ]; then + $sed 's|.incl.c|.h|' .deptmp >.deptmp.vos + mv -f .deptmp.vos .deptmp + fi $sed 's|^\(.*\$(OBJ_EXT):\) *\(.*/.*\.c\) *$|\1 \2; '"$defrule \2|" .deptmp \ >>$mf.new else @@ -222,7 +245,8 @@ $cp $mf.new $mf $rm $mf.new $echo "# WARNING: Put nothing here or make depend will gobble it up!" >> $mf -$rm -rf .deptmp UU .shlist .clist .hlist .hsed +$rm -rf .deptmp UU .shlist .clist .hlist .hsed .cout .cerr +rmdir .depending !NO!SUBS! $eunicefix makedepend BADGER last SWITCH; } # If 5.8.0 if ( $perl eq '5.8.0' ) { _patch(<<'BADGER'); --- makedepend.SH.org 2002-07-09 15:06:42.000000000 +0100 +++ makedepend.SH 2010-09-01 10:16:37.000000000 +0100 @@ -58,6 +58,11 @@ ;; esac +# Avoid localized gcc messages +case "$ccname" in + gcc) LC_ALL=C ; export LC_ALL ;; +esac + # We need .. when we are in the x2p directory if we are using the # cppstdin wrapper script. # Put .. and . first so that we pick up the present cppstdin, not @@ -78,7 +83,6 @@ # to be out of date. I don't know if OS/2 has touch, so do this: case "$osname" in os2) ;; - netbsd) ;; *) $touch $firstmakefile ;; esac fi @@ -123,7 +127,7 @@ *.y) filebase=`basename $file .y` ;; esac case "$file" in - */*) finc="-I`echo $file | sed 's#/[^/]*$##`" ;; + */*) finc="-I`echo $file | sed 's#/[^/]*$##'`" ;; *) finc= ;; esac $echo "Finding dependencies for $filebase$_o." @@ -136,6 +140,11 @@ -e 's|\\$||' \ -e p \ -e '}' ) >UU/$file.c + + if [ "$osname" = os390 -a "$file" = perly.c ]; then + $echo '#endif' >>UU/$file.c + fi + if [ "$osname" = os390 ]; then $cppstdin $finc -I. $cppflags $cppminus /d' \ -e '/^#.*/d' \ -e '/^#.*/d' \ + -e '/^#.*/d' \ -e '/^#.*"-"/d' \ + -e '/^#.*"\/.*\/"/d' \ -e '/: file path prefix .* never used$/d' \ -e 's#\.[0-9][0-9]*\.c#'"$file.c#" \ -e 's/^[ ]*#[ ]*line/#/' \ @@ -199,6 +210,10 @@ $echo "Updating $mf..." $echo "# If this runs make out of memory, delete /usr/include lines." \ >> $mf.new + if [ "$osname" = vos ]; then + $sed 's|.incl.c|.h|' .deptmp >.deptmp.vos + mv -f .deptmp.vos .deptmp + fi $sed 's|^\(.*\$(OBJ_EXT):\) *\(.*/.*\.c\) *$|\1 \2; '"$defrule \2|" .deptmp \ >>$mf.new else BADGER last SWITCH; } # If 5.9.4 if ( $perl eq '5.9.4' ) { _patch_b64(<<'BADGER'); LS0tIG1ha2VkZXBlbmQuU0gJMjAyMC0wNi0wOSAxNjoxNDo1NC43Njc2MTI2OTAgKzAxMDAKKysr IG1ha2VkZXBlbmQuU0gJMjAyMC0wNi0wOSAxNjoxNTowNC40MTEwODI2ODUgKzAxMDAKQEAgLTEy OCw3ICsxMjgsNyBAQAogICAgICoueSkgZmlsZWJhc2U9YGJhc2VuYW1lICRmaWxlIC55YCA7Owog ICAgIGVzYWMKICAgICBjYXNlICIkZmlsZSIgaW4KLSAgICAqLyopIGZpbmM9Ii1JYGVjaG8gJGZp bGUgfCBzZWQgJ3MjL1teL10qJCMjYCIgOzsKKyAgICAqLyopIGZpbmM9Ii1JYGVjaG8gJGZpbGUg fCBzZWQgJ3MjL1teL10qJCMjJ2AiIDs7CiAgICAgKikgICBmaW5jPSA7OwogICAgIGVzYWMKICAg ICAkZWNobyAiRmluZGluZyBkZXBlbmRlbmNpZXMgZm9yICRmaWxlYmFzZSRfby4iCkBAIC0xNjks NiArMTY5LDcgQEAKICAgICAgICAgICAgIC1lICcvXiMuKjxjb21tYW5kIGxpbmU+L2QnIFwKICAg ICAgICAgICAgIC1lICcvXiMuKjxjb21tYW5kLWxpbmU+L2QnIFwKIAkgICAgLWUgJy9eIy4qIi0i L2QnIFwKKwkgICAgLWUgJy9eIy4qIlwvLipcLyIvZCcgXAogCSAgICAtZSAnLzogZmlsZSBwYXRo IHByZWZpeCAuKiBuZXZlciB1c2VkJC9kJyBcCiAJICAgIC1lICdzI1wuWzAtOV1bMC05XSpcLmMj JyIkZmlsZS5jIyIgXAogCSAgICAtZSAncy9eWwkgXSojWwkgXSpsaW5lLyMvJyBcCg== BADGER last SWITCH; } # If 5.8.[12345678] and 5.9.[0123] _patch(<<'BADGER'); --- makedepend.SH.org 2003-06-05 19:11:10.000000000 +0100 +++ makedepend.SH 2010-09-01 10:24:39.000000000 +0100 @@ -83,7 +83,6 @@ # to be out of date. I don't know if OS/2 has touch, so do this: case "$osname" in os2) ;; - netbsd) ;; *) $touch $firstmakefile ;; esac fi @@ -128,7 +127,7 @@ *.y) filebase=`basename $file .y` ;; esac case "$file" in - */*) finc="-I`echo $file | sed 's#/[^/]*$##`" ;; + */*) finc="-I`echo $file | sed 's#/[^/]*$##'`" ;; *) finc= ;; esac $echo "Finding dependencies for $filebase$_o." @@ -167,7 +166,9 @@ -e '/^#.*/d' \ -e '/^#.*/d' \ -e '/^#.*/d' \ + -e '/^#.*/d' \ -e '/^#.*"-"/d' \ + -e '/^#.*"\/.*\/"/d' \ -e '/: file path prefix .* never used$/d' \ -e 's#\.[0-9][0-9]*\.c#'"$file.c#" \ -e 's/^[ ]*#[ ]*line/#/' \ @@ -209,6 +210,10 @@ $echo "Updating $mf..." $echo "# If this runs make out of memory, delete /usr/include lines." \ >> $mf.new + if [ "$osname" = vos ]; then + $sed 's|.incl.c|.h|' .deptmp >.deptmp.vos + mv -f .deptmp.vos .deptmp + fi $sed 's|^\(.*\$(OBJ_EXT):\) *\(.*/.*\.c\) *$|\1 \2; '"$defrule \2|" .deptmp \ >>$mf.new else BADGER } } sub _patch_conf_gconvert { my $perl = shift; _patch(<<'END'); --- Configure +++ Configure @@ -7851,6 +7851,21 @@ int main() Gconvert((DOUBLETYPE)0.1, 8, 0, buf); checkit("0.1", buf); + Gconvert((DOUBLETYPE)0.01, 8, 0, buf); + checkit("0.01", buf); + + Gconvert((DOUBLETYPE)0.001, 8, 0, buf); + checkit("0.001", buf); + + Gconvert((DOUBLETYPE)0.0001, 8, 0, buf); + checkit("0.0001", buf); + + Gconvert((DOUBLETYPE)0.00009, 8, 0, buf); + if (strlen(buf) > 5) + checkit("9e-005", buf); /* for Microsoft ?? */ + else + checkit("9e-05", buf); + Gconvert((DOUBLETYPE)1.0, 8, 0, buf); checkit("1", buf); @@ -7889,6 +7904,19 @@ int main() Gconvert((DOUBLETYPE)123.456, 8, 0, buf); checkit("123.456", buf); + /* Testing of 1e+129 in bigintpm.t must not get extra '.' here. */ + Gconvert((DOUBLETYPE)1e34, 8, 0, buf); + /* 34 should be enough to scare even long double + * places into using the e notation. */ + if (strlen(buf) > 5) + checkit("1e+034", buf); /* for Microsoft */ + else + checkit("1e+34", buf); + + /* For Perl, if you add additional tests here, also add them to + * t/base/num.t for benefit of platforms not using Configure or + * overriding d_Gconvert */ + exit(0); } EOP END } sub _patch_sort_N { system($^X, '-pi.bak', '-e', 's!\$sort \-n \+1!(\$sort -n -k 2 2>/dev/null || \$sort -n +1)!', 'Configure'); } sub _patch_archive_tar_tests { my $perl = shift; if ($perl =~ /^5\.10/) { _patch(<<'END'); --- lib/Archive/Tar/t/02_methods.t +++ lib/Archive/Tar/t/02_methods.t @@ -70,6 +70,20 @@ my $LONG_FILE = qq[directory/really-really-really-really-really-really-really-re my $TOO_LONG = ($^O eq 'MSWin32' or $^O eq 'cygwin' or $^O eq 'VMS') && length( cwd(). $LONG_FILE ) > 247; +if(!$TOO_LONG) { + my $alt = File::Spec->catfile( cwd(), $LONG_FILE); + eval 'mkpath([$alt]);'; + if($@) + { + $TOO_LONG = 1; + } + else + { + $@ = ''; + my $base = File::Spec->catfile( cwd(), 'directory'); + rmtree $base; + } +} ### warn if we are going to skip long file names if ($TOO_LONG) { diag("No long filename support - long filename extraction disabled") if ! $ENV{PERL_CORE}; END } else { _patch(<<'END'); --- cpan/Archive-Tar/t/02_methods.t +++ cpan/Archive-Tar/t/02_methods.t @@ -70,6 +70,20 @@ my $LONG_FILE = qq[directory/really-really-really-really-really-really-really-re my $TOO_LONG = ($^O eq 'MSWin32' or $^O eq 'cygwin' or $^O eq 'VMS') && length( cwd(). $LONG_FILE ) > 247; +if(!$TOO_LONG) { + my $alt = File::Spec->catfile( cwd(), $LONG_FILE); + eval 'mkpath([$alt]);'; + if($@) + { + $TOO_LONG = 1; + } + else + { + $@ = ''; + my $base = File::Spec->catfile( cwd(), 'directory'); + rmtree $base; + } +} ### warn if we are going to skip long file names if ($TOO_LONG) { diag("No long filename support - long filename extraction disabled") if ! $ENV{PERL_CORE}; END } } sub _patch_odbm_file_hints_linux { _patch(<<'END'); --- ext/ODBM_File/hints/linux.pl +++ ext/ODBM_File/hints/linux.pl @@ -1,8 +1,8 @@ # uses GDBM dbm compatibility feature - at least on SuSE 8.0 $self->{LIBS} = ['-lgdbm']; -# Debian/Ubuntu have /usr/lib/libgdbm_compat.so.3* but not this file, +# Debian/Ubuntu have libgdbm_compat.so but not this file, # so linking may fail -if (-e '/usr/lib/libgdbm_compat.so' or -e '/usr/lib64/libgdbm_compat.so') { - $self->{LIBS}->[0] .= ' -lgdbm_compat'; +foreach (split / /, $Config{libpth}) { + $self->{LIBS}->[0] .= ' -lgdbm_compat' if -e $_.'/libgdbm_compat.so'; } END } sub _patch_make_ext_pl { _patch(<<'END'); --- make_ext.pl +++ make_ext.pl @@ -377,6 +377,10 @@ WriteMakefile( EOM close $fh or die "Can't close Makefile.PL: $!"; } + eval { + my $ftime = time - 4; + utime $ftime, $ftime, 'Makefile.PL'; + }; print "\nRunning Makefile.PL in $ext_dir\n"; # Presumably this can be simplified END } sub _patch_589_perlio_c { _patch(<<'END'); --- perlio.c +++ perlio.c @@ -2323,6 +2323,12 @@ PerlIO_init(pTHX) { /* MUTEX_INIT(&PL_perlio_mutex) is done in PERL_SYS_INIT3(). */ PERL_UNUSED_CONTEXT; + /* + * No, for backwards compatibility (before PERL_SYS_INIT3 changed to be + * defined as a separate function call), we need to call + * MUTEX_INIT(&PL_perlio_mutex) (via the PERLIO_INIT macro). + */ + PERLIO_INIT; } void END } # http://perl5.git.perl.org/perl.git/commit/2674b61957c26a4924831d5110afa454ae7ae5a6 sub _patch_hsplit_rehash_58 { my $perl = shift; my $patch = <<'END'; --- hv.c +++ hv.c @@ -31,7 +31,8 @@ holds the key and hash value. #define PERL_HASH_INTERNAL_ACCESS #include "perl.h" -#define HV_MAX_LENGTH_BEFORE_SPLIT 14 +#define HV_MAX_LENGTH_BEFORE_REHASH 14 +#define SHOULD_DO_HSPLIT(xhv) ((xhv)->xhv_keys > (xhv)->xhv_max) /* HvTOTALKEYS(hv) > HvMAX(hv) */ STATIC void S_more_he(pTHX) @@ -705,23 +706,8 @@ Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, xhv->xhv_keys++; /* HvTOTALKEYS(hv)++ */ if (!counter) { /* initial entry? */ xhv->xhv_fill++; /* HvFILL(hv)++ */ - } else if (xhv->xhv_keys > (IV)xhv->xhv_max) { + } else if ( SHOULD_DO_HSPLIT(xhv) ) { hsplit(hv); - } else if(!HvREHASH(hv)) { - U32 n_links = 1; - - while ((counter = HeNEXT(counter))) - n_links++; - - if (n_links > HV_MAX_LENGTH_BEFORE_SPLIT) { - /* Use only the old HvKEYS(hv) > HvMAX(hv) condition to limit - bucket splits on a rehashed hash, as we're not going to - split it again, and if someone is lucky (evil) enough to - get all the keys in one list they could exhaust our memory - as we repeatedly double the number of buckets on every - entry. Linear search feels a less worse thing to do. */ - hsplit(hv); - } } } @@ -1048,7 +1034,7 @@ S_hsplit(pTHX_ HV *hv) /* Pick your policy for "hashing isn't working" here: */ - if (longest_chain <= HV_MAX_LENGTH_BEFORE_SPLIT /* split worked? */ + if (longest_chain <= HV_MAX_LENGTH_BEFORE_REHASH /* split worked? */ || HvREHASH(hv)) { return; } @@ -1966,8 +1952,8 @@ S_share_hek_flags(pTHX_ const char *str, I32 len, register U32 hash, int flags) xhv->xhv_keys++; /* HvTOTALKEYS(hv)++ */ if (!next) { /* initial entry? */ xhv->xhv_fill++; /* HvFILL(hv)++ */ - } else if (xhv->xhv_keys > (IV)xhv->xhv_max /* HvKEYS(hv) > HvMAX(hv) */) { - hsplit(PL_strtab); + } else if ( SHOULD_DO_HSPLIT(xhv) ) { + hsplit(PL_strtab); } } --- t/op/hash.t +++ t/op/hash.t @@ -39,22 +39,36 @@ use constant THRESHOLD => 14; use constant START => "a"; # some initial hash data -my %h2 = map {$_ => 1} 'a'..'cc'; +my %h2; +my $counter= "a"; +$h2{$counter++}++ while $counter ne 'cd'; ok (!Internals::HvREHASH(%h2), "starting with pre-populated non-pathological hash (rehash flag if off)"); my @keys = get_keys(\%h2); +my $buckets= buckets(\%h2); $h2{$_}++ for @keys; +$h2{$counter++}++ while buckets(\%h2) == $buckets; # force a split ok (Internals::HvREHASH(%h2), - scalar(@keys) . " colliding into the same bucket keys are triggering rehash"); + scalar(@keys) . " colliding into the same bucket keys are triggering rehash after split"); + +# returns the number of buckets in a hash +sub buckets { + my $hr = shift; + my $keys_buckets= scalar(%$hr); + if ($keys_buckets=~m!/([0-9]+)\z!) { + return 0+$1; + } else { + return 8; + } +} sub get_keys { my $hr = shift; # the minimum of bits required to mount the attack on a hash my $min_bits = log(THRESHOLD)/log(2); - # if the hash has already been populated with a significant amount # of entries the number of mask bits can be higher my $keys = scalar keys %$hr; -- 1.7.4.1 END if ($perl =~ qr/^5\.8\.8$/) { $patch =~ s/non-pathological/non-pathalogical/; $patch =~ s/triggering/triggerring/; } _patch($patch); } # http://perl5.git.perl.org/perl.git/commit/f14269908e5f8b4cab4b55643d7dd9de577e7918 # http://perl5.git.perl.org/perl.git/commit/9d83adcdf9ab3c1ac7d54d76f3944e57278f0e70 sub _patch_hsplit_rehash_510 { _patch(<<'END'); --- ext/Hash-Util-FieldHash/t/10_hash.t +++ ext/Hash-Util-FieldHash/t/10_hash.t @@ -46,15 +46,29 @@ use constant START => "a"; # some initial hash data fieldhash my %h2; -%h2 = map {$_ => 1} 'a'..'cc'; +my $counter= "a"; +$h2{$counter++}++ while $counter ne 'cd'; ok (!Internals::HvREHASH(%h2), "starting with pre-populated non-pathological hash (rehash flag if off)"); my @keys = get_keys(\%h2); +my $buckets= buckets(\%h2); $h2{$_}++ for @keys; +$h2{$counter++}++ while buckets(\%h2) == $buckets; # force a split ok (Internals::HvREHASH(%h2), - scalar(@keys) . " colliding into the same bucket keys are triggering rehash"); + scalar(@keys) . " colliding into the same bucket keys are triggering rehash after split"); + +# returns the number of buckets in a hash +sub buckets { + my $hr = shift; + my $keys_buckets= scalar(%$hr); + if ($keys_buckets=~m!/([0-9]+)\z!) { + return 0+$1; + } else { + return 8; + } +} sub get_keys { my $hr = shift; --- hv.c +++ hv.c @@ -35,7 +35,8 @@ holds the key and hash value. #define PERL_HASH_INTERNAL_ACCESS #include "perl.h" -#define HV_MAX_LENGTH_BEFORE_SPLIT 14 +#define HV_MAX_LENGTH_BEFORE_REHASH 14 +#define SHOULD_DO_HSPLIT(xhv) ((xhv)->xhv_keys > (xhv)->xhv_max) /* HvTOTALKEYS(hv) > HvMAX(hv) */ static const char S_strtab_error[] = "Cannot modify shared string table in hv_%s"; @@ -818,23 +819,8 @@ Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, xhv->xhv_keys++; /* HvTOTALKEYS(hv)++ */ if (!counter) { /* initial entry? */ xhv->xhv_fill++; /* HvFILL(hv)++ */ - } else if (xhv->xhv_keys > (IV)xhv->xhv_max) { + } else if ( SHOULD_DO_HSPLIT(xhv) ) { hsplit(hv); - } else if(!HvREHASH(hv)) { - U32 n_links = 1; - - while ((counter = HeNEXT(counter))) - n_links++; - - if (n_links > HV_MAX_LENGTH_BEFORE_SPLIT) { - /* Use only the old HvKEYS(hv) > HvMAX(hv) condition to limit - bucket splits on a rehashed hash, as we're not going to - split it again, and if someone is lucky (evil) enough to - get all the keys in one list they could exhaust our memory - as we repeatedly double the number of buckets on every - entry. Linear search feels a less worse thing to do. */ - hsplit(hv); - } } } @@ -1180,7 +1166,7 @@ S_hsplit(pTHX_ HV *hv) /* Pick your policy for "hashing isn't working" here: */ - if (longest_chain <= HV_MAX_LENGTH_BEFORE_SPLIT /* split worked? */ + if (longest_chain <= HV_MAX_LENGTH_BEFORE_REHASH /* split worked? */ || HvREHASH(hv)) { return; } @@ -2506,8 +2492,8 @@ S_share_hek_flags(pTHX_ const char *str, I32 len, register U32 hash, int flags) xhv->xhv_keys++; /* HvTOTALKEYS(hv)++ */ if (!next) { /* initial entry? */ xhv->xhv_fill++; /* HvFILL(hv)++ */ - } else if (xhv->xhv_keys > (IV)xhv->xhv_max /* HvKEYS(hv) > HvMAX(hv) */) { - hsplit(PL_strtab); + } else if ( SHOULD_DO_HSPLIT(xhv) ) { + hsplit(PL_strtab); } } diff --git a/t/op/hash.t b/t/op/hash.t index 9bde518..45eb782 100644 --- t/op/hash.t +++ t/op/hash.t @@ -39,22 +39,36 @@ use constant THRESHOLD => 14; use constant START => "a"; # some initial hash data -my %h2 = map {$_ => 1} 'a'..'cc'; +my %h2; +my $counter= "a"; +$h2{$counter++}++ while $counter ne 'cd'; ok (!Internals::HvREHASH(%h2), "starting with pre-populated non-pathological hash (rehash flag if off)"); my @keys = get_keys(\%h2); +my $buckets= buckets(\%h2); $h2{$_}++ for @keys; +$h2{$counter++}++ while buckets(\%h2) == $buckets; # force a split ok (Internals::HvREHASH(%h2), - scalar(@keys) . " colliding into the same bucket keys are triggering rehash"); + scalar(@keys) . " colliding into the same bucket keys are triggering rehash after split"); + +# returns the number of buckets in a hash +sub buckets { + my $hr = shift; + my $keys_buckets= scalar(%$hr); + if ($keys_buckets=~m!/([0-9]+)\z!) { + return 0+$1; + } else { + return 8; + } +} sub get_keys { my $hr = shift; # the minimum of bits required to mount the attack on a hash my $min_bits = log(THRESHOLD)/log(2); - # if the hash has already been populated with a significant amount # of entries the number of mask bits can be higher my $keys = scalar keys %$hr; -- 1.7.4.1 END } sub _patch_bitrig { return unless $^O eq 'bitrig'; my $perlver = shift; my $num = _norm_ver( $perlver ); return unless $num < 5.019004; unless ( $num < 5.00800 ) { _patch(<<'BOOGLE'); diff --git a/Configure b/Configure index 19bed50..e4e4075 100755 --- Configure +++ Configure @@ -3312,6 +3312,9 @@ EOM ;; next*) osname=next ;; nonstop-ux) osname=nonstopux ;; + bitrig) osname=bitrig + osvers="$3" + ;; openbsd) osname=openbsd osvers="$3" ;; BOOGLE } if ( $num < 5.008009 ) { _patch(<<'BITRIGM1'); diff --git a/Makefile.SH b/Makefile.SH index 17298fa..ecaa8ac 100755 --- Makefile.SH +++ Makefile.SH @@ -77,7 +77,7 @@ true) sunos*) linklibperl="-lperl" ;; - netbsd*|freebsd[234]*|openbsd*) + netbsd*|freebsd[234]*|openbsd*|bitrig*) linklibperl="-L. -lperl" ;; interix*) BITRIGM1 } else { _patch(<<'BITRIGMX'); diff --git a/Makefile.SH b/Makefile.SH index 17298fa..ecaa8ac 100755 --- Makefile.SH +++ Makefile.SH @@ -77,7 +77,7 @@ true) sunos*) linklibperl="-lperl" ;; - netbsd*|freebsd[234]*|openbsd*|dragonfly*) + netbsd*|freebsd[234]*|openbsd*|dragonfly*|bitrig*) linklibperl="-L. -lperl" ;; interix*) BITRIGMX } if ( $num < 5.008001 ) { # NOOP } elsif ( $num < 5.008007 ) { _patch(<<'BITRIGC3'); diff --git a/Configure b/Configure index 19bed50..e4e4075 100755 --- Configure Thu Aug 22 23:20:14 2013 +++ Configure Thu Aug 22 23:20:35 2013 @@ -7855,7 +7855,7 @@ solaris) xxx="-R $shrpdir" ;; - freebsd|netbsd|openbsd) + freebsd|netbsd|openbsd|bitrig) xxx="-Wl,-R$shrpdir" ;; bsdos|linux|irix*|dec_osf) BITRIGC3 } elsif ( $num < 5.008009 ) { _patch(<<'BITRIGC2'); diff --git a/Configure b/Configure index 19bed50..e4e4075 100755 --- Configure Thu Aug 22 22:56:04 2013 +++ Configure Thu Aug 22 22:56:25 2013 @@ -7892,7 +7892,7 @@ solaris) xxx="-R $shrpdir" ;; - freebsd|netbsd|openbsd|interix) + freebsd|netbsd|openbsd|interix|bitrig) xxx="-Wl,-R$shrpdir" ;; bsdos|linux|irix*|dec_osf|gnu*) BITRIGC2 } elsif ( $num < 5.013000 ) { _patch(<<'BITRIGC1'); diff --git a/Configure b/Configure index 19bed50..e4e4075 100755 --- Configure +++ Configure @@ -8328,7 +8331,7 @@ if "$useshrplib"; then solaris) xxx="-R $shrpdir" ;; - freebsd|netbsd|openbsd|interix|dragonfly) + freebsd|netbsd|openbsd|interix|dragonfly|bitrig) xxx="-Wl,-R$shrpdir" ;; bsdos|linux|irix*|dec_osf|gnu*) BITRIGC1 } else { _patch(<<'BITRIGCX'); diff --git a/Configure b/Configure index 19bed50..e4e4075 100755 --- Configure +++ Configure @@ -8328,7 +8331,7 @@ if "$useshrplib"; then solaris) xxx="-R $shrpdir" ;; - freebsd|mirbsd|netbsd|openbsd|interix|dragonfly) + freebsd|mirbsd|netbsd|openbsd|interix|dragonfly|bitrig) xxx="-Wl,-R$shrpdir" ;; bsdos|linux|irix*|dec_osf|gnu*) BITRIGCX } } sub _patch_conf_solaris { return unless $^O eq 'solaris'; my $perlver = shift; my $num = _norm_ver( $perlver ); return unless $num < 5.018000; _patch(<<'BUBBLE'); diff --git a/Configure b/Configure index ff511d3..30ab78a 100755 --- Configure +++ Configure @@ -8048,7 +8048,20 @@ EOM ;; linux|irix*|gnu*) dflt="-shared $optimize" ;; next) dflt='none' ;; - solaris) dflt='-G' ;; + solaris) # See [perl #66604]. On Solaris 11, gcc -m64 on amd64 + # appears not to understand -G. gcc versions at + # least as old as 3.4.3 support -shared, so just + # use that with Solaris 11 and later, but keep + # the old behavior for older Solaris versions. + case "$gccversion" in + '') dflt='-G' ;; + *) case "$osvers" in + 2.?|2.10) dflt='-G' ;; + *) dflt='-shared' ;; + esac + ;; + esac + ;; sunos) dflt='-assert nodefinitions' ;; svr4*|esix*|nonstopux) dflt="-G $ldflags" ;; *) dflt='none' ;; BUBBLE } #commit 4149c7198d9b78d861df289cce40dd865cab57e7 sub _patch_regmatch_pointer_5180 { _patch(<<'BOBBLE'); diff --git a/regexec.c b/regexec.c index bc38839..b865b46 100644 --- regexec.c +++ regexec.c @@ -6662,7 +6662,7 @@ S_regrepeat(pTHX_ regexp *prog, char **startposp, const regnode *p, scan = *startposp; if (max == REG_INFTY) max = I32_MAX; - else if (! utf8_target && scan + max < loceol) + else if (! utf8_target && loceol - scan > max) loceol = scan + max; /* Here, for the case of a non-UTF-8 target we have adjusted down @@ -6711,7 +6711,7 @@ S_regrepeat(pTHX_ regexp *prog, char **startposp, const regnode *p, scan = loceol; break; case CANY: /* Move forward bytes, unless goes off end */ - if (utf8_target && scan + max < loceol) { + if (utf8_target && loceol - scan > max) { /* hadn't been adjusted in the UTF-8 case */ scan += max; @@ -6730,7 +6730,7 @@ S_regrepeat(pTHX_ regexp *prog, char **startposp, const regnode *p, * can use UTF8_IS_INVARIANT() even if the pattern isn't UTF-8, as it's * true iff it doesn't matter if the argument is in UTF-8 or not */ if (UTF8_IS_INVARIANT(c) || (! utf8_target && ! is_utf8_pat)) { - if (utf8_target && scan + max < loceol) { + if (utf8_target && loceol - scan > max) { /* We didn't adjust because is UTF-8, but ok to do so, * since here, to match at all, 1 char == 1 byte */ loceol = scan + max; @@ -6910,7 +6910,7 @@ S_regrepeat(pTHX_ regexp *prog, char **startposp, const regnode *p, /* FALLTHROUGH */ case POSIXA: - if (utf8_target && scan + max < loceol) { + if (utf8_target && loceol - scan > max) { /* We didn't adjust at the beginning of this routine * because is UTF-8, but it is actually ok to do so, since here, to diff --git a/t/re/pat_rt_report.t b/t/re/pat_rt_report.t index 2244fdf..9a9b5f5 100644 --- t/re/pat_rt_report.t +++ t/re/pat_rt_report.t @@ -22,7 +22,7 @@ BEGIN { } -plan tests => 2530; # Update this when adding/deleting tests. +plan tests => 2532; # Update this when adding/deleting tests. run_tests() unless caller; @@ -1158,6 +1158,21 @@ EOP '$_ = "abc"; /b/g; $_ = "hello"; print eval q|$\'|,"\n"', "c\n", {}, '$\' first mentioned after match'); } + + { + # [perl #118175] threaded perl-5.18.0 fails pat_rt_report_thr.t + # this tests some related failures + # + # The tests in the block *only* fail when run on 32-bit systems + # with a malloc that allocates above the 2GB line. On the system + # in the report above that only happened in a thread. + my $s = "\x{1ff}" . "f" x 32; + ok($s =~ /\x{1ff}[[:alpha:]]+/gca, "POSIXA pointer wrap"); + + # this one segfaulted under the conditions above + # of course, CANY is evil, maybe it should crash + ok($s =~ /.\C+/, "CANY pointer wrap"); + } } # End of sub run_tests 1; BOBBLE } sub _patch_makefile_sh_phony { _patch(<<'END'); diff --git a/Makefile.SH b/Makefile.SH index ac5ade4..8e66603 100755 --- Makefile.SH +++ Makefile.SH @@ -295,6 +295,30 @@ obj = $(obj1) $(obj2) $(obj3) $(ARCHOBJS) # EMBEDDING is on by default, and MULTIPLICITY doesn't work. # +.PHONY: all compile translators utilities \ + FORCE \ + preplibrary \ + install install-strip install-all install-verbose install-silent \ + no-install install.perl install.man installman install.html installhtml \ + check_byacc run_byacc \ + regen_headers regen_pods regen_all \ + clean _tidy _mopup _cleaner1 _cleaner2 \ + realclean _realcleaner clobber _clobber \ + distclean veryclean _verycleaner \ + lint \ + depend \ + test check test_prep _test_prep \ + test_tty test-tty _test_tty test_notty test-notty _test_notty \ + utest ucheck test.utf8 check.utf8 \ + test.third check.third utest.third ucheck.third test_notty.third \ + test.deparse test_notty.deparse \ + minitest \ + ok okfile oknack okfilenack nok nokfile noknack nokfilenack \ + clist hlist shlist pllist \ + distcheck \ + elc \ + etags ctags tags + lintflags = -hbvxac .c$(OBJ_EXT): END } sub _patch_cow_speed { _patch(<<'COWSAY'); diff --git a/sv.c b/sv.c index 06c0b83..ac1d972 100644 --- sv.c +++ sv.c @@ -1574,14 +1574,19 @@ Perl_sv_grow(pTHX_ SV *const sv, STRLEN newlen) newlen++; #endif +#if defined(PERL_USE_MALLOC_SIZE) && defined(Perl_safesysmalloc_size) +#define PERL_UNWARANTED_CHUMMINESS_WITH_MALLOC +#endif + if (newlen > SvLEN(sv)) { /* need more room? */ STRLEN minlen = SvCUR(sv); minlen += (minlen >> PERL_STRLEN_EXPAND_SHIFT) + 10; if (newlen < minlen) newlen = minlen; -#ifndef Perl_safesysmalloc_size - if (SvLEN(sv)) +#ifndef PERL_UNWARANTED_CHUMMINESS_WITH_MALLOC + if (SvLEN(sv)) { newlen = PERL_STRLEN_ROUNDUP(newlen); + } #endif if (SvLEN(sv) && s) { s = (char*)saferealloc(s, newlen); @@ -1593,7 +1598,7 @@ Perl_sv_grow(pTHX_ SV *const sv, STRLEN newlen) } } SvPV_set(sv, s); -#ifdef Perl_safesysmalloc_size +#ifdef PERL_UNWARANTED_CHUMMINESS_WITH_MALLOC /* Do this here, do it once, do it right, and then we will never get called back into sv_grow() unless there really is some growing needed. */ COWSAY } sub _patch_preprocess_options { my $perl = shift; if ($perl =~ /^5\.(?:8|10)\./) { _patch(<<'END'); diff --git a/perl.c b/perl.c index 82e5538..b9e02fe 100644 --- perl.c +++ perl.c @@ -3758,7 +3758,7 @@ S_open_script(pTHX_ const char *scriptname, bool dosearch, SV *sv, # ifdef VMS cpp_discard_flag = ""; # else - cpp_discard_flag = "-C"; + cpp_discard_flag = "-C -ffreestanding"; # endif # ifdef OS2 END } elsif ($perl =~ /^5\.6\./) { _patch(<<'END'); diff --git a/perl.c b/perl.c index 623f9be..014d318 100644 --- perl.c +++ perl.c @@ -2631,7 +2631,7 @@ sed %s -e \"/^[^#]/b\" \ -e '/^#[ ]*undef[ ]/b' \ -e '/^#[ ]*endif/b' \ -e 's/^[ ]*#.*//' \ - %s | %"SVf" -C %"SVf" %s", + %s | %"SVf" -C -ffreestanding %"SVf" %s", # endif #ifdef LOC_SED LOC_SED, END } } sub _patch_5183_metajson { _patch(<<'DOGSAY'); diff --git a/META.json b/META.json index 64caea7..200e324 100644 --- META.json +++ META.json @@ -118,7 +118,7 @@ "TestInit.pm" ] }, - "release_status" : "testing", + "release_status" : "stable", "resources" : { "bugtracker" : { "web" : "http://rt.perl.org/perlbug/" DOGSAY } sub _patch_handy { _patch(<<'END'); --- handy.h +++ handy.h @@ -43,12 +43,10 @@ this file first, then you will have to manually set -DHAS_BOOL in your command line to avoid a conflict. */ -#ifdef _G_HAVE_BOOL -# if _G_HAVE_BOOL +#ifdef __GNUG__ # ifndef HAS_BOOL # define HAS_BOOL 1 # endif -# endif #endif /* The NeXT dynamic loader headers will not build with the bool macro END } sub _replace_makedepend { # Replace makedepend with blead's version _write_or_die('makedepend.SH', <<'END'); #! /bin/sh case $PERL_CONFIG_SH in '') if test -f config.sh; then TOP=.; elif test -f ../config.sh; then TOP=..; elif test -f ../../config.sh; then TOP=../..; elif test -f ../../../config.sh; then TOP=../../..; elif test -f ../../../../config.sh; then TOP=../../../..; else echo "Can't find config.sh."; exit 1 fi . $TOP/config.sh ;; esac : This forces SH files to create target in same directory as SH file. : This is so that make depend always knows where to find SH derivatives. case "$0" in */*) cd `expr X$0 : 'X\(.*\)/'` ;; esac echo "Extracting makedepend (with variable substitutions)" rm -f makedepend $spitshell >makedepend <>makedepend <<'!NO!SUBS!' if test -d .depending; then echo "$0: Already running, exiting." exit 0 fi mkdir .depending # This script should be called with # sh ./makedepend MAKE=$(MAKE) case "$1" in MAKE=*) eval $1; shift ;; esac export PATH || (echo "OOPS, this isn't sh. Desperation time. I will feed myself to sh."; sh \$0; kill \$\$) case $PERL_CONFIG_SH in '') if test -f config.sh; then TOP=.; elif test -f ../config.sh; then TOP=..; elif test -f ../../config.sh; then TOP=../..; elif test -f ../../../config.sh; then TOP=../../..; elif test -f ../../../../config.sh; then TOP=../../../..; else echo "Can't find config.sh."; exit 1 fi . $TOP/config.sh ;; esac # Avoid localized gcc messages case "$ccname" in gcc) LC_ALL=C ; export LC_ALL ;; esac # We need .. when we are in the x2p directory if we are using the # cppstdin wrapper script. # Put .. and . first so that we pick up the present cppstdin, not # an older one lying about in /usr/local/bin. PATH=".$path_sep..$path_sep$PATH" export PATH case "$osname" in amigaos) cat=/bin/cat ;; # must be absolute esac $cat /dev/null >.deptmp $rm -f *.c.c c/*.c.c if test -f Makefile; then rm -f $firstmakefile cp Makefile $firstmakefile # On QNX, 'cp' preserves timestamp, so $firstmakefile appears # to be out of date. I don't know if OS/2 has touch, so do this: case "$osname" in os2) ;; *) $touch $firstmakefile ;; esac fi mf=$firstmakefile if test -f $mf; then defrule=`<$mf sed -n \ -e '/^\.c\$(OBJ_EXT):.*;/{' \ -e 's/\$\*\.c//' \ -e 's/^[^;]*;[ ]*//p' \ -e q \ -e '}' \ -e '/^\.c\$(OBJ_EXT): *$/{' \ -e N \ -e 's/\$\*\.c//' \ -e 's/^.*\n[ ]*//p' \ -e q \ -e '}'` fi case "$defrule" in '') defrule='$(CC) -c $(CFLAGS)' ;; esac : Create files in UU directory to avoid problems with long filenames : on systems with 14 character filename limits so file.c.c and file.c : might be identical $test -d UU || mkdir UU $MAKE clist || ($echo "Searching for .c files..."; \ $echo *.c | $tr ' ' $trnl | $egrep -v '\*' >.clist) for file in `$cat .clist`; do # for file in `cat /dev/null`; do case "$osname" in uwin) uwinfix="-e s,\\\\\\\\,/,g -e s,\\([a-zA-Z]\\):/,/\\1/,g" ;; os2) uwinfix="-e s,\\\\\\\\,/,g" ;; cygwin) uwinfix="-e s,\\\\\\\\,/,g" ;; posix-bc) uwinfix="-e s/\\*POSIX(\\(.*\\))/\\1/" ;; vos) uwinfix="-e s/\#/\\\#/" ;; *) uwinfix="" ;; esac case "$file" in *.c) filebase=`basename $file .c` ;; *.y) filebase=`basename $file .y` ;; esac case "$file" in */*) finc="-I`echo $file | sed 's#/[^/]*$##'`" ;; *) finc= ;; esac $echo "Finding dependencies for $filebase$_o." # Below, we strip out all but preprocessor directives. # We have to take care of situations like # #if defined(FOO) BAR /* comment line 1 # more comment lines */ # If we just delete text starting from the '/*' to the end of line, we will # screw up cases like # #if defined(FOO) /* comment */ \ # && defined(BAR) /* comment */ \ # && defined(BAZ) /* comment */ \ # etc. # Also, in lines like # #defined FOO(a,b) a/**/b # the comment may be important and so needs to be retained. # This code processes the single-line comments first; it assumes there is # at most one straightforward comment per continued preprocessor line, # replacing each non-empty comment (and its surrounding white space) by a # single space. (sed only has a greedy '*' quantifier, so this doesn't # work right if there are multiple comments per line, and strings can look # like comments to it; both are unlikely in a preprocessor statement.) Any # continuation line is joined, and the process repeated on the enlarged # line as long as there are continuations. At the end, if there are any # comments remaining, they are either completely empty or are like the # first situation. The latter are just deleted by first deleting to the # end of line (including preceding white space) things that start with '/*' # and the next char isn't a '*'; then things that start with '/**', but the # next char isn't a '/'. (Subsequent lines of the comment are irrelevant # and get dropped.) At the end, we unjoin very long lines to avoid # preprocessor limitations ( $echo "#line 2 \"$file\""; \ $sed -n <$file \ -e "/^${filebase}_init(/q" \ -e ': testcont' \ -e '/^[ ]*#/s|[ ]*/\*..*\*/[ ]*| |' \ -e '/\\$/{' \ -e 'N' \ -e 'b testcont' \ -e '}' \ -e 's/\\\n//g' \ -e '/^#line/d' \ -e '/^[ ]*#/{' \ -e 's|[ ]*/\*[^*].*$||' \ -e 's|[ ]*/\*\*[^/].*$||' \ -e 's/.\{255\}/&\\\n/g' \ -e p \ -e '}' ) >UU/$file.c # We're not sure why this was there; the #endif is extraneous on modern z/OS #if [ "$osname" = os390 -a "$file" = perly.c ]; then # $echo '#endif' >>UU/$file.c #fi if [ "$osname" = os390 ]; then $cppstdin $finc -I. $cppflags $cppminus /d' \ -e '/^#.*"-"/d' \ -e '/^#.*git_version\.h/d' \ -e 's#\.[0-9][0-9]*\.c#'"$file.c#" \ -e 's/^[ ]*#[ ]*line/#/' \ -e '/^# *[0-9][0-9]* *[".\/]/!d' \ -e 's/^.*"\(.*\)".*$/'$filebase'\$(OBJ_EXT): \1/' \ -e 's/^# *[0-9][0-9]* \(.*\)$/'$filebase'\$(OBJ_EXT): \1/' \ -e 's|: \./|: |' \ -e 's|\.c\.c|.c|' $uwinfix | \ $uniq | $sort | $uniq >> .deptmp else $cppstdin $finc -I. $cppflags $cppminus .cout 2>.cerr $sed \ -e '1d' \ -e '/^#.*/d' \ -e '/^#.*/d' \ -e '/^#.*/d' \ -e '/^#.*/d' \ -e '/^#.*/d' \ -e '/^#.*"-"/d' \ -e '/^#.*"\/.*\/"/d' \ -e '/: file path prefix .* never used$/d' \ -e '/^#.*git_version\.h/d' \ -e 's#\.[0-9][0-9]*\.c#'"$file.c#" \ -e 's/^[ ]*#[ ]*line/#/' \ -e '/^# *[0-9][0-9]* *[".\/]/!d' \ -e 's/^.*"\(.*\)".*$/'$filebase'\$(OBJ_EXT): \1/' \ -e 's/^# *[0-9][0-9]* \(.*\)$/'$filebase'\$(OBJ_EXT): \1/' \ -e 's|: \./|: |' \ -e 's|\.c\.c|.c|' $uwinfix .cout .cerr| \ $uniq | $sort | $uniq >> .deptmp fi echo "$filebase\$(OBJ_EXT): $@" >> .deptmp done $sed <$mf >$mf.new -e '1,/^# AUTOMATICALLY/!d' if $test -s .deptmp; then $echo "Updating $mf..." $echo "# If this runs make out of memory, delete /usr/include lines." \ >> $mf.new if [ "$osname" = vos ]; then $sed 's|\.incl\.c|.h|' .deptmp >.deptmp.vos mv -f .deptmp.vos .deptmp fi $sed 's|^\(.*\$(OBJ_EXT):\) *\(.*/.*\.c\) *$|\1 \2; '"$defrule \2|" .deptmp \ >>$mf.new else $MAKE hlist || ($echo "Searching for .h files..."; \ $echo *.h | $tr ' ' $trnl | $egrep -v '\*' >.hlist) $echo "You don't seem to have a proper C preprocessor. Using grep instead." $egrep '^#include ' `cat .clist` `cat .hlist` >.deptmp $echo "Updating $mf..." <.clist $sed -n \ -e '/\//{' \ -e 's|^\(.*\)/\(.*\)\.c|\2\$(OBJ_EXT): \1/\2.c; '"$defrule \1/\2.c|p" \ -e d \ -e '}' \ -e 's|^\(.*\)\.c|\1\$(OBJ_EXT): \1.c|p' >> $mf.new <.hlist $sed -n 's|\(.*/\)\(.*\)|s= \2= \1\2=|p' >.hsed <.deptmp $sed -n 's|c:#include "\(.*\)".*$|o: \1|p' | \ $sed 's|^[^;]*/||' | \ $sed -f .hsed >> $mf.new <.deptmp $sed -n 's|h:#include "\(.*\)".*$|h: \1|p' | \ $sed -f .hsed >> $mf.new fi $rm -f $mf.old $cp $mf $mf.old $rm -f $mf $cp $mf.new $mf $rm $mf.new $echo "# WARNING: Put nothing here or make depend will gobble it up!" >> $mf $rm -rf .deptmp UU .clist .hlist .hsed .cout .cerr rmdir .depending !NO!SUBS! $eunicefix makedepend chmod +x makedepend END } sub _patch_5_005_02 { _patch(<<'END'); --- Configure +++ Configure @@ -21,7 +21,7 @@ # $Id: Head.U,v 3.0.1.9 1997/02/28 15:02:09 ram Exp $ # # Generated on Tue Jul 7 10:10:21 EDT 1998 [metaconfig 3.0 PL70] -# (with additional metaconfig patches by doughera@lafayette.edu) +# (with additional metaconfig patches by jhi@iki.fi) cat >/tmp/c1$$ </dev/null`" in - foox) - trnl='\n' - ;; - esac -fi -if test X"$trnl" = X; then - case "`echo foo|tr '\012' x 2>/dev/null`" in - foox) - trnl='\012' - ;; - esac -fi -if test -n "$DJGPP"; then - trnl='\012' -fi -if test X"$trnl" = X; then - cat <&2 - -$me: Fatal Error: cannot figure out how to translate newlines with 'tr'. - -EOM - exit 1 -fi - : Proper separator for the PATH environment variable p_=: : On OS/2 this directory should exist if this is not floppy only system :-] @@ -391,7 +364,6 @@ d_getservprotos='' d_getsbyname='' d_getsbyport='' d_gnulibc='' -i_arpainet='' d_htonl='' d_inetaton='' d_isascii='' @@ -540,6 +512,7 @@ dlsrc='' ld='' lddlflags='' usedl='' +ebcdic='' doublesize='' fpostype='' gidtype='' @@ -548,6 +521,7 @@ h_fcntl='' h_sysfile='' db_hashtype='' db_prefixtype='' +i_arpainet='' i_db='' i_dbm='' i_rpcsvcdbm='' @@ -633,6 +607,7 @@ libpth='' loclibpth='' plibpth='' xlibpth='' +ignore_versioned_solibs='' libs='' lns='' lseektype='' @@ -697,11 +672,13 @@ randbits='' installscript='' scriptdir='' scriptdirexp='' +selectminbits='' selecttype='' sh='' sig_name='' sig_name_init='' sig_num='' +sig_num_init='' installsitearch='' sitearch='' sitearchexp='' @@ -719,6 +696,7 @@ startperl='' startsh='' stdchar='' sysman='' +trnl='' uidtype='' nm_opt='' nm_so_opt='' @@ -733,7 +711,6 @@ mips_type='' usrinc='' defvoidused='' voidflags='' -ebcdic='' CONFIG='' define='define' @@ -836,6 +813,8 @@ plibpth='' : default library list libswanted='' +: some systems want only to use the non-versioned libso:s +ignore_versioned_solibs='' : Possible local include directories to search. : Set locincpth to "" in a hint file to defeat local include searches. locincpth="/usr/local/include /opt/local/include /usr/gnu/include" @@ -904,7 +883,7 @@ case "$sh" in $me: Fatal Error: I can't find a Bourne Shell anywhere. Usually it's in /bin/sh. How did you even get this far? -Please contact me (Andy Dougherty) at doughera@lafayette.edu and +Please contact me (Jarkko Hietaniemi) at jhi@iki.fi and we'll try to straighten this all out. EOM exit 1 @@ -1240,7 +1219,7 @@ cat >extract <<'EOS' CONFIG=true echo "Doing variable substitutions on .SH files..." if test -f $src/MANIFEST; then - set x `awk '{print $1}' <$src/MANIFEST | grep '\.SH'` + set x `awk '{print $1}' <$src/MANIFEST | grep '\.SH$'` else echo "(Looking for .SH files under the source directory.)" set x `(cd $src; find . -name "*.SH" -print)` @@ -1373,7 +1352,7 @@ THIS PACKAGE SEEMS TO BE INCOMPLETE. You have the option of continuing the configuration process, despite the distinct possibility that your kit is damaged, by typing 'y'es. If you do, don't blame me if something goes wrong. I advise you to type 'n'o -and contact the author (doughera@lafayette.edu). +and contact the author (jhi@iki.fi). EOM echo $n "Continue? [n] $c" >&4 @@ -1396,6 +1375,30 @@ else fi rm -f missing x?? +echo " " +: Find the appropriate value for a newline for tr +if test -n "$DJGPP"; then + trnl='\012' +fi +if test X"$trnl" = X; then + case "`echo foo|tr '\n' x 2>/dev/null`" in + foox) trnl='\n' ;; + esac +fi +if test X"$trnl" = X; then + case "`echo foo|tr '\012' x 2>/dev/null`" in + foox) trnl='\012' ;; + esac +fi +if test X"$trnl" = X; then + cat <&2 + +$me: Fatal Error: cannot figure out how to translate newlines with 'tr'. + +EOM + exit 1 +fi + : compute the number of columns on the terminal for proper question formatting case "$COLUMNS" in '') COLUMNS='80';; @@ -1574,7 +1577,7 @@ Much effort has been expended to ensure that this shell script will run on any Unix system. If despite that it blows up on yours, your best bet is to edit Configure and run it again. If you can't run Configure for some reason, you'll have to generate a config.sh file by hand. Whatever problems you -have, let me (doughera@lafayette.edu) know how I blew it. +have, let me (jhi@iki.fi) know how I blew it. This installation script affects things in two ways: @@ -1841,14 +1844,14 @@ ABYZ) *C9D1*|*c9d1*) echo "Hey, this might be EBCDIC." >&4 if test "X$up" = X -o "X$low" = X; then - case "`echo IJ | tr '[A-IJ-RS-Z]' '[a-ij-rs-z]' 2>/dev/null`" in + case "`echo IJ | $tr '[A-IJ-RS-Z]' '[a-ij-rs-z]' 2>/dev/null`" in ij) up='[A-IJ-RS-Z]' low='[a-ij-rs-z]' ;; esac fi if test "X$up" = X -o "X$low" = X; then - case "`echo IJ | tr A-IJ-RS-Z a-ij-rs-z 2>/dev/null`" in + case "`echo IJ | $tr A-IJ-RS-Z a-ij-rs-z 2>/dev/null`" in ij) up='A-IJ-RS-Z' low='a-ij-rs-z' ;; @@ -1941,7 +1944,7 @@ EOM (cd $src/hints; ls -C *.sh) | $sed 's/\.sh/ /g' >&4 dflt='' : Half the following guesses are probably wrong... If you have better - : tests or hints, please send them to doughera@lafayette.edu + : tests or hints, please send them to jhi@iki.fi : The metaconfig authors would also appreciate a copy... $test -f /irix && osname=irix $test -f /xenix && osname=sco_xenix @@ -2025,7 +2028,7 @@ EOM osvers="$3" ;; dynixptx*) osname=dynixptx - osvers="$3" + osvers=`echo "$4" | $sed 's/^v//'` ;; freebsd) osname=freebsd osvers="$3" ;; @@ -3442,7 +3445,11 @@ cat <<'EOT' >testcpp.c ABC.XYZ EOT cd .. +if test ! -f cppstdin; then echo 'cat >.$$.c; '"$cc"' -E ${1+"$@"} .$$.c; rm .$$.c' >cppstdin +else + echo "Keeping your $hint cppstdin wrapper." +fi chmod 755 cppstdin wrapper=`pwd`/cppstdin ok='false' @@ -3693,7 +3700,8 @@ case "$libswanted" in esac for thislib in $libswanted; do - if xxx=`./loc lib$thislib.$so.[0-9]'*' X $libpth`; $test -f "$xxx"; then + if xxx=`./loc lib$thislib.$so.[0-9]'*' X $libpth`; + $test -f "$xxx" -a "X$ignore_versioned_solibs" = "X"; then echo "Found -l$thislib (shared)." case " $dflt " in *"-l$thislib "*);; @@ -3980,10 +3988,21 @@ rmlist="$rmlist pdp11" : coherency check echo " " echo "Checking your choice of C compiler and flags for coherency..." >&4 +$cat > try.c <<'EOF' +#include +main() { printf("Ok\n"); exit(0); } +EOF set X $cc $optimize $ccflags -o try $ldflags try.c $libs shift -$cat >try.msg <try.msg <<'EOM' +I've tried to compile and run the following simple program: + +EOM +$cat try.c + +$cat >> try.msg < try.c <<'EOF' -#include -main() { printf("Ok\n"); exit(0); } -EOF dflt=y if sh -c "$cc $optimize $ccflags -o try $ldflags try.c $libs" >>try.msg 2>&1; then if sh -c './try' >>try.msg 2>&1; then @@ -4031,7 +4046,7 @@ y) $cat try.msg >&4 case "$knowitall" in '') - echo "(The supplied flags might be incorrect with this C compiler.)" + echo "(The supplied flags or libraries might be incorrect.)" ;; *) dflt=n;; esac @@ -4149,9 +4164,8 @@ eval $inhdr : determine which malloc to compile in echo " " case "$usemymalloc" in -''|y*|true) dflt='y' ;; -n*|false) dflt='n' ;; -*) dflt="$usemymalloc" ;; +''|[yY]*|true|$define) dflt='y' ;; +*) dflt='n' ;; esac rp="Do you wish to attempt to use the malloc that comes with $package?" . ./myread @@ -4253,7 +4267,7 @@ understands function prototypes. Unfortunately, your C compiler $cc $ccflags doesn't seem to understand them. Sorry about that. -If GNU cc is avaiable for your system, perhaps you could try that instead. +If GNU cc is available for your system, perhaps you could try that instead. Eventually, we hope to support building Perl with pre-ANSI compilers. If you would like to help in that effort, please contact . @@ -4308,32 +4322,6 @@ shift; $cc $optimize $ccflags $ldflags -o ${mc_file} $* ${mc_file}.c $libs;' echo " " -echo "Determining whether or not we are on an EBCDIC system..." >&4 -cat >tebcdic.c <&4 - val="$define" - else - echo "Nope, no EBCDIC. Assuming ASCII or some ISO Latin." >&4 - fi -else - echo "I'm unable to compile the test program." >&4 - echo "I'll asuume ASCII or some ISO Latin." >&4 -fi -$rm -f tebcdic.c tebcdic -set ebcdic -eval $setvar - -echo " " echo "Checking for GNU C Library..." >&4 cat >gnulibc.c < @@ -5147,7 +5135,7 @@ case "$shrpdir" in *) $cat >&4 <&1`" in "SVID messages"*"not configured"*) - echo "But your FreeBSD kernel does not have the msg*(2) configured." >&4 + echo "But your $osname does not have the msg*(2) configured." >&4 h_msg=false val="$undef" set msgctl d_msgctl @@ -7678,7 +7687,7 @@ set poll d_poll eval $inlibc -: see whether the various POSIXish _yields exist within given cccmd +: see whether the various POSIXish _yields exist $cat >try.c < main() { @@ -8136,7 +8145,7 @@ case "$osname" in freebsd) case "`ipcs 2>&1`" in "SVID messages"*"not configured"*) - echo "But your FreeBSD kernel does not have the sem*(2) configured." >&4 + echo "But your $osname does not have the sem*(2) configured." >&4 h_sem=false val="$undef" set semctl d_semctl @@ -8185,6 +8194,31 @@ case "$d_sem" in $define) : see whether semctl IPC_STAT can use union semun echo " " + $cat > try.h <>3) +# define S_IWGRP (S_IWUSR>>3) +# define S_IXGRP (S_IXUSR>>3) +# define S_IROTH (S_IRUSR>>6) +# define S_IWOTH (S_IWUSR>>6) +# define S_IXOTH (S_IXUSR>>6) +#endif +#ifndef S_IRWXU +# define S_IRWXU (S_IRUSR|S_IWUSR|S_IXUSR) +# define S_IRWXG (S_IRGRP|S_IWGRP|S_IXGRP) +# define S_IRWXO (S_IROTH|S_IWOTH|S_IXOTH) +#endif +END + $cat > try.c < #include @@ -8259,6 +8293,7 @@ END #include #include #include +#include "try.h" #ifndef errno extern int errno; #endif @@ -8305,6 +8340,7 @@ END *) echo "You cannot use struct semid_ds * for semctl IPC_STAT." >&4 ;; esac + $rm -f try.h ;; *) val="$undef" @@ -8499,7 +8535,7 @@ case "$osname" in freebsd) case "`ipcs 2>&1`" in "SVID shared memory"*"not configured"*) - echo "But your FreeBSD kernel does not have the shm*(2) configured." >&4 + echo "But your $osname does not have the shm*(2) configured." >&4 h_shm=false val="$undef" set shmctl d_shmctl @@ -8652,21 +8688,8 @@ eval $inlibc : see if stat knows about block sizes echo " " -xxx=`./findhdr sys/stat.h` -if $contains 'st_blocks;' "$xxx" >/dev/null 2>&1 ; then - if $contains 'st_blksize;' "$xxx" >/dev/null 2>&1 ; then - echo "Your stat() knows about block sizes." >&4 - val="$define" - else - echo "Your stat() doesn't know about block sizes." >&4 - val="$undef" - fi -else - echo "Your stat() doesn't know about block sizes." >&4 - val="$undef" -fi -set d_statblks -eval $setvar +set d_statblks stat st_blocks $i_sysstat sys/stat.h +eval $hasfield : see if _ptr and _cnt from stdio act std echo " " @@ -9610,6 +9633,32 @@ EOCP esac $rm -f try.c try +echo " " +echo "Determining whether or not we are on an EBCDIC system..." >&4 +$cat >tebcdic.c <&4 + val="$define" + else + echo "Nope, no EBCDIC. Assuming ASCII or some ISO Latin." >&4 + fi +else + echo "I'm unable to compile the test program." >&4 + echo "I'll assume ASCII or some ISO Latin." >&4 +fi +$rm -f tebcdic.c tebcdic +set ebcdic +eval $setvar + : see what type file positions are declared as in the library rp="What is the type for file position used by fsetpos()?" set fpos_t fpostype long stdio.h sys/types.h @@ -10217,8 +10266,10 @@ EOM : The first arg can be int, unsigned, or size_t : The last arg may or may not be 'const' val='' + : void pointer has been seen but using that + : breaks the selectminbits test for xxx in 'fd_set *' 'int *'; do - for nfd in 'int' 'size_t' 'unsigned' ; do + for nfd in 'int' 'size_t' 'unsigned' 'unsigned long'; do for tmo in 'struct timeval *' 'const struct timeval *'; do case "$val" in '') try="extern select _(($nfd, $xxx, $xxx, $xxx, $tmo));" @@ -10250,6 +10301,100 @@ EOM ;; esac +: check for the select 'width' +case "$selectminbits" in +'') case "$d_select" in + $define) + $cat <try.c < +#$i_time I_TIME +#$i_systime I_SYS_TIME +#$i_systimek I_SYS_TIME_KERNEL +#ifdef I_TIME +# include +#endif +#ifdef I_SYS_TIME +# ifdef I_SYS_TIME_KERNEL +# define KERNEL +# endif +# include +# ifdef I_SYS_TIME_KERNEL +# undef KERNEL +# endif +#endif +#$i_sysselct I_SYS_SELECT +#ifdef I_SYS_SELECT +#include +#endif +#include +$selecttype b; +#define S sizeof(*(b)) +#define MINBITS 64 +#define NBYTES (S * 8 > MINBITS ? S : MINBITS/8) +#define NBITS (NBYTES * 8) +int main() { + char s[NBYTES]; + struct timeval t; + int i; + FILE* fp; + int fd; + + fclose(stdin); + fp = fopen("try.c", "r"); + if (fp == 0) + exit(1); + fd = fileno(fp); + if (fd < 0) + exit(2); + b = ($selecttype)s; + for (i = 0; i < NBITS; i++) + FD_SET(i, b); + t.tv_sec = 0; + t.tv_usec = 0; + select(fd + 1, b, 0, 0, &t); + for (i = NBITS - 1; i > fd && FD_ISSET(i, b); i--); + printf("%d\n", i + 1); + return 0; +} +EOCP + set try + if eval $compile_ok; then + selectminbits=`./try` + case "$selectminbits" in + '') cat >&4 <&4 + else + rp='What is the minimum number of bits your select() operates on?' + case "$byteorder" in + 1234|12345678) dflt=32 ;; + *) dflt=1 ;; + esac + . ./myread + val=$ans + selectminbits="$val" + fi + $rm -f try.* try + ;; + *) : no select, so pick a harmless default + selectminbits='32' + ;; + esac + ;; +esac + : Trace out the files included by signal.h, then look for SIGxxx names. : Remove SIGARRAYSIZE used by HPUX. : Remove SIGTYP void lines used by OS2. @@ -10458,7 +10603,13 @@ $eunicefix signal_cmd : generate list of signal names echo " " case "$sig_name_init" in -'') +'') doinit=yes ;; +*) case "$sig_num_init" in + ''|*,*) doinit=yes ;; + esac ;; +esac +case "$doinit" in +yes) echo "Generating a list of signal names and numbers..." >&4 . ./signal_cmd sig_name=`$awk '{printf "%s ", $1}' signal.lst` @@ -10466,7 +10617,9 @@ case "$sig_name_init" in sig_name_init=`$awk 'BEGIN { printf "\"ZERO\", " } { printf "\"%s\", ", $1 } END { printf "0\n" }' signal.lst` - sig_num=`$awk 'BEGIN { printf "0, " } + sig_num=`$awk '{printf "%d ", $2}' signal.lst` + sig_num="0 $sig_num" + sig_num_init=`$awk 'BEGIN { printf "0, " } { printf "%d, ", $2} END { printf "0\n"}' signal.lst` ;; @@ -10830,7 +10983,13 @@ $rm -f try.c EOS chmod +x ccsym $eunicefix ccsym -./ccsym | $sort | $uniq >ccsym.raw +./ccsym > ccsym1.raw +if $test -s ccsym1.raw; then + $sort ccsym1.raw | $uniq >ccsym.raw +else + mv ccsym1.raw ccsym.raw +fi + $awk '/\=/ { print $0; next } { print $0"=1" }' ccsym.raw >ccsym.list $awk '{ print $0"=1" }' Cppsym.true >ccsym.true @@ -11055,10 +11214,6 @@ eval $inhdr set sys/resource.h i_sysresrc eval $inhdr -: see if sys/stat.h is available -set sys/stat.h i_sysstat -eval $inhdr - : see if this is a sys/un.h system set sys/un.h i_sysun eval $inhdr @@ -11195,6 +11350,7 @@ for xxx in $known_extensions ; do esac ;; IPC/SysV|ipc/sysv) + : XXX Do we need a useipcsysv variable here case "${d_msg}${d_sem}${d_shm}" in *"${define}"*) avail_ext="$avail_ext $xxx" ;; esac @@ -11774,6 +11930,7 @@ i_values='$i_values' i_varargs='$i_varargs' i_varhdr='$i_varhdr' i_vfork='$i_vfork' +ignore_versioned_solibs='$ignore_versioned_solibs' incpath='$incpath' inews='$inews' installarchlib='$installarchlib' @@ -11882,6 +12039,7 @@ runnm='$runnm' scriptdir='$scriptdir' scriptdirexp='$scriptdirexp' sed='$sed' +selectminbits='$selectminbits' selecttype='$selecttype' sendmail='$sendmail' sh='$sh' @@ -11894,6 +12052,7 @@ shsharp='$shsharp' sig_name='$sig_name' sig_name_init='$sig_name_init' sig_num='$sig_num' +sig_num_init='$sig_num_init' signal_t='$signal_t' sitearch='$sitearch' sitearchexp='$sitearchexp' @@ -12023,51 +12182,6 @@ esac : if this fails, just run all the .SH files by hand . ./config.sh -case "$ebcdic" in -$define) - xxx='' - echo "This is an EBCDIC system, checking if any parser files need regenerating." >&4 - rm -f y.tab.c y.tab.h - yacc -d perly.y >/dev/null 2>&1 - if cmp -s y.tab.c perly.c; then - rm -f y.tab.c - else - echo "perly.y -> perly.c" >&4 - mv -f y.tab.c perly.c - chmod u+w perly.c - sed -e 's/fprintf *( *stderr *,/PerlIO_printf(Perl_debug_log,/g' \ - -e 's/y\.tab/perly/g' perly.c >perly.tmp && mv perly.tmp perly.c - xxx="$xxx perly.c" - fi - if cmp -s y.tab.h perly.h; then - rm -f y.tab.h - else - echo "perly.y -> perly.h" >&4 - mv -f y.tab.h perly.h - xxx="$xxx perly.h" - fi - echo "x2p/a2p.y" >&4 - cd x2p - rm -f y.tab.c - yacc a2p.y >/dev/null 2>&1 - if cmp -s y.tab.c a2p.c - then - rm -f y.tab.c - else - echo "a2p.y -> a2p.c" >&4 - mv -f y.tab.c a2p.c - chmod u+w a2p.c - sed -e 's/fprintf *( *stderr *,/PerlIO_printf(Perl_debug_log,/g' \ - -e 's/y\.tab/a2p/g' a2p.c >a2p.tmp && mv a2p.tmp a2p.c - xxx="$xxx a2p.c" - fi - cd .. - case "$xxx" in - '') echo "No parser files were regenerated. That's okay." >&4 ;; - esac - ;; -esac - echo " " exec 1>&4 . ./UU/extract --- Makefile.SH +++ Makefile.SH @@ -644,3 +644,83 @@ case `pwd` in ;; esac $rm -f $firstmakefile + +# Now do any special processing required before building. + +case "$ebcdic" in +$define) + xxx='' + echo "This is an EBCDIC system, checking if any parser files need regenerating." >&4 +case "$osname" in +os390) + rm -f y.tab.c y.tab.h + yacc -d perly.y >/dev/null 2>&1 + if cmp -s y.tab.c perly.c; then + rm -f y.tab.c + else + echo "perly.y -> perly.c" >&2 + mv -f y.tab.c perly.c + chmod u+w perly.c + sed -e '/^#include "perl\.h"/a\ +\ +#define yydebug PL_yydebug\ +#define yynerrs PL_yynerrs\ +#define yyerrflag PL_yyerrflag\ +#define yychar PL_yychar\ +#define yyval PL_yyval\ +#define yylval PL_yylval' \ + -e '/YYSTYPE *yyval;/D' \ + -e '/YYSTYPE *yylval;/D' \ + -e '/int yychar,/,/yynerrs;/D' \ + -e 's/int yydebug = 0;/yydebug = 0;/' \ + -e 's/[^_]realloc(/PerlMem_realloc(/g' \ + -e 's/fprintf *( *stderr *,/PerlIO_printf(Perl_debug_log,/g' \ + -e 's/y\.tab/perly/g' perly.c >perly.tmp && mv perly.tmp perly.c + xxx="$xxx perly.c" + fi + if cmp -s y.tab.h perly.h; then + rm -f y.tab.h + else + echo "perly.y -> perly.h" >&2 + mv -f y.tab.h perly.h + xxx="$xxx perly.h" + fi + if cd x2p + then + rm -f y.tab.c y.tab.h + yacc a2p.y >/dev/null 2>&1 + if cmp -s y.tab.c a2p.c + then + rm -f y.tab.c + else + echo "a2p.y -> a2p.c" >&2 + mv -f y.tab.c a2p.c + chmod u+w a2p.c + sed -e 's/fprintf *( *stderr *,/PerlIO_printf(Perl_debug_log,/g' \ + -e 's/y\.tab/a2p/g' a2p.c >a2p.tmp && mv a2p.tmp a2p.c + xxx="$xxx a2p.c" + fi + # In case somebody yacc -d:ed the a2p.y. + if test -f y.tab.h + then + if cmp -s y.tab.h a2p.h + then + rm -f y.tab.h + else + echo "a2p.h -> a2p.h" >&2 + mv -f y.tab.h a2p.h + xxx="$xxx a2p.h" + fi + fi + cd .. + fi + ;; +*) + echo "'$osname' is an EBCDIC system I don't know that well." >&4 + ;; +esac + case "$xxx" in + '') echo "No parser files were regenerated. That's okay." >&2 ;; + esac + ;; +esac --- config_h.SH +++ config_h.SH @@ -1813,7 +1813,7 @@ sed <config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- * the sig_name list. */ #define SIG_NAME $sig_name_init /**/ -#define SIG_NUM $sig_num /**/ +#define SIG_NUM $sig_num_init /**/ /* VOIDFLAGS: * This symbol indicates how much support of the void type is given by this @@ -1902,6 +1902,15 @@ sed <config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- #define PRIVLIB "$privlib" /**/ #define PRIVLIB_EXP "$privlibexp" /**/ +/* SELECT_MIN_BITS: + * This symbol holds the minimum number of bits operated by select. + * That is, if you do select(n, ...), how many bits at least will be + * cleared in the masks if some activity is detected. Usually this + * is either n or 32*ceil(n/32), especially many little-endians do + * the latter. This is only useful if you have select(), naturally. + */ +#define SELECT_MIN_BITS $selectminbits /**/ + /* SITEARCH: * This symbol contains the name of the private library for this package. * The library is private in the sense that it needn't be in anyone's --- pp_sys.c +++ pp_sys.c @@ -56,7 +56,10 @@ extern "C" int syscall(unsigned long,...); /* XXX Configure test needed. h_errno might not be a simple 'int', especially for multi-threaded - applications. HOST_NOT_FOUND is typically defined in . + applications, see "extern int errno in perl.h". Creating such + a test requires taking into account the differences between + compiling multithreaded and singlethreaded ($ccflags et al). + HOST_NOT_FOUND is typically defined in . */ #if defined(HOST_NOT_FOUND) && !defined(h_errno) extern int h_errno; @@ -753,12 +756,17 @@ PP(pp_sselect) maxlen = j; } +/* little endians can use vecs directly */ #if BYTEORDER == 0x1234 || BYTEORDER == 0x12345678 -/* XXX Configure test needed. */ -#if defined(__linux__) || defined(OS2) || defined(NeXT) || defined(__osf__) || defined(sun) - growsize = sizeof(fd_set); +# if SELECT_MIN_BITS > 1 + /* If SELECT_MIN_BITS is greater than one we most probably will want + * to align the sizes with SELECT_MIN_BITS/8 because for example + * in many little-endian (Intel, Alpha) systems (Linux, OS/2, Digital + * UNIX, Solaris, NeXT) the smallest quantum select() operates on + * (sets bit) is 32 bits. */ + growsize = maxlen + (SELECT_MIN_BITS/8 - (maxlen % (SELECT_MIN_BITS/8))); #else - growsize = maxlen; /* little endians can use vecs directly */ + growsize = sizeof(fd_set); #endif #else #ifdef NFDBITS END } sub _patch_5_005_01 { _patch(<<'END'); --- Configure +++ Configure @@ -21,7 +21,7 @@ # $Id: Head.U,v 3.0.1.9 1997/02/28 15:02:09 ram Exp $ # # Generated on Tue Jul 7 10:10:21 EDT 1998 [metaconfig 3.0 PL70] -# (with additional metaconfig patches by doughera@lafayette.edu) +# (with additional metaconfig patches by jhi@iki.fi) cat >/tmp/c1$$ </dev/null`" in - foox) - trnl='\n' - ;; - esac -fi -if test X"$trnl" = X; then - case "`echo foo|tr '\012' x 2>/dev/null`" in - foox) - trnl='\012' - ;; - esac -fi -if test -n "$DJGPP"; then - trnl='\012' -fi -if test X"$trnl" = X; then - cat <&2 - -$me: Fatal Error: cannot figure out how to translate newlines with 'tr'. - -EOM - exit 1 -fi - : Proper separator for the PATH environment variable p_=: : On OS/2 this directory should exist if this is not floppy only system :-] @@ -391,7 +364,6 @@ d_getservprotos='' d_getsbyname='' d_getsbyport='' d_gnulibc='' -i_arpainet='' d_htonl='' d_inetaton='' d_isascii='' @@ -540,6 +512,7 @@ dlsrc='' ld='' lddlflags='' usedl='' +ebcdic='' doublesize='' fpostype='' gidtype='' @@ -548,6 +521,7 @@ h_fcntl='' h_sysfile='' db_hashtype='' db_prefixtype='' +i_arpainet='' i_db='' i_dbm='' i_rpcsvcdbm='' @@ -633,6 +607,7 @@ libpth='' loclibpth='' plibpth='' xlibpth='' +ignore_versioned_solibs='' libs='' lns='' lseektype='' @@ -697,11 +672,13 @@ randbits='' installscript='' scriptdir='' scriptdirexp='' +selectminbits='' selecttype='' sh='' sig_name='' sig_name_init='' sig_num='' +sig_num_init='' installsitearch='' sitearch='' sitearchexp='' @@ -719,6 +696,7 @@ startperl='' startsh='' stdchar='' sysman='' +trnl='' uidtype='' nm_opt='' nm_so_opt='' @@ -733,7 +711,6 @@ mips_type='' usrinc='' defvoidused='' voidflags='' -ebcdic='' CONFIG='' define='define' @@ -836,6 +813,8 @@ plibpth='' : default library list libswanted='' +: some systems want only to use the non-versioned libso:s +ignore_versioned_solibs='' : Possible local include directories to search. : Set locincpth to "" in a hint file to defeat local include searches. locincpth="/usr/local/include /opt/local/include /usr/gnu/include" @@ -904,7 +883,7 @@ case "$sh" in $me: Fatal Error: I can't find a Bourne Shell anywhere. Usually it's in /bin/sh. How did you even get this far? -Please contact me (Andy Dougherty) at doughera@lafayette.edu and +Please contact me (Jarkko Hietaniemi) at jhi@iki.fi and we'll try to straighten this all out. EOM exit 1 @@ -1240,7 +1219,7 @@ cat >extract <<'EOS' CONFIG=true echo "Doing variable substitutions on .SH files..." if test -f $src/MANIFEST; then - set x `awk '{print $1}' <$src/MANIFEST | grep '\.SH'` + set x `awk '{print $1}' <$src/MANIFEST | grep '\.SH$'` else echo "(Looking for .SH files under the source directory.)" set x `(cd $src; find . -name "*.SH" -print)` @@ -1373,7 +1352,7 @@ THIS PACKAGE SEEMS TO BE INCOMPLETE. You have the option of continuing the configuration process, despite the distinct possibility that your kit is damaged, by typing 'y'es. If you do, don't blame me if something goes wrong. I advise you to type 'n'o -and contact the author (doughera@lafayette.edu). +and contact the author (jhi@iki.fi). EOM echo $n "Continue? [n] $c" >&4 @@ -1396,6 +1375,30 @@ else fi rm -f missing x?? +echo " " +: Find the appropriate value for a newline for tr +if test -n "$DJGPP"; then + trnl='\012' +fi +if test X"$trnl" = X; then + case "`echo foo|tr '\n' x 2>/dev/null`" in + foox) trnl='\n' ;; + esac +fi +if test X"$trnl" = X; then + case "`echo foo|tr '\012' x 2>/dev/null`" in + foox) trnl='\012' ;; + esac +fi +if test X"$trnl" = X; then + cat <&2 + +$me: Fatal Error: cannot figure out how to translate newlines with 'tr'. + +EOM + exit 1 +fi + : compute the number of columns on the terminal for proper question formatting case "$COLUMNS" in '') COLUMNS='80';; @@ -1574,7 +1577,7 @@ Much effort has been expended to ensure that this shell script will run on any Unix system. If despite that it blows up on yours, your best bet is to edit Configure and run it again. If you can't run Configure for some reason, you'll have to generate a config.sh file by hand. Whatever problems you -have, let me (doughera@lafayette.edu) know how I blew it. +have, let me (jhi@iki.fi) know how I blew it. This installation script affects things in two ways: @@ -1841,14 +1844,14 @@ ABYZ) *C9D1*|*c9d1*) echo "Hey, this might be EBCDIC." >&4 if test "X$up" = X -o "X$low" = X; then - case "`echo IJ | tr '[A-IJ-RS-Z]' '[a-ij-rs-z]' 2>/dev/null`" in + case "`echo IJ | $tr '[A-IJ-RS-Z]' '[a-ij-rs-z]' 2>/dev/null`" in ij) up='[A-IJ-RS-Z]' low='[a-ij-rs-z]' ;; esac fi if test "X$up" = X -o "X$low" = X; then - case "`echo IJ | tr A-IJ-RS-Z a-ij-rs-z 2>/dev/null`" in + case "`echo IJ | $tr A-IJ-RS-Z a-ij-rs-z 2>/dev/null`" in ij) up='A-IJ-RS-Z' low='a-ij-rs-z' ;; @@ -1941,7 +1944,7 @@ EOM (cd $src/hints; ls -C *.sh) | $sed 's/\.sh/ /g' >&4 dflt='' : Half the following guesses are probably wrong... If you have better - : tests or hints, please send them to doughera@lafayette.edu + : tests or hints, please send them to jhi@iki.fi : The metaconfig authors would also appreciate a copy... $test -f /irix && osname=irix $test -f /xenix && osname=sco_xenix @@ -2025,7 +2028,7 @@ EOM osvers="$3" ;; dynixptx*) osname=dynixptx - osvers="$3" + osvers=`echo "$4" | $sed 's/^v//'` ;; freebsd) osname=freebsd osvers="$3" ;; @@ -3454,7 +3457,11 @@ cat <<'EOT' >testcpp.c ABC.XYZ EOT cd .. +if test ! -f cppstdin; then echo 'cat >.$$.c; '"$cc"' -E ${1+"$@"} .$$.c; rm .$$.c' >cppstdin +else + echo "Keeping your $hint cppstdin wrapper." +fi chmod 755 cppstdin wrapper=`pwd`/cppstdin ok='false' @@ -3705,7 +3712,8 @@ case "$libswanted" in esac for thislib in $libswanted; do - if xxx=`./loc lib$thislib.$so.[0-9]'*' X $libpth`; $test -f "$xxx"; then + if xxx=`./loc lib$thislib.$so.[0-9]'*' X $libpth`; + $test -f "$xxx" -a "X$ignore_versioned_solibs" = "X"; then echo "Found -l$thislib (shared)." case " $dflt " in *"-l$thislib "*);; @@ -3992,10 +4000,21 @@ rmlist="$rmlist pdp11" : coherency check echo " " echo "Checking your choice of C compiler and flags for coherency..." >&4 +$cat > try.c <<'EOF' +#include +main() { printf("Ok\n"); exit(0); } +EOF set X $cc $optimize $ccflags -o try $ldflags try.c $libs shift -$cat >try.msg <try.msg <<'EOM' +I've tried to compile and run the following simple program: + +EOM +$cat try.c + +$cat >> try.msg < try.c <<'EOF' -#include -main() { printf("Ok\n"); exit(0); } -EOF dflt=y if sh -c "$cc $optimize $ccflags -o try $ldflags try.c $libs" >>try.msg 2>&1; then if sh -c './try' >>try.msg 2>&1; then @@ -4043,7 +4058,7 @@ y) $cat try.msg >&4 case "$knowitall" in '') - echo "(The supplied flags might be incorrect with this C compiler.)" + echo "(The supplied flags or libraries might be incorrect.)" ;; *) dflt=n;; esac @@ -4161,9 +4176,8 @@ eval $inhdr : determine which malloc to compile in echo " " case "$usemymalloc" in -''|y*|true) dflt='y' ;; -n*|false) dflt='n' ;; -*) dflt="$usemymalloc" ;; +''|[yY]*|true|$define) dflt='y' ;; +*) dflt='n' ;; esac rp="Do you wish to attempt to use the malloc that comes with $package?" . ./myread @@ -4265,7 +4279,7 @@ understands function prototypes. Unfortunately, your C compiler $cc $ccflags doesn't seem to understand them. Sorry about that. -If GNU cc is avaiable for your system, perhaps you could try that instead. +If GNU cc is available for your system, perhaps you could try that instead. Eventually, we hope to support building Perl with pre-ANSI compilers. If you would like to help in that effort, please contact . @@ -4320,32 +4334,6 @@ shift; $cc $optimize $ccflags $ldflags -o ${mc_file} $* ${mc_file}.c $libs;' echo " " -echo "Determining whether or not we are on an EBCDIC system..." >&4 -cat >tebcdic.c <&4 - val="$define" - else - echo "Nope, no EBCDIC. Assuming ASCII or some ISO Latin." >&4 - fi -else - echo "I'm unable to compile the test program." >&4 - echo "I'll asuume ASCII or some ISO Latin." >&4 -fi -$rm -f tebcdic.c tebcdic -set ebcdic -eval $setvar - -echo " " echo "Checking for GNU C Library..." >&4 cat >gnulibc.c < @@ -5159,7 +5147,7 @@ case "$shrpdir" in *) $cat >&4 <&1`" in + "SVID messages"*"not configured"*) + echo "But your $osname does not have the msg*(2) configured." >&4 + h_msg=false + val="$undef" + set msgctl d_msgctl + eval $setvar + set msgget d_msgget + eval $setvar + set msgsnd d_msgsnd + eval $setvar + set msgrcv d_msgrcv + eval $setvar + ;; + esac + ;; +esac + : we could also check for sys/ipc.h ... if $h_msg && $test `./findhdr sys/msg.h`; then echo "You have the full msg*(2) library." >&4 @@ -7671,7 +7701,7 @@ set poll d_poll eval $inlibc -: see whether the various POSIXish _yields exist within given cccmd +: see whether the various POSIXish _yields exist $cat >try.c < main() { @@ -8125,6 +8155,25 @@ echo " " case "$d_semctl$d_semget$d_semop" in *"$undef"*) h_sem=false;; esac + +case "$osname" in +freebsd) + case "`ipcs 2>&1`" in + "SVID messages"*"not configured"*) + echo "But your $osname does not have the sem*(2) configured." >&4 + h_sem=false + val="$undef" + set semctl d_semctl + eval $setvar + set semget d_semget + eval $setvar + set semop d_semop + eval $setvar + ;; + esac + ;; +esac + : we could also check for sys/ipc.h ... if $h_sem && $test `./findhdr sys/sem.h`; then echo "You have the full sem*(2) library." >&4 @@ -8161,6 +8210,31 @@ case "$d_sem" in $define) : see whether semctl IPC_STAT can use union semun echo " " + $cat > try.h <>3) +# define S_IWGRP (S_IWUSR>>3) +# define S_IXGRP (S_IXUSR>>3) +# define S_IROTH (S_IRUSR>>6) +# define S_IWOTH (S_IWUSR>>6) +# define S_IXOTH (S_IXUSR>>6) +#endif +#ifndef S_IRWXU +# define S_IRWXU (S_IRUSR|S_IWUSR|S_IXUSR) +# define S_IRWXG (S_IRGRP|S_IWGRP|S_IXGRP) +# define S_IRWXO (S_IROTH|S_IWOTH|S_IXOTH) +#endif +END + $cat > try.c < #include @@ -8235,6 +8309,7 @@ END #include #include #include +#include "try.h" #ifndef errno extern int errno; #endif @@ -8281,6 +8356,7 @@ END *) echo "You cannot use struct semid_ds * for semctl IPC_STAT." >&4 ;; esac + $rm -f try.h ;; *) val="$undef" @@ -8471,6 +8547,27 @@ echo " " case "$d_shmctl$d_shmget$d_shmat$d_shmdt" in *"$undef"*) h_shm=false;; esac + +case "$osname" in +freebsd) + case "`ipcs 2>&1`" in + "SVID shared memory"*"not configured"*) + echo "But your $osname does not have the shm*(2) configured." >&4 + h_shm=false + val="$undef" + set shmctl d_shmctl + evat $setvar + set shmget d_shmget + evat $setvar + set shmat d_shmat + evat $setvar + set shmdt d_shmdt + evat $setvar + ;; + esac + ;; +esac + : we could also check for sys/ipc.h ... if $h_shm && $test `./findhdr sys/shm.h`; then echo "You have the full shm*(2) library." >&4 @@ -8609,21 +8706,8 @@ eval $inlibc : see if stat knows about block sizes echo " " -xxx=`./findhdr sys/stat.h` -if $contains 'st_blocks;' "$xxx" >/dev/null 2>&1 ; then - if $contains 'st_blksize;' "$xxx" >/dev/null 2>&1 ; then - echo "Your stat() knows about block sizes." >&4 - val="$define" - else - echo "Your stat() doesn't know about block sizes." >&4 - val="$undef" - fi -else - echo "Your stat() doesn't know about block sizes." >&4 - val="$undef" -fi -set d_statblks -eval $setvar +set d_statblks stat st_blocks $i_sysstat sys/stat.h +eval $hasfield : see if _ptr and _cnt from stdio act std echo " " @@ -9567,6 +9651,32 @@ EOCP esac $rm -f try.c try +echo " " +echo "Determining whether or not we are on an EBCDIC system..." >&4 +$cat >tebcdic.c <&4 + val="$define" + else + echo "Nope, no EBCDIC. Assuming ASCII or some ISO Latin." >&4 + fi +else + echo "I'm unable to compile the test program." >&4 + echo "I'll assume ASCII or some ISO Latin." >&4 +fi +$rm -f tebcdic.c tebcdic +set ebcdic +eval $setvar + : see what type file positions are declared as in the library rp="What is the type for file position used by fsetpos()?" set fpos_t fpostype long stdio.h sys/types.h @@ -10174,8 +10284,10 @@ EOM : The first arg can be int, unsigned, or size_t : The last arg may or may not be 'const' val='' + : void pointer has been seen but using that + : breaks the selectminbits test for xxx in 'fd_set *' 'int *'; do - for nfd in 'int' 'size_t' 'unsigned' ; do + for nfd in 'int' 'size_t' 'unsigned' 'unsigned long'; do for tmo in 'struct timeval *' 'const struct timeval *'; do case "$val" in '') try="extern select _(($nfd, $xxx, $xxx, $xxx, $tmo));" @@ -10207,6 +10319,100 @@ EOM ;; esac +: check for the select 'width' +case "$selectminbits" in +'') case "$d_select" in + $define) + $cat <try.c < +#$i_time I_TIME +#$i_systime I_SYS_TIME +#$i_systimek I_SYS_TIME_KERNEL +#ifdef I_TIME +# include +#endif +#ifdef I_SYS_TIME +# ifdef I_SYS_TIME_KERNEL +# define KERNEL +# endif +# include +# ifdef I_SYS_TIME_KERNEL +# undef KERNEL +# endif +#endif +#$i_sysselct I_SYS_SELECT +#ifdef I_SYS_SELECT +#include +#endif +#include +$selecttype b; +#define S sizeof(*(b)) +#define MINBITS 64 +#define NBYTES (S * 8 > MINBITS ? S : MINBITS/8) +#define NBITS (NBYTES * 8) +int main() { + char s[NBYTES]; + struct timeval t; + int i; + FILE* fp; + int fd; + + fclose(stdin); + fp = fopen("try.c", "r"); + if (fp == 0) + exit(1); + fd = fileno(fp); + if (fd < 0) + exit(2); + b = ($selecttype)s; + for (i = 0; i < NBITS; i++) + FD_SET(i, b); + t.tv_sec = 0; + t.tv_usec = 0; + select(fd + 1, b, 0, 0, &t); + for (i = NBITS - 1; i > fd && FD_ISSET(i, b); i--); + printf("%d\n", i + 1); + return 0; +} +EOCP + set try + if eval $compile_ok; then + selectminbits=`./try` + case "$selectminbits" in + '') cat >&4 <&4 + else + rp='What is the minimum number of bits your select() operates on?' + case "$byteorder" in + 1234|12345678) dflt=32 ;; + *) dflt=1 ;; + esac + . ./myread + val=$ans + selectminbits="$val" + fi + $rm -f try.* try + ;; + *) : no select, so pick a harmless default + selectminbits='32' + ;; + esac + ;; +esac + : Trace out the files included by signal.h, then look for SIGxxx names. : Remove SIGARRAYSIZE used by HPUX. : Remove SIGTYP void lines used by OS2. @@ -10415,7 +10621,13 @@ $eunicefix signal_cmd : generate list of signal names echo " " case "$sig_name_init" in -'') +'') doinit=yes ;; +*) case "$sig_num_init" in + ''|*,*) doinit=yes ;; + esac ;; +esac +case "$doinit" in +yes) echo "Generating a list of signal names and numbers..." >&4 . ./signal_cmd sig_name=`$awk '{printf "%s ", $1}' signal.lst` @@ -10423,7 +10635,9 @@ case "$sig_name_init" in sig_name_init=`$awk 'BEGIN { printf "\"ZERO\", " } { printf "\"%s\", ", $1 } END { printf "0\n" }' signal.lst` - sig_num=`$awk 'BEGIN { printf "0, " } + sig_num=`$awk '{printf "%d ", $2}' signal.lst` + sig_num="0 $sig_num" + sig_num_init=`$awk 'BEGIN { printf "0, " } { printf "%d, ", $2} END { printf "0\n"}' signal.lst` ;; @@ -10787,7 +11001,13 @@ $rm -f try.c EOS chmod +x ccsym $eunicefix ccsym -./ccsym | $sort | $uniq >ccsym.raw +./ccsym > ccsym1.raw +if $test -s ccsym1.raw; then + $sort ccsym1.raw | $uniq >ccsym.raw +else + mv ccsym1.raw ccsym.raw +fi + $awk '/\=/ { print $0; next } { print $0"=1" }' ccsym.raw >ccsym.list $awk '{ print $0"=1" }' Cppsym.true >ccsym.true @@ -11012,10 +11232,6 @@ eval $inhdr set sys/resource.h i_sysresrc eval $inhdr -: see if sys/stat.h is available -set sys/stat.h i_sysstat -eval $inhdr - : see if this is a sys/un.h system set sys/un.h i_sysun eval $inhdr @@ -11152,6 +11368,7 @@ for xxx in $known_extensions ; do esac ;; IPC/SysV|ipc/sysv) + : XXX Do we need a useipcsysv variable here case "${d_msg}${d_sem}${d_shm}" in *"${define}"*) avail_ext="$avail_ext $xxx" ;; esac @@ -11731,6 +11948,7 @@ i_values='$i_values' i_varargs='$i_varargs' i_varhdr='$i_varhdr' i_vfork='$i_vfork' +ignore_versioned_solibs='$ignore_versioned_solibs' incpath='$incpath' inews='$inews' installarchlib='$installarchlib' @@ -11839,6 +12057,7 @@ runnm='$runnm' scriptdir='$scriptdir' scriptdirexp='$scriptdirexp' sed='$sed' +selectminbits='$selectminbits' selecttype='$selecttype' sendmail='$sendmail' sh='$sh' @@ -11851,6 +12070,7 @@ shsharp='$shsharp' sig_name='$sig_name' sig_name_init='$sig_name_init' sig_num='$sig_num' +sig_num_init='$sig_num_init' signal_t='$signal_t' sitearch='$sitearch' sitearchexp='$sitearchexp' --- Makefile.SH +++ Makefile.SH @@ -644,3 +644,83 @@ case `pwd` in ;; esac $rm -f $firstmakefile + +# Now do any special processing required before building. + +case "$ebcdic" in +$define) + xxx='' + echo "This is an EBCDIC system, checking if any parser files need regenerating." >&4 +case "$osname" in +os390) + rm -f y.tab.c y.tab.h + yacc -d perly.y >/dev/null 2>&1 + if cmp -s y.tab.c perly.c; then + rm -f y.tab.c + else + echo "perly.y -> perly.c" >&2 + mv -f y.tab.c perly.c + chmod u+w perly.c + sed -e '/^#include "perl\.h"/a\ +\ +#define yydebug PL_yydebug\ +#define yynerrs PL_yynerrs\ +#define yyerrflag PL_yyerrflag\ +#define yychar PL_yychar\ +#define yyval PL_yyval\ +#define yylval PL_yylval' \ + -e '/YYSTYPE *yyval;/D' \ + -e '/YYSTYPE *yylval;/D' \ + -e '/int yychar,/,/yynerrs;/D' \ + -e 's/int yydebug = 0;/yydebug = 0;/' \ + -e 's/[^_]realloc(/PerlMem_realloc(/g' \ + -e 's/fprintf *( *stderr *,/PerlIO_printf(Perl_debug_log,/g' \ + -e 's/y\.tab/perly/g' perly.c >perly.tmp && mv perly.tmp perly.c + xxx="$xxx perly.c" + fi + if cmp -s y.tab.h perly.h; then + rm -f y.tab.h + else + echo "perly.y -> perly.h" >&2 + mv -f y.tab.h perly.h + xxx="$xxx perly.h" + fi + if cd x2p + then + rm -f y.tab.c y.tab.h + yacc a2p.y >/dev/null 2>&1 + if cmp -s y.tab.c a2p.c + then + rm -f y.tab.c + else + echo "a2p.y -> a2p.c" >&2 + mv -f y.tab.c a2p.c + chmod u+w a2p.c + sed -e 's/fprintf *( *stderr *,/PerlIO_printf(Perl_debug_log,/g' \ + -e 's/y\.tab/a2p/g' a2p.c >a2p.tmp && mv a2p.tmp a2p.c + xxx="$xxx a2p.c" + fi + # In case somebody yacc -d:ed the a2p.y. + if test -f y.tab.h + then + if cmp -s y.tab.h a2p.h + then + rm -f y.tab.h + else + echo "a2p.h -> a2p.h" >&2 + mv -f y.tab.h a2p.h + xxx="$xxx a2p.h" + fi + fi + cd .. + fi + ;; +*) + echo "'$osname' is an EBCDIC system I don't know that well." >&4 + ;; +esac + case "$xxx" in + '') echo "No parser files were regenerated. That's okay." >&2 ;; + esac + ;; +esac --- config_h.SH +++ config_h.SH @@ -1813,7 +1813,7 @@ sed <config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- * the sig_name list. */ #define SIG_NAME $sig_name_init /**/ -#define SIG_NUM $sig_num /**/ +#define SIG_NUM $sig_num_init /**/ /* VOIDFLAGS: * This symbol indicates how much support of the void type is given by this @@ -1902,6 +1902,15 @@ sed <config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- #define PRIVLIB "$privlib" /**/ #define PRIVLIB_EXP "$privlibexp" /**/ +/* SELECT_MIN_BITS: + * This symbol holds the minimum number of bits operated by select. + * That is, if you do select(n, ...), how many bits at least will be + * cleared in the masks if some activity is detected. Usually this + * is either n or 32*ceil(n/32), especially many little-endians do + * the latter. This is only useful if you have select(), naturally. + */ +#define SELECT_MIN_BITS $selectminbits /**/ + /* SITEARCH: * This symbol contains the name of the private library for this package. * The library is private in the sense that it needn't be in anyone's --- pp_sys.c +++ pp_sys.c @@ -56,7 +56,10 @@ extern "C" int syscall(unsigned long,...); /* XXX Configure test needed. h_errno might not be a simple 'int', especially for multi-threaded - applications. HOST_NOT_FOUND is typically defined in . + applications, see "extern int errno in perl.h". Creating such + a test requires taking into account the differences between + compiling multithreaded and singlethreaded ($ccflags et al). + HOST_NOT_FOUND is typically defined in . */ #if defined(HOST_NOT_FOUND) && !defined(h_errno) extern int h_errno; @@ -753,12 +756,17 @@ PP(pp_sselect) maxlen = j; } +/* little endians can use vecs directly */ #if BYTEORDER == 0x1234 || BYTEORDER == 0x12345678 -/* XXX Configure test needed. */ -#if defined(__linux__) || defined(OS2) || defined(NeXT) || defined(__osf__) || defined(sun) - growsize = sizeof(fd_set); +# if SELECT_MIN_BITS > 1 + /* If SELECT_MIN_BITS is greater than one we most probably will want + * to align the sizes with SELECT_MIN_BITS/8 because for example + * in many little-endian (Intel, Alpha) systems (Linux, OS/2, Digital + * UNIX, Solaris, NeXT) the smallest quantum select() operates on + * (sets bit) is 32 bits. */ + growsize = maxlen + (SELECT_MIN_BITS/8 - (maxlen % (SELECT_MIN_BITS/8))); #else - growsize = maxlen; /* little endians can use vecs directly */ + growsize = sizeof(fd_set); #endif #else #ifdef NFDBITS END } sub _patch_5_005 { _patch(<<'END'); --- Configure +++ Configure @@ -21,7 +21,7 @@ # $Id: Head.U,v 3.0.1.9 1997/02/28 15:02:09 ram Exp $ # # Generated on Tue Jul 7 10:10:21 EDT 1998 [metaconfig 3.0 PL70] -# (with additional metaconfig patches by doughera@lafayette.edu) +# (with additional metaconfig patches by jhi@iki.fi) cat >/tmp/c1$$ </dev/null`" in - foox) - trnl='\n' - ;; - esac -fi -if test X"$trnl" = X; then - case "`echo foo|tr '\012' x 2>/dev/null`" in - foox) - trnl='\012' - ;; - esac -fi -if test -n "$DJGPP"; then - trnl='\012' -fi -if test X"$trnl" = X; then - cat <&2 - -$me: Fatal Error: cannot figure out how to translate newlines with 'tr'. - -EOM - exit 1 -fi - : Proper separator for the PATH environment variable p_=: : On OS/2 this directory should exist if this is not floppy only system :-] @@ -391,7 +364,6 @@ d_getservprotos='' d_getsbyname='' d_getsbyport='' d_gnulibc='' -i_arpainet='' d_htonl='' d_inetaton='' d_isascii='' @@ -540,6 +512,7 @@ dlsrc='' ld='' lddlflags='' usedl='' +ebcdic='' doublesize='' fpostype='' gidtype='' @@ -548,6 +521,7 @@ h_fcntl='' h_sysfile='' db_hashtype='' db_prefixtype='' +i_arpainet='' i_db='' i_dbm='' i_rpcsvcdbm='' @@ -633,6 +607,7 @@ libpth='' loclibpth='' plibpth='' xlibpth='' +ignore_versioned_solibs='' libs='' lns='' lseektype='' @@ -697,11 +672,13 @@ randbits='' installscript='' scriptdir='' scriptdirexp='' +selectminbits='' selecttype='' sh='' sig_name='' sig_name_init='' sig_num='' +sig_num_init='' installsitearch='' sitearch='' sitearchexp='' @@ -719,6 +696,7 @@ startperl='' startsh='' stdchar='' sysman='' +trnl='' uidtype='' nm_opt='' nm_so_opt='' @@ -733,7 +711,6 @@ mips_type='' usrinc='' defvoidused='' voidflags='' -ebcdic='' CONFIG='' define='define' @@ -836,6 +813,8 @@ plibpth='' : default library list libswanted='' +: some systems want only to use the non-versioned libso:s +ignore_versioned_solibs='' : Possible local include directories to search. : Set locincpth to "" in a hint file to defeat local include searches. locincpth="/usr/local/include /opt/local/include /usr/gnu/include" @@ -904,7 +883,7 @@ case "$sh" in $me: Fatal Error: I can't find a Bourne Shell anywhere. Usually it's in /bin/sh. How did you even get this far? -Please contact me (Andy Dougherty) at doughera@lafayette.edu and +Please contact me (Jarkko Hietaniemi) at jhi@iki.fi and we'll try to straighten this all out. EOM exit 1 @@ -1240,7 +1219,7 @@ cat >extract <<'EOS' CONFIG=true echo "Doing variable substitutions on .SH files..." if test -f $src/MANIFEST; then - set x `awk '{print $1}' <$src/MANIFEST | grep '\.SH'` + set x `awk '{print $1}' <$src/MANIFEST | grep '\.SH$'` else echo "(Looking for .SH files under the source directory.)" set x `(cd $src; find . -name "*.SH" -print)` @@ -1373,7 +1352,7 @@ THIS PACKAGE SEEMS TO BE INCOMPLETE. You have the option of continuing the configuration process, despite the distinct possibility that your kit is damaged, by typing 'y'es. If you do, don't blame me if something goes wrong. I advise you to type 'n'o -and contact the author (doughera@lafayette.edu). +and contact the author (jhi@iki.fi). EOM echo $n "Continue? [n] $c" >&4 @@ -1396,6 +1375,30 @@ else fi rm -f missing x?? +echo " " +: Find the appropriate value for a newline for tr +if test -n "$DJGPP"; then + trnl='\012' +fi +if test X"$trnl" = X; then + case "`echo foo|tr '\n' x 2>/dev/null`" in + foox) trnl='\n' ;; + esac +fi +if test X"$trnl" = X; then + case "`echo foo|tr '\012' x 2>/dev/null`" in + foox) trnl='\012' ;; + esac +fi +if test X"$trnl" = X; then + cat <&2 + +$me: Fatal Error: cannot figure out how to translate newlines with 'tr'. + +EOM + exit 1 +fi + : compute the number of columns on the terminal for proper question formatting case "$COLUMNS" in '') COLUMNS='80';; @@ -1574,7 +1577,7 @@ Much effort has been expended to ensure that this shell script will run on any Unix system. If despite that it blows up on yours, your best bet is to edit Configure and run it again. If you can't run Configure for some reason, you'll have to generate a config.sh file by hand. Whatever problems you -have, let me (doughera@lafayette.edu) know how I blew it. +have, let me (jhi@iki.fi) know how I blew it. This installation script affects things in two ways: @@ -1841,14 +1844,14 @@ ABYZ) *C9D1*|*c9d1*) echo "Hey, this might be EBCDIC." >&4 if test "X$up" = X -o "X$low" = X; then - case "`echo IJ | tr '[A-IJ-RS-Z]' '[a-ij-rs-z]' 2>/dev/null`" in + case "`echo IJ | $tr '[A-IJ-RS-Z]' '[a-ij-rs-z]' 2>/dev/null`" in ij) up='[A-IJ-RS-Z]' low='[a-ij-rs-z]' ;; esac fi if test "X$up" = X -o "X$low" = X; then - case "`echo IJ | tr A-IJ-RS-Z a-ij-rs-z 2>/dev/null`" in + case "`echo IJ | $tr A-IJ-RS-Z a-ij-rs-z 2>/dev/null`" in ij) up='A-IJ-RS-Z' low='a-ij-rs-z' ;; @@ -1941,7 +1944,7 @@ EOM (cd $src/hints; ls -C *.sh) | $sed 's/\.sh/ /g' >&4 dflt='' : Half the following guesses are probably wrong... If you have better - : tests or hints, please send them to doughera@lafayette.edu + : tests or hints, please send them to jhi@iki.fi : The metaconfig authors would also appreciate a copy... $test -f /irix && osname=irix $test -f /xenix && osname=sco_xenix @@ -2025,7 +2028,7 @@ EOM osvers="$3" ;; dynixptx*) osname=dynixptx - osvers="$3" + osvers=`echo "$4" | $sed 's/^v//'` ;; freebsd) osname=freebsd osvers="$3" ;; @@ -3454,7 +3457,11 @@ cat <<'EOT' >testcpp.c ABC.XYZ EOT cd .. +if test ! -f cppstdin; then echo 'cat >.$$.c; '"$cc"' -E ${1+"$@"} .$$.c; rm .$$.c' >cppstdin +else + echo "Keeping your $hint cppstdin wrapper." +fi chmod 755 cppstdin wrapper=`pwd`/cppstdin ok='false' @@ -3705,7 +3712,8 @@ case "$libswanted" in esac for thislib in $libswanted; do - if xxx=`./loc lib$thislib.$so.[0-9]'*' X $libpth`; $test -f "$xxx"; then + if xxx=`./loc lib$thislib.$so.[0-9]'*' X $libpth`; + $test -f "$xxx" -a "X$ignore_versioned_solibs" = "X"; then echo "Found -l$thislib (shared)." case " $dflt " in *"-l$thislib "*);; @@ -3992,10 +4000,21 @@ rmlist="$rmlist pdp11" : coherency check echo " " echo "Checking your choice of C compiler and flags for coherency..." >&4 +$cat > try.c <<'EOF' +#include +main() { printf("Ok\n"); exit(0); } +EOF set X $cc $optimize $ccflags -o try $ldflags try.c $libs shift -$cat >try.msg <try.msg <<'EOM' +I've tried to compile and run the following simple program: + +EOM +$cat try.c + +$cat >> try.msg < try.c <<'EOF' -#include -main() { printf("Ok\n"); exit(0); } -EOF dflt=y if sh -c "$cc $optimize $ccflags -o try $ldflags try.c $libs" >>try.msg 2>&1; then if sh -c './try' >>try.msg 2>&1; then @@ -4043,7 +4058,7 @@ y) $cat try.msg >&4 case "$knowitall" in '') - echo "(The supplied flags might be incorrect with this C compiler.)" + echo "(The supplied flags or libraries might be incorrect.)" ;; *) dflt=n;; esac @@ -4161,9 +4176,8 @@ eval $inhdr : determine which malloc to compile in echo " " case "$usemymalloc" in -''|y*|true) dflt='y' ;; -n*|false) dflt='n' ;; -*) dflt="$usemymalloc" ;; +''|[yY]*|true|$define) dflt='y' ;; +*) dflt='n' ;; esac rp="Do you wish to attempt to use the malloc that comes with $package?" . ./myread @@ -4265,7 +4279,7 @@ understands function prototypes. Unfortunately, your C compiler $cc $ccflags doesn't seem to understand them. Sorry about that. -If GNU cc is avaiable for your system, perhaps you could try that instead. +If GNU cc is available for your system, perhaps you could try that instead. Eventually, we hope to support building Perl with pre-ANSI compilers. If you would like to help in that effort, please contact . @@ -4320,32 +4334,6 @@ shift; $cc $optimize $ccflags $ldflags -o ${mc_file} $* ${mc_file}.c $libs;' echo " " -echo "Determining whether or not we are on an EBCDIC system..." >&4 -cat >tebcdic.c <&4 - val="$define" - else - echo "Nope, no EBCDIC. Assuming ASCII or some ISO Latin." >&4 - fi -else - echo "I'm unable to compile the test program." >&4 - echo "I'll asuume ASCII or some ISO Latin." >&4 -fi -$rm -f tebcdic.c tebcdic -set ebcdic -eval $setvar - -echo " " echo "Checking for GNU C Library..." >&4 cat >gnulibc.c < @@ -5159,7 +5147,7 @@ case "$shrpdir" in *) $cat >&4 <&1`" in + "SVID messages"*"not configured"*) + echo "But your $osname does not have the msg*(2) configured." >&4 + h_msg=false + val="$undef" + set msgctl d_msgctl + eval $setvar + set msgget d_msgget + eval $setvar + set msgsnd d_msgsnd + eval $setvar + set msgrcv d_msgrcv + eval $setvar + ;; + esac + ;; +esac + : we could also check for sys/ipc.h ... if $h_msg && $test `./findhdr sys/msg.h`; then echo "You have the full msg*(2) library." >&4 @@ -7671,7 +7701,7 @@ set poll d_poll eval $inlibc -: see whether the various POSIXish _yields exist within given cccmd +: see whether the various POSIXish _yields exist $cat >try.c < main() { @@ -8125,6 +8155,25 @@ echo " " case "$d_semctl$d_semget$d_semop" in *"$undef"*) h_sem=false;; esac + +case "$osname" in +freebsd) + case "`ipcs 2>&1`" in + "SVID messages"*"not configured"*) + echo "But your $osname does not have the sem*(2) configured." >&4 + h_sem=false + val="$undef" + set semctl d_semctl + eval $setvar + set semget d_semget + eval $setvar + set semop d_semop + eval $setvar + ;; + esac + ;; +esac + : we could also check for sys/ipc.h ... if $h_sem && $test `./findhdr sys/sem.h`; then echo "You have the full sem*(2) library." >&4 @@ -8161,6 +8210,31 @@ case "$d_sem" in $define) : see whether semctl IPC_STAT can use union semun echo " " + $cat > try.h <>3) +# define S_IWGRP (S_IWUSR>>3) +# define S_IXGRP (S_IXUSR>>3) +# define S_IROTH (S_IRUSR>>6) +# define S_IWOTH (S_IWUSR>>6) +# define S_IXOTH (S_IXUSR>>6) +#endif +#ifndef S_IRWXU +# define S_IRWXU (S_IRUSR|S_IWUSR|S_IXUSR) +# define S_IRWXG (S_IRGRP|S_IWGRP|S_IXGRP) +# define S_IRWXO (S_IROTH|S_IWOTH|S_IXOTH) +#endif +END + $cat > try.c < #include @@ -8235,6 +8309,7 @@ END #include #include #include +#include "try.h" #ifndef errno extern int errno; #endif @@ -8281,6 +8356,7 @@ END *) echo "You cannot use struct semid_ds * for semctl IPC_STAT." >&4 ;; esac + $rm -f try.h ;; *) val="$undef" @@ -8471,6 +8547,27 @@ echo " " case "$d_shmctl$d_shmget$d_shmat$d_shmdt" in *"$undef"*) h_shm=false;; esac + +case "$osname" in +freebsd) + case "`ipcs 2>&1`" in + "SVID shared memory"*"not configured"*) + echo "But your $osname does not have the shm*(2) configured." >&4 + h_shm=false + val="$undef" + set shmctl d_shmctl + evat $setvar + set shmget d_shmget + evat $setvar + set shmat d_shmat + evat $setvar + set shmdt d_shmdt + evat $setvar + ;; + esac + ;; +esac + : we could also check for sys/ipc.h ... if $h_shm && $test `./findhdr sys/shm.h`; then echo "You have the full shm*(2) library." >&4 @@ -8609,21 +8706,8 @@ eval $inlibc : see if stat knows about block sizes echo " " -xxx=`./findhdr sys/stat.h` -if $contains 'st_blocks;' "$xxx" >/dev/null 2>&1 ; then - if $contains 'st_blksize;' "$xxx" >/dev/null 2>&1 ; then - echo "Your stat() knows about block sizes." >&4 - val="$define" - else - echo "Your stat() doesn't know about block sizes." >&4 - val="$undef" - fi -else - echo "Your stat() doesn't know about block sizes." >&4 - val="$undef" -fi -set d_statblks -eval $setvar +set d_statblks stat st_blocks $i_sysstat sys/stat.h +eval $hasfield : see if _ptr and _cnt from stdio act std echo " " @@ -9567,6 +9651,32 @@ EOCP esac $rm -f try.c try +echo " " +echo "Determining whether or not we are on an EBCDIC system..." >&4 +$cat >tebcdic.c <&4 + val="$define" + else + echo "Nope, no EBCDIC. Assuming ASCII or some ISO Latin." >&4 + fi +else + echo "I'm unable to compile the test program." >&4 + echo "I'll assume ASCII or some ISO Latin." >&4 +fi +$rm -f tebcdic.c tebcdic +set ebcdic +eval $setvar + : see what type file positions are declared as in the library rp="What is the type for file position used by fsetpos()?" set fpos_t fpostype long stdio.h sys/types.h @@ -10174,8 +10284,10 @@ EOM : The first arg can be int, unsigned, or size_t : The last arg may or may not be 'const' val='' + : void pointer has been seen but using that + : breaks the selectminbits test for xxx in 'fd_set *' 'int *'; do - for nfd in 'int' 'size_t' 'unsigned' ; do + for nfd in 'int' 'size_t' 'unsigned' 'unsigned long'; do for tmo in 'struct timeval *' 'const struct timeval *'; do case "$val" in '') try="extern select _(($nfd, $xxx, $xxx, $xxx, $tmo));" @@ -10207,6 +10319,100 @@ EOM ;; esac +: check for the select 'width' +case "$selectminbits" in +'') case "$d_select" in + $define) + $cat <try.c < +#$i_time I_TIME +#$i_systime I_SYS_TIME +#$i_systimek I_SYS_TIME_KERNEL +#ifdef I_TIME +# include +#endif +#ifdef I_SYS_TIME +# ifdef I_SYS_TIME_KERNEL +# define KERNEL +# endif +# include +# ifdef I_SYS_TIME_KERNEL +# undef KERNEL +# endif +#endif +#$i_sysselct I_SYS_SELECT +#ifdef I_SYS_SELECT +#include +#endif +#include +$selecttype b; +#define S sizeof(*(b)) +#define MINBITS 64 +#define NBYTES (S * 8 > MINBITS ? S : MINBITS/8) +#define NBITS (NBYTES * 8) +int main() { + char s[NBYTES]; + struct timeval t; + int i; + FILE* fp; + int fd; + + fclose(stdin); + fp = fopen("try.c", "r"); + if (fp == 0) + exit(1); + fd = fileno(fp); + if (fd < 0) + exit(2); + b = ($selecttype)s; + for (i = 0; i < NBITS; i++) + FD_SET(i, b); + t.tv_sec = 0; + t.tv_usec = 0; + select(fd + 1, b, 0, 0, &t); + for (i = NBITS - 1; i > fd && FD_ISSET(i, b); i--); + printf("%d\n", i + 1); + return 0; +} +EOCP + set try + if eval $compile_ok; then + selectminbits=`./try` + case "$selectminbits" in + '') cat >&4 <&4 + else + rp='What is the minimum number of bits your select() operates on?' + case "$byteorder" in + 1234|12345678) dflt=32 ;; + *) dflt=1 ;; + esac + . ./myread + val=$ans + selectminbits="$val" + fi + $rm -f try.* try + ;; + *) : no select, so pick a harmless default + selectminbits='32' + ;; + esac + ;; +esac + : Trace out the files included by signal.h, then look for SIGxxx names. : Remove SIGARRAYSIZE used by HPUX. : Remove SIGTYP void lines used by OS2. @@ -10415,7 +10621,13 @@ $eunicefix signal_cmd : generate list of signal names echo " " case "$sig_name_init" in -'') +'') doinit=yes ;; +*) case "$sig_num_init" in + ''|*,*) doinit=yes ;; + esac ;; +esac +case "$doinit" in +yes) echo "Generating a list of signal names and numbers..." >&4 . ./signal_cmd sig_name=`$awk '{printf "%s ", $1}' signal.lst` @@ -10423,7 +10635,9 @@ case "$sig_name_init" in sig_name_init=`$awk 'BEGIN { printf "\"ZERO\", " } { printf "\"%s\", ", $1 } END { printf "0\n" }' signal.lst` - sig_num=`$awk 'BEGIN { printf "0, " } + sig_num=`$awk '{printf "%d ", $2}' signal.lst` + sig_num="0 $sig_num" + sig_num_init=`$awk 'BEGIN { printf "0, " } { printf "%d, ", $2} END { printf "0\n"}' signal.lst` ;; @@ -10787,7 +11001,13 @@ $rm -f try.c EOS chmod +x ccsym $eunicefix ccsym -./ccsym | $sort | $uniq >ccsym.raw +./ccsym > ccsym1.raw +if $test -s ccsym1.raw; then + $sort ccsym1.raw | $uniq >ccsym.raw +else + mv ccsym1.raw ccsym.raw +fi + $awk '/\=/ { print $0; next } { print $0"=1" }' ccsym.raw >ccsym.list $awk '{ print $0"=1" }' Cppsym.true >ccsym.true @@ -11012,10 +11232,6 @@ eval $inhdr set sys/resource.h i_sysresrc eval $inhdr -: see if sys/stat.h is available -set sys/stat.h i_sysstat -eval $inhdr - : see if this is a sys/un.h system set sys/un.h i_sysun eval $inhdr @@ -11152,6 +11368,7 @@ for xxx in $known_extensions ; do esac ;; IPC/SysV|ipc/sysv) + : XXX Do we need a useipcsysv variable here case "${d_msg}${d_sem}${d_shm}" in *"${define}"*) avail_ext="$avail_ext $xxx" ;; esac @@ -11731,6 +11948,7 @@ i_values='$i_values' i_varargs='$i_varargs' i_varhdr='$i_varhdr' i_vfork='$i_vfork' +ignore_versioned_solibs='$ignore_versioned_solibs' incpath='$incpath' inews='$inews' installarchlib='$installarchlib' @@ -11839,6 +12057,7 @@ runnm='$runnm' scriptdir='$scriptdir' scriptdirexp='$scriptdirexp' sed='$sed' +selectminbits='$selectminbits' selecttype='$selecttype' sendmail='$sendmail' sh='$sh' @@ -11851,6 +12070,7 @@ shsharp='$shsharp' sig_name='$sig_name' sig_name_init='$sig_name_init' sig_num='$sig_num' +sig_num_init='$sig_num_init' signal_t='$signal_t' sitearch='$sitearch' sitearchexp='$sitearchexp' --- Makefile.SH +++ Makefile.SH @@ -644,3 +644,83 @@ case `pwd` in ;; esac $rm -f $firstmakefile + +# Now do any special processing required before building. + +case "$ebcdic" in +$define) + xxx='' + echo "This is an EBCDIC system, checking if any parser files need regenerating." >&4 +case "$osname" in +os390) + rm -f y.tab.c y.tab.h + yacc -d perly.y >/dev/null 2>&1 + if cmp -s y.tab.c perly.c; then + rm -f y.tab.c + else + echo "perly.y -> perly.c" >&2 + mv -f y.tab.c perly.c + chmod u+w perly.c + sed -e '/^#include "perl\.h"/a\ +\ +#define yydebug PL_yydebug\ +#define yynerrs PL_yynerrs\ +#define yyerrflag PL_yyerrflag\ +#define yychar PL_yychar\ +#define yyval PL_yyval\ +#define yylval PL_yylval' \ + -e '/YYSTYPE *yyval;/D' \ + -e '/YYSTYPE *yylval;/D' \ + -e '/int yychar,/,/yynerrs;/D' \ + -e 's/int yydebug = 0;/yydebug = 0;/' \ + -e 's/[^_]realloc(/PerlMem_realloc(/g' \ + -e 's/fprintf *( *stderr *,/PerlIO_printf(Perl_debug_log,/g' \ + -e 's/y\.tab/perly/g' perly.c >perly.tmp && mv perly.tmp perly.c + xxx="$xxx perly.c" + fi + if cmp -s y.tab.h perly.h; then + rm -f y.tab.h + else + echo "perly.y -> perly.h" >&2 + mv -f y.tab.h perly.h + xxx="$xxx perly.h" + fi + if cd x2p + then + rm -f y.tab.c y.tab.h + yacc a2p.y >/dev/null 2>&1 + if cmp -s y.tab.c a2p.c + then + rm -f y.tab.c + else + echo "a2p.y -> a2p.c" >&2 + mv -f y.tab.c a2p.c + chmod u+w a2p.c + sed -e 's/fprintf *( *stderr *,/PerlIO_printf(Perl_debug_log,/g' \ + -e 's/y\.tab/a2p/g' a2p.c >a2p.tmp && mv a2p.tmp a2p.c + xxx="$xxx a2p.c" + fi + # In case somebody yacc -d:ed the a2p.y. + if test -f y.tab.h + then + if cmp -s y.tab.h a2p.h + then + rm -f y.tab.h + else + echo "a2p.h -> a2p.h" >&2 + mv -f y.tab.h a2p.h + xxx="$xxx a2p.h" + fi + fi + cd .. + fi + ;; +*) + echo "'$osname' is an EBCDIC system I don't know that well." >&4 + ;; +esac + case "$xxx" in + '') echo "No parser files were regenerated. That's okay." >&2 ;; + esac + ;; +esac --- config_h.SH +++ config_h.SH @@ -1813,7 +1813,7 @@ sed <config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- * the sig_name list. */ #define SIG_NAME $sig_name_init /**/ -#define SIG_NUM $sig_num /**/ +#define SIG_NUM $sig_num_init /**/ /* VOIDFLAGS: * This symbol indicates how much support of the void type is given by this @@ -1902,6 +1902,15 @@ sed <config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- #define PRIVLIB "$privlib" /**/ #define PRIVLIB_EXP "$privlibexp" /**/ +/* SELECT_MIN_BITS: + * This symbol holds the minimum number of bits operated by select. + * That is, if you do select(n, ...), how many bits at least will be + * cleared in the masks if some activity is detected. Usually this + * is either n or 32*ceil(n/32), especially many little-endians do + * the latter. This is only useful if you have select(), naturally. + */ +#define SELECT_MIN_BITS $selectminbits /**/ + /* SITEARCH: * This symbol contains the name of the private library for this package. * The library is private in the sense that it needn't be in anyone's --- pp_sys.c +++ pp_sys.c @@ -56,7 +56,10 @@ extern "C" int syscall(unsigned long,...); /* XXX Configure test needed. h_errno might not be a simple 'int', especially for multi-threaded - applications. HOST_NOT_FOUND is typically defined in . + applications, see "extern int errno in perl.h". Creating such + a test requires taking into account the differences between + compiling multithreaded and singlethreaded ($ccflags et al). + HOST_NOT_FOUND is typically defined in . */ #if defined(HOST_NOT_FOUND) && !defined(h_errno) extern int h_errno; @@ -753,12 +756,17 @@ PP(pp_sselect) maxlen = j; } +/* little endians can use vecs directly */ #if BYTEORDER == 0x1234 || BYTEORDER == 0x12345678 -/* XXX Configure test needed. */ -#if defined(__linux__) || defined(OS2) || defined(NeXT) || defined(__osf__) - growsize = sizeof(fd_set); +# if SELECT_MIN_BITS > 1 + /* If SELECT_MIN_BITS is greater than one we most probably will want + * to align the sizes with SELECT_MIN_BITS/8 because for example + * in many little-endian (Intel, Alpha) systems (Linux, OS/2, Digital + * UNIX, Solaris, NeXT) the smallest quantum select() operates on + * (sets bit) is 32 bits. */ + growsize = maxlen + (SELECT_MIN_BITS/8 - (maxlen % (SELECT_MIN_BITS/8))); #else - growsize = maxlen; /* little endians can use vecs directly */ + growsize = sizeof(fd_set); #endif #else #ifdef NFDBITS END } sub _patch_errno_gcc5 { my $perlver = shift; my $num = _norm_ver( $perlver ); return unless $num < 5.021009; return if $num > 5.020002 && $num < 5.021; if ( $num < 5.006 ) { warn "The Errno GCC 5 patch only goes back as far as v5.6.0\n"; warn "You will have to generate your own patch to go farther back\n"; return; } elsif ( $num < 5.006001 ) { _patch(<<'END'); diff --git a/ext/Errno/Errno_pm.PL b/ext/Errno/Errno_pm.PL index df68dc3..8385048 100644 --- ext/Errno/Errno_pm.PL +++ ext/Errno/Errno_pm.PL @@ -143,16 +143,26 @@ sub write_errno_pm { # invoke CPP and read the output + my $inhibit_linemarkers = ''; + if ($Config{gccversion} =~ /\A(\d+)\./ and $1 >= 5) { + # GCC 5.0 interleaves expanded macros with line numbers breaking + # each line into multiple lines. RT#123784 + $inhibit_linemarkers = ' -P'; + } + if ($^O eq 'VMS') { - my $cpp = "$Config{cppstdin} $Config{cppflags} $Config{cppminus}"; + my $cpp = "$Config{cppstdin} $Config{cppflags}" . + $inhibit_linemarkers . " $Config{cppminus}"; $cpp =~ s/sys\$input//i; open(CPPO,"$cpp errno.c |") or die "Cannot exec $Config{cppstdin}"; } elsif ($^O eq 'MSWin32') { - open(CPPO,"$Config{cpprun} $Config{cppflags} errno.c |") or - die "Cannot run '$Config{cpprun} $Config{cppflags} errno.c'"; + my $cpp = "$Config{cpprun} $Config{cppflags}" . + $inhibit_linemarkers; + open(CPPO,"$cpp errno.c |") or + die "Cannot run '$cpp errno.c'"; } else { - my $cpp = default_cpp(); + my $cpp = default_cpp() . $inhibit_linemarkers; open(CPPO,"$cpp < errno.c |") or die "Cannot exec $cpp"; } END } elsif ( $num == 5.00700 ) { _patch_b64(<<'END'); ZGlmZiAtLWdpdCBhL2V4dC9FcnJuby9FcnJub19wbS5QTCBiL2V4dC9FcnJuby9FcnJub19wbS5Q TAppbmRleCBkZjY4ZGMzYmRhLi4yNTFmMmJhNjYzIDEwMDY0NAotLS0gZXh0L0Vycm5vL0Vycm5v X3BtLlBMCisrKyBleHQvRXJybm8vRXJybm9fcG0uUEwKQEAgLTIsOSArMiw3IEBAIHVzZSBFeHRV dGlsczo6TWFrZU1ha2VyOwogdXNlIENvbmZpZzsKIHVzZSBzdHJpY3Q7CiAKLXVzZSB2YXJzIHF3 KCRWRVJTSU9OKTsKLQotJFZFUlNJT04gPSAiMS4xMTEiOworb3VyICRWRVJTSU9OID0gIjEuMTEx IjsKIAogbXkgJWVyciA9ICgpOwogCkBAIC0yOSw2ICsyNywxMiBAQCBzdWIgcHJvY2Vzc19maWxl IHsKICAgICAgICAgICAgIHdhcm4gIkNhbm5vdCBvcGVuICckZmlsZSciOwogICAgICAgICAgICAg cmV0dXJuOwogCX0gICAgIAorICAgIH0gZWxzaWYgKCRDb25maWd7Z2NjdmVyc2lvbn0gbmUgJycp IHsgCisJIyBXaXRoIHRoZSAtZE0gb3B0aW9uLCBnY2Mgb3V0cHV0cyBldmVyeSAjZGVmaW5lIGl0 IGZpbmRzCisJdW5sZXNzKG9wZW4oRkgsIiRDb25maWd7Y2N9IC1FIC1kTSAkQ29uZmlne2NwcGZs YWdzfSAkZmlsZSB8IikpIHsKKyAgICAgICAgICAgIHdhcm4gIkNhbm5vdCBvcGVuICckZmlsZSci OworICAgICAgICAgICAgcmV0dXJuOworCX0gICAgIAogICAgIH0gZWxzZSB7CiAJdW5sZXNzKG9w ZW4oRkgsIjwgJGZpbGUiKSkgewogCSAgICAjIFRoaXMgZmlsZSBjb3VsZCBiZSBhIHRlbXBvcmFy eSBmaWxlIGNyZWF0ZWQgYnkgY3Bwc3RkaW4KQEAgLTM3LDExICs0MSwxOSBAQCBzdWIgcHJvY2Vz c19maWxlIHsKICAgICAgICAgICAgIHJldHVybjsKIAl9CiAgICAgfQotICAgIHdoaWxlKDxGSD4p IHsKLQkkZXJyeyQxfSA9IDEKLQkgICAgaWYgL15ccyojXHMqZGVmaW5lXHMrKEVcdyspXHMrLzsK LSAgIH0KLSAgIGNsb3NlKEZIKTsKKworICAgIGlmICgkXk8gZXEgJ01hY09TJykgeworCXdoaWxl KDxGSD4pIHsKKwkgICAgJGVycnskMX0gPSAkMgorCQlpZiAvXlxzKiNccypkZWZpbmVccysoRVx3 KylccysoXGQrKS87CisJfQorICAgIH0gZWxzZSB7CisJd2hpbGUoPEZIPikgeworCSAgICAkZXJy eyQxfSA9IDEKKwkJaWYgL15ccyojXHMqZGVmaW5lXHMrKEVcdyspXHMrLzsKKwl9CisgICAgfQor ICAgIGNsb3NlKEZIKTsKIH0KIAogbXkgJGNwcHN0ZGluOwpAQCAtNzksNiArOTEsMTggQEAgc3Vi IGdldF9maWxlcyB7CiAgICAgfSBlbHNpZiAoJF5PIGVxICd2bWVzYScpIHsKIAkjIE9TLzM5MCBD IGNvbXBpbGVyIGRvZXNuJ3QgZ2VuZXJhdGUgI2ZpbGUgb3IgI2xpbmUgZGlyZWN0aXZlcwogCSRm aWxleycuLi8uLi92bWVzYS9lcnJuby5oJ30gPSAxOworICAgIH0gZWxzaWYgKCRDb25maWd7YXJj aG5hbWV9IGVxICdlcG9jJykgeworCSMgV2F0Y2ggb3V0IGZvciBjcm9zcyBjb21waWxpbmcgZm9y IEVQT0MgKHVzdWFsbHkgZG9uZSBvbiBsaW51eCkKKwkkZmlsZXsnL3Vzci9sb2NhbC9lcG9jL2lu Y2x1ZGUvbGliYy9zeXMvZXJybm8uaCd9ID0gMTsKKyAgICB9IGVsc2lmICgkXk8gZXEgJ2xpbnV4 JykgeworCSMgU29tZSBMaW51eGVzIGhhdmUgd2VpcmQgZXJybm8uaHMgd2hpY2ggZ2VuZXJhdGUK KwkjIG5vICNmaWxlIG9yICNsaW5lIGRpcmVjdGl2ZXMKKwkkZmlsZXsnL3Vzci9pbmNsdWRlL2Vy cm5vLmgnfSA9IDE7CisgICAgfSBlbHNpZiAoJF5PIGVxICdNYWNPUycpIHsKKwkjIG5vdGUgdGhh dCB3ZSBhcmUgb25seSBnZXR0aW5nIHRoZSBHVVNJIGVycm5vJ3MgaGVyZSAuLi4KKwkjIHdlIG1p Z2h0IG1pc3Mgb3V0IG9uIGNvbXBpbGVyLXNwZWNpZmljIG9uZXMKKwkkZmlsZXsiJEVOVntHVVNJ fWluY2x1ZGU6c3lzOmVycm5vLmgifSA9IDE7CisKICAgICB9IGVsc2UgewogCW9wZW4oQ1BQSSwi PiBlcnJuby5jIikgb3IKIAkgICAgZGllICJDYW5ub3Qgb3BlbiBlcnJuby5jIjsKQEAgLTEwMiw3 ICsxMjYsNyBAQCBzdWIgZ2V0X2ZpbGVzIHsKIAkgICAgJHBhdCA9ICdeL1wqXHMrKC4rKVxzK1xk K1xzKjpccytcKi8nOwogCX0KIAllbHNlIHsKLQkgICAgJHBhdCA9ICdeIyg/OmxpbmUpP1xzKlxk K1xzKyIoW14iXSspIic7CisJICAgICRwYXQgPSAnXiNccyooPzpsaW5lKT9ccypcZCtccysiKFte Il0rKSInOwogCX0KIAl3aGlsZSg8Q1BQTz4pIHsKIAkgICAgaWYgKCReTyBlcSAnb3MyJyBvciAk Xk8gZXEgJ01TV2luMzInKSB7CkBAIC0xNDEsMzEgKzE2NSw0MyBAQCBzdWIgd3JpdGVfZXJybm9f cG0gewogCiAgICAgY2xvc2UoQ1BQSSk7CiAKKyAgICB1bmxlc3MgKCReTyBlcSAnTWFjT1MnKSB7 CSMgdHJ1c3Qgd2hhdCB3ZSBoYXZlCiAgICAgIyBpbnZva2UgQ1BQIGFuZCByZWFkIHRoZSBvdXRw dXQKIAotICAgIGlmICgkXk8gZXEgJ1ZNUycpIHsKLQlteSAkY3BwID0gIiRDb25maWd7Y3Bwc3Rk aW59ICRDb25maWd7Y3BwZmxhZ3N9ICRDb25maWd7Y3BwbWludXN9IjsKLQkkY3BwID1+IHMvc3lz XCRpbnB1dC8vaTsKLQlvcGVuKENQUE8sIiRjcHAgIGVycm5vLmMgfCIpIG9yCi0gICAgICAgICAg ZGllICJDYW5ub3QgZXhlYyAkQ29uZmlne2NwcHN0ZGlufSI7Ci0gICAgfSBlbHNpZiAoJF5PIGVx ICdNU1dpbjMyJykgewotCW9wZW4oQ1BQTywiJENvbmZpZ3tjcHBydW59ICRDb25maWd7Y3BwZmxh Z3N9IGVycm5vLmMgfCIpIG9yCi0JICAgIGRpZSAiQ2Fubm90IHJ1biAnJENvbmZpZ3tjcHBydW59 ICRDb25maWd7Y3BwZmxhZ3N9IGVycm5vLmMnIjsKLSAgICB9IGVsc2UgewotCW15ICRjcHAgPSBk ZWZhdWx0X2NwcCgpOwotCW9wZW4oQ1BQTywiJGNwcCA8IGVycm5vLmMgfCIpCi0JICAgIG9yIGRp ZSAiQ2Fubm90IGV4ZWMgJGNwcCI7Ci0gICAgfQorICAgICAgIG15ICRpbmhpYml0X2xpbmVtYXJr ZXJzID0gJyc7CisgICAgICAgaWYgKCRDb25maWd7Z2NjdmVyc2lvbn0gPX4gL1xBKFxkKylcLi8g YW5kICQxID49IDUpIHsKKyAgICAgICAgICAgIyBHQ0MgNS4wIGludGVybGVhdmVzIGV4cGFuZGVk IG1hY3JvcyB3aXRoIGxpbmUgbnVtYmVycyBicmVha2luZworICAgICAgICAgICAjIGVhY2ggbGlu ZSBpbnRvIG11bHRpcGxlIGxpbmVzLiBSVCMxMjM3ODQKKyAgICAgICAgICAgJGluaGliaXRfbGlu ZW1hcmtlcnMgPSAnIC1QJzsKKyAgICAgICB9CisKKwlpZiAoJF5PIGVxICdWTVMnKSB7CisJICAg IG15ICRjcHAgPSAiJENvbmZpZ3tjcHBzdGRpbn0gJENvbmZpZ3tjcHBmbGFnc30iIC4KKyAgICAg ICAgJGluaGliaXRfbGluZW1hcmtlcnMgLiAiICRDb25maWd7Y3BwbWludXN9IjsKKwkgICAgJGNw cCA9fiBzL3N5c1wkaW5wdXQvL2k7CisJICAgIG9wZW4oQ1BQTywiJGNwcCAgZXJybm8uYyB8Iikg b3IKKwkJZGllICJDYW5ub3QgZXhlYyAkQ29uZmlne2NwcHN0ZGlufSI7CisJfSBlbHNpZiAoJF5P IGVxICdNU1dpbjMyJykgeworICAgICAgICAgICBteSAkY3BwID0gIiRDb25maWd7Y3BwcnVufSAk Q29uZmlne2NwcGZsYWdzfSIgLgorICAgICAgICAgICAgICAgJGluaGliaXRfbGluZW1hcmtlcnM7 CisgICAgICAgICAgIG9wZW4oQ1BQTywiJGNwcCBlcnJuby5jIHwiKSBvcgorICAgICAgICAgICAg ICAgZGllICJDYW5ub3QgcnVuICckY3BwIGVycm5vLmMnIjsKKwl9IGVsc2UgeworCSAgICBteSAk Y3BwID0gZGVmYXVsdF9jcHAoKSAuICRpbmhpYml0X2xpbmVtYXJrZXJzOworCSAgICBvcGVuKENQ UE8sIiRjcHAgPCBlcnJuby5jIHwiKQorCQlvciBkaWUgIkNhbm5vdCBleGVjICRjcHAiOworCX0K IAotICAgICVlcnIgPSAoKTsKKwklZXJyID0gKCk7CiAKLSAgICB3aGlsZSg8Q1BQTz4pIHsKLQlt eSgkbmFtZSwkZXhwcik7Ci0JbmV4dCB1bmxlc3MgKCRuYW1lLCAkZXhwcikgPSAvIiguKj8pIlxz KlxbXHMqXFtccyooLio/KVxzKlxdXHMqXF0vOwotCW5leHQgaWYgJG5hbWUgZXEgJGV4cHI7Ci0J JGVycnskbmFtZX0gPSBldmFsICRleHByOworCXdoaWxlKDxDUFBPPikgeworCSAgICBteSgkbmFt ZSwkZXhwcik7CisJICAgIG5leHQgdW5sZXNzICgkbmFtZSwgJGV4cHIpID0gLyIoLio/KSJccypc W1xzKlxbXHMqKC4qPylccypcXVxzKlxdLzsKKwkgICAgbmV4dCBpZiAkbmFtZSBlcSAkZXhwcjsK KwkgICAgJGVycnskbmFtZX0gPSBldmFsICRleHByOworCX0KKwljbG9zZShDUFBPKTsKICAgICB9 Ci0gICAgY2xvc2UoQ1BQTyk7CiAKICAgICAjIFdyaXRlIEVycm5vLnBtCiAKQEAgLTE3NSw3ICsy MTEsNyBAQCBzdWIgd3JpdGVfZXJybm9fcG0gewogIwogCiBwYWNrYWdlIEVycm5vOwotdXNlIHZh cnMgcXcoXEBFWFBPUlRfT0sgXCVFWFBPUlRfVEFHUyBcQElTQSBcJFZFUlNJT04gXCVlcnJubyBc JEFVVE9MT0FEKTsKK291ciAoXEBFWFBPUlRfT0ssXCVFWFBPUlRfVEFHUyxcQElTQSxcJFZFUlNJ T04sXCVlcnJubyxcJEFVVE9MT0FEKTsKIHVzZSBFeHBvcnRlciAoKTsKIHVzZSBDb25maWc7CiB1 c2Ugc3RyaWN0Owo= END } elsif ( $num < 5.007002 ) { # v5.6.0 et al _patch(<<'END'); diff --git a/ext/Errno/Errno_pm.PL b/ext/Errno/Errno_pm.PL index 3f2f3e0..d8fe44e 100644 --- ext/Errno/Errno_pm.PL +++ ext/Errno/Errno_pm.PL @@ -172,16 +172,26 @@ sub write_errno_pm { unless ($^O eq 'MacOS') { # trust what we have # invoke CPP and read the output + my $inhibit_linemarkers = ''; + if ($Config{gccversion} =~ /\A(\d+)\./ and $1 >= 5) { + # GCC 5.0 interleaves expanded macros with line numbers breaking + # each line into multiple lines. RT#123784 + $inhibit_linemarkers = ' -P'; + } + if ($^O eq 'VMS') { - my $cpp = "$Config{cppstdin} $Config{cppflags} $Config{cppminus}"; + my $cpp = "$Config{cppstdin} $Config{cppflags}" . + $inhibit_linemarkers . " $Config{cppminus}"; $cpp =~ s/sys\$input//i; open(CPPO,"$cpp errno.c |") or die "Cannot exec $Config{cppstdin}"; } elsif ($^O eq 'MSWin32') { - open(CPPO,"$Config{cpprun} $Config{cppflags} errno.c |") or - die "Cannot run '$Config{cpprun} $Config{cppflags} errno.c'"; + my $cpp = "$Config{cpprun} $Config{cppflags}" . + $inhibit_linemarkers; + open(CPPO,"$cpp errno.c |") or + die "Cannot run '$cpp errno.c'"; } else { - my $cpp = default_cpp(); + my $cpp = default_cpp() . $inhibit_linemarkers; open(CPPO,"$cpp < errno.c |") or die "Cannot exec $cpp"; } END } elsif ( $num < 5.007003 ) { # v5.7.2 _patch(<<'END'); diff --git a/ext/Errno/Errno_pm.PL b/ext/Errno/Errno_pm.PL index 3f2f3e0..d8fe44e 100644 --- ext/Errno/Errno_pm.PL +++ ext/Errno/Errno_pm.PL @@ -172,16 +172,26 @@ sub write_errno_pm { unless ($^O eq 'MacOS') { # trust what we have # invoke CPP and read the output + my $inhibit_linemarkers = ''; + if ($Config{gccversion} =~ /\A(\d+)\./ and $1 >= 5) { + # GCC 5.0 interleaves expanded macros with line numbers breaking + # each line into multiple lines. RT#123784 + $inhibit_linemarkers = ' -P'; + } + if ($^O eq 'VMS') { - my $cpp = "$Config{cppstdin} $Config{cppflags} $Config{cppminus}"; + my $cpp = "$Config{cppstdin} $Config{cppflags}" . + $inhibit_linemarkers . " $Config{cppminus}"; $cpp =~ s/sys\$input//i; open(CPPO,"$cpp errno.c |") or die "Cannot exec $Config{cppstdin}"; } elsif ($^O eq 'MSWin32' || $^O eq 'NetWare') { - open(CPPO,"$Config{cpprun} $Config{cppflags} errno.c |") or - die "Cannot run '$Config{cpprun} $Config{cppflags} errno.c'"; + my $cpp = "$Config{cpprun} $Config{cppflags}" . + $inhibit_linemarkers; + open(CPPO,"$cpp errno.c |") or + die "Cannot run '$cpp errno.c'"; } else { - my $cpp = default_cpp(); + my $cpp = default_cpp() . $inhibit_linemarkers; open(CPPO,"$cpp < errno.c |") or die "Cannot exec $cpp"; } END } elsif ( $num < 5.008009 ) { _patch(<<'END'); diff --git a/ext/Errno/Errno_pm.PL b/ext/Errno/Errno_pm.PL index d8a0ab3..796e2f1 100644 --- ext/Errno/Errno_pm.PL +++ ext/Errno/Errno_pm.PL @@ -235,16 +235,26 @@ sub write_errno_pm { unless ($^O eq 'MacOS' || $^O eq 'beos') { # trust what we have / get later # invoke CPP and read the output + my $inhibit_linemarkers = ''; + if ($Config{gccversion} =~ /\A(\d+)\./ and $1 >= 5) { + # GCC 5.0 interleaves expanded macros with line numbers breaking + # each line into multiple lines. RT#123784 + $inhibit_linemarkers = ' -P'; + } + if ($^O eq 'VMS') { - my $cpp = "$Config{cppstdin} $Config{cppflags} $Config{cppminus}"; + my $cpp = "$Config{cppstdin} $Config{cppflags}" . + $inhibit_linemarkers . " $Config{cppminus}"; $cpp =~ s/sys\$input//i; open(CPPO,"$cpp errno.c |") or die "Cannot exec $Config{cppstdin}"; } elsif ($^O eq 'MSWin32' || $^O eq 'NetWare') { - open(CPPO,"$Config{cpprun} $Config{cppflags} errno.c |") or - die "Cannot run '$Config{cpprun} $Config{cppflags} errno.c'"; + my $cpp = "$Config{cpprun} $Config{cppflags}" . + $inhibit_linemarkers; + open(CPPO,"$cpp errno.c |") or + die "Cannot run '$cpp errno.c'"; } else { - my $cpp = default_cpp(); + my $cpp = default_cpp() . $inhibit_linemarkers; open(CPPO,"$cpp < errno.c |") or die "Cannot exec $cpp"; } END } elsif ( $num > 5.008009 and $num < 5.009003 ) { _patch_b64(<<'END'); LS0tIGV4dC9FcnJuby9FcnJub19wbS5QTAorKysgZXh0L0Vycm5vL0Vycm5vX3BtLlBMCkBAIC03 LDEyICs3LDM1IEBAIG91ciAkVkVSU0lPTiA9ICIxLjA5XzAxIjsKIG15ICVlcnIgPSAoKTsKIG15 ICV3c2EgPSAoKTsKIAorIyBTeW1iaWFuIGNyb3NzLWNvbXBpbGluZyBlbnZpcm9ubWVudC4KK215 ICRJc1N5bWJpYW4gPSBleGlzdHMgJEVOVntTREt9ICYmIC1kICIkRU5We1NES31cXGVwb2MzMiI7 CisKK215ICRJc01TV2luMzIgPSAkXk8gZXEgJ01TV2luMzInICYmICEkSXNTeW1iaWFuOworCiB1 bmxpbmsgIkVycm5vLnBtIiBpZiAtZiAiRXJybm8ucG0iOwogb3BlbiBPVVQsICI+RXJybm8ucG0i IG9yIGRpZSAiQ2Fubm90IG9wZW4gRXJybm8ucG06ICQhIjsKIHNlbGVjdCBPVVQ7CiBteSAkZmls ZTsKLWZvcmVhY2ggJGZpbGUgKGdldF9maWxlcygpKSB7Ci0gICAgcHJvY2Vzc19maWxlKCRmaWxl KTsKK215IEBmaWxlcyA9IGdldF9maWxlcygpOworaWYgKCRDb25maWd7Z2NjdmVyc2lvbn0gbmUg JycgJiYgJF5PIGVxICdNU1dpbjMyJykgeworICAgICMgTWluR1cgY29tcGxhaW5zICJ3YXJuaW5n OiAjcHJhZ21hIHN5c3RlbV9oZWFkZXIgaWdub3JlZCBvdXRzaWRlIGluY2x1ZGUKKyAgICAjIGZp bGUiIGlmIHRoZSBoZWFkZXIgZmlsZXMgYXJlIHByb2Nlc3NlZCBpbmRpdmlkdWFsbHksIHNvIGlu Y2x1ZGUgdGhlbQorICAgICMgYWxsIGluIC5jIGZpbGUgYW5kIHByb2Nlc3MgdGhhdCBpbnN0ZWFk LgorICAgIG9wZW4gSU5DUywgJz5pbmNsdWRlcy5jJyBvcgorCWRpZSAiQ2Fubm90IG9wZW4gaW5j bHVkZXMuYyI7CisgICAgZm9yZWFjaCAkZmlsZSAoQGZpbGVzKSB7CisJbmV4dCBpZiAkZmlsZSBl cSAnZXJybm8uYyc7CisJbmV4dCB1bmxlc3MgLWYgJGZpbGU7CisJcHJpbnQgSU5DUyBxcVsjaW5j bHVkZSAiJGZpbGUiXG5dOworICAgIH0KKyAgICBjbG9zZSBJTkNTOworICAgIHByb2Nlc3NfZmls ZSgnaW5jbHVkZXMuYycpOworICAgIHVubGluayAnaW5jbHVkZXMuYyc7Cit9CitlbHNlIHsKKyAg ICBmb3JlYWNoICRmaWxlIChAZmlsZXMpIHsKKwlwcm9jZXNzX2ZpbGUoJGZpbGUpOworICAgIH0K IH0KIHdyaXRlX2Vycm5vX3BtKCk7CiB1bmxpbmsgImVycm5vLmMiIGlmIC1mICJlcnJuby5jIjsK QEAgLTI3LDcgKzUwLDcgQEAgc3ViIHByb2Nlc3NfZmlsZSB7CiAgICAgfQogCiAgICAgcmV0dXJu IHVubGVzcyBkZWZpbmVkICRmaWxlIGFuZCAtZiAkZmlsZTsKLSMgICB3YXJuICJQcm9jZXNzaW5n ICRmaWxlXG4iOworIyAgICB3YXJuICJQcm9jZXNzaW5nICRmaWxlXG4iOwogCiAgICAgbG9jYWwg KkZIOwogICAgIGlmICgoJF5PIGVxICdWTVMnKSAmJiAoJENvbmZpZ3t2bXNfY2NfdHlwZX0gbmUg J2dudWMnKSkgewpAQCAtNTMsNyArNzYsNyBAQCBzdWIgcHJvY2Vzc19maWxlIHsKICAgICAgICAg ICAgIHJldHVybjsKIAl9CiAgICAgfQotCisgICAgCiAgICAgaWYgKCReTyBlcSAnTWFjT1MnKSB7 CiAJd2hpbGUoPEZIPikgewogCSAgICAkZXJyeyQxfSA9ICQyCkBAIC02MywxMiArODYsMTMgQEAg c3ViIHByb2Nlc3NfZmlsZSB7CiAJd2hpbGUoPEZIPikgewogCSAgICAkZXJyeyQxfSA9IDEKIAkJ aWYgL15ccyojXHMqZGVmaW5lXHMrKEVcdyspXHMrLzsKLSAgICAgICAgICAgIGlmICgkXk8gZXEg J01TV2luMzInKSB7CisgICAgICAgICAgICBpZiAoJElzTVNXaW4zMikgewogCSAgICAgICAgJHdz YXskMX0gPSAxCiAJICAgIAkgICAgaWYgL15ccyojXHMqZGVmaW5lXHMrV1NBKEVcdyspXHMrLzsK ICAgICAgICAgICAgIH0KIAl9CiAgICAgfQorCiAgICAgY2xvc2UoRkgpOwogfQogCkBAIC0xMzAs NiArMTU0LDEwIEBAIHN1YiBnZXRfZmlsZXMgewogICAgIH0gZWxzaWYgKCReTyBlcSAndm9zJykg ewogCSMgYXZvaWQgcHJvYmxlbSB3aGVyZSBjcHAgcmV0dXJucyBub24tUE9TSVggcGF0aG5hbWVz CiAJJGZpbGV7Jy9zeXN0ZW0vaW5jbHVkZV9saWJyYXJ5L2Vycm5vLmgnfSA9IDE7CisgICAgfSBl bHNpZiAoJElzU3ltYmlhbikgeworICAgICAgICBteSAkU0RLID0gJEVOVntTREt9OworICAgICAg ICAkU0RLID1+IHMhXFwhLyFnOworCSRmaWxleyIkU0RLL2Vwb2MzMi9pbmNsdWRlL2xpYmMvc3lz L2Vycm5vLmgifSA9IDE7CiAgICAgfSBlbHNlIHsKIAlvcGVuKENQUEksIj4gZXJybm8uYyIpIG9y CiAJICAgIGRpZSAiQ2Fubm90IG9wZW4gZXJybm8uYyI7CkBAIC0xMzgsNyArMTY2LDcgQEAgc3Vi IGdldF9maWxlcyB7CiAJICAgIHByaW50IENQUEkgIiNpbmNsdWRlIDxud2Vycm5vLmg+XG4iOwog CX0gZWxzZSB7CiAJICAgIHByaW50IENQUEkgIiNpbmNsdWRlIDxlcnJuby5oPlxuIjsKLQkgICAg aWYgKCReTyBlcSAnTVNXaW4zMicpIHsKKwkgICAgaWYgKCRJc01TV2luMzIpIHsKIAkJcHJpbnQg Q1BQSSAiI2RlZmluZSBfV0lOU09DS0FQSV9cbiI7ICMgZG9uJ3QgZHJhZyBpbiBldmVyeXRoaW5n CiAJCXByaW50IENQUEkgIiNpbmNsdWRlIDx3aW5zb2NrLmg+XG4iOwogCSAgICB9CkBAIC0xNDcs NyArMTc1LDcgQEAgc3ViIGdldF9maWxlcyB7CiAJY2xvc2UoQ1BQSSk7CiAKIAkjIGludm9rZSBD UFAgYW5kIHJlYWQgdGhlIG91dHB1dAotCWlmICgkXk8gZXEgJ01TV2luMzInIHx8ICReTyBlcSAn TmV0V2FyZScpIHsKKwlpZiAoJElzTVNXaW4zMiB8fCAkXk8gZXEgJ05ldFdhcmUnKSB7CiAJICAg IG9wZW4oQ1BQTywiJENvbmZpZ3tjcHBydW59ICRDb25maWd7Y3BwZmxhZ3N9IGVycm5vLmMgfCIp IG9yCiAJCWRpZSAiQ2Fubm90IHJ1biAnJENvbmZpZ3tjcHBydW59ICRDb25maWd7Y3BwZmxhZ3N9 IGVycm5vLmMnIjsKIAl9IGVsc2UgewpAQCAtMTU3LDE0ICsxODUsMTQgQEAgc3ViIGdldF9maWxl cyB7CiAJfQogCiAJbXkgJHBhdDsKLQlpZiAoKCReTyBlcSAnTVNXaW4zMicgfHwgJF5PIGVxICdO ZXRXYXJlJykgYW5kICRDb25maWd7Y2N9ID1+IC9eYmNjL2kpIHsKKwlpZiAoKCRJc01TV2luMzIg fHwgJF5PIGVxICdOZXRXYXJlJykgYW5kICRDb25maWd7Y2N9ID1+IC9eYmNjL2kpIHsKIAkgICAg JHBhdCA9ICdeL1wqXHMrKC4rKVxzK1xkK1xzKjpccytcKi8nOwogCX0KIAllbHNlIHsKIAkgICAg JHBhdCA9ICdeI1xzKig/OmxpbmUpP1xzKlxkK1xzKyIoW14iXSspIic7CiAJfQogCXdoaWxlKDxD UFBPPikgewotCSAgICBpZiAoJF5PIGVxICdvczInIG9yICReTyBlcSAnTVNXaW4zMicgb3IgJF5P IGVxICdOZXRXYXJlJykgeworCSAgICBpZiAoJF5PIGVxICdvczInIG9yICRJc01TV2luMzIgb3Ig JF5PIGVxICdOZXRXYXJlJykgewogCQlpZiAoLyRwYXQvbykgewogCQkgICBteSAkZiA9ICQxOwog CQkgICAkZiA9fiBzLFxcXFwsLyxnOwpAQCAtMTk4LDcgKzIyNiw3IEBAIHN1YiB3cml0ZV9lcnJu b19wbSB7CiAgICAgZWxzZSB7CiAJcHJpbnQgQ1BQSSAiI2luY2x1ZGUgPGVycm5vLmg+XG4iOwog ICAgIH0KLSAgICBpZiAoJF5PIGVxICdNU1dpbjMyJykgeworICAgIGlmICgkSXNNU1dpbjMyKSB7 CiAJcHJpbnQgQ1BQSSAiI2luY2x1ZGUgPHdpbnNvY2suaD5cbiI7CiAJZm9yZWFjaCAkZXJyIChr ZXlzICV3c2EpIHsKIAkgICAgcHJpbnQgQ1BQSSAiI2lmbmRlZiAkZXJyXG4iOwpAQCAtMjE3LDE2 ICsyNDUsMzEgQEAgc3ViIHdyaXRlX2Vycm5vX3BtIHsKICAgICB1bmxlc3MgKCReTyBlcSAnTWFj T1MnIHx8ICReTyBlcSAnYmVvcycpIHsJIyB0cnVzdCB3aGF0IHdlIGhhdmUgLyBnZXQgbGF0ZXIK ICAgICAjIGludm9rZSBDUFAgYW5kIHJlYWQgdGhlIG91dHB1dAogCisJbXkgJGluaGliaXRfbGlu ZW1hcmtlcnMgPSAnJzsKKwlpZiAoJENvbmZpZ3tnY2N2ZXJzaW9ufSA9fiAvXEEoXGQrKVwuLyBh bmQgJDEgPj0gNSkgeworCSAgICAjIEdDQyA1LjAgaW50ZXJsZWF2ZXMgZXhwYW5kZWQgbWFjcm9z IHdpdGggbGluZSBudW1iZXJzIGJyZWFraW5nCisJICAgICMgZWFjaCBsaW5lIGludG8gbXVsdGlw bGUgbGluZXMuIFJUIzEyMzc4NAorCSAgICAkaW5oaWJpdF9saW5lbWFya2VycyA9ICcgLVAnOwor CX0KKwogCWlmICgkXk8gZXEgJ1ZNUycpIHsKLQkgICAgbXkgJGNwcCA9ICIkQ29uZmlne2NwcHN0 ZGlufSAkQ29uZmlne2NwcGZsYWdzfSAkQ29uZmlne2NwcG1pbnVzfSI7CisJICAgIG15ICRjcHAg PSAiJENvbmZpZ3tjcHBzdGRpbn0gJENvbmZpZ3tjcHBmbGFnc30iIC4KKwkJJGluaGliaXRfbGlu ZW1hcmtlcnMgLiAiICRDb25maWd7Y3BwbWludXN9IjsKIAkgICAgJGNwcCA9fiBzL3N5c1wkaW5w dXQvL2k7CiAJICAgIG9wZW4oQ1BQTywiJGNwcCAgZXJybm8uYyB8Iikgb3IKIAkJZGllICJDYW5u b3QgZXhlYyAkQ29uZmlne2NwcHN0ZGlufSI7Ci0JfSBlbHNpZiAoJF5PIGVxICdNU1dpbjMyJyB8 fCAkXk8gZXEgJ05ldFdhcmUnKSB7Ci0JICAgIG9wZW4oQ1BQTywiJENvbmZpZ3tjcHBydW59ICRD b25maWd7Y3BwZmxhZ3N9IGVycm5vLmMgfCIpIG9yCi0JCWRpZSAiQ2Fubm90IHJ1biAnJENvbmZp Z3tjcHBydW59ICRDb25maWd7Y3BwZmxhZ3N9IGVycm5vLmMnIjsKLQl9IGVsc2UgewotCSAgICBt eSAkY3BwID0gZGVmYXVsdF9jcHAoKTsKKwl9IGVsc2lmICgkSXNNU1dpbjMyIHx8ICReTyBlcSAn TmV0V2FyZScpIHsKKwkgICAgbXkgJGNwcCA9ICIkQ29uZmlne2NwcHJ1bn0gJENvbmZpZ3tjcHBm bGFnc30iIC4KKwkJJGluaGliaXRfbGluZW1hcmtlcnM7CisJICAgIG9wZW4oQ1BQTywiJGNwcCBl cnJuby5jIHwiKSBvcgorCQlkaWUgIkNhbm5vdCBydW4gJyRjcHAgZXJybm8uYyciOworCX0gZWxz aWYgKCRJc1N5bWJpYW4pIHsKKyAgICAgICAgICAgIG15ICRjcHAgPSAiZ2NjIC1FIC1JJEVOVntT REt9XFxlcG9jMzJcXGluY2x1ZGVcXGxpYmMiIC4KKwkJJGluaGliaXRfbGluZW1hcmtlcnMgLiIg LSI7CisJICAgIG9wZW4oQ1BQTywiJGNwcCA8IGVycm5vLmMgfCIpCisJCW9yIGRpZSAiQ2Fubm90 IGV4ZWMgJGNwcCI7CisgICAgICAgIH0gZWxzZSB7CisJICAgIG15ICRjcHAgPSBkZWZhdWx0X2Nw cCgpIC4gJGluaGliaXRfbGluZW1hcmtlcnM7CiAJICAgIG9wZW4oQ1BQTywiJGNwcCA8IGVycm5v LmMgfCIpCiAJCW9yIGRpZSAiQ2Fubm90IGV4ZWMgJGNwcCI7CiAJfQo= END } else { _patch(<<'END'); diff --git a/ext/Errno/Errno_pm.PL b/ext/Errno/Errno_pm.PL index 3dadfce..c6bfa06 100644 --- ext/Errno/Errno_pm.PL +++ ext/Errno/Errno_pm.PL @@ -215,20 +215,31 @@ sub write_errno_pm { { # BeOS (support now removed) did not enter this block # invoke CPP and read the output + my $inhibit_linemarkers = ''; + if ($Config{gccversion} =~ /\A(\d+)\./ and $1 >= 5) { + # GCC 5.0 interleaves expanded macros with line numbers breaking + # each line into multiple lines. RT#123784 + $inhibit_linemarkers = ' -P'; + } + if ($^O eq 'VMS') { - my $cpp = "$Config{cppstdin} $Config{cppflags} $Config{cppminus}"; + my $cpp = "$Config{cppstdin} $Config{cppflags}" . + $inhibit_linemarkers . " $Config{cppminus}"; $cpp =~ s/sys\$input//i; open(CPPO,"$cpp errno.c |") or die "Cannot exec $Config{cppstdin}"; } elsif ($IsMSWin32 || $^O eq 'NetWare') { - open(CPPO,"$Config{cpprun} $Config{cppflags} errno.c |") or - die "Cannot run '$Config{cpprun} $Config{cppflags} errno.c'"; + my $cpp = "$Config{cpprun} $Config{cppflags}" . + $inhibit_linemarkers; + open(CPPO,"$cpp errno.c |") or + die "Cannot run '$cpp errno.c'"; } elsif ($IsSymbian) { - my $cpp = "gcc -E -I$ENV{SDK}\\epoc32\\include\\libc -"; + my $cpp = "gcc -E -I$ENV{SDK}\\epoc32\\include\\libc" . + $inhibit_linemarkers ." -"; open(CPPO,"$cpp < errno.c |") or die "Cannot exec $cpp"; } else { - my $cpp = default_cpp(); + my $cpp = default_cpp() . $inhibit_linemarkers; open(CPPO,"$cpp < errno.c |") or die "Cannot exec $cpp"; } END } } sub _patch_time_hires { _patch(<<'END'); diff --git a/dist/Time-HiRes/HiRes.pm b/dist/Time-HiRes/HiRes.pm index ad9a65c99d..a3ddd595b7 100644 --- dist/Time-HiRes/HiRes.pm +++ dist/Time-HiRes/HiRes.pm @@ -23,12 +23,12 @@ our @EXPORT_OK = qw (usleep sleep ualarm alarm gettimeofday time tv_interval ITIMER_REAL ITIMER_VIRTUAL ITIMER_PROF ITIMER_REALPROF TIMER_ABSTIME d_usleep d_ualarm d_gettimeofday d_getitimer d_setitimer - d_nanosleep d_clock_gettime d_clock_getres + d_nanosleep d_clock_gettime d_clock_getres d_hires_utime d_clock d_clock_nanosleep - stat lstat + stat lstat utime ); -our $VERSION = '1.9733'; +our $VERSION = '1.9741'; our $XS_VERSION = $VERSION; $VERSION = eval $VERSION; @@ -60,6 +60,7 @@ sub import { ($i eq 'clock' && !&d_clock) || ($i eq 'nanosleep' && !&d_nanosleep) || ($i eq 'usleep' && !&d_usleep) || + ($i eq 'utime' && !&d_hires_utime) || ($i eq 'ualarm' && !&d_ualarm)) { require Carp; Carp::croak("Time::HiRes::$i(): unimplemented in this platform"); @@ -92,7 +93,7 @@ Time::HiRes - High resolution alarm, sleep, gettimeofday, interval timers use Time::HiRes qw( usleep ualarm gettimeofday tv_interval nanosleep clock_gettime clock_getres clock_nanosleep clock - stat lstat ); + stat lstat utime); usleep ($microseconds); nanosleep ($nanoseconds); @@ -137,6 +138,9 @@ Time::HiRes - High resolution alarm, sleep, gettimeofday, interval timers my @stat = stat(FH); my @stat = lstat("file"); + use Time::HiRes qw( utime ); + utime $floating_seconds, $floating_seconds, file...; + =head1 DESCRIPTION The C module implements a Perl interface to the @@ -446,6 +450,26 @@ if the operations are the access time stamp from t2 need not be greater-than the modify time stamp from t1: it may be equal or I. +=item utime LIST + +As L +but with the ability to set the access/modify file timestamps +in subsecond resolution, if the operating system and the filesystem +both support such timestamps. To override the standard utime(): + + use Time::HiRes qw(utime); + +Test for the value of &Time::HiRes::d_hires_utime to find out whether +the operating system supports setting subsecond file timestamps. + +As with CORE::utime(), passing undef as both the atime and mtime will +call the syscall with a NULL argument. + +The actual achievable subsecond resolution depends on the combination +of the operating system and the filesystem. + +Returns the number of files successfully changed. + =back =head1 EXAMPLES @@ -535,7 +559,7 @@ VMS have emulations for it.) Here is an example of using C from C: NV (*myNVtime)(); /* Returns -1 on failure. */ - SV **svp = hv_fetch(PL_modglobal, "Time::NVtime", 12, 0); + SV **svp = hv_fetchs(PL_modglobal, "Time::NVtime", 0); if (!svp) croak("Time::HiRes is required"); if (!SvIOK(*svp)) croak("Time::NVtime isn't a function pointer"); myNVtime = INT2PTR(NV(*)(), SvIV(*svp)); @@ -586,9 +610,13 @@ might help in this (in case your system supports CLOCK_MONOTONIC). Some systems have APIs but not implementations: for example QNX and Haiku have the interval timer APIs but not the functionality. -In OS X clock_getres(), clock_gettime() and clock_nanosleep() are -emulated using the Mach timers; as a side effect of being emulated -the CLOCK_REALTIME and CLOCK_MONOTONIC are the same timer. +In pre-Sierra macOS (pre-10.12, OS X) clock_getres(), clock_gettime() +and clock_nanosleep() are emulated using the Mach timers; as a side +effect of being emulated the CLOCK_REALTIME and CLOCK_MONOTONIC are +the same timer. + +gnukfreebsd seems to have non-functional futimens() and utimensat() +(at least as of 10.1): therefore the hires utime() does not work. =head1 SEE ALSO diff --git a/dist/Time-HiRes/HiRes.xs b/dist/Time-HiRes/HiRes.xs index 38ca0dc320..6b0dba8e68 100644 --- dist/Time-HiRes/HiRes.xs +++ dist/Time-HiRes/HiRes.xs @@ -87,6 +87,10 @@ extern "C" { # undef ITIMER_REALPROF #endif +#ifndef TIME_HIRES_CLOCKID_T +typedef int clockid_t; +#endif + #if defined(TIME_HIRES_CLOCK_GETTIME) && defined(_STRUCT_ITIMERSPEC) /* HP-UX has CLOCK_XXX values but as enums, not as defines. @@ -747,21 +751,33 @@ hrstatns(UV *atime_nsec, UV *mtime_nsec, UV *ctime_nsec) #endif /* !TIME_HIRES_STAT */ } -/* Until Apple implements clock_gettime() (ditto clock_getres()) - * we will emulate it using Mach interfaces. */ -#if defined(PERL_DARWIN) && !defined(CLOCK_REALTIME) - -# include +/* Until Apple implements clock_gettime() + * (ditto clock_getres() and clock_nanosleep()) + * we will emulate them using the Mach kernel interfaces. */ +#if defined(PERL_DARWIN) && \ + (defined(TIME_HIRES_CLOCK_GETTIME_EMULATION) || \ + defined(TIME_HIRES_CLOCK_GETRES_EMULATION) || \ + defined(TIME_HIRES_CLOCK_NANOSLEEP_EMULATION)) +#ifndef CLOCK_REALTIME # define CLOCK_REALTIME 0x01 # define CLOCK_MONOTONIC 0x02 +#endif +#ifndef TIMER_ABSTIME # define TIMER_ABSTIME 0x01 +#endif #ifdef USE_ITHREADS +# define PERL_DARWIN_MUTEX +#endif + +#ifdef PERL_DARWIN_MUTEX STATIC perl_mutex darwin_time_mutex; #endif +#include + static uint64_t absolute_time_init; static mach_timebase_info_data_t timebase_info; static struct timespec timespec_init; @@ -769,7 +785,7 @@ static struct timespec timespec_init; static int darwin_time_init() { struct timeval tv; int success = 1; -#ifdef USE_ITHREADS +#ifdef PERL_DARWIN_MUTEX MUTEX_LOCK(&darwin_time_mutex); #endif if (absolute_time_init == 0) { @@ -784,13 +800,14 @@ static int darwin_time_init() { } } } -#ifdef USE_ITHREADS +#ifdef PERL_DARWIN_MUTEX MUTEX_UNLOCK(&darwin_time_mutex); #endif return success; } -static int clock_gettime(int clock_id, struct timespec *ts) { +#ifdef TIME_HIRES_CLOCK_GETTIME_EMULATION +static int th_clock_gettime(clockid_t clock_id, struct timespec *ts) { if (darwin_time_init() && timebase_info.denom) { switch (clock_id) { case CLOCK_REALTIME: @@ -822,7 +839,12 @@ static int clock_gettime(int clock_id, struct timespec *ts) { return -1; } -static int clock_getres(int clock_id, struct timespec *ts) { +#define clock_gettime(clock_id, ts) th_clock_gettime((clock_id), (ts)) + +#endif /* TIME_HIRES_CLOCK_GETTIME_EMULATION */ + +#ifdef TIME_HIRES_CLOCK_GETRES_EMULATION +static int th_clock_getres(clockid_t clock_id, struct timespec *ts) { if (darwin_time_init() && timebase_info.denom) { switch (clock_id) { case CLOCK_REALTIME: @@ -842,7 +864,11 @@ static int clock_getres(int clock_id, struct timespec *ts) { return -1; } -static int clock_nanosleep(int clock_id, int flags, +#define clock_getres(clock_id, ts) th_clock_getres((clock_id), (ts)) +#endif /* TIME_HIRES_CLOCK_GETRES_EMULATION */ + +#ifdef TIME_HIRES_CLOCK_NANOSLEEP_EMULATION +static int th_clock_nanosleep(clockid_t clock_id, int flags, const struct timespec *rqtp, struct timespec *rmtp) { if (darwin_time_init()) { @@ -880,6 +906,11 @@ static int clock_nanosleep(int clock_id, int flags, return -1; } +#define clock_nanosleep(clock_id, flags, rqtp, rmtp) \ + th_clock_nanosleep((clock_id), (flags), (rqtp), (rmtp)) + +#endif /* TIME_HIRES_CLOCK_NANOSLEEP_EMULATION */ + #endif /* PERL_DARWIN */ #include "const-c.inc" @@ -921,6 +952,22 @@ nsec_without_unslept(struct timespec *sleepfor, #endif +/* In case Perl and/or Devel::PPPort are too old, minimally emulate + * IS_SAFE_PATHNAME() (which looks for zero bytes in the pathname). */ +#ifndef IS_SAFE_PATHNAME +#if PERL_VERSION >= 12 /* Perl_ck_warner is 5.10.0 -> */ +#ifdef WARN_SYSCALLS +#define WARNEMUCAT WARN_SYSCALLS /* 5.22.0 -> */ +#else +#define WARNEMUCAT WARN_MISC +#endif +#define WARNEMU(opname) Perl_ck_warner(aTHX_ packWARN(WARNEMUCAT), "Invalid \\0 character in pathname for %s",opname) +#else +#define WARNEMU(opname) Perl_warn(aTHX_ "Invalid \\0 character in pathname for %s",opname) +#endif +#define IS_SAFE_PATHNAME(pv, len, opname) (((len)>1)&&memchr((pv), 0, (len)-1)?(SETERRNO(ENOENT, LIB_INVARG),WARNEMU(opname),FALSE):(TRUE)) +#endif + MODULE = Time::HiRes PACKAGE = Time::HiRes PROTOTYPES: ENABLE @@ -941,7 +988,7 @@ BOOT: # endif #endif #if defined(PERL_DARWIN) -# ifdef USE_ITHREADS +# if defined(USE_ITHREADS) && defined(PERL_DARWIN_MUTEX) MUTEX_INIT(&darwin_time_mutex); # endif #endif @@ -978,7 +1025,8 @@ usleep(useconds) useconds -= NV_1E6 * seconds; } } else if (useconds < 0.0) - croak("Time::HiRes::usleep(%"NVgf"): negative time not invented yet", useconds); + croak("Time::HiRes::usleep(%" NVgf + "): negative time not invented yet", useconds); usleep((U32)useconds); } else PerlProc_pause(); @@ -1000,7 +1048,8 @@ nanosleep(nsec) struct timespec sleepfor, unslept; CODE: if (nsec < 0.0) - croak("Time::HiRes::nanosleep(%"NVgf"): negative time not invented yet", nsec); + croak("Time::HiRes::nanosleep(%" NVgf + "): negative time not invented yet", nsec); nanosleep_init(nsec, &sleepfor, &unslept); if (nanosleep(&sleepfor, &unslept) == 0) { RETVAL = nsec; @@ -1045,11 +1094,15 @@ sleep(...) useconds = -(IV)useconds; #endif /* #if defined(__sparc64__) && defined(__GNUC__) */ if ((IV)useconds < 0) - croak("Time::HiRes::sleep(%"NVgf"): internal error: useconds < 0 (unsigned %"UVuf" signed %"IVdf")", seconds, useconds, (IV)useconds); + croak("Time::HiRes::sleep(%" NVgf + "): internal error: useconds < 0 (unsigned %" UVuf + " signed %" IVdf ")", + seconds, useconds, (IV)useconds); } usleep(useconds); } else - croak("Time::HiRes::sleep(%"NVgf"): negative time not invented yet", seconds); + croak("Time::HiRes::sleep(%" NVgf + "): negative time not invented yet", seconds); } else PerlProc_pause(); gettimeofday(&Tb, NULL); @@ -1097,7 +1150,9 @@ ualarm(useconds,uinterval=0) } #else if (useconds >= IV_1E6 || uinterval >= IV_1E6) - croak("Time::HiRes::ualarm(%d, %d): useconds or uinterval equal to or more than %"IVdf, useconds, uinterval, IV_1E6); + croak("Time::HiRes::ualarm(%d, %d): useconds or uinterval" + " equal to or more than %" IVdf, + useconds, uinterval, IV_1E6); RETVAL = ualarm(useconds, uinterval); #endif @@ -1110,7 +1165,8 @@ alarm(seconds,interval=0) NV interval CODE: if (seconds < 0.0 || interval < 0.0) - croak("Time::HiRes::alarm(%"NVgf", %"NVgf"): negative time not invented yet", seconds, interval); + croak("Time::HiRes::alarm(%" NVgf ", %" NVgf + "): negative time not invented yet", seconds, interval); { IV iseconds = (IV)seconds; IV iinterval = (IV)interval; @@ -1118,7 +1174,9 @@ alarm(seconds,interval=0) NV finterval = interval - iinterval; IV useconds, uinterval; if (fseconds >= 1.0 || finterval >= 1.0) - croak("Time::HiRes::alarm(%"NVgf", %"NVgf"): seconds or interval too large to split correctly", seconds, interval); + croak("Time::HiRes::alarm(%" NVgf ", %" NVgf + "): seconds or interval too large to split correctly", + seconds, interval); useconds = IV_1E6 * fseconds; uinterval = IV_1E6 * finterval; #if defined(HAS_SETITIMER) && defined(ITIMER_REAL) @@ -1138,7 +1196,9 @@ alarm(seconds,interval=0) } #else if (iseconds || iinterval) - croak("Time::HiRes::alarm(%"NVgf", %"NVgf"): seconds or interval equal to or more than 1.0 ", seconds, interval); + croak("Time::HiRes::alarm(%" NVgf ", %" NVgf + "): seconds or interval equal to or more than 1.0 ", + seconds, interval); RETVAL = (NV)ualarm( useconds, uinterval ) / NV_1E6; #endif } @@ -1266,7 +1326,9 @@ setitimer(which, seconds, interval = 0) struct itimerval oldit; PPCODE: if (seconds < 0.0 || interval < 0.0) - croak("Time::HiRes::setitimer(%"IVdf", %"NVgf", %"NVgf"): negative time not invented yet", (IV)which, seconds, interval); + croak("Time::HiRes::setitimer(%" IVdf ", %" NVgf ", %" NVgf + "): negative time not invented yet", + (IV)which, seconds, interval); newit.it_value.tv_sec = (IV)seconds; newit.it_value.tv_usec = (IV)((seconds - (NV)newit.it_value.tv_sec) * NV_1E6); @@ -1317,11 +1379,89 @@ getitimer(which) #endif /* #if defined(HAS_GETITIMER) && defined(HAS_SETITIMER) */ +#if defined(TIME_HIRES_UTIME) + +I32 +utime(accessed, modified, ...) +PROTOTYPE: $$@ + PREINIT: + SV* accessed; + SV* modified; + SV* file; + + struct timespec utbuf[2]; + struct timespec *utbufp = utbuf; + int tot; + + CODE: + accessed = ST(0); + modified = ST(1); + items -= 2; + tot = 0; + + if ( accessed == &PL_sv_undef && modified == &PL_sv_undef ) + utbufp = NULL; + else { + if (SvNV(accessed) < 0.0 || SvNV(modified) < 0.0) + croak("Time::HiRes::utime(%" NVgf ", %" NVgf + "): negative time not invented yet", + SvNV(accessed), SvNV(modified)); + Zero(&utbuf, sizeof utbuf, char); + utbuf[0].tv_sec = (Time_t)SvNV(accessed); /* time accessed */ + utbuf[0].tv_nsec = (long)( ( SvNV(accessed) - utbuf[0].tv_sec ) * 1e9 ); + utbuf[1].tv_sec = (Time_t)SvNV(modified); /* time modified */ + utbuf[1].tv_nsec = (long)( ( SvNV(modified) - utbuf[1].tv_sec ) * 1e9 ); + } + + while (items > 0) { + file = POPs; items--; + + if (SvROK(file) && GvIO(SvRV(file)) && IoIFP(sv_2io(SvRV(file)))) { + int fd = PerlIO_fileno(IoIFP(sv_2io(file))); + if (fd < 0) + SETERRNO(EBADF,RMS_IFI); + else +#ifdef HAS_FUTIMENS + if (futimens(fd, utbufp) == 0) + tot++; +#else /* HAS_FUTIMES */ + croak("futimens unimplemented in this platform"); +#endif /* HAS_FUTIMES */ + } + else { +#ifdef HAS_UTIMENSAT + STRLEN len; + char * name = SvPV(file, len); + if (IS_SAFE_PATHNAME(name, len, "utime") && + utimensat(AT_FDCWD, name, utbufp, 0) == 0) + tot++; +#else /* HAS_UTIMENSAT */ + croak("utimensat unimplemented in this platform"); +#endif /* HAS_UTIMENSAT */ + } + } /* while items */ + RETVAL = tot; + + OUTPUT: + RETVAL + +#else /* #if defined(TIME_HIRES_UTIME) */ + +I32 +utime(accessed, modified, ...) + CODE: + croak("Time::HiRes::utime(): unimplemented in this platform"); + RETVAL = 0; + OUTPUT: + RETVAL + +#endif /* #if defined(TIME_HIRES_UTIME) */ + #if defined(TIME_HIRES_CLOCK_GETTIME) NV clock_gettime(clock_id = CLOCK_REALTIME) - int clock_id + clockid_t clock_id PREINIT: struct timespec ts; int status = -1; @@ -1340,7 +1480,7 @@ clock_gettime(clock_id = CLOCK_REALTIME) NV clock_gettime(clock_id = 0) - int clock_id + clockid_t clock_id CODE: PERL_UNUSED_ARG(clock_id); croak("Time::HiRes::clock_gettime(): unimplemented in this platform"); @@ -1354,7 +1494,7 @@ clock_gettime(clock_id = 0) NV clock_getres(clock_id = CLOCK_REALTIME) - int clock_id + clockid_t clock_id PREINIT: int status = -1; struct timespec ts; @@ -1373,7 +1513,7 @@ clock_getres(clock_id = CLOCK_REALTIME) NV clock_getres(clock_id = 0) - int clock_id + clockid_t clock_id CODE: PERL_UNUSED_ARG(clock_id); croak("Time::HiRes::clock_getres(): unimplemented in this platform"); @@ -1387,14 +1527,15 @@ clock_getres(clock_id = 0) NV clock_nanosleep(clock_id, nsec, flags = 0) - int clock_id + clockid_t clock_id NV nsec int flags PREINIT: struct timespec sleepfor, unslept; CODE: if (nsec < 0.0) - croak("Time::HiRes::clock_nanosleep(..., %"NVgf"): negative time not invented yet", nsec); + croak("Time::HiRes::clock_nanosleep(..., %" NVgf + "): negative time not invented yet", nsec); nanosleep_init(nsec, &sleepfor, &unslept); if (clock_nanosleep(clock_id, flags, &sleepfor, &unslept) == 0) { RETVAL = nsec; @@ -1408,7 +1549,7 @@ clock_nanosleep(clock_id, nsec, flags = 0) NV clock_nanosleep(clock_id, nsec, flags = 0) - int clock_id + clockid_t clock_id NV nsec int flags CODE: diff --git a/dist/Time-HiRes/Makefile.PL b/dist/Time-HiRes/Makefile.PL index 087ab79871..ccad6a3e6f 100644 --- dist/Time-HiRes/Makefile.PL +++ dist/Time-HiRes/Makefile.PL @@ -88,7 +88,7 @@ sub try_compile_and_link { my $obj_ext = $Config{obj_ext} || ".o"; unlink("$tmp.c", "$tmp$obj_ext"); - if (open(TMPC, ">$tmp.c")) { + if (open(TMPC, '>', "$tmp.c")) { print TMPC $c; close(TMPC); @@ -132,7 +132,7 @@ __EOD__ unless defined $cccmd; if ($^O eq 'VMS') { - open( CMDFILE, ">$tmp.com" ); + open( CMDFILE, '>', "$tmp.com" ); print CMDFILE "\$ SET MESSAGE/NOFACILITY/NOSEVERITY/NOIDENT/NOTEXT\n"; print CMDFILE "\$ $cccmd\n"; print CMDFILE "\$ IF \$SEVERITY .NE. 1 THEN EXIT 44\n"; # escalate @@ -290,6 +290,7 @@ sub has_clock_xxx_syscall { #include "EXTERN.h" #include "perl.h" #include "XSUB.h" +#include #include <$SYSCALL_H> int main(int argc, char** argv) { @@ -309,6 +310,7 @@ sub has_clock_xxx { #include "EXTERN.h" #include "perl.h" #include "XSUB.h" +#include int main(int argc, char** argv) { struct timespec ts; @@ -325,6 +327,7 @@ sub has_clock { #include "EXTERN.h" #include "perl.h" #include "XSUB.h" +#include int main(int argc, char** argv) { clock_t tictoc; @@ -348,12 +351,63 @@ int main(int argc, char** argv) struct timespec ts2; ts1.tv_sec = 0; ts1.tv_nsec = 750000000;; - ret = clock_nanosleep(CLOCK_MONOTONIC, 0, &ts1, &ts2); + /* All implementations are supposed to support CLOCK_REALTIME. */ + ret = clock_nanosleep(CLOCK_REALTIME, 0, &ts1, &ts2); ret == 0 ? exit(0) : exit(errno ? errno : -1); } EOM } +sub has_futimens { + return 1 if + try_compile_and_link(< +int main(int argc, char** argv) +{ + int ret; + struct timespec ts[2]; + ret = futimens(0, ts); + ret == 0 ? exit(0) : exit(errno ? errno : -1); +} +EOM +} + +sub has_utimensat{ + return 1 if + try_compile_and_link(< +#include +int main(int argc, char** argv) +{ + int ret; + struct timespec ts[2]; + ret = utimensat(AT_FDCWD, 0, ts, 0); + ret == 0 ? exit(0) : exit(errno ? errno : -1); +} +EOM +} + +sub has_clockid_t{ + return 1 if + try_compile_and_link(< +int main(int argc, char** argv) +{ + clockid_t id = CLOCK_REALTIME; + exit(id == CLOCK_REALTIME ? 1 : 0); +} +EOM +} + sub DEFINE { my ($def, $val) = @_; my $define = defined $val ? "$def=$val" : $def ; @@ -534,6 +588,16 @@ EOD print "(It would not be portable anyway.)\n"; } + print "Looking for clockid_t... "; + my $has_clockid_t; + if (has_clockid_t()) { + print "found.\n"; + $has_clockid_t++; + $DEFINE .= ' -DTIME_HIRES_CLOCKID_T'; + } else { + print "NOT found, will use int.\n"; + } + print "Looking for clock_gettime()... "; my $has_clock_gettime; my $has_clock_gettime_emulation; @@ -548,7 +612,7 @@ EOD } elsif ($^O eq 'darwin') { $has_clock_gettime_emulation++; $has_clock_gettime++; - $DEFINE .= ' -DTIME_HIRES_CLOCK_GETTIME'; + $DEFINE .= ' -DTIME_HIRES_CLOCK_GETTIME -DTIME_HIRES_CLOCK_GETTIME_EMULATION'; } if ($has_clock_gettime) { @@ -577,7 +641,7 @@ EOD } elsif ($^O eq 'darwin') { $has_clock_getres_emulation++; $has_clock_getres++; - $DEFINE .= ' -DTIME_HIRES_CLOCK_GETRES'; + $DEFINE .= ' -DTIME_HIRES_CLOCK_GETRES -DTIME_HIRES_CLOCK_GETRES_EMULATION'; } if ($has_clock_getres) { @@ -603,7 +667,7 @@ EOD } elsif ($^O eq 'darwin') { $has_clock_nanosleep++; $has_clock_nanosleep_emulation++; - $DEFINE .= ' -DTIME_HIRES_CLOCK_NANOSLEEP'; + $DEFINE .= ' -DTIME_HIRES_CLOCK_NANOSLEEP -DTIME_HIRES_CLOCK_NANOSLEEP_EMULATION'; } if ($has_clock_nanosleep) { @@ -631,6 +695,36 @@ EOD print "NOT found.\n"; } + print "Looking for futimens()... "; + my $has_futimens; + if (has_futimens()) { + $has_futimens++; + $DEFINE .= ' -DHAS_FUTIMENS'; + } + + if ($has_futimens) { + print "found.\n"; + } else { + print "NOT found.\n"; + } + + print "Looking for utimensat()... "; + my $has_utimensat; + if (has_utimensat()) { + $has_utimensat++; + $DEFINE .= ' -DHAS_UTIMENSAT'; + } + + if ($has_utimensat) { + print "found.\n"; + } else { + print "NOT found.\n"; + } + + if ($has_futimens or $has_utimensat) { + $DEFINE .= ' -DTIME_HIRES_UTIME'; + } + print "Looking for stat() subsecond timestamps...\n"; print "Trying struct stat st_atimespec.tv_nsec..."; @@ -644,7 +738,7 @@ int main(int argc, char** argv) { } EOM $has_stat_st_xtimespec++; - DEFINE('TIME_HIRES_STAT', 1); + DEFINE('TIME_HIRES_STAT_ST_XTIMESPEC'); # 1 } if ($has_stat_st_xtimespec) { @@ -664,7 +758,7 @@ int main(int argc, char** argv) { } EOM $has_stat_st_xtimensec++; - DEFINE('TIME_HIRES_STAT', 2); + DEFINE('TIME_HIRES_STAT_ST_XTIMENSEC'); # 2 } if ($has_stat_st_xtimensec) { @@ -684,7 +778,7 @@ int main(int argc, char** argv) { } EOM $has_stat_st_xtime_n++; - DEFINE('TIME_HIRES_STAT', 3); + DEFINE('TIME_HIRES_STAT_ST_XTIME_N'); # 3 } if ($has_stat_st_xtime_n) { @@ -704,7 +798,7 @@ int main(int argc, char** argv) { } EOM $has_stat_st_xtim++; - DEFINE('TIME_HIRES_STAT', 4); + DEFINE('TIME_HIRES_STAT_XTIM'); # 4 } if ($has_stat_st_xtim) { @@ -724,7 +818,7 @@ int main(int argc, char** argv) { } EOM $has_stat_st_uxtime++; - DEFINE('TIME_HIRES_STAT', 5); + DEFINE('TIME_HIRES_STAT_ST_UXTIME'); # 5 } if ($has_stat_st_uxtime) { @@ -733,6 +827,19 @@ EOM print "NOT found.\n"; } + # See HiRes.xs hrstatns() + if ($has_stat_st_xtimespec) { + DEFINE('TIME_HIRES_STAT', 1); + } elsif ($has_stat_st_xtimensec) { + DEFINE('TIME_HIRES_STAT', 2); + } elsif ($has_stat_st_xtime_n) { + DEFINE('TIME_HIRES_STAT', 3); + } elsif ($has_stat_st_xtim) { + DEFINE('TIME_HIRES_STAT', 4); + } elsif ($has_stat_st_uxtime) { + DEFINE('TIME_HIRES_STAT', 5); + } + if ($DEFINE =~ /-DTIME_HIRES_STAT=\d+/) { print "You seem to have stat() subsecond timestamps.\n"; print "(Your struct stat has them, but the filesystems must help.)\n"; @@ -757,7 +864,7 @@ EOM if ($DEFINE) { $DEFINE =~ s/^\s+//; - if (open(XDEFINE, ">xdefine")) { + if (open(XDEFINE, '>', 'xdefine')) { print XDEFINE $DEFINE, "\n"; close(XDEFINE); } @@ -791,7 +898,7 @@ sub doMakefile { 'DynaLoader' => 0, 'Exporter' => 0, 'ExtUtils::MakeMaker' => 0, - 'Test::More' => "0.82", + 'Test::More' => 0, 'strict' => 0, }, 'dist' => { @@ -869,7 +976,8 @@ sub doConstants { ); foreach (qw (d_usleep d_ualarm d_gettimeofday d_getitimer d_setitimer d_nanosleep d_clock_gettime d_clock_getres - d_clock d_clock_nanosleep d_hires_stat)) { + d_clock d_clock_nanosleep d_hires_stat + d_futimens d_utimensat d_hires_utime)) { my $macro = $_; if ($macro =~ /^(d_nanosleep|d_clock)$/) { $macro =~ s/^d_(.+)/TIME_HIRES_\U$1/; @@ -879,6 +987,13 @@ sub doConstants { push @names, {name => $_, macro => "TIME_HIRES_STAT", value => $d_hires_stat, default => ["IV", "0"]}; next; + } elsif ($macro =~ /^(d_hires_utime)$/) { + my $d_hires_utime = + ($DEFINE =~ /-DHAS_FUTIMENS/ || + $DEFINE =~ /-DHAS_UTIMENSAT/) ? 1 : 0; + push @names, {name => $_, macro => "TIME_HIRES_UTIME", value => $d_hires_utime, + default => ["IV", "0"]}; + next; } elsif ($macro =~ /^(d_clock_gettime|d_clock_getres|d_clock_nanosleep)$/) { $macro =~ s/^d_(.+)/TIME_HIRES_\U$1/; my $val = ($DEFINE =~ /-D$macro\b/) ? 1 : 0; @@ -900,8 +1015,8 @@ sub doConstants { foreach $file ('const-c.inc', 'const-xs.inc') { my $fallback = File::Spec->catfile('fallback', $file); local $/; - open IN, "<$fallback" or die "Can't open $fallback: $!"; - open OUT, ">$file" or die "Can't open $file: $!"; + open IN, '<', $fallback or die "Can't open $fallback: $!"; + open OUT, '>', $file or die "Can't open $file: $!"; print OUT or die $!; close OUT or die "Can't close $file: $!"; close IN or die "Can't close $fallback: $!"; @@ -920,7 +1035,7 @@ sub main { DEFINE('SELECT_IS_BROKEN'); $LIBS = []; print "System is $^O, skipping full configure...\n"; - open(XDEFINE, ">xdefine") or die "$0: Cannot create xdefine: $!\n"; + open(XDEFINE, '>', 'xdefine') or die "$0: Cannot create xdefine: $!\n"; close(XDEFINE); } else { init(); diff --git a/dist/Time-HiRes/fallback/const-c.inc b/dist/Time-HiRes/fallback/const-c.inc index a8626172af..524db169a9 100644 --- dist/Time-HiRes/fallback/const-c.inc +++ dist/Time-HiRes/fallback/const-c.inc @@ -19,6 +19,7 @@ typedef double NV; /* 5.6 and later define NVTYPE, and typedef NV to it. */ #ifndef pTHX_ #define pTHX_ /* 5.6 or later define this for threading support. */ #endif + static int constant_11 (pTHX_ const char *name, IV *iv_return) { /* When generated this function returned values for the list of names given @@ -86,6 +87,51 @@ constant_11 (pTHX_ const char *name, IV *iv_return) { return PERL_constant_NOTFOUND; } +static int +constant_13 (pTHX_ const char *name, IV *iv_return) { + /* When generated this function returned values for the list of names given + here. However, subsequent manual editing may have added or removed some. + CLOCK_HIGHRES TIMER_ABSTIME d_hires_utime */ + /* Offset 1 gives the best switch position. */ + switch (name[1]) { + case 'I': + if (memEQ(name, "TIMER_ABSTIME", 13)) { + /* ^ */ +#ifdef TIMER_ABSTIME + *iv_return = TIMER_ABSTIME; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'L': + if (memEQ(name, "CLOCK_HIGHRES", 13)) { + /* ^ */ +#ifdef CLOCK_HIGHRES + *iv_return = CLOCK_HIGHRES; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case '_': + if (memEQ(name, "d_hires_utime", 13)) { + /* ^ */ +#ifdef TIME_HIRES_UTIME + *iv_return = 1; + return PERL_constant_ISIV; +#else + *iv_return = 0; + return PERL_constant_ISIV; +#endif + } + break; + } + return PERL_constant_NOTFOUND; +} + static int constant_14 (pTHX_ const char *name, IV *iv_return) { /* When generated this function returned values for the list of names given @@ -250,16 +296,17 @@ my @names = (qw(CLOCKS_PER_SEC CLOCK_HIGHRES CLOCK_MONOTONIC {name=>"d_getitimer", type=>"IV", macro=>"HAS_GETITIMER", value=>"1", default=>["IV", "0"]}, {name=>"d_gettimeofday", type=>"IV", macro=>"HAS_GETTIMEOFDAY", value=>"1", default=>["IV", "0"]}, {name=>"d_hires_stat", type=>"IV", macro=>"TIME_HIRES_STAT", value=>"1", default=>["IV", "0"]}, + {name=>"d_hires_utime", type=>"IV", macro=>"TIME_HIRES_UTIME", value=>"1", default=>["IV", "0"]}, {name=>"d_nanosleep", type=>"IV", macro=>"TIME_HIRES_NANOSLEEP", value=>"1", default=>["IV", "0"]}, {name=>"d_setitimer", type=>"IV", macro=>"HAS_SETITIMER", value=>"1", default=>["IV", "0"]}, {name=>"d_ualarm", type=>"IV", macro=>"HAS_UALARM", value=>"1", default=>["IV", "0"]}, {name=>"d_usleep", type=>"IV", macro=>"HAS_USLEEP", value=>"1", default=>["IV", "0"]}); -print constant_types(); # macro defs +print constant_types(), "\n"; # macro defs foreach (C_constant ("Time::HiRes", 'constant', 'IV', $types, undef, 3, @names) ) { print $_, "\n"; # C constant subs } -print "#### XS Section:\n"; +print "\n#### XS Section:\n"; print XS_constant ("Time::HiRes", $types); __END__ */ @@ -322,33 +369,7 @@ __END__ } break; case 13: - /* Names all of length 13. */ - /* CLOCK_HIGHRES TIMER_ABSTIME */ - /* Offset 2 gives the best switch position. */ - switch (name[2]) { - case 'M': - if (memEQ(name, "TIMER_ABSTIME", 13)) { - /* ^ */ -#ifdef TIMER_ABSTIME - *iv_return = TIMER_ABSTIME; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'O': - if (memEQ(name, "CLOCK_HIGHRES", 13)) { - /* ^ */ -#ifdef CLOCK_HIGHRES - *iv_return = CLOCK_HIGHRES; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - } + return constant_13 (aTHX_ name, iv_return); break; case 14: return constant_14 (aTHX_ name, iv_return); diff --git a/dist/Time-HiRes/t/Watchdog.pm b/dist/Time-HiRes/t/Watchdog.pm index 83e854396f..44ec8081de 100644 --- dist/Time-HiRes/t/Watchdog.pm +++ dist/Time-HiRes/t/Watchdog.pm @@ -10,44 +10,44 @@ my $watchdog_pid; my $TheEnd; if ($Config{d_fork}) { - note "I am the main process $$, starting the watchdog process..."; + print("# I am the main process $$, starting the watchdog process...\n"); $watchdog_pid = fork(); if (defined $watchdog_pid) { if ($watchdog_pid == 0) { # We are the kid, set up the watchdog. my $ppid = getppid(); - note "I am the watchdog process $$, sleeping for $waitfor seconds..."; + print("# I am the watchdog process $$, sleeping for $waitfor seconds...\n"); sleep($waitfor - 2); # Workaround for perlbug #49073 sleep(2); # Wait for parent to exit if (kill(0, $ppid)) { # Check if parent still exists warn "\n$0: overall time allowed for tests (${waitfor}s) exceeded!\n"; - note "Terminating main process $ppid..."; + print("Terminating main process $ppid...\n"); kill('KILL', $ppid); - note "This is the watchdog process $$, over and out."; + print("# This is the watchdog process $$, over and out.\n"); } exit(0); } else { - note "The watchdog process $watchdog_pid launched, continuing testing..."; + print("# The watchdog process $watchdog_pid launched, continuing testing...\n"); $TheEnd = time() + $waitfor; } } else { warn "$0: fork failed: $!\n"; } } else { - note "No watchdog process (need fork)"; + print("# No watchdog process (need fork)\n"); } END { if ($watchdog_pid) { # Only in the main process. my $left = $TheEnd - time(); - note sprintf "I am the main process $$, terminating the watchdog process $watchdog_pid before it terminates me in %d seconds (testing took %d seconds).", $left, $waitfor - $left; + printf("# I am the main process $$, terminating the watchdog process $watchdog_pid before it terminates me in %d seconds (testing took %d seconds).\n", $left, $waitfor - $left); if (kill(0, $watchdog_pid)) { local $? = 0; my $kill = kill('KILL', $watchdog_pid); # We are done, the watchdog can go. wait(); - note sprintf "kill KILL $watchdog_pid = %d", $kill; + printf("# kill KILL $watchdog_pid = %d\n", $kill); } unlink("ktrace.out"); # Used in BSD system call tracing. - note "All done."; + print("# All done.\n"); } } diff --git a/dist/Time-HiRes/t/alarm.t b/dist/Time-HiRes/t/alarm.t index 841694f67c..4935410d36 100644 --- dist/Time-HiRes/t/alarm.t +++ dist/Time-HiRes/t/alarm.t @@ -1,6 +1,6 @@ use strict; -use Test::More 0.82 tests => 10; +use Test::More tests => 10; use t::Watchdog; BEGIN { require_ok "Time::HiRes"; } @@ -10,7 +10,7 @@ use Config; my $limit = 0.25; # 25% is acceptable slosh for testing timers my $xdefine = ''; -if (open(XDEFINE, "xdefine")) { +if (open(XDEFINE, "<", "xdefine")) { chomp($xdefine = || ""); close(XDEFINE); } @@ -29,12 +29,14 @@ SKIP: { my ($r, $i, $not, $ok); + $not = ""; + $r = [Time::HiRes::gettimeofday()]; $i = 5; my $oldaction; if ($use_sigaction) { $oldaction = new POSIX::SigAction; - note sprintf "sigaction tick, ALRM = %d", &POSIX::SIGALRM; + printf("# sigaction tick, ALRM = %d\n", &POSIX::SIGALRM); # Perl's deferred signals may be too wimpy to break through # a restartable select(), so use POSIX::sigaction if available. @@ -44,7 +46,7 @@ SKIP: { $oldaction) or die "Error setting SIGALRM handler with sigaction: $!\n"; } else { - note "SIG tick"; + print("# SIG tick\n"); $SIG{ALRM} = "tick"; } @@ -56,8 +58,8 @@ SKIP: { Time::HiRes::alarm(0.3); select (undef, undef, undef, 3); my $ival = Time::HiRes::tv_interval ($r); - note "Select returned! $i $ival"; - note abs($ival/3 - 1); + print("# Select returned! $i $ival\n"); + printf("# %s\n", abs($ival/3 - 1)); # Whether select() gets restarted after signals is # implementation dependent. If it is restarted, we # will get about 3.3 seconds: 3 from the select, 0.3 @@ -86,7 +88,7 @@ SKIP: { sub tick { $i--; my $ival = Time::HiRes::tv_interval ($r); - note "Tick! $i $ival"; + print("# Tick! $i $ival\n"); my $exp = 0.3 * (5 - $i); if ($exp == 0) { $not = "tick: divisor became zero"; @@ -106,8 +108,8 @@ SKIP: { Time::HiRes::alarm(0); # can't cancel usig %SIG } + print("# $not\n"); ok !$not; - note $not || $ok; } SKIP: { @@ -126,7 +128,7 @@ SKIP: { # http://groups.google.com/group/perl.perl5.porters/browse_thread/thread/adaffaaf939b042e/20dafc298df737f0%2320dafc298df737f0?sa=X&oi=groupsr&start=0&num=3 # Perl changes [18765] and [18770], perl bug [perl #20920] - note "Finding delay loop..."; + print("# Finding delay loop...\n"); my $T = 0.01; my $DelayN = 1024; @@ -137,7 +139,7 @@ SKIP: { for ($i = 0; $i < $DelayN; $i++) { } my $t1 = Time::HiRes::time(); my $dt = $t1 - $t0; - note "N = $DelayN, t1 = $t1, t0 = $t0, dt = $dt"; + print("# N = $DelayN, t1 = $t1, t0 = $t0, dt = $dt\n"); last N if $dt > $T; $DelayN *= 2; } while (1); @@ -169,7 +171,7 @@ SKIP: { $SIG{ALRM} = sub { $a++; - note "Alarm $a - ", Time::HiRes::time(); + printf("# Alarm $a - %s\n", Time::HiRes::time()); Time::HiRes::alarm(0) if $a >= $A; # Disarm the alarm. $Delay->(2); # Try burning CPU at least for 2T seconds. }; @@ -204,18 +206,18 @@ SKIP: { my $alrm = 0; $SIG{ALRM} = sub { $alrm++ }; my $got = Time::HiRes::alarm(2.7); - ok $got == 0 or note $got; + ok $got == 0 or print("# $got\n"); my $t0 = Time::HiRes::time(); 1 while Time::HiRes::time() - $t0 <= 1; $got = Time::HiRes::alarm(0); - ok $got > 0 && $got < 1.8 or note $got; + ok $got > 0 && $got < 1.8 or print("# $got\n"); - ok $alrm == 0 or note $alrm; + ok $alrm == 0 or print("# $alrm\n"); $got = Time::HiRes::alarm(0); - ok $got == 0 or note $got; + ok $got == 0 or print("# $got\n"); } } diff --git a/dist/Time-HiRes/t/clock.t b/dist/Time-HiRes/t/clock.t index 6d11dd2ca0..346ca57fbf 100644 --- dist/Time-HiRes/t/clock.t +++ dist/Time-HiRes/t/clock.t @@ -1,6 +1,6 @@ use strict; -use Test::More 0.82 tests => 5; +use Test::More tests => 5; use t::Watchdog; BEGIN { require_ok "Time::HiRes"; } @@ -13,10 +13,10 @@ sub has_symbol { return $@ eq ''; } -note sprintf "have_clock_gettime = %d", &Time::HiRes::d_clock_gettime; -note sprintf "have_clock_getres = %d", &Time::HiRes::d_clock_getres; -note sprintf "have_clock_nanosleep = %d", &Time::HiRes::d_clock_nanosleep; -note sprintf "have_clock = %d", &Time::HiRes::d_clock; +printf("# have_clock_gettime = %d\n", &Time::HiRes::d_clock_gettime); +printf("# have_clock_getres = %d\n", &Time::HiRes::d_clock_getres); +printf("# have_clock_nanosleep = %d\n", &Time::HiRes::d_clock_nanosleep); +printf("# have_clock = %d\n", &Time::HiRes::d_clock); # Ideally, we'd like to test that the timers are rather precise. # However, if the system is busy, there are no guarantees on how @@ -36,25 +36,25 @@ SKIP: { my $ok = 0; TRY: { for my $try (1..3) { - note "CLOCK_REALTIME: try = $try"; + print("# CLOCK_REALTIME: try = $try\n"); my $t0 = Time::HiRes::clock_gettime(&CLOCK_REALTIME); my $T = 1.5; Time::HiRes::sleep($T); my $t1 = Time::HiRes::clock_gettime(&CLOCK_REALTIME); if ($t0 > 0 && $t1 > $t0) { - note "t1 = $t1, t0 = $t0"; + print("# t1 = $t1, t0 = $t0\n"); my $dt = $t1 - $t0; my $rt = abs(1 - $dt / $T); - note "dt = $dt, rt = $rt"; + print("# dt = $dt, rt = $rt\n"); if ($rt <= 2 * $limit) { $ok = 1; last TRY; } } else { - note "Error: t0 = $t0, t1 = $t1"; + print("# Error: t0 = $t0, t1 = $t1\n"); } my $r = rand() + rand(); - note sprintf "Sleeping for %.6f seconds...\n", $r; + printf("# Sleeping for %.6f seconds...\n", $r); Time::HiRes::sleep($r); } } @@ -64,7 +64,7 @@ SKIP: { SKIP: { skip "no clock_getres", 1 unless &Time::HiRes::d_clock_getres; my $tr = Time::HiRes::clock_getres(); - ok $tr > 0 or note "tr = $tr"; + ok $tr > 0 or print("# tr = $tr\n"); } SKIP: { @@ -73,17 +73,17 @@ SKIP: { my $s = 1.5e9; my $t = Time::HiRes::clock_nanosleep(&CLOCK_REALTIME, $s); my $r = abs(1 - $t / $s); - ok $r < 2 * $limit or note "t = $t, r = $r"; + ok $r < 2 * $limit or print("# t = $t, r = $r\n"); } SKIP: { skip "no clock", 1 unless &Time::HiRes::d_clock; my @clock = Time::HiRes::clock(); - note "clock = @clock"; + print("# clock = @clock\n"); for my $i (1..3) { for (my $j = 0; $j < 1e6; $j++) { } push @clock, Time::HiRes::clock(); - note "clock = @clock"; + print("# clock = @clock\n"); } ok $clock[0] >= 0 && $clock[1] > $clock[0] && diff --git a/dist/Time-HiRes/t/gettimeofday.t b/dist/Time-HiRes/t/gettimeofday.t index 8f7c5f3039..69defe8672 100644 --- dist/Time-HiRes/t/gettimeofday.t +++ dist/Time-HiRes/t/gettimeofday.t @@ -8,26 +8,26 @@ BEGIN { } } -use Test::More 0.82 tests => 6; +use Test::More tests => 6; use t::Watchdog; my @one = Time::HiRes::gettimeofday(); -note 'gettimeofday returned ', 0+@one, ' args'; +printf("# gettimeofday returned %d args\n", 0+@one); ok @one == 2; -ok $one[0] > 850_000_000 or note "@one too small"; +ok $one[0] > 850_000_000 or print("# @one too small\n"); sleep 1; my @two = Time::HiRes::gettimeofday(); ok $two[0] > $one[0] || ($two[0] == $one[0] && $two[1] > $one[1]) - or note "@two is not greater than @one"; + or print("# @two is not greater than @one\n"); my $f = Time::HiRes::time(); -ok $f > 850_000_000 or note "$f too small"; -ok $f - $two[0] < 2 or note "$f - $two[0] >= 2"; +ok $f > 850_000_000 or print("# $f too small\n"); +ok $f - $two[0] < 2 or print("# $f - $two[0] >= 2\n"); my $r = [Time::HiRes::gettimeofday()]; my $g = Time::HiRes::tv_interval $r; -ok $g < 2 or note $g; +ok $g < 2 or print("# $g\n"); 1; diff --git a/dist/Time-HiRes/t/itimer.t b/dist/Time-HiRes/t/itimer.t index 9eb2b93f6f..31cdd674ae 100644 --- dist/Time-HiRes/t/itimer.t +++ dist/Time-HiRes/t/itimer.t @@ -25,7 +25,7 @@ BEGIN { } } -use Test::More 0.82 tests => 2; +use Test::More tests => 2; use t::Watchdog; my $limit = 0.25; # 25% is acceptable slosh for testing timers @@ -35,11 +35,11 @@ my $r = [Time::HiRes::gettimeofday()]; $SIG{VTALRM} = sub { $i ? $i-- : Time::HiRes::setitimer(&Time::HiRes::ITIMER_VIRTUAL, 0); - note "Tick! $i ", Time::HiRes::tv_interval($r); + printf("# Tick! $i %s\n", Time::HiRes::tv_interval($r)); }; -note "setitimer: ", join(" ", - Time::HiRes::setitimer(&Time::HiRes::ITIMER_VIRTUAL, 0.5, 0.4)); +printf("# setitimer: %s\n", join(" ", + Time::HiRes::setitimer(&Time::HiRes::ITIMER_VIRTUAL, 0.5, 0.4))); # Assume interval timer granularity of $limit * 0.5 seconds. Too bold? my $virt = Time::HiRes::getitimer(&Time::HiRes::ITIMER_VIRTUAL); @@ -47,19 +47,19 @@ ok(defined $virt && abs($virt / 0.5) - 1 < $limit, "ITIMER_VIRTUAL defined with sufficient granularity") or diag "virt=" . (defined $virt ? $virt : 'undef'); -note "getitimer: ", join(" ", - Time::HiRes::getitimer(&Time::HiRes::ITIMER_VIRTUAL)); +printf("# getitimer: %s\n", join(" ", + Time::HiRes::getitimer(&Time::HiRes::ITIMER_VIRTUAL))); while (Time::HiRes::getitimer(&Time::HiRes::ITIMER_VIRTUAL)) { my $j; for (1..1000) { $j++ } # Can't be unbreakable, must test getitimer(). } -note "getitimer: ", join(" ", - Time::HiRes::getitimer(&Time::HiRes::ITIMER_VIRTUAL)); +printf("# getitimer: %s\n", join(" ", + Time::HiRes::getitimer(&Time::HiRes::ITIMER_VIRTUAL))); $virt = Time::HiRes::getitimer(&Time::HiRes::ITIMER_VIRTUAL); -note "at end, i=$i"; +print("# at end, i=$i\n"); is($virt, 0, "time left should be zero"); $SIG{VTALRM} = 'DEFAULT'; diff --git a/dist/Time-HiRes/t/nanosleep.t b/dist/Time-HiRes/t/nanosleep.t index aef9db6163..c17a7e4790 100644 --- dist/Time-HiRes/t/nanosleep.t +++ dist/Time-HiRes/t/nanosleep.t @@ -8,7 +8,7 @@ BEGIN { } } -use Test::More 0.82 tests => 3; +use Test::More tests => 3; use t::Watchdog; eval { Time::HiRes::nanosleep(-5) }; @@ -21,7 +21,7 @@ my $two = CORE::time; Time::HiRes::nanosleep(10_000_000); my $three = CORE::time; ok $one == $two || $two == $three - or note "slept too long, $one $two $three"; + or print("# slept too long, $one $two $three\n"); SKIP: { skip "no gettimeofday", 1 unless &Time::HiRes::d_gettimeofday; @@ -29,7 +29,7 @@ SKIP: { Time::HiRes::nanosleep(500_000_000); my $f2 = Time::HiRes::time(); my $d = $f2 - $f; - ok $d > 0.4 && $d < 0.9 or note "slept $d secs $f to $f2"; + ok $d > 0.4 && $d < 0.9 or print("# slept $d secs $f to $f2\n"); } 1; diff --git a/dist/Time-HiRes/t/sleep.t b/dist/Time-HiRes/t/sleep.t index e7cc6271a8..b84b4c6725 100644 --- dist/Time-HiRes/t/sleep.t +++ dist/Time-HiRes/t/sleep.t @@ -1,6 +1,6 @@ use strict; -use Test::More 0.82 tests => 4; +use Test::More tests => 4; use t::Watchdog; BEGIN { require_ok "Time::HiRes"; } @@ -8,7 +8,7 @@ BEGIN { require_ok "Time::HiRes"; } use Config; my $xdefine = ''; -if (open(XDEFINE, "xdefine")) { +if (open(XDEFINE, "<", "xdefine")) { chomp($xdefine = || ""); close(XDEFINE); } @@ -26,12 +26,12 @@ like $@, qr/::sleep\(-1\): negative time not invented yet/, SKIP: { skip "no subsecond alarm", 2 unless $can_subsecond_alarm; my $f = Time::HiRes::time; - note "time...$f"; + print("# time...$f\n"); ok 1; my $r = [Time::HiRes::gettimeofday()]; Time::HiRes::sleep (0.5); - note "sleep...", Time::HiRes::tv_interval($r); + printf("# sleep...%s\n", Time::HiRes::tv_interval($r)); ok 1; } diff --git a/dist/Time-HiRes/t/stat.t b/dist/Time-HiRes/t/stat.t index 68a6fb6bbd..a59a342e20 100644 --- dist/Time-HiRes/t/stat.t +++ dist/Time-HiRes/t/stat.t @@ -13,14 +13,14 @@ BEGIN { } } -use Test::More 0.82 tests => 43; +use Test::More tests => 43; use t::Watchdog; my @atime; my @mtime; for (1..5) { Time::HiRes::sleep(rand(0.1) + 0.1); - open(X, ">$$"); + open(X, '>', $$); print X $$; close(X); my($a, $stat, $b) = ("a", [Time::HiRes::stat($$)], "b"); @@ -33,7 +33,7 @@ for (1..5) { is $b, "b"; is_deeply $lstat, $stat; Time::HiRes::sleep(rand(0.1) + 0.1); - open(X, "<$$"); + open(X, '<', $$); ; close(X); $stat = [Time::HiRes::stat($$)]; @@ -42,8 +42,8 @@ for (1..5) { is_deeply $lstat, $stat; } 1 while unlink $$; -note "mtime = @mtime"; -note "atime = @atime"; +print("# mtime = @mtime\n"); +print("# atime = @atime\n"); my $ai = 0; my $mi = 0; my $ss = 0; @@ -63,7 +63,7 @@ for (my $i = 1; $i < @mtime; $i++) { $ss++; } } -note "ai = $ai, mi = $mi, ss = $ss"; +print("# ai = $ai, mi = $mi, ss = $ss\n"); # Need at least 75% of monotonical increase and # 20% of subsecond results. Yes, this is guessing. SKIP: { @@ -75,7 +75,7 @@ SKIP: { my $targetname = "tgt$$"; my $linkname = "link$$"; SKIP: { - open(X, ">$targetname"); + open(X, '>', $targetname); print X $$; close(X); eval { symlink $targetname, $linkname or die "can't symlink: $!"; }; diff --git a/dist/Time-HiRes/t/time.t b/dist/Time-HiRes/t/time.t index feec4799d9..6f219f9e0c 100644 --- dist/Time-HiRes/t/time.t +++ dist/Time-HiRes/t/time.t @@ -1,6 +1,6 @@ use strict; -use Test::More 0.82 tests => 2; +use Test::More tests => 2; use t::Watchdog; BEGIN { require_ok "Time::HiRes"; } @@ -16,8 +16,8 @@ SKIP: { # (CORE::time() may be rounding down, up, or closest), # but allow 10% of slop. ok abs($s) / $n <= 1.10 - or note "Time::HiRes::time() not close to CORE::time()"; - note "s = $s, n = $n, s/n = ", abs($s)/$n; + or print("# Time::HiRes::time() not close to CORE::time()\n"); + printf("# s = $s, n = $n, s/n = %s\n", abs($s)/$n); } 1; diff --git a/dist/Time-HiRes/t/tv_interval.t b/dist/Time-HiRes/t/tv_interval.t index bffcf39ec1..8ac876daf3 100644 --- dist/Time-HiRes/t/tv_interval.t +++ dist/Time-HiRes/t/tv_interval.t @@ -1,10 +1,10 @@ use strict; -use Test::More 0.82 tests => 2; +use Test::More tests => 2; BEGIN { require_ok "Time::HiRes"; } my $f = Time::HiRes::tv_interval [5, 100_000], [10, 500_000]; -ok abs($f - 5.4) < 0.001 or note $f; +ok abs($f - 5.4) < 0.001 or print("# $f\n"); 1; diff --git a/dist/Time-HiRes/t/ualarm.t b/dist/Time-HiRes/t/ualarm.t index 12ef4b52cc..b50a175f44 100644 --- dist/Time-HiRes/t/ualarm.t +++ dist/Time-HiRes/t/ualarm.t @@ -8,7 +8,7 @@ BEGIN { } } -use Test::More 0.82 tests => 12; +use Test::More tests => 12; use t::Watchdog; use Config; @@ -24,13 +24,13 @@ SKIP: { $tick = 0; Time::HiRes::ualarm(10_000); while ($tick == 0) { } my $three = CORE::time; ok $one == $two || $two == $three - or note "slept too long, $one $two $three"; - note "tick = $tick, one = $one, two = $two, three = $three"; + or print("# slept too long, $one $two $three\n"); + print("# tick = $tick, one = $one, two = $two, three = $three\n"); $tick = 0; Time::HiRes::ualarm(10_000, 10_000); while ($tick < 3) { } ok 1; Time::HiRes::ualarm(0); - note "tick = $tick, one = $one, two = $two, three = $three"; + print("# tick = $tick, one = $one, two = $two, three = $three\n"); } eval { Time::HiRes::ualarm(-4) }; @@ -59,24 +59,24 @@ for my $n (100_000, 1_100_000, 2_200_000, 4_300_000) { my $alarmed = 0; local $SIG{ ALRM } = sub { $alarmed++ }; my $t0 = Time::HiRes::time(); - note "t0 = $t0"; - note "ualarm($n)"; + print("# t0 = $t0\n"); + print("# ualarm($n)\n"); Time::HiRes::ualarm($n); 1 while $alarmed == 0; my $t1 = Time::HiRes::time(); - note "t1 = $t1"; + print("# t1 = $t1\n"); my $dt = $t1 - $t0; - note "dt = $dt"; + print("# dt = $dt\n"); my $r = $dt / ($n/1e6); - note "r = $r"; + print("# r = $r\n"); $ok = ($n < 1_000_000 || # Too much noise. ($r >= 0.8 && $r <= 1.6)); last if $ok; my $nap = bellish(3, 15); - note sprintf "Retrying in %.1f seconds...\n", $nap; + printf("# Retrying in %.1f seconds...\n", $nap); Time::HiRes::sleep($nap); } - ok $ok or note "ualarm($n) close enough"; + ok $ok or print("# ualarm($n) close enough\n"); } { @@ -93,12 +93,12 @@ for my $n (100_000, 1_100_000, 2_200_000, 4_300_000) { } while $t1 - $t0 <= 0.3; my $got1 = Time::HiRes::ualarm(0); - note "t0 = $t0"; - note "got0 = $got0"; - note "t1 = $t1"; - note "t1 - t0 = ", ($t1 - $t0); - note "got1 = $got1"; - ok $got0 == 0 or note $got0; + print("# t0 = $t0\n"); + print("# got0 = $got0\n"); + print("# t1 = $t1\n"); + printf("# t1 - t0 = %s\n", ($t1 - $t0)); + print("# got1 = $got1\n"); + ok $got0 == 0 or print("# $got0\n"); SKIP: { skip "alarm interval exceeded", 2 if $t1 - $t0 >= 0.5; ok $got1 > 0; @@ -106,7 +106,7 @@ for my $n (100_000, 1_100_000, 2_200_000, 4_300_000) { } ok $got1 < 300_000; my $got2 = Time::HiRes::ualarm(0); - ok $got2 == 0 or note $got2; + ok $got2 == 0 or print("# $got2\n"); } 1; diff --git a/dist/Time-HiRes/t/usleep.t b/dist/Time-HiRes/t/usleep.t index 0d6bacfac3..bdf372bd16 100644 --- dist/Time-HiRes/t/usleep.t +++ dist/Time-HiRes/t/usleep.t @@ -8,7 +8,7 @@ BEGIN { } } -use Test::More 0.82 tests => 6; +use Test::More tests => 6; use t::Watchdog; eval { Time::HiRes::usleep(-2) }; @@ -23,7 +23,7 @@ my $two = CORE::time; Time::HiRes::usleep(10_000); my $three = CORE::time; ok $one == $two || $two == $three -or note "slept too long, $one $two $three"; +or print("# slept too long, $one $two $three\n"); SKIP: { skip "no gettimeofday", 1 unless &Time::HiRes::d_gettimeofday; @@ -31,7 +31,7 @@ SKIP: { Time::HiRes::usleep(500_000); my $f2 = Time::HiRes::time(); my $d = $f2 - $f; - ok $d > 0.4 && $d < 0.9 or note "slept $d secs $f to $f2"; + ok $d > 0.4 && $d < 0.9 or print("# slept $d secs $f to $f2\n"); } SKIP: { @@ -39,7 +39,7 @@ SKIP: { my $r = [ Time::HiRes::gettimeofday() ]; Time::HiRes::sleep( 0.5 ); my $f = Time::HiRes::tv_interval $r; - ok $f > 0.4 && $f < 0.9 or note "slept $f instead of 0.5 secs."; + ok $f > 0.4 && $f < 0.9 or print("# slept $f instead of 0.5 secs.\n"); } SKIP: { @@ -59,7 +59,7 @@ SKIP: { SKIP: { skip $msg, 1 unless $td < $sleep * (1 + $limit); - ok $a < $limit or note $msg; + ok $a < $limit or print("# $msg\n"); } $t0 = Time::HiRes::gettimeofday(); @@ -71,7 +71,7 @@ SKIP: { SKIP: { skip $msg, 1 unless $td < $sleep * (1 + $limit); - ok $a < $limit or note $msg; + ok $a < $limit or print("# $msg\n"); } } diff --git a/dist/Time-HiRes/typemap b/dist/Time-HiRes/typemap index 1124eb6483..3fa91f3a0b 100644 --- dist/Time-HiRes/typemap +++ dist/Time-HiRes/typemap @@ -28,6 +28,8 @@ AV * T_AVREF HV * T_HVREF CV * T_CVREF +clockid_t T_IV + IV T_IV UV T_UV NV T_NV END } sub _patch_fp_class_denorm { my $perlver = shift; my $num = _norm_ver( $perlver ); if ($num < 5.025004) { _patch(<<'END'); --- perl.h.orig +++ perl.h @@ -1585,6 +1585,26 @@ EXTERN_C char *crypt(const char *, const char *); #endif #endif +/* We have somehow managed not to define the denormal/subnormal + * detection. + * + * This may happen if the compiler doesn't expose the C99 math like + * the fpclassify() without some special switches. Perl tries to + * stay C89, so for example -std=c99 is not an option. + * + * The Perl_isinf() and Perl_isnan() should have been defined even if + * the C99 isinf() and isnan() are unavailable, and the NV_MIN becomes + * from the C89 DBL_MIN or moral equivalent. */ +#if !defined(Perl_fp_class_denorm) && defined(Perl_isinf) && defined(Perl_isnan) && defined(NV_MIN) +# define Perl_fp_class_denorm(x) ((x) != 0.0 && !Perl_isinf(x) && !Perl_isnan(x) && PERL_ABS(x) < NV_MIN) +#endif + +/* This is not a great fallback: subnormals tests will fail, + * but at least Perl will link and 99.999% of tests will work. */ +#if !defined(Perl_fp_class_denorm) +# define Perl_fp_class_denorm(x) FALSE +#endif + /* There is no quadmath_vsnprintf, and therefore my_vsnprintf() * dies if called under USE_QUADMATH. */ #if defined(HAS_VSNPRINTF) && defined(HAS_C99_VARIADIC_MACROS) && !(defined(DEBUGGING) && !defined(PERL_USE_GCC_BRACE_GROUPS)) && !defined(PERL_GCC_PEDANTIC) END } else { _patch(<<'END'); --- perl.h.orig +++ perl.h @@ -6867,6 +6867,26 @@ extern void moncontrol(int); # endif #endif +/* We have somehow managed not to define the denormal/subnormal + * detection. + * + * This may happen if the compiler doesn't expose the C99 math like + * the fpclassify() without some special switches. Perl tries to + * stay C89, so for example -std=c99 is not an option. + * + * The Perl_isinf() and Perl_isnan() should have been defined even if + * the C99 isinf() and isnan() are unavailable, and the NV_MIN becomes + * from the C89 DBL_MIN or moral equivalent. */ +#if !defined(Perl_fp_class_denorm) && defined(Perl_isinf) && defined(Perl_isnan) && defined(NV_MIN) +# define Perl_fp_class_denorm(x) ((x) != 0.0 && !Perl_isinf(x) && !Perl_isnan(x) && PERL_ABS(x) < NV_MIN) +#endif + +/* This is not a great fallback: subnormals tests will fail, + * but at least Perl will link and 99.999% of tests will work. */ +#if !defined(Perl_fp_class_denorm) +# define Perl_fp_class_denorm(x) FALSE +#endif + #ifdef DOUBLE_IS_IEEE_FORMAT # define DOUBLE_HAS_INF # define DOUBLE_HAS_NAN END } } sub _norm_ver { my $ver = shift; my @v = split(qr/[._]0*/, $ver); $v[2] ||= 0; return sprintf '%d.%03d%03d', @v; } sub _patch_develpatchperlversion { return if -d '.git'; my $dpv = $Devel::PatchPerl::VERSION || "(unreleased)"; _patch(<<"END"); diff --git a/Configure b/Configure index e12c8bb..1a8088f 100755 --- Configure +++ Configure @@ -25151,6 +25151,8 @@ zcat='\$zcat' zip='\$zip' EOT +echo "BuiltWithPatchPerl='$dpv'" >>config.sh + : add special variables \$test -f \$src/patchlevel.h && \ awk '/^#define[ ]+PERL_/ {printf "\%s=\%s\\n",\$2,\$3}' \$src/patchlevel.h >>config.sh END } sub _patch_conf_fwrapv { my $perlver = shift; my $num = _norm_ver( $perlver ); return unless $num < 5.019011; _patch(<<'FWRAPV'); diff --git a/Configure b/Configure index 15b3da1769..791889a2ab 100755 --- Configure +++ Configure @@ -4643,6 +4643,22 @@ case "$gccversion" in $rm -f try try.* esac +# gcc 4.9 by default does some optimizations that break perl. +# see ticket 121505. +# +# The -fwrapv disables those optimizations (and probably others,) so +# for gcc 4.9 (and later, since the optimizations probably won't go +# away), add -fwrapv unless the user requests -fno-wrapv, which +# disables -fwrapv, or if the user requests -fsanitize=undefined, +# which turns the overflows -fwrapv ignores into runtime errors. +case "$gccversion" in +4.[3-9].*|4.[1-9][0-9]*|[5-9].*|[1-9][0-9]*) + case "$ccflags" in + *-fno-wrapv*|*-fsanitize=undefined*|*-fwrapv*) ;; + *) ccflags="$ccflags -fwrapv" ;; + esac +esac + : What should the include directory be ? : Use sysroot if set, so findhdr looks in the right place. echo " " FWRAPV } sub _patch_utils_h2ph { my $perlver = shift; my $num = _norm_ver( $perlver ); return unless $num < 5.021009; return if $num == 5.020003; if ( $num < 5.006001 ) { return _patch_b64(<<'UH2PH560'); LS0tIHV0aWxzL2gycGguUEwKKysrIHV0aWxzL2gycGguUEwKQEAgLTM2LDEzICszNiwyMSBAQCAk Q29uZmlne3N0YXJ0cGVybH0KIAogcHJpbnQgT1VUIDw8JyFOTyFTVUJTISc7CiAKK3VzZSBzdHJp Y3Q7CisKIHVzZSBDb25maWc7CiB1c2UgRmlsZTo6UGF0aCBxdyhta3BhdGgpOwogdXNlIEdldG9w dDo6U3RkOwogCi1nZXRvcHRzKCdEZDpybGhhUScpOworIyBNYWtlIHN1cmUgcmVhZCBwZXJtaXNz aW9ucyBmb3IgYWxsIGFyZSBzZXQ6CitpZiAoZGVmaW5lZCB1bWFzayAmJiAodW1hc2soKSAmIDA0 NDQpKSB7CisgICAgdW1hc2sgKHVtYXNrKCkgJiB+MDQ0NCk7Cit9CisKK2dldG9wdHMoJ0RkOnJs aGFRZScpOwordXNlIHZhcnMgcXcoJG9wdF9EICRvcHRfZCAkb3B0X3IgJG9wdF9sICRvcHRfaCAk b3B0X2EgJG9wdF9RICRvcHRfZSk7CiBkaWUgIi1yIGFuZCAtYSBvcHRpb25zIGFyZSBtdXR1YWxs eSBleGNsdXNpdmVcbiIgaWYgKCRvcHRfciBhbmQgJG9wdF9hKTsKLUBpbmNfZGlycyA9IGluY19k aXJzKCkgaWYgJG9wdF9hOworbXkgQGluY19kaXJzID0gaW5jX2RpcnMoKSBpZiAkb3B0X2E7CiAK IG15ICRFeGl0ID0gMDsKIApAQCAtNTAsNyArNTgsNyBAQCBteSAkRGVzdF9kaXIgPSAkb3B0X2Qg fHwgJENvbmZpZ3tpbnN0YWxsc2l0ZWFyY2h9OwogZGllICJEZXN0aW5hdGlvbiBkaXJlY3Rvcnkg JERlc3RfZGlyIGRvZXNuJ3QgZXhpc3Qgb3IgaXNuJ3QgYSBkaXJlY3RvcnlcbiIKICAgICB1bmxl c3MgLWQgJERlc3RfZGlyOwogCi1AaXNhdHlwZSA9IHNwbGl0KCcgJyw8PEVORCk7CitteSBAaXNh dHlwZSA9IHNwbGl0KCcgJyw8PEVORCk7CiAJY2hhcgl1Y2hhcgl1X2NoYXIKIAlzaG9ydAl1c2hv cnQJdV9zaG9ydAogCWludAl1aW50CXVfaW50CkBAIC01OCwxNCArNjYsMjYgQEAgZGllICJEZXN0 aW5hdGlvbiBkaXJlY3RvcnkgJERlc3RfZGlyIGRvZXNuJ3QgZXhpc3Qgb3IgaXNuJ3QgYSBkaXJl Y3RvcnlcbiIKIAlGSUxFCWtleV90CWNhZGRyX3QKIEVORAogCitteSAlaXNhdHlwZTsKIEBpc2F0 eXBle0Bpc2F0eXBlfSA9ICgxKSB4IEBpc2F0eXBlOwotJGluaWYgPSAwOworbXkgJGluaWYgPSAw OworbXkgJUlzX2NvbnZlcnRlZDsKK215ICViYWRfZmlsZSA9ICgpOwogCiBAQVJHViA9ICgnLScp IHVubGVzcyBAQVJHVjsKIAogYnVpbGRfcHJlYW1ibGVfaWZfbmVjZXNzYXJ5KCk7CiAKLXdoaWxl IChkZWZpbmVkICgkZmlsZSA9IG5leHRfZmlsZSgpKSkgeworc3ViIHJlaW5kZW50KCQpIHsKKyAg ICBteSgkdGV4dCkgPSBzaGlmdDsKKyAgICAkdGV4dCA9fiBzL1xuL1xuICAgIC9nOworICAgICR0 ZXh0ID1+IHMvICAgICAgICAvXHQvZzsKKyAgICAkdGV4dDsKK30KKworbXkgKCR0LCAkdGFiLCAl Y3VyYXJncywgJG5ldywgJGV2YWxfaW5kZXgsICRkaXIsICRuYW1lLCAkYXJncywgJG91dGZpbGUp OworbXkgKCRpbmNsLCAkaW5jbF90eXBlLCAkaW5jbF9xdW90ZSwgJG5leHQpOword2hpbGUgKGRl ZmluZWQgKG15ICRmaWxlID0gbmV4dF9maWxlKCkpKSB7CiAgICAgaWYgKC1sICRmaWxlIGFuZCAt ZCAkZmlsZSkgewogICAgICAgICBsaW5rX2lmX3Bvc3NpYmxlKCRmaWxlKSBpZiAoJG9wdF9sKTsK ICAgICAgICAgbmV4dDsKQEAgLTEwMCwzNiArMTIwLDIzIEBAIHdoaWxlIChkZWZpbmVkICgkZmls ZSA9IG5leHRfZmlsZSgpKSkgewogCW9wZW4oT1VULCI+JERlc3RfZGlyLyRvdXRmaWxlIikgfHwg ZGllICJDYW4ndCBjcmVhdGUgJG91dGZpbGU6ICQhXG4iOwogICAgIH0KIAotICAgIHByaW50IE9V VCAicmVxdWlyZSAnX2gycGhfcHJlLnBoJztcblxuIjsKLSAgICB3aGlsZSAoPElOPikgewotCWNo b3A7Ci0Jd2hpbGUgKC9cXCQvKSB7Ci0JICAgIGNob3A7Ci0JICAgICRfIC49IDxJTj47Ci0JICAg IGNob3A7Ci0JfQotCXByaW50IE9VVCAiIyAkX1xuIiBpZiAkb3B0X0Q7Ci0KLQlpZiAoczovXCo6 XDIwMDpnKSB7Ci0JICAgIHM6XCovOlwyMDE6ZzsKLQkgICAgcy9cMjAwW15cMjAxXSpcMjAxLy9n OwkjIGRlbGV0ZSBzaW5nbGUgbGluZSBjb21tZW50cwotCSAgICBpZiAocy9cMjAwLiovLykgewkJ IyBiZWdpbiBtdWx0aS1saW5lIGNvbW1lbnQ/Ci0JCSRfIC49ICcvKic7Ci0JCSRfIC49IDxJTj47 Ci0JCXJlZG87Ci0JICAgIH0KLQl9CisgICAgcHJpbnQgT1VUCisgICAgICAgICJyZXF1aXJlICdf aDJwaF9wcmUucGgnO1xuXG4iLAorICAgICAgICAibm8gd2FybmluZ3MgJ3JlZGVmaW5lJztcblxu IjsKKworICAgIHdoaWxlIChkZWZpbmVkIChsb2NhbCAkXyA9IG5leHRfbGluZSgkZmlsZSkpKSB7 CiAJaWYgKHMvXlxzKlwjXHMqLy8pIHsKIAkgICAgaWYgKHMvXmRlZmluZVxzKyhcdyspLy8pIHsK IAkJJG5hbWUgPSAkMTsKIAkJJG5ldyA9ICcnOwogCQlzL1xzKyQvLzsKKwkJcy9cKFx3K1xzKlwo XCpcKVxzKlwoXHcqXClcKVxzKigtP1xkKykvJDEvOyAjIChpbnQgKCopKGZvb190KSkwCiAJCWlm IChzL15cKChbXHcsXHNdKilcKS8vKSB7CiAJCSAgICAkYXJncyA9ICQxOwogICAgIAkgICAgCSAg ICBteSAkcHJvdG8gPSAnKCkgJzsKIAkJICAgIGlmICgkYXJncyBuZSAnJykgewogICAgIAkgICAg CSAgICAJJHByb3RvID0gJyc7Ci0JCQlmb3JlYWNoICRhcmcgKHNwbGl0KC8sXHMqLywkYXJncykp IHsKKwkJCWZvcmVhY2ggbXkgJGFyZyAoc3BsaXQoLyxccyovLCRhcmdzKSkgewogCQkJICAgICRh cmcgPX4gcy9eXHMqKFteXHNdLipbXlxzXSlccyokLyQxLzsKIAkJCSAgICAkY3VyYXJnc3skYXJn fSA9IDE7CiAJCQl9CkBAIC0xNzcsMjIgKzE4NCwzMiBAQCB3aGlsZSAoZGVmaW5lZCAoJGZpbGUg PSBuZXh0X2ZpbGUoKSkpIHsKICAgICAgICAgICAgICAgICAgICAgICBwcmludCBPVVQgJHQsInVu bGVzcyhkZWZpbmVkKFwmJG5hbWUpKSB7XG4gICAgc3ViICRuYW1lICgpIHtcdCIsJG5ldywiO31c bn1cbiI7CiAJCSAgICB9CiAJCX0KLQkgICAgfSBlbHNpZiAoL14oaW5jbHVkZXxpbXBvcnQpXHMq WzwiXSguKilbPiJdLykgewotCQkoJGluY2wgPSAkMikgPX4gcy9cLmgkLy5waC87Ci0JCXByaW50 IE9VVCAkdCwicmVxdWlyZSAnJGluY2wnO1xuIjsKLQkgICAgfSBlbHNpZigvXmluY2x1ZGVfbmV4 dFxzKls8Il0oLiopWz4iXS8pIHsKLQkJKCRpbmNsID0gJDEpID1+IHMvXC5oJC8ucGgvOworCSAg ICB9IGVsc2lmICgvXihpbmNsdWRlfGltcG9ydHxpbmNsdWRlX25leHQpXHMqKFs8XCJdKSguKilb PlwiXS8pIHsKKyAgICAgICAgICAgICAgICAkaW5jbF90eXBlID0gJDE7CisgICAgICAgICAgICAg ICAgJGluY2xfcXVvdGUgPSAkMjsKKyAgICAgICAgICAgICAgICAkaW5jbCA9ICQzOworICAgICAg ICAgICAgICAgIGlmICgoJGluY2xfdHlwZSBlcSAnaW5jbHVkZV9uZXh0JykgfHwKKyAgICAgICAg ICAgICAgICAgICAgKCRvcHRfZSAmJiBleGlzdHMoJGJhZF9maWxleyRpbmNsfSkpKSB7CisgICAg ICAgICAgICAgICAgICAgICRpbmNsID1+IHMvXC5oJC8ucGgvOwogCQlwcmludCBPVVQgKCR0LAog CQkJICAgImV2YWwge1xuIik7CiAgICAgICAgICAgICAgICAgJHRhYiArPSA0OwogICAgICAgICAg ICAgICAgICR0ID0gIlx0IiB4ICgkdGFiIC8gOCkgLiAnICcgeCAoJHRhYiAlIDgpOworICAgICAg ICAgICAgICAgICAgICBwcmludCBPVVQgKCR0LCAibXkoXEBSRU0pO1xuIik7CisgICAgICAgICAg ICAgICAgICAgIGlmICgkaW5jbF90eXBlIGVxICdpbmNsdWRlX25leHQnKSB7CiAJCXByaW50IE9V VCAoJHQsCiAJCQkgICAibXkoXCVJTkNEKSA9IG1hcCB7IFwkSU5De1wkX30gPT4gMSB9ICIsCi0J CQkgICAiKGdyZXAgeyBcJF8gZXEgXCIkaW5jbFwiIH0ga2V5cyhcJUlOQykpO1xuIik7CisJCQkg ICAgICAgICAgICIoZ3JlcCB7IFwkXyBlcSBcIiRpbmNsXCIgfSAiLAorICAgICAgICAgICAgICAg ICAgICAgICAgICAgICAgICAgICAia2V5cyhcJUlOQykpO1xuIik7CiAJCXByaW50IE9VVCAoJHQs Ci0JCQkgICAibXkoXEBSRU0pID0gbWFwIHsgXCJcJF8vJGluY2xcIiB9ICIsCisJCQkgICAgICAg ICAgICJcQFJFTSA9IG1hcCB7IFwiXCRfLyRpbmNsXCIgfSAiLAogCQkJICAgIihncmVwIHsgbm90 IGV4aXN0cyhcJElOQ0R7XCJcJF8vJGluY2xcIn0pIiwKLQkJCSAgICJhbmQgLWYgXCJcJF8vJGlu Y2xcIiB9IFxASU5DKTtcbiIpOworCQkJICAgICAgICAgICAiIGFuZCAtZiBcIlwkXy8kaW5jbFwi IH0gXEBJTkMpO1xuIik7CisgICAgICAgICAgICAgICAgICAgIH0gZWxzZSB7CisgICAgICAgICAg ICAgICAgICAgICAgICBwcmludCBPVVQgKCR0LAorICAgICAgICAgICAgICAgICAgICAgICAgICAg ICAgICAgICAiXEBSRU0gPSBtYXAgeyBcIlwkXy8kaW5jbFwiIH0gIiwKKyAgICAgICAgICAgICAg ICAgICAgICAgICAgICAgICAgICAgIihncmVwIHstciBcIlwkXy8kaW5jbFwiIH0gXEBJTkMpO1xu Iik7CisgICAgICAgICAgICAgICAgICAgIH0KIAkJcHJpbnQgT1VUICgkdCwKIAkJCSAgICJyZXF1 aXJlIFwiXCRSRU1bMF1cIiBpZiBcQFJFTTtcbiIpOwogICAgICAgICAgICAgICAgICR0YWIgLT0g NDsKQEAgLTIwMSw2ICsyMTgsMTQgQEAgd2hpbGUgKGRlZmluZWQgKCRmaWxlID0gbmV4dF9maWxl KCkpKSB7CiAJCQkgICAifTtcbiIpOwogCQlwcmludCBPVVQgKCR0LAogCQkJICAgIndhcm4oXCRc QCkgaWYgXCRcQDtcbiIpOworICAgICAgICAgICAgICAgIH0gZWxzZSB7CisgICAgICAgICAgICAg ICAgICAgICRpbmNsID1+IHMvXC5oJC8ucGgvOworICAgICAgICAgICAgICAgICAgICAjIGNvcHkg dGhlIHByZWZpeCBpbiB0aGUgcXVvdGUgc3ludGF4ICgjaW5jbHVkZSAieC5oIikgY2FzZQorICAg ICAgICAgICAgICAgICAgICBpZiAoJGluY2wgIX4gbXwvfCAmJiAkaW5jbF9xdW90ZSBlcSBxeyJ9 ICYmICRmaWxlID1+IG18XiguKikvfCkgeworICAgICAgICAgICAgICAgICAgICAgICAgJGluY2wg PSAiJDEvJGluY2wiOworICAgICAgICAgICAgICAgICAgICB9CisJCSAgICBwcmludCBPVVQgJHQs InJlcXVpcmUgJyRpbmNsJztcbiI7CisgICAgICAgICAgICAgICAgfQogCSAgICB9IGVsc2lmICgv XmlmZGVmXHMrKFx3KykvKSB7CiAJCXByaW50IE9VVCAkdCwiaWYoZGVmaW5lZCgmJDEpKSB7XG4i OwogCQkkdGFiICs9IDQ7CkBAIC0yNDgsMjAgKzI3MywyNCBAQCB3aGlsZSAoZGVmaW5lZCAoJGZp bGUgPSBuZXh0X2ZpbGUoKSkpIHsKIAkgICAgfSBlbHNpZigvXmlkZW50XHMrKC4qKS8pIHsKIAkJ cHJpbnQgT1VUICR0LCAiIyAkMVxuIjsKIAkgICAgfQotIAl9IGVsc2lmKC9eXHMqKHR5cGVkZWZc cyopP2VudW1ccyooXHMrW2EtekEtWl9dXHcqXHMqKT9cey8pIHsKLQkgICAgdW50aWwoL1x9Lio/ Oy8pIHsKLQkJY2hvbXAoJG5leHQgPSA8SU4+KTsKKwl9IGVsc2lmKC9eXHMqKHR5cGVkZWZccyop P2VudW1ccyooXHMrW2EtekEtWl9dXHcqXHMqKT8vKSB7CisJICAgIHVudGlsKC9ce1tefV0qXH0u KjsvIHx8IC87LykgeworCQlsYXN0IHVubGVzcyBkZWZpbmVkICgkbmV4dCA9IG5leHRfbGluZSgk ZmlsZSkpOworCQljaG9tcCAkbmV4dDsKKwkJIyBkcm9wICIjZGVmaW5lIEZPTyBGT08iIGluIGVu dW1zCisJCSRuZXh0ID1+IHMvXlxzKiNccypkZWZpbmVccysoXHcrKVxzK1wxXHMqJC8vOwogCQkk XyAuPSAkbmV4dDsKIAkJcHJpbnQgT1VUICIjICRuZXh0XG4iIGlmICRvcHRfRDsKIAkgICAgfQor CSAgICBzLyNccyppZi4qPyNccyplbmRpZi8vZzsgIyBkcm9wICNpZmRlZnMKIAkgICAgc0AvXCou Kj9cKi9AQGc7CiAJICAgIHMvXHMrLyAvZzsKLQkgICAgL15ccz8odHlwZWRlZlxzPyk/ZW51bVxz PyhbYS16QS1aX11cdyopP1xzP1x7KC4qKVx9XHM/KFthLXpBLVpfXVx3Kik/XHM/Oy87Ci0JICAg ICgkZW51bV9zdWJzID0gJDMpID1+IHMvXHMvL2c7Ci0JICAgIEBlbnVtX3N1YnMgPSBzcGxpdCgv LC8sICRlbnVtX3N1YnMpOwotCSAgICAkZW51bV92YWwgPSAtMTsKLQkgICAgZm9yICRlbnVtIChA ZW51bV9zdWJzKSB7Ci0JCSgkZW51bV9uYW1lLCAkZW51bV92YWx1ZSkgPSAkZW51bSA9fiAvXihb YS16QS1aX11cdyopKD0uKyk/JC87CisJICAgIG5leHQgdW5sZXNzIC9eXHM/KHR5cGVkZWZccz8p P2VudW1ccz8oW2EtekEtWl9dXHcqKT9ccz9ceyguKilcfVxzPyhbYS16QS1aX11cdyopP1xzPzsv OworCSAgICAobXkgJGVudW1fc3VicyA9ICQzKSA9fiBzL1xzLy9nOworCSAgICBteSBAZW51bV9z dWJzID0gc3BsaXQoLywvLCAkZW51bV9zdWJzKTsKKwkgICAgbXkgJGVudW1fdmFsID0gLTE7CisJ ICAgIGZvcmVhY2ggbXkgJGVudW0gKEBlbnVtX3N1YnMpIHsKKwkJbXkgKCRlbnVtX25hbWUsICRl bnVtX3ZhbHVlKSA9ICRlbnVtID1+IC9eKFthLXpBLVpfXVx3KikoPS4rKT8kLzsKIAkJJGVudW1f dmFsdWUgPX4gcy9ePS8vOwogCQkkZW51bV92YWwgPSAobGVuZ3RoKCRlbnVtX3ZhbHVlKSA/ICRl bnVtX3ZhbHVlIDogJGVudW1fdmFsICsgMSk7CiAJCWlmICgkb3B0X2gpIHsKQEAgLTI3OCwzMSAr MzA3LDQ3IEBAIHdoaWxlIChkZWZpbmVkICgkZmlsZSA9IG5leHRfZmlsZSgpKSkgewogCSAgICB9 CiAJfQogICAgIH0KLSAgICBwcmludCBPVVQgIjE7XG4iOwotCi0gICAgJGlzX2NvbnZlcnRlZHsk ZmlsZX0gPSAxOworICAgICRJc19jb252ZXJ0ZWR7JGZpbGV9ID0gMTsKKyAgICBpZiAoJG9wdF9l ICYmIGV4aXN0cygkYmFkX2ZpbGV7JGZpbGV9KSkgeworICAgICAgICB1bmxpbmsoJERlc3RfZGly IC4gJy8nIC4gJG91dGZpbGUpOworICAgICAgICAkbmV4dCA9ICcnOworICAgIH0gZWxzZSB7Cisg ICAgICAgIHByaW50IE9VVCAiMTtcbiI7CiAgICAgcXVldWVfaW5jbHVkZXNfZnJvbSgkZmlsZSkg aWYgKCRvcHRfYSk7CisgICAgfQogfQogCi1leGl0ICRFeGl0OwotCi1zdWIgcmVpbmRlbnQoJCkg ewotICAgIG15KCR0ZXh0KSA9IHNoaWZ0OwotICAgICR0ZXh0ID1+IHMvXG4vXG4gICAgL2c7Ci0g ICAgJHRleHQgPX4gcy8gICAgICAgIC9cdC9nOwotICAgICR0ZXh0OworaWYgKCRvcHRfZSAmJiAo c2NhbGFyKGtleXMgJWJhZF9maWxlKSA+IDApKSB7CisgICAgd2FybiAiV2FzIHVuYWJsZSB0byBj b252ZXJ0IHRoZSBmb2xsb3dpbmcgZmlsZXM6XG4iOworICAgIHdhcm4gIlx0IiAuIGpvaW4oIlxu XHQiLHNvcnQoa2V5cyAlYmFkX2ZpbGUpKSAuICJcbiI7CiB9CiAKK2V4aXQgJEV4aXQ7CisKIHN1 YiBleHByIHsKKyAgICBteSAkam9pbmVkX2FyZ3M7CiAgICAgaWYoa2V5cyglY3VyYXJncykpIHsK LQlteSgkam9pbmVkX2FyZ3MpID0gam9pbignfCcsIGtleXMoJWN1cmFyZ3MpKTsKKwkkam9pbmVk X2FyZ3MgPSBqb2luKCd8Jywga2V5cyglY3VyYXJncykpOwogICAgIH0KICAgICB3aGlsZSAoJF8g bmUgJycpIHsKIAlzL15cJlwmLy8gJiYgZG8geyAkbmV3IC49ICIgJiYiOyBuZXh0O307ICMgaGFu ZGxlICYmIG9wZXJhdG9yCiAJcy9eXCYoW1woYS16XCldKykvJDEvaTsJIyBoYWNrIGZvciB0aGlu Z3MgdGhhdCB0YWtlIHRoZSBhZGRyZXNzIG9mCiAJcy9eKFxzKykvLwkJJiYgZG8geyRuZXcgLj0g JyAnOyBuZXh0O307Ci0Jcy9eKDBYWzAtOUEtRl0rKVtVTF0qLy9pCSYmIGRvIHskbmV3IC49IGxj KCQxKTsgbmV4dDt9OwotCXMvXigtP1xkK1wuXGQrRVstK11cZCspRj8vL2kJJiYgZG8geyRuZXcg Lj0gJDE7IG5leHQ7fTsKKwlzL14wWChbMC05QS1GXSspW1VMXSovL2kgCisJICAgICYmIGRvIHtt eSAkaGV4ID0gJDE7CisJCSAgICRoZXggPX4gcy9eMCsvLzsKKwkJICAgaWYgKGxlbmd0aCAkaGV4 ID4gOCAmJiAhJENvbmZpZ3t1c2U2NGJpdGludH0pIHsKKwkJICAgICAgICMgQ3JvYWsgaWYgbnZf cHJlc2VydmVzX3V2X2JpdHMgPCA2NCA/CisJCSAgICAgICAkbmV3IC49ICAgICAgICAgaGV4KHN1 YnN0cigkaGV4LCAtOCkpICsKKwkJCSAgICAgICAyKiozMiAqIGhleChzdWJzdHIoJGhleCwgIDAs IC04KSk7CisJCSAgICAgICAjIFRoZSBhYm92ZSB3aWxsIHByb2R1Y2UgImVycm9ybmV1cyIgY29k ZQorCQkgICAgICAgIyBpZiB0aGUgaGV4IGNvbnN0YW50IHdhcyBlLmcuIGluc2lkZSBVSU5UNjRf QworCQkgICAgICAgIyBtYWNybywgYnV0IHRoZW4gYWdhaW4sIGgycGggaXMgYW4gYXBwcm94aW1h dGlvbi4KKwkJICAgfSBlbHNlIHsKKwkJICAgICAgICRuZXcgLj0gbGMoIjB4JGhleCIpOworCQkg ICB9CisJCSAgIG5leHQ7fTsKKwlzL14oLT9cZCtcLlxkK0VbLStdP1xkKylbRkxdPy8vaQkmJiBk byB7JG5ldyAuPSAkMTsgbmV4dDt9OwogCXMvXihcZCspXHMqW0xVXSovL2kJJiYgZG8geyRuZXcg Lj0gJDE7IG5leHQ7fTsKIAlzL14oIihcXCJ8W14iXSkqIikvLwkmJiBkbyB7JG5ldyAuPSAkMTsg bmV4dDt9OwogCXMvXicoKFxcInxbXiJdKSopJy8vCSYmIGRvIHsKQEAgLTM0MSwxMyArMzg2LDEz IEBAIHN1YiBleHByIHsKIAkjIEVsaW1pbmF0ZSB0eXBlZGVmcwogCS9cKChbXHdcc10rKVtcKlxz XSpcKVxzKltcd1woXS8gJiYgZG8gewogCSAgICBmb3JlYWNoIChzcGxpdCAvXHMrLywgJDEpIHsg ICMgTWFrZSBzdXJlIGFsbCB0aGUgd29yZHMgYXJlIHR5cGVzLAotCQlsYXN0IHVubGVzcyAoJGlz YXR5cGV7JF99IG9yICRfIGVxICdzdHJ1Y3QnKTsKKwkJbGFzdCB1bmxlc3MgKCRpc2F0eXBleyRf fSBvciAkXyBlcSAnc3RydWN0JyBvciAkXyBlcSAndW5pb24nKTsKIAkgICAgfQogCSAgICBzL1wo W1x3XHNdK1tcKlxzXSpcKS8vICYmIG5leHQ7ICAgICAgIyB0aGVuIGVsaW1pbmF0ZSB0aGVtLgog CX07CiAJIyBzdHJ1Y3QvdW5pb24gbWVtYmVyLCBpbmNsdWRpbmcgYXJyYXlzOgogCXMvXihbX0Et Wl1cdyooXFtbXlxdXStcXSk/KChcLnwtPilbX0EtWl1cdyooXFtbXlxdXStcXSk/KSspLy9pICYm IGRvIHsKLQkgICAgJGlkID0gJDE7CisJICAgIG15ICRpZCA9ICQxOwogCSAgICAkaWQgPX4gcy8o XC58KC0+KSkoW15cLlwtXSopLy0+XHskM1x9L2c7CiAJICAgICRpZCA9fiBzL1xiKFteXCRdKSgk am9pbmVkX2FyZ3MpLyQxXCQkMi9nIGlmIGxlbmd0aCgkam9pbmVkX2FyZ3MpOwogCSAgICB3aGls ZSgkaWQgPX4gL1xbXHMqKFteXCRcJlxkXF1dKylcXS8pIHsKQEAgLTM2Myw4ICs0MDgsOCBAQCBz dWIgZXhwciB7CiAJICAgICRuZXcgLj0gIiAoXCQkaWQpIjsKIAl9OwogCXMvXihbX2EtekEtWl1c dyopLy8JJiYgZG8gewotCSAgICAkaWQgPSAkMTsKLQkgICAgaWYgKCRpZCBlcSAnc3RydWN0Jykg eworCSAgICBteSAkaWQgPSAkMTsKKwkgICAgaWYgKCRpZCBlcSAnc3RydWN0JyB8fCAkaWQgZXEg J3VuaW9uJykgewogCQlzL15ccysoXHcrKS8vOwogCQkkaWQgLj0gJyAnIC4gJDE7CiAJCSRpc2F0 eXBleyRpZH0gPSAxOwpAQCAtMzc3LDggKzQyMiw4IEBAIHN1YiBleHByIHsKIAkJJG5ldyAuPSAn LT4nIGlmIC9eW1xbXHtdLzsKIAkgICAgfSBlbHNpZiAoJGlkIGVxICdkZWZpbmVkJykgewogCQkk bmV3IC49ICdkZWZpbmVkJzsKLQkgICAgfSBlbHNpZiAoL15cKC8pIHsKLQkJcy9eXCgoXHcpLC8o IiQxIiwvIGlmICRpZCA9fiAvXl9JT1tXUl0qJC9pOwkjIGNoZWF0CisJICAgIH0gZWxzaWYgKC9e XHMqXCgvKSB7CisJCXMvXlxzKlwoKFx3KSwvKCIkMSIsLyBpZiAkaWQgPX4gL15fSU9bV1JdKiQv aTsJIyBjaGVhdAogCQkkbmV3IC49ICIgJiRpZCI7CiAJICAgIH0gZWxzaWYgKCRpc2F0eXBleyRp ZH0pIHsKIAkJaWYgKCRuZXcgPX4gL3tccyokLykgewpAQCAtMzkxLDcgKzQzNiw3IEBAIHN1YiBl eHByIHsKIAkJfQogCSAgICB9IGVsc2UgewogCQlpZiAoJGluaWYgJiYgJG5ldyAhfiAvZGVmaW5l ZFxzKlwoJC8pIHsKLQkJICAgICRuZXcgLj0gJyhkZWZpbmVkKCYnIC4gJGlkIC4gJykgPyAmJyAu ICRpZCAuICcgOiAwKSc7CisJCSAgICAkbmV3IC49ICcoZGVmaW5lZCgmJyAuICRpZCAuICcpID8g JicgLiAkaWQgLiAnIDogdW5kZWYpJzsKIAkJfSBlbHNpZiAoL15cWy8pIHsKIAkJICAgICRuZXcg Lj0gIiBcJCRpZCI7CiAJCX0gZWxzZSB7CkBAIC00MDUsNiArNDUwLDEwMSBAQCBzdWIgZXhwciB7 CiB9CiAKIAorc3ViIG5leHRfbGluZQoreworICAgIG15ICRmaWxlID0gc2hpZnQ7CisgICAgbXkg KCRpbiwgJG91dCk7CisgICAgbXkgJHByZV9zdWJfdHJpX2dyYXBocyA9IDE7CisKKyAgICBSRUFE OiB3aGlsZSAobm90IGVvZiBJTikgeworICAgICAgICAkaW4gIC49IDxJTj47CisgICAgICAgIGNo b21wICRpbjsKKyAgICAgICAgbmV4dCB1bmxlc3MgbGVuZ3RoICRpbjsKKworICAgICAgICB3aGls ZSAobGVuZ3RoICRpbikgeworICAgICAgICAgICAgaWYgKCRwcmVfc3ViX3RyaV9ncmFwaHMpIHsK KyAgICAgICAgICAgICAgICAjIFByZXByb2Nlc3MgYWxsIHRyaS1ncmFwaHMgCisgICAgICAgICAg ICAgICAgIyBpbmNsdWRpbmcgdGhpbmdzIHN0dWNrIGluIHF1b3RlZCBzdHJpbmcgY29uc3RhbnRz LgorICAgICAgICAgICAgICAgICRpbiA9fiBzL1w/XD89LyMvZzsgICAgICAgICAgICAgICAgICAg ICAgICAgIyB8ID8/PXwgICN8CisgICAgICAgICAgICAgICAgJGluID1+IHMvXD9cP1whL3wvZzsg ICAgICAgICAgICAgICAgICAgICAgICAjIHwgPz8hfCAgfHwKKyAgICAgICAgICAgICAgICAkaW4g PX4gcy9cP1w/Jy9eL2c7ICAgICAgICAgICAgICAgICAgICAgICAgICMgfCA/Pyd8ICBefAorICAg ICAgICAgICAgICAgICRpbiA9fiBzL1w/XD9cKC9bL2c7ICAgICAgICAgICAgICAgICAgICAgICAg IyB8ID8/KHwgIFt8CisgICAgICAgICAgICAgICAgJGluID1+IHMvXD9cP1wpL10vZzsgICAgICAg ICAgICAgICAgICAgICAgICAjIHwgPz8pfCAgXXwKKyAgICAgICAgICAgICAgICAkaW4gPX4gcy9c P1w/XC0vfi9nOyAgICAgICAgICAgICAgICAgICAgICAgICMgfCA/Py18ICB+fAorICAgICAgICAg ICAgICAgICRpbiA9fiBzL1w/XD9cLy9cXC9nOyAgICAgICAgICAgICAgICAgICAgICAgIyB8ID8/ L3wgIFx8CisgICAgICAgICAgICAgICAgJGluID1+IHMvXD9cPzwvey9nOyAgICAgICAgICAgICAg ICAgICAgICAgICAjIHwgPz88fCAge3wKKyAgICAgICAgICAgICAgICAkaW4gPX4gcy9cP1w/Pi99 L2c7ICAgICAgICAgICAgICAgICAgICAgICAgICMgfCA/Pz58ICB9fAorICAgICAgICAgICAgfQor CSAgICBpZiAoJGluID1+IC9eXCNpZmRlZiBfX0xBTkdVQUdFX1BBU0NBTF9fLykgeworICAgICAg ICAgICAgICAgICMgVHJ1NjQgZGlzYXNzZW1ibGVyLmggZXZpbG5lc3M6IG1peGVkIEMgYW5kIFBh c2NhbC4KKwkJd2hpbGUgKDxJTj4pIHsKKwkJICAgIGxhc3QgaWYgL15cI2VuZGlmLzsgCisJCX0K KwkJbmV4dCBSRUFEOworCSAgICB9CisJICAgIGlmICgkaW4gPX4gL15leHRlcm4gaW5saW5lIC8g JiYgIyBJbmxpbmVkIGFzc2VtYmxlci4KKwkJJF5PIGVxICdsaW51eCcgJiYgJGZpbGUgPX4gbSEo PzpefC8pYXNtL1teL10rXC5oJCEpIHsKKyAJCXdoaWxlICg8SU4+KSB7CisJCSAgICBsYXN0IGlm IC9efS87IAorCQl9CisJCW5leHQgUkVBRDsKKwkgICAgfQorICAgICAgICAgICAgaWYgKCRpbiA9 fiBzL1xcJC8vKSB7ICAgICAgICAgICAgICAgICAgICAgICAgICAgIyBcLW5ld2xpbmUKKyAgICAg ICAgICAgICAgICAkb3V0ICAgIC49ICcgJzsKKyAgICAgICAgICAgICAgICBuZXh0IFJFQUQ7Cisg ICAgICAgICAgICB9IGVsc2lmICgkaW4gPX4gcy9eKFteIidcXFwvXSspLy8pIHsgICAgICAgICAg ICAjIFBhc3N0aHJvdWdoCisgICAgICAgICAgICAgICAgJG91dCAgICAuPSAkMTsKKyAgICAgICAg ICAgIH0gZWxzaWYgKCRpbiA9fiBzL14oXFwuKS8vKSB7ICAgICAgICAgICAgICAgICAgICMgXC4u LgorICAgICAgICAgICAgICAgICRvdXQgICAgLj0gJDE7CisgICAgICAgICAgICB9IGVsc2lmICgk aW4gPX4gL14nLykgeyAgICAgICAgICAgICAgICAgICAgICAgICAjICcuLi4KKyAgICAgICAgICAg ICAgICBpZiAoJGluID1+IHMvXignKFxcLnxbXidcXF0pKicpLy8pIHsKKyAgICAgICAgICAgICAg ICAgICAgJG91dCAgICAuPSAkMTsKKyAgICAgICAgICAgICAgICB9IGVsc2UgeworICAgICAgICAg ICAgICAgICAgICBuZXh0IFJFQUQ7CisgICAgICAgICAgICAgICAgfQorICAgICAgICAgICAgfSBl bHNpZiAoJGluID1+IC9eIi8pIHsgICAgICAgICAgICAgICAgICAgICAgICAgIyAiLi4uCisgICAg ICAgICAgICAgICAgaWYgKCRpbiA9fiBzL14oIihcXC58W14iXFxdKSoiKS8vKSB7CisgICAgICAg ICAgICAgICAgICAgICRvdXQgICAgLj0gJDE7CisgICAgICAgICAgICAgICAgfSBlbHNlIHsKKyAg ICAgICAgICAgICAgICAgICAgbmV4dCBSRUFEOworICAgICAgICAgICAgICAgIH0KKyAgICAgICAg ICAgIH0gZWxzaWYgKCRpbiA9fiBzL15cL1wvLiovLykgeyAgICAgICAgICAgICAgICAgICMgLy8u Li4KKyAgICAgICAgICAgICAgICAjIGZhbGwgdGhyb3VnaAorICAgICAgICAgICAgfSBlbHNpZiAo JGluID1+IG0vXlwvXCovKSB7ICAgICAgICAgICAgICAgICAgICAgIyAvKi4uLgorICAgICAgICAg ICAgICAgICMgQyBjb21tZW50IHJlbW92YWwgYWRhcHRlZCBmcm9tIHBlcmxmYXE2OgorICAgICAg ICAgICAgICAgIGlmICgkaW4gPX4gcy9eXC9cKlteKl0qXCorKFteXC8qXVteKl0qXCorKSpcLy8v KSB7CisgICAgICAgICAgICAgICAgICAgICRvdXQgICAgLj0gJyAnOworICAgICAgICAgICAgICAg IH0gZWxzZSB7ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIyBJbmNvbXBsZXRl IC8qICovCisgICAgICAgICAgICAgICAgICAgIG5leHQgUkVBRDsKKyAgICAgICAgICAgICAgICB9 CisgICAgICAgICAgICB9IGVsc2lmICgkaW4gPX4gcy9eKFwvKS8vKSB7ICAgICAgICAgICAgICAg ICAgICAjIC8uLi4KKyAgICAgICAgICAgICAgICAkb3V0ICAgIC49ICQxOworICAgICAgICAgICAg fSBlbHNpZiAoJGluID1+IHMvXihbXlwnXCJcXFwvXSspLy8pIHsKKyAgICAgICAgICAgICAgICAk b3V0ICAgIC49ICQxOworICAgICAgICAgICAgfSBlbHNpZiAoJF5PIGVxICdsaW51eCcgJiYKKyAg ICAgICAgICAgICAgICAgICAgICRmaWxlID1+IG0hKD86XnwvKWxpbnV4L2J5dGVvcmRlci9wZHBf ZW5kaWFuXC5oJCEgJiYKKyAgICAgICAgICAgICAgICAgICAgICRpbiAgID1+IHMhXCdUIEtOT1ch ISkgeworICAgICAgICAgICAgICAgICRvdXQgICAgPX4gcyFJIERPTiQhSV9ET19OT1RfS05PVyE7 CisgICAgICAgICAgICB9IGVsc2UgeworICAgICAgICAgICAgICAgIGlmICgkb3B0X2UpIHsKKyAg ICAgICAgICAgICAgICAgICAgd2FybiAiQ2Fubm90IHBhcnNlICRmaWxlOlxuJGluXG4iOworICAg ICAgICAgICAgICAgICAgICAkYmFkX2ZpbGV7JGZpbGV9ID0gMTsKKyAgICAgICAgICAgICAgICAg ICAgJGluID0gJyc7CisgICAgICAgICAgICAgICAgICAgICRvdXQgPSB1bmRlZjsKKyAgICAgICAg ICAgICAgICAgICAgbGFzdCBSRUFEOworICAgICAgICAgICAgICAgIH0gZWxzZSB7CisJCWRpZSAi Q2Fubm90IHBhcnNlOlxuJGluXG4iOworICAgICAgICAgICAgICAgIH0KKyAgICAgICAgICAgIH0K KyAgICAgICAgfQorCisgICAgICAgIGxhc3QgUkVBRCBpZiAkb3V0ID1+IC9cUy87CisgICAgfQor CisgICAgcmV0dXJuICRvdXQ7Cit9CisKKwogIyBIYW5kbGUgcmVjdXJzaXZlIHN1YmRpcmVjdG9y aWVzIHdpdGhvdXQgZ2V0dGluZyBhIGdyb3Rlc3F1ZWx5IGJpZyBzdGFjay4KICMgQ291bGQgdGhp cyBiZSBpbXBsZW1lbnRlZCB1c2luZyBGaWxlOjpGaW5kPwogc3ViIG5leHRfZmlsZQpAQCAtNTA0 LDggKzY0NCwxMyBAQCBzdWIgcXVldWVfaW5jbHVkZXNfZnJvbQogICAgICAgICAgICAgICAgICRs aW5lIC49IDxIRUFERVI+OwogICAgICAgICAgICAgfQogCi0gICAgICAgICAgICBpZiAoJGxpbmUg PX4gL14jXHMqaW5jbHVkZVxzKzwoLio/KT4vKSB7Ci0gICAgICAgICAgICAgICAgcHVzaChAQVJH ViwgJDEpIHVubGVzcyAkaXNfY29udmVydGVkeyQxfTsKKyAgICAgICAgICAgIGlmICgkbGluZSA9 fiAvXiNccyppbmNsdWRlXHMrKFs8Il0pKC4qPylbPiJdLykgeworICAgICAgICAgICAgICAgIG15 ICgkZGVsaW1pdGVyLCAkbmV3X2ZpbGUpID0gKCQxLCAkMik7CisgICAgICAgICAgICAgICAgIyBj b3B5IHRoZSBwcmVmaXggaW4gdGhlIHF1b3RlIHN5bnRheCAoI2luY2x1ZGUgInguaCIpIGNhc2UK KyAgICAgICAgICAgICAgICBpZiAoJGRlbGltaXRlciBlcSBxeyJ9ICYmICRmaWxlID1+IG18Xigu KikvfCkgeworICAgICAgICAgICAgICAgICAgICAkbmV3X2ZpbGUgPSAiJDEvJG5ld19maWxlIjsK KyAgICAgICAgICAgICAgICB9CisgICAgICAgICAgICAgICAgcHVzaChAQVJHViwgJG5ld19maWxl KSB1bmxlc3MgJElzX2NvbnZlcnRlZHskbmV3X2ZpbGV9OwogICAgICAgICAgICAgfQogICAgICAg ICB9CiAgICAgY2xvc2UgSEVBREVSOwpAQCAtNTQ2LDI1ICs2OTEsNTAgQEAgc3ViIGJ1aWxkX3By ZWFtYmxlX2lmX25lY2Vzc2FyeQogICAgIG15ICglZGVmaW5lKSA9IF9leHRyYWN0X2NjX2RlZmlu ZXMoKTsKIAogICAgIG9wZW4gIFBSRUFNQkxFLCAiPiRwcmVhbWJsZSIgb3IgZGllICJDYW5ub3Qg b3BlbiAkcHJlYW1ibGU6ICAkISI7Ci0gICAgICAgIHByaW50IFBSRUFNQkxFICIjIFRoaXMgZmls ZSB3YXMgY3JlYXRlZCBieSBoMnBoIHZlcnNpb24gJFZFUlNJT05cbiI7Ci0KLSAgICAgICAgZm9y ZWFjaCAoc29ydCBrZXlzICVkZWZpbmUpIHsKLSAgICAgICAgICAgIGlmICgkb3B0X0QpIHsKLSAg ICAgICAgICAgICAgICBwcmludCBQUkVBTUJMRSAiIyAkXz0kZGVmaW5leyRffVxuIjsKLSAgICAg ICAgICAgIH0KLQotICAgICAgICAgICAgaWYgKCRkZWZpbmV7JF99ID1+IC9eXGQrJC8pIHsKLSAg ICAgICAgICAgICAgICBwcmludCBQUkVBTUJMRQotICAgICAgICAgICAgICAgICAgICAidW5sZXNz IChkZWZpbmVkICYkXykgeyBzdWIgJF8oKSB7ICRkZWZpbmV7JF99IH0gfVxuXG4iOwotICAgICAg ICAgICAgfSBlbHNpZiAoJGRlZmluZXskX30gPX4gL15cdyskLykgewotICAgICAgICAgICAgICAg IHByaW50IFBSRUFNQkxFCi0gICAgICAgICAgICAgICAgICAgICJ1bmxlc3MgKGRlZmluZWQgJiRf KSB7IHN1YiAkXygpIHsgJiRkZWZpbmV7JF99IH0gfVxuXG4iOwotICAgICAgICAgICAgfSBlbHNl IHsKKwlwcmludCBQUkVBTUJMRSAiIyBUaGlzIGZpbGUgd2FzIGNyZWF0ZWQgYnkgaDJwaCB2ZXJz aW9uICRWRVJTSU9OXG4iOworICAgICAgICAjIFByZXZlbnQgbm9uLXBvcnRhYmxlIGhleCBjb25z dGFudHMgZnJvbSB3YXJuaW5nLgorICAgICAgICAjCisgICAgICAgICMgV2Ugc3RpbGwgcHJvZHVj ZSBhbiBvdmVyZmxvdyB3YXJuaW5nIGlmIHdlIGNhbid0IHJlcHJlc2VudAorICAgICAgICAjIGEg aGV4IGNvbnN0YW50IGFzIGFuIGludGVnZXIuCisgICAgICAgIHByaW50IFBSRUFNQkxFICJubyB3 YXJuaW5ncyBxdyhwb3J0YWJsZSk7XG4iOworCisJZm9yZWFjaCAoc29ydCBrZXlzICVkZWZpbmUp IHsKKwkgICAgaWYgKCRvcHRfRCkgeworCQlwcmludCBQUkVBTUJMRSAiIyAkXz0kZGVmaW5leyRf fVxuIjsKKwkgICAgfQorCSAgICBpZiAoJGRlZmluZXskX30gPX4gL15cKCguKilcKSQvKSB7CisJ CSMgcGFyZW50aGVzaXplZCB2YWx1ZTogIGQ9KHYpCisJCSRkZWZpbmV7JF99ID0gJDE7CisJICAg IH0KKwkgICAgaWYgKCRkZWZpbmV7JF99ID1+IC9eKFsrLV0/KFxkKyk/XC5cZCsoW2VFXVsrLV0/ XGQrKT8pW0ZMXT8kLykgeworCQkjIGZsb2F0OgorCQlwcmludCBQUkVBTUJMRQorCQkgICAgInVu bGVzcyAoZGVmaW5lZCAmJF8pIHsgc3ViICRfKCkgeyAkMSB9IH1cblxuIjsKKwkgICAgfSBlbHNp ZiAoJGRlZmluZXskX30gPX4gL14oWystXT9cZCspVT9MezAsMn0kL2kpIHsKKwkJIyBpbnRlZ2Vy OgorCQlwcmludCBQUkVBTUJMRQorCQkgICAgInVubGVzcyAoZGVmaW5lZCAmJF8pIHsgc3ViICRf KCkgeyAkMSB9IH1cblxuIjsKKyAgICAgICAgICAgIH0gZWxzaWYgKCRkZWZpbmV7JF99ID1+IC9e KFsrLV0/MHhbXGRhLWZdKylVP0x7MCwyfSQvaSkgeworICAgICAgICAgICAgICAgICMgaGV4IGlu dGVnZXIKKyAgICAgICAgICAgICAgICAjIFNwZWNpYWwgY2FzZWQsIHNpbmNlIHBlcmwgd2FybnMg b24gaGV4IGludGVnZXJzCisgICAgICAgICAgICAgICAgIyB0aGF0IGNhbid0IGJlIHJlcHJlc2Vu dGVkIGluIGEgVVYuCisgICAgICAgICAgICAgICAgIworICAgICAgICAgICAgICAgICMgVGhpcyB3 YXkgd2UgZ2V0IHRoZSB3YXJuaW5nIGF0IHRpbWUgb2YgdXNlLCBzbyB0aGUgdXNlcgorICAgICAg ICAgICAgICAgICMgb25seSBnZXRzIHRoZSB3YXJuaW5nIGlmIHRoZXkgaGFwcGVuIHRvIHVzZSB0 aGlzCisgICAgICAgICAgICAgICAgIyBwbGF0Zm9ybS1zcGVjaWZpYyBkZWZpbml0aW9uLgorICAg ICAgICAgICAgICAgIG15ICRjb2RlID0gJDE7CisgICAgICAgICAgICAgICAgJGNvZGUgPSAiaGV4 KCckY29kZScpIiBpZiBsZW5ndGggJGNvZGUgPiAxMDsKICAgICAgICAgICAgICAgICBwcmludCBQ UkVBTUJMRQotICAgICAgICAgICAgICAgICAgICAidW5sZXNzIChkZWZpbmVkICYkXykgeyBzdWIg JF8oKSB7IFwiIiwKLSAgICAgICAgICAgICAgICAgICAgcXVvdGVtZXRhKCRkZWZpbmV7JF99KSwg IlwiIH0gfVxuXG4iOwotICAgICAgICAgICAgfQotICAgICAgICB9CisgICAgICAgICAgICAgICAg ICAgICJ1bmxlc3MgKGRlZmluZWQgJiRfKSB7IHN1YiAkXygpIHsgJGNvZGUgfSB9XG5cbiI7CisJ ICAgIH0gZWxzaWYgKCRkZWZpbmV7JF99ID1+IC9eXHcrJC8pIHsKKwkJcHJpbnQgUFJFQU1CTEUK KwkJICAgICJ1bmxlc3MgKGRlZmluZWQgJiRfKSB7IHN1YiAkXygpIHsgJiRkZWZpbmV7JF99IH0g fVxuXG4iOworCSAgICB9IGVsc2UgeworCQlwcmludCBQUkVBTUJMRQorCQkgICAgInVubGVzcyAo ZGVmaW5lZCAmJF8pIHsgc3ViICRfKCkgeyBcIiIsCisJCSAgICBxdW90ZW1ldGEoJGRlZmluZXsk X30pLCAiXCIgfSB9XG5cbiI7CisJICAgIH0KKwl9CiAgICAgY2xvc2UgUFJFQU1CTEUgICAgICAg ICAgICAgICBvciBkaWUgIkNhbm5vdCBjbG9zZSAkcHJlYW1ibGU6ICAkISI7CiB9CiAKQEAgLTU3 NSwxNSArNzQ1LDE1IEBAIHN1YiBidWlsZF9wcmVhbWJsZV9pZl9uZWNlc3NhcnkKIHN1YiBfZXh0 cmFjdF9jY19kZWZpbmVzCiB7CiAgICAgbXkgJWRlZmluZTsKLSAgICBteSAkYWxsc3ltYm9scyA9 IGpvaW4gIiAiLCBAQ29uZmlne2Njc3ltYm9scywgY3Bwc3ltYm9scywgY3BwY2NzeW1ib2xzfTsK KyAgICBteSAkYWxsc3ltYm9scyAgPSBqb2luICIgIiwKKwlAQ29uZmlneydjY3N5bWJvbHMnLCAn Y3Bwc3ltYm9scycsICdjcHBjY3N5bWJvbHMnfTsKIAogICAgICMgU3BsaXQgY29tcGlsZXIgcHJl LWRlZmluaXRpb25zIGludG8gYGtleT12YWx1ZScgcGFpcnM6Ci0gICAgZm9yZWFjaCAoc3BsaXQg L1xzKy8sICRhbGxzeW1ib2xzKSB7Ci0gICAgICAgIC8oLis/KT0oLispLyBhbmQgJGRlZmluZXsk MX0gPSAkMjsKLQotICAgICAgICBpZiAoJG9wdF9EKSB7Ci0gICAgICAgICAgICBwcmludCBTVERF UlIgIiRfOiAgJDEgLT4gJDJcbiI7Ci0gICAgICAgIH0KKyAgICB3aGlsZSAoJGFsbHN5bWJvbHMg PX4gLyhbXlxzXSspPSgoXFxcc3xbXlxzXSkrKS9nKSB7CisJJGRlZmluZXskMX0gPSAkMjsKKwlp ZiAoJG9wdF9EKSB7CisJICAgIHByaW50IFNUREVSUiAiJF86ICAkMSAtPiAkMlxuIjsKKwl9CiAg ICAgfQogCiAgICAgcmV0dXJuICVkZWZpbmU7CkBAIC02MTIsNiArNzgyLDEwIEBAIEl0IGlzIG1v c3QgZWFzaWx5IHJ1biB3aGlsZSBpbiAvdXNyL2luY2x1ZGU6CiAKIAljZCAvdXNyL2luY2x1ZGU7 IGgycGggKiBzeXMvKgogCitvcgorCisJY2QgL3Vzci9pbmNsdWRlOyBoMnBoICogc3lzLyogYXJw YS8qIG5ldGluZXQvKgorCiBvcgogCiAJY2QgL3Vzci9pbmNsdWRlOyBoMnBoIC1yIC1sIC4KQEAg LTYyOSw3ICs4MDMsNyBAQCBJZiBydW4gd2l0aCBubyBhcmd1bWVudHMsIGZpbHRlcnMgc3RhbmRh cmQgaW5wdXQgdG8gc3RhbmRhcmQgb3V0cHV0LgogPWl0ZW0gLWQgZGVzdGluYXRpb25fZGlyCiAK IFB1dCB0aGUgcmVzdWx0aW5nIEI8LnBoPiBmaWxlcyBiZW5lYXRoIEI8ZGVzdGluYXRpb25fZGly PiwgaW5zdGVhZCBvZgotYmVuZWF0aCB0aGUgZGVmYXVsdCBQZXJsIGxpYnJhcnkgbG9jYXRpb24g KEM8JENvbmZpZ3snaW5zdGFsbHNpdHNlYXJjaCd9PikuCitiZW5lYXRoIHRoZSBkZWZhdWx0IFBl cmwgbGlicmFyeSBsb2NhdGlvbiAoQzwkQ29uZmlneydpbnN0YWxsc2l0ZWFyY2gnfT4pLgogCiA9 aXRlbSAtcgogCkBAIC03MDgsMTggKzg4MiwxNiBAQCB0aGF0IGl0IGNhbiB0cmFuc2xhdGUuCiBJ dCdzIG9ubHkgaW50ZW5kZWQgYXMgYSByb3VnaCB0b29sLgogWW91IG1heSBuZWVkIHRvIGRpY2tl ciB3aXRoIHRoZSBmaWxlcyBwcm9kdWNlZC4KIAotRG9lc24ndCBydW4gd2l0aCBDPHVzZSBzdHJp Y3Q+Ci0KIFlvdSBoYXZlIHRvIHJ1biB0aGlzIHByb2dyYW0gYnkgaGFuZDsgaXQncyBub3QgcnVu IGFzIHBhcnQgb2YgdGhlIFBlcmwKIGluc3RhbGxhdGlvbi4KIAogRG9lc24ndCBoYW5kbGUgY29t cGxpY2F0ZWQgZXhwcmVzc2lvbnMgYnVpbHQgcGllY2VtZWFsLCBhIGxhOgogCiAgICAgZW51bSB7 Ci0gICAgICAgIEZJUlNUX1ZBTFVFLAotICAgICAgICBTRUNPTkRfVkFMVUUsCisJRklSU1RfVkFM VUUsCisJU0VDT05EX1ZBTFVFLAogICAgICNpZmRlZiBBQkMKLSAgICAgICAgVEhJUkRfVkFMVUUK KwlUSElSRF9WQUxVRQogICAgICNlbmRpZgogICAgIH07CiAK UH2PH560 } if ( $num < 5.007000 ) { return _patch_b64(<<'UH2PH562'); LS0tIHV0aWxzL2gycGguUEwKKysrIHV0aWxzL2gycGguUEwKQEAgLTQyLDggKzQyLDEzIEBAIHVz ZSBDb25maWc7CiB1c2UgRmlsZTo6UGF0aCBxdyhta3BhdGgpOwogdXNlIEdldG9wdDo6U3RkOwog Ci1nZXRvcHRzKCdEZDpybGhhUScpOwotdXNlIHZhcnMgcXcoJG9wdF9EICRvcHRfZCAkb3B0X3Ig JG9wdF9sICRvcHRfaCAkb3B0X2EgJG9wdF9RKTsKKyMgTWFrZSBzdXJlIHJlYWQgcGVybWlzc2lv bnMgZm9yIGFsbCBhcmUgc2V0OgoraWYgKGRlZmluZWQgdW1hc2sgJiYgKHVtYXNrKCkgJiAwNDQ0 KSkgeworICAgIHVtYXNrICh1bWFzaygpICYgfjA0NDQpOworfQorCitnZXRvcHRzKCdEZDpybGhh UWUnKTsKK3VzZSB2YXJzIHF3KCRvcHRfRCAkb3B0X2QgJG9wdF9yICRvcHRfbCAkb3B0X2ggJG9w dF9hICRvcHRfUSAkb3B0X2UpOwogZGllICItciBhbmQgLWEgb3B0aW9ucyBhcmUgbXV0dWFsbHkg ZXhjbHVzaXZlXG4iIGlmICgkb3B0X3IgYW5kICRvcHRfYSk7CiBteSBAaW5jX2RpcnMgPSBpbmNf ZGlycygpIGlmICRvcHRfYTsKIApAQCAtNjUsMTMgKzcwLDIxIEBAIG15ICVpc2F0eXBlOwogQGlz YXR5cGV7QGlzYXR5cGV9ID0gKDEpIHggQGlzYXR5cGU7CiBteSAkaW5pZiA9IDA7CiBteSAlSXNf Y29udmVydGVkOworbXkgJWJhZF9maWxlID0gKCk7CiAKIEBBUkdWID0gKCctJykgdW5sZXNzIEBB UkdWOwogCiBidWlsZF9wcmVhbWJsZV9pZl9uZWNlc3NhcnkoKTsKIAorc3ViIHJlaW5kZW50KCQp IHsKKyAgICBteSgkdGV4dCkgPSBzaGlmdDsKKyAgICAkdGV4dCA9fiBzL1xuL1xuICAgIC9nOwor ICAgICR0ZXh0ID1+IHMvICAgICAgICAvXHQvZzsKKyAgICAkdGV4dDsKK30KKwogbXkgKCR0LCAk dGFiLCAlY3VyYXJncywgJG5ldywgJGV2YWxfaW5kZXgsICRkaXIsICRuYW1lLCAkYXJncywgJG91 dGZpbGUpOwotbXkgKCRpbmNsLCAkbmV4dCk7CitteSAoJGluY2wsICRpbmNsX3R5cGUsICRpbmNs X3F1b3RlLCAkbmV4dCk7CiB3aGlsZSAoZGVmaW5lZCAobXkgJGZpbGUgPSBuZXh0X2ZpbGUoKSkp IHsKICAgICBpZiAoLWwgJGZpbGUgYW5kIC1kICRmaWxlKSB7CiAgICAgICAgIGxpbmtfaWZfcG9z c2libGUoJGZpbGUpIGlmICgkb3B0X2wpOwpAQCAtMTA3LDMwICsxMjAsMTcgQEAgd2hpbGUgKGRl ZmluZWQgKG15ICRmaWxlID0gbmV4dF9maWxlKCkpKSB7CiAJb3BlbihPVVQsIj4kRGVzdF9kaXIv JG91dGZpbGUiKSB8fCBkaWUgIkNhbid0IGNyZWF0ZSAkb3V0ZmlsZTogJCFcbiI7CiAgICAgfQog Ci0gICAgcHJpbnQgT1VUICJyZXF1aXJlICdfaDJwaF9wcmUucGgnO1xuXG4iOwotICAgIHdoaWxl ICg8SU4+KSB7Ci0JY2hvcDsKLQl3aGlsZSAoL1xcJC8pIHsKLQkgICAgY2hvcDsKLQkgICAgJF8g Lj0gPElOPjsKLQkgICAgY2hvcDsKLQl9Ci0JcHJpbnQgT1VUICIjICRfXG4iIGlmICRvcHRfRDsK LQotCWlmIChzOi9cKjpcMjAwOmcpIHsKLQkgICAgczpcKi86XDIwMTpnOwotCSAgICBzL1wyMDBb XlwyMDFdKlwyMDEvL2c7CSMgZGVsZXRlIHNpbmdsZSBsaW5lIGNvbW1lbnRzCi0JICAgIGlmIChz L1wyMDAuKi8vKSB7CQkjIGJlZ2luIG11bHRpLWxpbmUgY29tbWVudD8KLQkJJF8gLj0gJy8qJzsK LQkJJF8gLj0gPElOPjsKLQkJcmVkbzsKLQkgICAgfQotCX0KKyAgICBwcmludCBPVVQKKyAgICAg ICAgInJlcXVpcmUgJ19oMnBoX3ByZS5waCc7XG5cbiIsCisgICAgICAgICJubyB3YXJuaW5ncyAn cmVkZWZpbmUnO1xuXG4iOworCisgICAgd2hpbGUgKGRlZmluZWQgKGxvY2FsICRfID0gbmV4dF9s aW5lKCRmaWxlKSkpIHsKIAlpZiAocy9eXHMqXCNccyovLykgewogCSAgICBpZiAocy9eZGVmaW5l XHMrKFx3KykvLykgewogCQkkbmFtZSA9ICQxOwogCQkkbmV3ID0gJyc7CiAJCXMvXHMrJC8vOwor CQlzL1woXHcrXHMqXChcKlwpXHMqXChcdypcKVwpXHMqKC0/XGQrKS8kMS87ICMgKGludCAoKiko Zm9vX3QpKTAKIAkJaWYgKHMvXlwoKFtcdyxcc10qKVwpLy8pIHsKIAkJICAgICRhcmdzID0gJDE7 CiAgICAgCSAgICAJICAgIG15ICRwcm90byA9ICcoKSAnOwpAQCAtMTg0LDIyICsxODQsMzIgQEAg d2hpbGUgKGRlZmluZWQgKG15ICRmaWxlID0gbmV4dF9maWxlKCkpKSB7CiAgICAgICAgICAgICAg ICAgICAgICAgcHJpbnQgT1VUICR0LCJ1bmxlc3MoZGVmaW5lZChcJiRuYW1lKSkge1xuICAgIHN1 YiAkbmFtZSAoKSB7XHQiLCRuZXcsIjt9XG59XG4iOwogCQkgICAgfQogCQl9Ci0JICAgIH0gZWxz aWYgKC9eKGluY2x1ZGV8aW1wb3J0KVxzKls8Il0oLiopWz4iXS8pIHsKLQkJKCRpbmNsID0gJDIp ID1+IHMvXC5oJC8ucGgvOwotCQlwcmludCBPVVQgJHQsInJlcXVpcmUgJyRpbmNsJztcbiI7Ci0J ICAgIH0gZWxzaWYoL15pbmNsdWRlX25leHRccypbPCJdKC4qKVs+Il0vKSB7Ci0JCSgkaW5jbCA9 ICQxKSA9fiBzL1wuaCQvLnBoLzsKKwkgICAgfSBlbHNpZiAoL14oaW5jbHVkZXxpbXBvcnR8aW5j bHVkZV9uZXh0KVxzKihbPFwiXSkoLiopWz5cIl0vKSB7CisgICAgICAgICAgICAgICAgJGluY2xf dHlwZSA9ICQxOworICAgICAgICAgICAgICAgICRpbmNsX3F1b3RlID0gJDI7CisgICAgICAgICAg ICAgICAgJGluY2wgPSAkMzsKKyAgICAgICAgICAgICAgICBpZiAoKCRpbmNsX3R5cGUgZXEgJ2lu Y2x1ZGVfbmV4dCcpIHx8CisgICAgICAgICAgICAgICAgICAgICgkb3B0X2UgJiYgZXhpc3RzKCRi YWRfZmlsZXskaW5jbH0pKSkgeworICAgICAgICAgICAgICAgICAgICAkaW5jbCA9fiBzL1wuaCQv LnBoLzsKIAkJcHJpbnQgT1VUICgkdCwKIAkJCSAgICJldmFsIHtcbiIpOwogICAgICAgICAgICAg ICAgICR0YWIgKz0gNDsKICAgICAgICAgICAgICAgICAkdCA9ICJcdCIgeCAoJHRhYiAvIDgpIC4g JyAnIHggKCR0YWIgJSA4KTsKKyAgICAgICAgICAgICAgICAgICAgcHJpbnQgT1VUICgkdCwgIm15 KFxAUkVNKTtcbiIpOworICAgICAgICAgICAgICAgICAgICBpZiAoJGluY2xfdHlwZSBlcSAnaW5j bHVkZV9uZXh0JykgewogCQlwcmludCBPVVQgKCR0LAogCQkJICAgIm15KFwlSU5DRCkgPSBtYXAg eyBcJElOQ3tcJF99ID0+IDEgfSAiLAotCQkJICAgIihncmVwIHsgXCRfIGVxIFwiJGluY2xcIiB9 IGtleXMoXCVJTkMpKTtcbiIpOworCQkJICAgICAgICAgICAiKGdyZXAgeyBcJF8gZXEgXCIkaW5j bFwiIH0gIiwKKyAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgImtleXMoXCVJTkMp KTtcbiIpOwogCQlwcmludCBPVVQgKCR0LAotCQkJICAgIm15KFxAUkVNKSA9IG1hcCB7IFwiXCRf LyRpbmNsXCIgfSAiLAorCQkJICAgICAgICAgICAiXEBSRU0gPSBtYXAgeyBcIlwkXy8kaW5jbFwi IH0gIiwKIAkJCSAgICIoZ3JlcCB7IG5vdCBleGlzdHMoXCRJTkNEe1wiXCRfLyRpbmNsXCJ9KSIs Ci0JCQkgICAiYW5kIC1mIFwiXCRfLyRpbmNsXCIgfSBcQElOQyk7XG4iKTsKKwkJCSAgICAgICAg ICAgIiBhbmQgLWYgXCJcJF8vJGluY2xcIiB9IFxASU5DKTtcbiIpOworICAgICAgICAgICAgICAg ICAgICB9IGVsc2UgeworICAgICAgICAgICAgICAgICAgICAgICAgcHJpbnQgT1VUICgkdCwKKyAg ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIlxAUkVNID0gbWFwIHsgXCJcJF8vJGlu Y2xcIiB9ICIsCisgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICIoZ3JlcCB7LXIg XCJcJF8vJGluY2xcIiB9IFxASU5DKTtcbiIpOworICAgICAgICAgICAgICAgICAgICB9CiAJCXBy aW50IE9VVCAoJHQsCiAJCQkgICAicmVxdWlyZSBcIlwkUkVNWzBdXCIgaWYgXEBSRU07XG4iKTsK ICAgICAgICAgICAgICAgICAkdGFiIC09IDQ7CkBAIC0yMDgsNiArMjE4LDE0IEBAIHdoaWxlIChk ZWZpbmVkIChteSAkZmlsZSA9IG5leHRfZmlsZSgpKSkgewogCQkJICAgIn07XG4iKTsKIAkJcHJp bnQgT1VUICgkdCwKIAkJCSAgICJ3YXJuKFwkXEApIGlmIFwkXEA7XG4iKTsKKyAgICAgICAgICAg ICAgICB9IGVsc2UgeworICAgICAgICAgICAgICAgICAgICAkaW5jbCA9fiBzL1wuaCQvLnBoLzsK KyAgICAgICAgICAgICAgICAgICAgIyBjb3B5IHRoZSBwcmVmaXggaW4gdGhlIHF1b3RlIHN5bnRh eCAoI2luY2x1ZGUgInguaCIpIGNhc2UKKyAgICAgICAgICAgICAgICAgICAgaWYgKCRpbmNsICF+ IG18L3wgJiYgJGluY2xfcXVvdGUgZXEgcXsifSAmJiAkZmlsZSA9fiBtfF4oLiopL3wpIHsKKyAg ICAgICAgICAgICAgICAgICAgICAgICRpbmNsID0gIiQxLyRpbmNsIjsKKyAgICAgICAgICAgICAg ICAgICAgfQorCQkgICAgcHJpbnQgT1VUICR0LCJyZXF1aXJlICckaW5jbCc7XG4iOworICAgICAg ICAgICAgICAgIH0KIAkgICAgfSBlbHNpZiAoL15pZmRlZlxzKyhcdyspLykgewogCQlwcmludCBP VVQgJHQsImlmKGRlZmluZWQoJiQxKSkge1xuIjsKIAkJJHRhYiArPSA0OwpAQCAtMjU1LDE1ICsy NzMsMTkgQEAgd2hpbGUgKGRlZmluZWQgKG15ICRmaWxlID0gbmV4dF9maWxlKCkpKSB7CiAJICAg IH0gZWxzaWYoL15pZGVudFxzKyguKikvKSB7CiAJCXByaW50IE9VVCAkdCwgIiMgJDFcbiI7CiAJ ICAgIH0KLSAJfSBlbHNpZigvXlxzKih0eXBlZGVmXHMqKT9lbnVtXHMqKFxzK1thLXpBLVpfXVx3 KlxzKik/XHsvKSB7Ci0JICAgIHVudGlsKC9cfS4qPzsvKSB7Ci0JCWNob21wKCRuZXh0ID0gPElO Pik7CisJfSBlbHNpZigvXlxzKih0eXBlZGVmXHMqKT9lbnVtXHMqKFxzK1thLXpBLVpfXVx3Klxz Kik/LykgeworCSAgICB1bnRpbCgvXHtbXn1dKlx9Lio7LyB8fCAvOy8pIHsKKwkJbGFzdCB1bmxl c3MgZGVmaW5lZCAoJG5leHQgPSBuZXh0X2xpbmUoJGZpbGUpKTsKKwkJY2hvbXAgJG5leHQ7CisJ CSMgZHJvcCAiI2RlZmluZSBGT08gRk9PIiBpbiBlbnVtcworCQkkbmV4dCA9fiBzL15ccyojXHMq ZGVmaW5lXHMrKFx3KylccytcMVxzKiQvLzsKIAkJJF8gLj0gJG5leHQ7CiAJCXByaW50IE9VVCAi IyAkbmV4dFxuIiBpZiAkb3B0X0Q7CiAJICAgIH0KKwkgICAgcy8jXHMqaWYuKj8jXHMqZW5kaWYv L2c7ICMgZHJvcCAjaWZkZWZzCiAJICAgIHNAL1wqLio/XCovQEBnOwogCSAgICBzL1xzKy8gL2c7 Ci0JICAgIC9eXHM/KHR5cGVkZWZccz8pP2VudW1ccz8oW2EtekEtWl9dXHcqKT9ccz9ceyguKilc fVxzPyhbYS16QS1aX11cdyopP1xzPzsvOworCSAgICBuZXh0IHVubGVzcyAvXlxzPyh0eXBlZGVm XHM/KT9lbnVtXHM/KFthLXpBLVpfXVx3Kik/XHM/XHsoLiopXH1ccz8oW2EtekEtWl9dXHcqKT9c cz87LzsKIAkgICAgKG15ICRlbnVtX3N1YnMgPSAkMykgPX4gcy9ccy8vZzsKIAkgICAgbXkgQGVu dW1fc3VicyA9IHNwbGl0KC8sLywgJGVudW1fc3Vicyk7CiAJICAgIG15ICRlbnVtX3ZhbCA9IC0x OwpAQCAtMjg1LDIyICszMDcsMjIgQEAgd2hpbGUgKGRlZmluZWQgKG15ICRmaWxlID0gbmV4dF9m aWxlKCkpKSB7CiAJICAgIH0KIAl9CiAgICAgfQotICAgIHByaW50IE9VVCAiMTtcbiI7Ci0KICAg ICAkSXNfY29udmVydGVkeyRmaWxlfSA9IDE7CisgICAgaWYgKCRvcHRfZSAmJiBleGlzdHMoJGJh ZF9maWxleyRmaWxlfSkpIHsKKyAgICAgICAgdW5saW5rKCREZXN0X2RpciAuICcvJyAuICRvdXRm aWxlKTsKKyAgICAgICAgJG5leHQgPSAnJzsKKyAgICB9IGVsc2UgeworICAgICAgICBwcmludCBP VVQgIjE7XG4iOwogICAgIHF1ZXVlX2luY2x1ZGVzX2Zyb20oJGZpbGUpIGlmICgkb3B0X2EpOwor ICAgIH0KIH0KIAotZXhpdCAkRXhpdDsKLQotCi1zdWIgcmVpbmRlbnQoJCkgewotICAgIG15KCR0 ZXh0KSA9IHNoaWZ0OwotICAgICR0ZXh0ID1+IHMvXG4vXG4gICAgL2c7Ci0gICAgJHRleHQgPX4g cy8gICAgICAgIC9cdC9nOwotICAgICR0ZXh0OworaWYgKCRvcHRfZSAmJiAoc2NhbGFyKGtleXMg JWJhZF9maWxlKSA+IDApKSB7CisgICAgd2FybiAiV2FzIHVuYWJsZSB0byBjb252ZXJ0IHRoZSBm b2xsb3dpbmcgZmlsZXM6XG4iOworICAgIHdhcm4gIlx0IiAuIGpvaW4oIlxuXHQiLHNvcnQoa2V5 cyAlYmFkX2ZpbGUpKSAuICJcbiI7CiB9CiAKK2V4aXQgJEV4aXQ7CiAKIHN1YiBleHByIHsKICAg ICBteSAkam9pbmVkX2FyZ3M7CkBAIC0zMTEsOCArMzMzLDIxIEBAIHN1YiBleHByIHsKIAlzL15c JlwmLy8gJiYgZG8geyAkbmV3IC49ICIgJiYiOyBuZXh0O307ICMgaGFuZGxlICYmIG9wZXJhdG9y CiAJcy9eXCYoW1woYS16XCldKykvJDEvaTsJIyBoYWNrIGZvciB0aGluZ3MgdGhhdCB0YWtlIHRo ZSBhZGRyZXNzIG9mCiAJcy9eKFxzKykvLwkJJiYgZG8geyRuZXcgLj0gJyAnOyBuZXh0O307Ci0J cy9eKDBYWzAtOUEtRl0rKVtVTF0qLy9pCSYmIGRvIHskbmV3IC49IGxjKCQxKTsgbmV4dDt9Owot CXMvXigtP1xkK1wuXGQrRVstK11cZCspRj8vL2kJJiYgZG8geyRuZXcgLj0gJDE7IG5leHQ7fTsK KwlzL14wWChbMC05QS1GXSspW1VMXSovL2kgCisJICAgICYmIGRvIHtteSAkaGV4ID0gJDE7CisJ CSAgICRoZXggPX4gcy9eMCsvLzsKKwkJICAgaWYgKGxlbmd0aCAkaGV4ID4gOCAmJiAhJENvbmZp Z3t1c2U2NGJpdGludH0pIHsKKwkJICAgICAgICMgQ3JvYWsgaWYgbnZfcHJlc2VydmVzX3V2X2Jp dHMgPCA2NCA/CisJCSAgICAgICAkbmV3IC49ICAgICAgICAgaGV4KHN1YnN0cigkaGV4LCAtOCkp ICsKKwkJCSAgICAgICAyKiozMiAqIGhleChzdWJzdHIoJGhleCwgIDAsIC04KSk7CisJCSAgICAg ICAjIFRoZSBhYm92ZSB3aWxsIHByb2R1Y2UgImVycm9ybmV1cyIgY29kZQorCQkgICAgICAgIyBp ZiB0aGUgaGV4IGNvbnN0YW50IHdhcyBlLmcuIGluc2lkZSBVSU5UNjRfQworCQkgICAgICAgIyBt YWNybywgYnV0IHRoZW4gYWdhaW4sIGgycGggaXMgYW4gYXBwcm94aW1hdGlvbi4KKwkJICAgfSBl bHNlIHsKKwkJICAgICAgICRuZXcgLj0gbGMoIjB4JGhleCIpOworCQkgICB9CisJCSAgIG5leHQ7 fTsKKwlzL14oLT9cZCtcLlxkK0VbLStdP1xkKylbRkxdPy8vaQkmJiBkbyB7JG5ldyAuPSAkMTsg bmV4dDt9OwogCXMvXihcZCspXHMqW0xVXSovL2kJJiYgZG8geyRuZXcgLj0gJDE7IG5leHQ7fTsK IAlzL14oIihcXCJ8W14iXSkqIikvLwkmJiBkbyB7JG5ldyAuPSAkMTsgbmV4dDt9OwogCXMvXico KFxcInxbXiJdKSopJy8vCSYmIGRvIHsKQEAgLTM1MSw3ICszODYsNyBAQCBzdWIgZXhwciB7CiAJ IyBFbGltaW5hdGUgdHlwZWRlZnMKIAkvXCgoW1x3XHNdKylbXCpcc10qXClccypbXHdcKF0vICYm IGRvIHsKIAkgICAgZm9yZWFjaCAoc3BsaXQgL1xzKy8sICQxKSB7ICAjIE1ha2Ugc3VyZSBhbGwg dGhlIHdvcmRzIGFyZSB0eXBlcywKLQkJbGFzdCB1bmxlc3MgKCRpc2F0eXBleyRffSBvciAkXyBl cSAnc3RydWN0Jyk7CisJCWxhc3QgdW5sZXNzICgkaXNhdHlwZXskX30gb3IgJF8gZXEgJ3N0cnVj dCcgb3IgJF8gZXEgJ3VuaW9uJyk7CiAJICAgIH0KIAkgICAgcy9cKFtcd1xzXStbXCpcc10qXCkv LyAmJiBuZXh0OyAgICAgICMgdGhlbiBlbGltaW5hdGUgdGhlbS4KIAl9OwpAQCAtMzc0LDcgKzQw OSw3IEBAIHN1YiBleHByIHsKIAl9OwogCXMvXihbX2EtekEtWl1cdyopLy8JJiYgZG8gewogCSAg ICBteSAkaWQgPSAkMTsKLQkgICAgaWYgKCRpZCBlcSAnc3RydWN0JykgeworCSAgICBpZiAoJGlk IGVxICdzdHJ1Y3QnIHx8ICRpZCBlcSAndW5pb24nKSB7CiAJCXMvXlxzKyhcdyspLy87CiAJCSRp ZCAuPSAnICcgLiAkMTsKIAkJJGlzYXR5cGV7JGlkfSA9IDE7CkBAIC0zODcsOCArNDIyLDggQEAg c3ViIGV4cHIgewogCQkkbmV3IC49ICctPicgaWYgL15bXFtce10vOwogCSAgICB9IGVsc2lmICgk aWQgZXEgJ2RlZmluZWQnKSB7CiAJCSRuZXcgLj0gJ2RlZmluZWQnOwotCSAgICB9IGVsc2lmICgv XlwoLykgewotCQlzL15cKChcdyksLygiJDEiLC8gaWYgJGlkID1+IC9eX0lPW1dSXSokL2k7CSMg Y2hlYXQKKwkgICAgfSBlbHNpZiAoL15ccypcKC8pIHsKKwkJcy9eXHMqXCgoXHcpLC8oIiQxIiwv IGlmICRpZCA9fiAvXl9JT1tXUl0qJC9pOwkjIGNoZWF0CiAJCSRuZXcgLj0gIiAmJGlkIjsKIAkg ICAgfSBlbHNpZiAoJGlzYXR5cGV7JGlkfSkgewogCQlpZiAoJG5ldyA9fiAve1xzKiQvKSB7CkBA IC00MDEsNyArNDM2LDcgQEAgc3ViIGV4cHIgewogCQl9CiAJICAgIH0gZWxzZSB7CiAJCWlmICgk aW5pZiAmJiAkbmV3ICF+IC9kZWZpbmVkXHMqXCgkLykgewotCQkgICAgJG5ldyAuPSAnKGRlZmlu ZWQoJicgLiAkaWQgLiAnKSA/ICYnIC4gJGlkIC4gJyA6IDApJzsKKwkJICAgICRuZXcgLj0gJyhk ZWZpbmVkKCYnIC4gJGlkIC4gJykgPyAmJyAuICRpZCAuICcgOiB1bmRlZiknOwogCQl9IGVsc2lm ICgvXlxbLykgewogCQkgICAgJG5ldyAuPSAiIFwkJGlkIjsKIAkJfSBlbHNlIHsKQEAgLTQxNSw2 ICs0NTAsMTAxIEBAIHN1YiBleHByIHsKIH0KIAogCitzdWIgbmV4dF9saW5lCit7CisgICAgbXkg JGZpbGUgPSBzaGlmdDsKKyAgICBteSAoJGluLCAkb3V0KTsKKyAgICBteSAkcHJlX3N1Yl90cmlf Z3JhcGhzID0gMTsKKworICAgIFJFQUQ6IHdoaWxlIChub3QgZW9mIElOKSB7CisgICAgICAgICRp biAgLj0gPElOPjsKKyAgICAgICAgY2hvbXAgJGluOworICAgICAgICBuZXh0IHVubGVzcyBsZW5n dGggJGluOworCisgICAgICAgIHdoaWxlIChsZW5ndGggJGluKSB7CisgICAgICAgICAgICBpZiAo JHByZV9zdWJfdHJpX2dyYXBocykgeworICAgICAgICAgICAgICAgICMgUHJlcHJvY2VzcyBhbGwg dHJpLWdyYXBocyAKKyAgICAgICAgICAgICAgICAjIGluY2x1ZGluZyB0aGluZ3Mgc3R1Y2sgaW4g cXVvdGVkIHN0cmluZyBjb25zdGFudHMuCisgICAgICAgICAgICAgICAgJGluID1+IHMvXD9cPz0v Iy9nOyAgICAgICAgICAgICAgICAgICAgICAgICAjIHwgPz89fCAgI3wKKyAgICAgICAgICAgICAg ICAkaW4gPX4gcy9cP1w/XCEvfC9nOyAgICAgICAgICAgICAgICAgICAgICAgICMgfCA/PyF8ICB8 fAorICAgICAgICAgICAgICAgICRpbiA9fiBzL1w/XD8nL14vZzsgICAgICAgICAgICAgICAgICAg ICAgICAgIyB8ID8/J3wgIF58CisgICAgICAgICAgICAgICAgJGluID1+IHMvXD9cP1woL1svZzsg ICAgICAgICAgICAgICAgICAgICAgICAjIHwgPz8ofCAgW3wKKyAgICAgICAgICAgICAgICAkaW4g PX4gcy9cP1w/XCkvXS9nOyAgICAgICAgICAgICAgICAgICAgICAgICMgfCA/Pyl8ICBdfAorICAg ICAgICAgICAgICAgICRpbiA9fiBzL1w/XD9cLS9+L2c7ICAgICAgICAgICAgICAgICAgICAgICAg IyB8ID8/LXwgIH58CisgICAgICAgICAgICAgICAgJGluID1+IHMvXD9cP1wvL1xcL2c7ICAgICAg ICAgICAgICAgICAgICAgICAjIHwgPz8vfCAgXHwKKyAgICAgICAgICAgICAgICAkaW4gPX4gcy9c P1w/PC97L2c7ICAgICAgICAgICAgICAgICAgICAgICAgICMgfCA/Pzx8ICB7fAorICAgICAgICAg ICAgICAgICRpbiA9fiBzL1w/XD8+L30vZzsgICAgICAgICAgICAgICAgICAgICAgICAgIyB8ID8/ PnwgIH18CisgICAgICAgICAgICB9CisJICAgIGlmICgkaW4gPX4gL15cI2lmZGVmIF9fTEFOR1VB R0VfUEFTQ0FMX18vKSB7CisgICAgICAgICAgICAgICAgIyBUcnU2NCBkaXNhc3NlbWJsZXIuaCBl dmlsbmVzczogbWl4ZWQgQyBhbmQgUGFzY2FsLgorCQl3aGlsZSAoPElOPikgeworCQkgICAgbGFz dCBpZiAvXlwjZW5kaWYvOyAKKwkJfQorCQluZXh0IFJFQUQ7CisJICAgIH0KKwkgICAgaWYgKCRp biA9fiAvXmV4dGVybiBpbmxpbmUgLyAmJiAjIElubGluZWQgYXNzZW1ibGVyLgorCQkkXk8gZXEg J2xpbnV4JyAmJiAkZmlsZSA9fiBtISg/Ol58Lylhc20vW14vXStcLmgkISkgeworIAkJd2hpbGUg KDxJTj4pIHsKKwkJICAgIGxhc3QgaWYgL159LzsgCisJCX0KKwkJbmV4dCBSRUFEOworCSAgICB9 CisgICAgICAgICAgICBpZiAoJGluID1+IHMvXFwkLy8pIHsgICAgICAgICAgICAgICAgICAgICAg ICAgICAjIFwtbmV3bGluZQorICAgICAgICAgICAgICAgICRvdXQgICAgLj0gJyAnOworICAgICAg ICAgICAgICAgIG5leHQgUkVBRDsKKyAgICAgICAgICAgIH0gZWxzaWYgKCRpbiA9fiBzL14oW14i J1xcXC9dKykvLykgeyAgICAgICAgICAgICMgUGFzc3Rocm91Z2gKKyAgICAgICAgICAgICAgICAk b3V0ICAgIC49ICQxOworICAgICAgICAgICAgfSBlbHNpZiAoJGluID1+IHMvXihcXC4pLy8pIHsg ICAgICAgICAgICAgICAgICAgIyBcLi4uCisgICAgICAgICAgICAgICAgJG91dCAgICAuPSAkMTsK KyAgICAgICAgICAgIH0gZWxzaWYgKCRpbiA9fiAvXicvKSB7ICAgICAgICAgICAgICAgICAgICAg ICAgICMgJy4uLgorICAgICAgICAgICAgICAgIGlmICgkaW4gPX4gcy9eKCcoXFwufFteJ1xcXSkq JykvLykgeworICAgICAgICAgICAgICAgICAgICAkb3V0ICAgIC49ICQxOworICAgICAgICAgICAg ICAgIH0gZWxzZSB7CisgICAgICAgICAgICAgICAgICAgIG5leHQgUkVBRDsKKyAgICAgICAgICAg ICAgICB9CisgICAgICAgICAgICB9IGVsc2lmICgkaW4gPX4gL14iLykgeyAgICAgICAgICAgICAg ICAgICAgICAgICAjICIuLi4KKyAgICAgICAgICAgICAgICBpZiAoJGluID1+IHMvXigiKFxcLnxb XiJcXF0pKiIpLy8pIHsKKyAgICAgICAgICAgICAgICAgICAgJG91dCAgICAuPSAkMTsKKyAgICAg ICAgICAgICAgICB9IGVsc2UgeworICAgICAgICAgICAgICAgICAgICBuZXh0IFJFQUQ7CisgICAg ICAgICAgICAgICAgfQorICAgICAgICAgICAgfSBlbHNpZiAoJGluID1+IHMvXlwvXC8uKi8vKSB7 ICAgICAgICAgICAgICAgICAgIyAvLy4uLgorICAgICAgICAgICAgICAgICMgZmFsbCB0aHJvdWdo CisgICAgICAgICAgICB9IGVsc2lmICgkaW4gPX4gbS9eXC9cKi8pIHsgICAgICAgICAgICAgICAg ICAgICAjIC8qLi4uCisgICAgICAgICAgICAgICAgIyBDIGNvbW1lbnQgcmVtb3ZhbCBhZGFwdGVk IGZyb20gcGVybGZhcTY6CisgICAgICAgICAgICAgICAgaWYgKCRpbiA9fiBzL15cL1wqW14qXSpc KisoW15cLypdW14qXSpcKispKlwvLy8pIHsKKyAgICAgICAgICAgICAgICAgICAgJG91dCAgICAu PSAnICc7CisgICAgICAgICAgICAgICAgfSBlbHNlIHsgICAgICAgICAgICAgICAgICAgICAgICAg ICAgICAgICAgICAjIEluY29tcGxldGUgLyogKi8KKyAgICAgICAgICAgICAgICAgICAgbmV4dCBS RUFEOworICAgICAgICAgICAgICAgIH0KKyAgICAgICAgICAgIH0gZWxzaWYgKCRpbiA9fiBzL14o XC8pLy8pIHsgICAgICAgICAgICAgICAgICAgICMgLy4uLgorICAgICAgICAgICAgICAgICRvdXQg ICAgLj0gJDE7CisgICAgICAgICAgICB9IGVsc2lmICgkaW4gPX4gcy9eKFteXCdcIlxcXC9dKykv LykgeworICAgICAgICAgICAgICAgICRvdXQgICAgLj0gJDE7CisgICAgICAgICAgICB9IGVsc2lm ICgkXk8gZXEgJ2xpbnV4JyAmJgorICAgICAgICAgICAgICAgICAgICAgJGZpbGUgPX4gbSEoPzpe fC8pbGludXgvYnl0ZW9yZGVyL3BkcF9lbmRpYW5cLmgkISAmJgorICAgICAgICAgICAgICAgICAg ICAgJGluICAgPX4gcyFcJ1QgS05PVyEhKSB7CisgICAgICAgICAgICAgICAgJG91dCAgICA9fiBz IUkgRE9OJCFJX0RPX05PVF9LTk9XITsKKyAgICAgICAgICAgIH0gZWxzZSB7CisgICAgICAgICAg ICAgICAgaWYgKCRvcHRfZSkgeworICAgICAgICAgICAgICAgICAgICB3YXJuICJDYW5ub3QgcGFy c2UgJGZpbGU6XG4kaW5cbiI7CisgICAgICAgICAgICAgICAgICAgICRiYWRfZmlsZXskZmlsZX0g PSAxOworICAgICAgICAgICAgICAgICAgICAkaW4gPSAnJzsKKyAgICAgICAgICAgICAgICAgICAg JG91dCA9IHVuZGVmOworICAgICAgICAgICAgICAgICAgICBsYXN0IFJFQUQ7CisgICAgICAgICAg ICAgICAgfSBlbHNlIHsKKwkJZGllICJDYW5ub3QgcGFyc2U6XG4kaW5cbiI7CisgICAgICAgICAg ICAgICAgfQorICAgICAgICAgICAgfQorICAgICAgICB9CisKKyAgICAgICAgbGFzdCBSRUFEIGlm ICRvdXQgPX4gL1xTLzsKKyAgICB9CisKKyAgICByZXR1cm4gJG91dDsKK30KKworCiAjIEhhbmRs ZSByZWN1cnNpdmUgc3ViZGlyZWN0b3JpZXMgd2l0aG91dCBnZXR0aW5nIGEgZ3JvdGVzcXVlbHkg YmlnIHN0YWNrLgogIyBDb3VsZCB0aGlzIGJlIGltcGxlbWVudGVkIHVzaW5nIEZpbGU6OkZpbmQ/ CiBzdWIgbmV4dF9maWxlCkBAIC01MTQsOCArNjQ0LDEzIEBAIHN1YiBxdWV1ZV9pbmNsdWRlc19m cm9tCiAgICAgICAgICAgICAgICAgJGxpbmUgLj0gPEhFQURFUj47CiAgICAgICAgICAgICB9CiAK LSAgICAgICAgICAgIGlmICgkbGluZSA9fiAvXiNccyppbmNsdWRlXHMrPCguKj8pPi8pIHsKLSAg ICAgICAgICAgICAgICBwdXNoKEBBUkdWLCAkMSkgdW5sZXNzICRJc19jb252ZXJ0ZWR7JDF9Owor ICAgICAgICAgICAgaWYgKCRsaW5lID1+IC9eI1xzKmluY2x1ZGVccysoWzwiXSkoLio/KVs+Il0v KSB7CisgICAgICAgICAgICAgICAgbXkgKCRkZWxpbWl0ZXIsICRuZXdfZmlsZSkgPSAoJDEsICQy KTsKKyAgICAgICAgICAgICAgICAjIGNvcHkgdGhlIHByZWZpeCBpbiB0aGUgcXVvdGUgc3ludGF4 ICgjaW5jbHVkZSAieC5oIikgY2FzZQorICAgICAgICAgICAgICAgIGlmICgkZGVsaW1pdGVyIGVx IHF7In0gJiYgJGZpbGUgPX4gbXxeKC4qKS98KSB7CisgICAgICAgICAgICAgICAgICAgICRuZXdf ZmlsZSA9ICIkMS8kbmV3X2ZpbGUiOworICAgICAgICAgICAgICAgIH0KKyAgICAgICAgICAgICAg ICBwdXNoKEBBUkdWLCAkbmV3X2ZpbGUpIHVubGVzcyAkSXNfY29udmVydGVkeyRuZXdfZmlsZX07 CiAgICAgICAgICAgICB9CiAgICAgICAgIH0KICAgICBjbG9zZSBIRUFERVI7CkBAIC01NTYsMjUg KzY5MSw1MCBAQCBzdWIgYnVpbGRfcHJlYW1ibGVfaWZfbmVjZXNzYXJ5CiAgICAgbXkgKCVkZWZp bmUpID0gX2V4dHJhY3RfY2NfZGVmaW5lcygpOwogCiAgICAgb3BlbiAgUFJFQU1CTEUsICI+JHBy ZWFtYmxlIiBvciBkaWUgIkNhbm5vdCBvcGVuICRwcmVhbWJsZTogICQhIjsKLSAgICAgICAgcHJp bnQgUFJFQU1CTEUgIiMgVGhpcyBmaWxlIHdhcyBjcmVhdGVkIGJ5IGgycGggdmVyc2lvbiAkVkVS U0lPTlxuIjsKLQotICAgICAgICBmb3JlYWNoIChzb3J0IGtleXMgJWRlZmluZSkgewotICAgICAg ICAgICAgaWYgKCRvcHRfRCkgewotICAgICAgICAgICAgICAgIHByaW50IFBSRUFNQkxFICIjICRf PSRkZWZpbmV7JF99XG4iOwotICAgICAgICAgICAgfQotCi0gICAgICAgICAgICBpZiAoJGRlZmlu ZXskX30gPX4gL15cZCskLykgewotICAgICAgICAgICAgICAgIHByaW50IFBSRUFNQkxFCi0gICAg ICAgICAgICAgICAgICAgICJ1bmxlc3MgKGRlZmluZWQgJiRfKSB7IHN1YiAkXygpIHsgJGRlZmlu ZXskX30gfSB9XG5cbiI7Ci0gICAgICAgICAgICB9IGVsc2lmICgkZGVmaW5leyRffSA9fiAvXlx3 KyQvKSB7Ci0gICAgICAgICAgICAgICAgcHJpbnQgUFJFQU1CTEUKLSAgICAgICAgICAgICAgICAg ICAgInVubGVzcyAoZGVmaW5lZCAmJF8pIHsgc3ViICRfKCkgeyAmJGRlZmluZXskX30gfSB9XG5c biI7Ci0gICAgICAgICAgICB9IGVsc2UgeworCXByaW50IFBSRUFNQkxFICIjIFRoaXMgZmlsZSB3 YXMgY3JlYXRlZCBieSBoMnBoIHZlcnNpb24gJFZFUlNJT05cbiI7CisgICAgICAgICMgUHJldmVu dCBub24tcG9ydGFibGUgaGV4IGNvbnN0YW50cyBmcm9tIHdhcm5pbmcuCisgICAgICAgICMKKyAg ICAgICAgIyBXZSBzdGlsbCBwcm9kdWNlIGFuIG92ZXJmbG93IHdhcm5pbmcgaWYgd2UgY2FuJ3Qg cmVwcmVzZW50CisgICAgICAgICMgYSBoZXggY29uc3RhbnQgYXMgYW4gaW50ZWdlci4KKyAgICAg ICAgcHJpbnQgUFJFQU1CTEUgIm5vIHdhcm5pbmdzIHF3KHBvcnRhYmxlKTtcbiI7CisKKwlmb3Jl YWNoIChzb3J0IGtleXMgJWRlZmluZSkgeworCSAgICBpZiAoJG9wdF9EKSB7CisJCXByaW50IFBS RUFNQkxFICIjICRfPSRkZWZpbmV7JF99XG4iOworCSAgICB9CisJICAgIGlmICgkZGVmaW5leyRf fSA9fiAvXlwoKC4qKVwpJC8pIHsKKwkJIyBwYXJlbnRoZXNpemVkIHZhbHVlOiAgZD0odikKKwkJ JGRlZmluZXskX30gPSAkMTsKKwkgICAgfQorCSAgICBpZiAoJGRlZmluZXskX30gPX4gL14oWyst XT8oXGQrKT9cLlxkKyhbZUVdWystXT9cZCspPylbRkxdPyQvKSB7CisJCSMgZmxvYXQ6CisJCXBy aW50IFBSRUFNQkxFCisJCSAgICAidW5sZXNzIChkZWZpbmVkICYkXykgeyBzdWIgJF8oKSB7ICQx IH0gfVxuXG4iOworCSAgICB9IGVsc2lmICgkZGVmaW5leyRffSA9fiAvXihbKy1dP1xkKylVP0x7 MCwyfSQvaSkgeworCQkjIGludGVnZXI6CisJCXByaW50IFBSRUFNQkxFCisJCSAgICAidW5sZXNz IChkZWZpbmVkICYkXykgeyBzdWIgJF8oKSB7ICQxIH0gfVxuXG4iOworICAgICAgICAgICAgfSBl bHNpZiAoJGRlZmluZXskX30gPX4gL14oWystXT8weFtcZGEtZl0rKVU/THswLDJ9JC9pKSB7Cisg ICAgICAgICAgICAgICAgIyBoZXggaW50ZWdlcgorICAgICAgICAgICAgICAgICMgU3BlY2lhbCBj YXNlZCwgc2luY2UgcGVybCB3YXJucyBvbiBoZXggaW50ZWdlcnMKKyAgICAgICAgICAgICAgICAj IHRoYXQgY2FuJ3QgYmUgcmVwcmVzZW50ZWQgaW4gYSBVVi4KKyAgICAgICAgICAgICAgICAjCisg ICAgICAgICAgICAgICAgIyBUaGlzIHdheSB3ZSBnZXQgdGhlIHdhcm5pbmcgYXQgdGltZSBvZiB1 c2UsIHNvIHRoZSB1c2VyCisgICAgICAgICAgICAgICAgIyBvbmx5IGdldHMgdGhlIHdhcm5pbmcg aWYgdGhleSBoYXBwZW4gdG8gdXNlIHRoaXMKKyAgICAgICAgICAgICAgICAjIHBsYXRmb3JtLXNw ZWNpZmljIGRlZmluaXRpb24uCisgICAgICAgICAgICAgICAgbXkgJGNvZGUgPSAkMTsKKyAgICAg ICAgICAgICAgICAkY29kZSA9ICJoZXgoJyRjb2RlJykiIGlmIGxlbmd0aCAkY29kZSA+IDEwOwog ICAgICAgICAgICAgICAgIHByaW50IFBSRUFNQkxFCi0gICAgICAgICAgICAgICAgICAgICJ1bmxl c3MgKGRlZmluZWQgJiRfKSB7IHN1YiAkXygpIHsgXCIiLAotICAgICAgICAgICAgICAgICAgICBx dW90ZW1ldGEoJGRlZmluZXskX30pLCAiXCIgfSB9XG5cbiI7Ci0gICAgICAgICAgICB9Ci0gICAg ICAgIH0KKyAgICAgICAgICAgICAgICAgICAgInVubGVzcyAoZGVmaW5lZCAmJF8pIHsgc3ViICRf KCkgeyAkY29kZSB9IH1cblxuIjsKKwkgICAgfSBlbHNpZiAoJGRlZmluZXskX30gPX4gL15cdysk LykgeworCQlwcmludCBQUkVBTUJMRQorCQkgICAgInVubGVzcyAoZGVmaW5lZCAmJF8pIHsgc3Vi ICRfKCkgeyAmJGRlZmluZXskX30gfSB9XG5cbiI7CisJICAgIH0gZWxzZSB7CisJCXByaW50IFBS RUFNQkxFCisJCSAgICAidW5sZXNzIChkZWZpbmVkICYkXykgeyBzdWIgJF8oKSB7IFwiIiwKKwkJ ICAgIHF1b3RlbWV0YSgkZGVmaW5leyRffSksICJcIiB9IH1cblxuIjsKKwkgICAgfQorCX0KICAg ICBjbG9zZSBQUkVBTUJMRSAgICAgICAgICAgICAgIG9yIGRpZSAiQ2Fubm90IGNsb3NlICRwcmVh bWJsZTogICQhIjsKIH0KIApAQCAtNTg2LDE1ICs3NDYsMTQgQEAgc3ViIF9leHRyYWN0X2NjX2Rl ZmluZXMKIHsKICAgICBteSAlZGVmaW5lOwogICAgIG15ICRhbGxzeW1ib2xzICA9IGpvaW4gIiAi LAotICAgICAgICBAQ29uZmlneydjY3N5bWJvbHMnLCAnY3Bwc3ltYm9scycsICdjcHBjY3N5bWJv bHMnfTsKKwlAQ29uZmlneydjY3N5bWJvbHMnLCAnY3Bwc3ltYm9scycsICdjcHBjY3N5bWJvbHMn fTsKIAogICAgICMgU3BsaXQgY29tcGlsZXIgcHJlLWRlZmluaXRpb25zIGludG8gYGtleT12YWx1 ZScgcGFpcnM6Ci0gICAgZm9yZWFjaCAoc3BsaXQgL1xzKy8sICRhbGxzeW1ib2xzKSB7Ci0gICAg ICAgIC8oLis/KT0oLispLyBhbmQgJGRlZmluZXskMX0gPSAkMjsKLQotICAgICAgICBpZiAoJG9w dF9EKSB7Ci0gICAgICAgICAgICBwcmludCBTVERFUlIgIiRfOiAgJDEgLT4gJDJcbiI7Ci0gICAg ICAgIH0KKyAgICB3aGlsZSAoJGFsbHN5bWJvbHMgPX4gLyhbXlxzXSspPSgoXFxcc3xbXlxzXSkr KS9nKSB7CisJJGRlZmluZXskMX0gPSAkMjsKKwlpZiAoJG9wdF9EKSB7CisJICAgIHByaW50IFNU REVSUiAiJF86ICAkMSAtPiAkMlxuIjsKKwl9CiAgICAgfQogCiAgICAgcmV0dXJuICVkZWZpbmU7 CkBAIC02MjMsNiArNzgyLDEwIEBAIEl0IGlzIG1vc3QgZWFzaWx5IHJ1biB3aGlsZSBpbiAvdXNy L2luY2x1ZGU6CiAKIAljZCAvdXNyL2luY2x1ZGU7IGgycGggKiBzeXMvKgogCitvcgorCisJY2Qg L3Vzci9pbmNsdWRlOyBoMnBoICogc3lzLyogYXJwYS8qIG5ldGluZXQvKgorCiBvcgogCiAJY2Qg L3Vzci9pbmNsdWRlOyBoMnBoIC1yIC1sIC4KQEAgLTY0MCw3ICs4MDMsNyBAQCBJZiBydW4gd2l0 aCBubyBhcmd1bWVudHMsIGZpbHRlcnMgc3RhbmRhcmQgaW5wdXQgdG8gc3RhbmRhcmQgb3V0cHV0 LgogPWl0ZW0gLWQgZGVzdGluYXRpb25fZGlyCiAKIFB1dCB0aGUgcmVzdWx0aW5nIEI8LnBoPiBm aWxlcyBiZW5lYXRoIEI8ZGVzdGluYXRpb25fZGlyPiwgaW5zdGVhZCBvZgotYmVuZWF0aCB0aGUg ZGVmYXVsdCBQZXJsIGxpYnJhcnkgbG9jYXRpb24gKEM8JENvbmZpZ3snaW5zdGFsbHNpdHNlYXJj aCd9PikuCitiZW5lYXRoIHRoZSBkZWZhdWx0IFBlcmwgbGlicmFyeSBsb2NhdGlvbiAoQzwkQ29u ZmlneydpbnN0YWxsc2l0ZWFyY2gnfT4pLgogCiA9aXRlbSAtcgogCkBAIC03MjUsMTAgKzg4OCwx MCBAQCBpbnN0YWxsYXRpb24uCiBEb2Vzbid0IGhhbmRsZSBjb21wbGljYXRlZCBleHByZXNzaW9u cyBidWlsdCBwaWVjZW1lYWwsIGEgbGE6CiAKICAgICBlbnVtIHsKLSAgICAgICAgRklSU1RfVkFM VUUsCi0gICAgICAgIFNFQ09ORF9WQUxVRSwKKwlGSVJTVF9WQUxVRSwKKwlTRUNPTkRfVkFMVUUs CiAgICAgI2lmZGVmIEFCQwotICAgICAgICBUSElSRF9WQUxVRQorCVRISVJEX1ZBTFVFCiAgICAg I2VuZGlmCiAgICAgfTsKIAo= UH2PH562 } if ( $num < 5.007001 ) { _patch_b64(<<'UH2PH570'); LS0tIHV0aWxzL2gycGguUEwKKysrIHV0aWxzL2gycGguUEwKQEAgLTM2LDEzICszNiwxNiBAQAog CiBwcmludCBPVVQgPDwnIU5PIVNVQlMhJzsKIAordXNlIHN0cmljdDsKKwogdXNlIENvbmZpZzsK IHVzZSBGaWxlOjpQYXRoIHF3KG1rcGF0aCk7CiB1c2UgR2V0b3B0OjpTdGQ7CiAKIGdldG9wdHMo J0RkOnJsaGFRJyk7Cit1c2UgdmFycyBxdygkb3B0X0QgJG9wdF9kICRvcHRfciAkb3B0X2wgJG9w dF9oICRvcHRfYSAkb3B0X1EpOwogZGllICItciBhbmQgLWEgb3B0aW9ucyBhcmUgbXV0dWFsbHkg ZXhjbHVzaXZlXG4iIGlmICgkb3B0X3IgYW5kICRvcHRfYSk7Ci1AaW5jX2RpcnMgPSBpbmNfZGly cygpIGlmICRvcHRfYTsKK215IEBpbmNfZGlycyA9IGluY19kaXJzKCkgaWYgJG9wdF9hOwogCiBt eSAkRXhpdCA9IDA7CiAKQEAgLTUwLDcgKzUzLDcgQEAKIGRpZSAiRGVzdGluYXRpb24gZGlyZWN0 b3J5ICREZXN0X2RpciBkb2Vzbid0IGV4aXN0IG9yIGlzbid0IGEgZGlyZWN0b3J5XG4iCiAgICAg dW5sZXNzIC1kICREZXN0X2RpcjsKIAotQGlzYXR5cGUgPSBzcGxpdCgnICcsPDxFTkQpOworbXkg QGlzYXR5cGUgPSBzcGxpdCgnICcsPDxFTkQpOwogCWNoYXIJdWNoYXIJdV9jaGFyCiAJc2hvcnQJ dXNob3J0CXVfc2hvcnQKIAlpbnQJdWludAl1X2ludApAQCAtNTgsMTQgKzYxLDE4IEBACiAJRklM RQlrZXlfdAljYWRkcl90CiBFTkQKIAorbXkgJWlzYXR5cGU7CiBAaXNhdHlwZXtAaXNhdHlwZX0g PSAoMSkgeCBAaXNhdHlwZTsKLSRpbmlmID0gMDsKK215ICRpbmlmID0gMDsKK215ICVJc19jb252 ZXJ0ZWQ7CiAKIEBBUkdWID0gKCctJykgdW5sZXNzIEBBUkdWOwogCiBidWlsZF9wcmVhbWJsZV9p Zl9uZWNlc3NhcnkoKTsKIAotd2hpbGUgKGRlZmluZWQgKCRmaWxlID0gbmV4dF9maWxlKCkpKSB7 CitteSAoJHQsICR0YWIsICVjdXJhcmdzLCAkbmV3LCAkZXZhbF9pbmRleCwgJGRpciwgJG5hbWUs ICRhcmdzLCAkb3V0ZmlsZSk7CitteSAoJGluY2wsICRuZXh0KTsKK3doaWxlIChkZWZpbmVkICht eSAkZmlsZSA9IG5leHRfZmlsZSgpKSkgewogICAgIGlmICgtbCAkZmlsZSBhbmQgLWQgJGZpbGUp IHsKICAgICAgICAgbGlua19pZl9wb3NzaWJsZSgkZmlsZSkgaWYgKCRvcHRfbCk7CiAgICAgICAg IG5leHQ7CkBAIC0xMDEsMjQgKzEwOCw3IEBACiAgICAgfQogCiAgICAgcHJpbnQgT1VUICJyZXF1 aXJlICdfaDJwaF9wcmUucGgnO1xuXG4iOwotICAgIHdoaWxlICg8SU4+KSB7Ci0JY2hvcDsKLQl3 aGlsZSAoL1xcJC8pIHsKLQkgICAgY2hvcDsKLQkgICAgJF8gLj0gPElOPjsKLQkgICAgY2hvcDsK LQl9Ci0JcHJpbnQgT1VUICIjICRfXG4iIGlmICRvcHRfRDsKLQotCWlmIChzOi9cKjpcMjAwOmcp IHsKLQkgICAgczpcKi86XDIwMTpnOwotCSAgICBzL1wyMDBbXlwyMDFdKlwyMDEvL2c7CSMgZGVs ZXRlIHNpbmdsZSBsaW5lIGNvbW1lbnRzCi0JICAgIGlmIChzL1wyMDAuKi8vKSB7CQkjIGJlZ2lu IG11bHRpLWxpbmUgY29tbWVudD8KLQkJJF8gLj0gJy8qJzsKLQkJJF8gLj0gPElOPjsKLQkJcmVk bzsKLQkgICAgfQotCX0KKyAgICB3aGlsZSAoZGVmaW5lZCAobG9jYWwgJF8gPSBuZXh0X2xpbmUo KSkpIHsKIAlpZiAocy9eXHMqXCNccyovLykgewogCSAgICBpZiAocy9eZGVmaW5lXHMrKFx3Kykv LykgewogCQkkbmFtZSA9ICQxOwpAQCAtMTI5LDcgKzExOSw3IEBACiAgICAgCSAgICAJICAgIG15 ICRwcm90byA9ICcoKSAnOwogCQkgICAgaWYgKCRhcmdzIG5lICcnKSB7CiAgICAgCSAgICAJICAg IAkkcHJvdG8gPSAnJzsKLQkJCWZvcmVhY2ggJGFyZyAoc3BsaXQoLyxccyovLCRhcmdzKSkgewor CQkJZm9yZWFjaCBteSAkYXJnIChzcGxpdCgvLFxzKi8sJGFyZ3MpKSB7CiAJCQkgICAgJGFyZyA9 fiBzL15ccyooW15cc10uKlteXHNdKVxzKiQvJDEvOwogCQkJICAgICRjdXJhcmdzeyRhcmd9ID0g MTsKIAkJCX0KQEAgLTI0OCwyMCArMjM4LDI0IEBACiAJICAgIH0gZWxzaWYoL15pZGVudFxzKygu KikvKSB7CiAJCXByaW50IE9VVCAkdCwgIiMgJDFcbiI7CiAJICAgIH0KLSAJfSBlbHNpZigvXlxz Kih0eXBlZGVmXHMqKT9lbnVtXHMqKFxzK1thLXpBLVpfXVx3KlxzKik/XHsvKSB7Ci0JICAgIHVu dGlsKC9cfS4qPzsvKSB7Ci0JCWNob21wKCRuZXh0ID0gPElOPik7CisJfSBlbHNpZigvXlxzKih0 eXBlZGVmXHMqKT9lbnVtXHMqKFxzK1thLXpBLVpfXVx3KlxzKik/LykgeworCSAgICB1bnRpbCgv XHtbXn1dKlx9Lio7LyB8fCAvOy8pIHsKKwkJbGFzdCB1bmxlc3MgZGVmaW5lZCAoJG5leHQgPSBu ZXh0X2xpbmUoKSk7CisJCWNob21wICRuZXh0OworCQkjIGRyb3AgIiNkZWZpbmUgRk9PIEZPTyIg aW4gZW51bXMKKwkJJG5leHQgPX4gcy9eXHMqI1xzKmRlZmluZVxzKyhcdyspXHMrXDFccyokLy87 CiAJCSRfIC49ICRuZXh0OwogCQlwcmludCBPVVQgIiMgJG5leHRcbiIgaWYgJG9wdF9EOwogCSAg ICB9CisJICAgIHMvI1xzKmlmLio/I1xzKmVuZGlmLy9nOyAjIGRyb3AgI2lmZGVmcwogCSAgICBz QC9cKi4qP1wqL0BAZzsKIAkgICAgcy9ccysvIC9nOwotCSAgICAvXlxzPyh0eXBlZGVmXHM/KT9l bnVtXHM/KFthLXpBLVpfXVx3Kik/XHM/XHsoLiopXH1ccz8oW2EtekEtWl9dXHcqKT9ccz87LzsK LQkgICAgKCRlbnVtX3N1YnMgPSAkMykgPX4gcy9ccy8vZzsKLQkgICAgQGVudW1fc3VicyA9IHNw bGl0KC8sLywgJGVudW1fc3Vicyk7Ci0JICAgICRlbnVtX3ZhbCA9IC0xOwotCSAgICBmb3IgJGVu dW0gKEBlbnVtX3N1YnMpIHsKLQkJKCRlbnVtX25hbWUsICRlbnVtX3ZhbHVlKSA9ICRlbnVtID1+ IC9eKFthLXpBLVpfXVx3KikoPS4rKT8kLzsKKwkgICAgbmV4dCB1bmxlc3MgL15ccz8odHlwZWRl ZlxzPyk/ZW51bVxzPyhbYS16QS1aX11cdyopP1xzP1x7KC4qKVx9XHM/KFthLXpBLVpfXVx3Kik/ XHM/Oy87CisJICAgIChteSAkZW51bV9zdWJzID0gJDMpID1+IHMvXHMvL2c7CisJICAgIG15IEBl bnVtX3N1YnMgPSBzcGxpdCgvLC8sICRlbnVtX3N1YnMpOworCSAgICBteSAkZW51bV92YWwgPSAt MTsKKwkgICAgZm9yZWFjaCBteSAkZW51bSAoQGVudW1fc3VicykgeworCQlteSAoJGVudW1fbmFt ZSwgJGVudW1fdmFsdWUpID0gJGVudW0gPX4gL14oW2EtekEtWl9dXHcqKSg9LispPyQvOwogCQkk ZW51bV92YWx1ZSA9fiBzL149Ly87CiAJCSRlbnVtX3ZhbCA9IChsZW5ndGgoJGVudW1fdmFsdWUp ID8gJGVudW1fdmFsdWUgOiAkZW51bV92YWwgKyAxKTsKIAkJaWYgKCRvcHRfaCkgewpAQCAtMjgw LDEyICsyNzQsMTMgQEAKICAgICB9CiAgICAgcHJpbnQgT1VUICIxO1xuIjsKIAotICAgICRpc19j b252ZXJ0ZWR7JGZpbGV9ID0gMTsKKyAgICAkSXNfY29udmVydGVkeyRmaWxlfSA9IDE7CiAgICAg cXVldWVfaW5jbHVkZXNfZnJvbSgkZmlsZSkgaWYgKCRvcHRfYSk7CiB9CiAKIGV4aXQgJEV4aXQ7 CiAKKwogc3ViIHJlaW5kZW50KCQpIHsKICAgICBteSgkdGV4dCkgPSBzaGlmdDsKICAgICAkdGV4 dCA9fiBzL1xuL1xuICAgIC9nOwpAQCAtMjkzLDkgKzI4OCwxMSBAQAogICAgICR0ZXh0OwogfQog CisKIHN1YiBleHByIHsKKyAgICBteSAkam9pbmVkX2FyZ3M7CiAgICAgaWYoa2V5cyglY3VyYXJn cykpIHsKLQlteSgkam9pbmVkX2FyZ3MpID0gam9pbignfCcsIGtleXMoJWN1cmFyZ3MpKTsKKwkk am9pbmVkX2FyZ3MgPSBqb2luKCd8Jywga2V5cyglY3VyYXJncykpOwogICAgIH0KICAgICB3aGls ZSAoJF8gbmUgJycpIHsKIAlzL15cJlwmLy8gJiYgZG8geyAkbmV3IC49ICIgJiYiOyBuZXh0O307 ICMgaGFuZGxlICYmIG9wZXJhdG9yCkBAIC0zNDEsMTMgKzMzOCwxMyBAQAogCSMgRWxpbWluYXRl IHR5cGVkZWZzCiAJL1woKFtcd1xzXSspW1wqXHNdKlwpXHMqW1x3XChdLyAmJiBkbyB7CiAJICAg IGZvcmVhY2ggKHNwbGl0IC9ccysvLCAkMSkgeyAgIyBNYWtlIHN1cmUgYWxsIHRoZSB3b3JkcyBh cmUgdHlwZXMsCi0JCWxhc3QgdW5sZXNzICgkaXNhdHlwZXskX30gb3IgJF8gZXEgJ3N0cnVjdCcp OworCQlsYXN0IHVubGVzcyAoJGlzYXR5cGV7JF99IG9yICRfIGVxICdzdHJ1Y3QnIG9yICRfIGVx ICd1bmlvbicpOwogCSAgICB9CiAJICAgIHMvXChbXHdcc10rW1wqXHNdKlwpLy8gJiYgbmV4dDsg ICAgICAjIHRoZW4gZWxpbWluYXRlIHRoZW0uCiAJfTsKIAkjIHN0cnVjdC91bmlvbiBtZW1iZXIs IGluY2x1ZGluZyBhcnJheXM6CiAJcy9eKFtfQS1aXVx3KihcW1teXF1dK1xdKT8oKFwufC0+KVtf QS1aXVx3KihcW1teXF1dK1xdKT8pKykvL2kgJiYgZG8gewotCSAgICAkaWQgPSAkMTsKKwkgICAg bXkgJGlkID0gJDE7CiAJICAgICRpZCA9fiBzLyhcLnwoLT4pKShbXlwuXC1dKikvLT5ceyQzXH0v ZzsKIAkgICAgJGlkID1+IHMvXGIoW15cJF0pKCRqb2luZWRfYXJncykvJDFcJCQyL2cgaWYgbGVu Z3RoKCRqb2luZWRfYXJncyk7CiAJICAgIHdoaWxlKCRpZCA9fiAvXFtccyooW15cJFwmXGRcXV0r KVxdLykgewpAQCAtMzYzLDggKzM2MCw4IEBACiAJICAgICRuZXcgLj0gIiAoXCQkaWQpIjsKIAl9 OwogCXMvXihbX2EtekEtWl1cdyopLy8JJiYgZG8gewotCSAgICAkaWQgPSAkMTsKLQkgICAgaWYg KCRpZCBlcSAnc3RydWN0JykgeworCSAgICBteSAkaWQgPSAkMTsKKwkgICAgaWYgKCRpZCBlcSAn c3RydWN0JyB8fCAkaWQgZXEgJ3VuaW9uJykgewogCQlzL15ccysoXHcrKS8vOwogCQkkaWQgLj0g JyAnIC4gJDE7CiAJCSRpc2F0eXBleyRpZH0gPSAxOwpAQCAtMzc3LDggKzM3NCw4IEBACiAJCSRu ZXcgLj0gJy0+JyBpZiAvXltcW1x7XS87CiAJICAgIH0gZWxzaWYgKCRpZCBlcSAnZGVmaW5lZCcp IHsKIAkJJG5ldyAuPSAnZGVmaW5lZCc7Ci0JICAgIH0gZWxzaWYgKC9eXCgvKSB7Ci0JCXMvXlwo KFx3KSwvKCIkMSIsLyBpZiAkaWQgPX4gL15fSU9bV1JdKiQvaTsJIyBjaGVhdAorCSAgICB9IGVs c2lmICgvXlxzKlwoLykgeworCQlzL15ccypcKChcdyksLygiJDEiLC8gaWYgJGlkID1+IC9eX0lP W1dSXSokL2k7CSMgY2hlYXQKIAkJJG5ldyAuPSAiICYkaWQiOwogCSAgICB9IGVsc2lmICgkaXNh dHlwZXskaWR9KSB7CiAJCWlmICgkbmV3ID1+IC97XHMqJC8pIHsKQEAgLTQwNSw2ICs0MDIsNjYg QEAKIH0KIAogCitzdWIgbmV4dF9saW5lCit7CisgICAgbXkgKCRpbiwgJG91dCk7CisgICAgbXkg JHByZV9zdWJfdHJpX2dyYXBocyA9IDE7CisKKyAgICBSRUFEOiB3aGlsZSAobm90IGVvZiBJTikg eworICAgICAgICAkaW4gIC49IDxJTj47CisgICAgICAgIGNob21wICRpbjsKKyAgICAgICAgbmV4 dCB1bmxlc3MgbGVuZ3RoICRpbjsKKworICAgICAgICB3aGlsZSAobGVuZ3RoICRpbikgeworICAg ICAgICAgICAgaWYgKCRwcmVfc3ViX3RyaV9ncmFwaHMpIHsKKyAgICAgICAgICAgICAgICAjIFBy ZXByb2Nlc3MgYWxsIHRyaS1ncmFwaHMgCisgICAgICAgICAgICAgICAgIyBpbmNsdWRpbmcgdGhp bmdzIHN0dWNrIGluIHF1b3RlZCBzdHJpbmcgY29uc3RhbnRzLgorICAgICAgICAgICAgICAgICRp biA9fiBzL1w/XD89LyMvZzsgICAgICAgICAgICAgICAgICAgICAgICAgIyB8ID8/PXwgICN8Cisg ICAgICAgICAgICAgICAgJGluID1+IHMvXD9cP1whL3wvZzsgICAgICAgICAgICAgICAgICAgICAg ICAjIHwgPz8hfCAgfHwKKyAgICAgICAgICAgICAgICAkaW4gPX4gcy9cP1w/Jy9eL2c7ICAgICAg ICAgICAgICAgICAgICAgICAgICMgfCA/Pyd8ICBefAorICAgICAgICAgICAgICAgICRpbiA9fiBz L1w/XD9cKC9bL2c7ICAgICAgICAgICAgICAgICAgICAgICAgIyB8ID8/KHwgIFt8CisgICAgICAg ICAgICAgICAgJGluID1+IHMvXD9cP1wpL10vZzsgICAgICAgICAgICAgICAgICAgICAgICAjIHwg Pz8pfCAgXXwKKyAgICAgICAgICAgICAgICAkaW4gPX4gcy9cP1w/XC0vfi9nOyAgICAgICAgICAg ICAgICAgICAgICAgICMgfCA/Py18ICB+fAorICAgICAgICAgICAgICAgICRpbiA9fiBzL1w/XD9c Ly9cXC9nOyAgICAgICAgICAgICAgICAgICAgICAgIyB8ID8/L3wgIFx8CisgICAgICAgICAgICAg ICAgJGluID1+IHMvXD9cPzwvey9nOyAgICAgICAgICAgICAgICAgICAgICAgICAjIHwgPz88fCAg e3wKKyAgICAgICAgICAgICAgICAkaW4gPX4gcy9cP1w/Pi99L2c7ICAgICAgICAgICAgICAgICAg ICAgICAgICMgfCA/Pz58ICB9fAorICAgICAgICAgICAgfQorICAgICAgICAgICAgaWYgKCRpbiA9 fiBzL1xcJC8vKSB7ICAgICAgICAgICAgICAgICAgICAgICAgICAgIyBcLW5ld2xpbmUKKyAgICAg ICAgICAgICAgICAkb3V0ICAgIC49ICcgJzsKKyAgICAgICAgICAgICAgICBuZXh0IFJFQUQ7Cisg ICAgICAgICAgICB9IGVsc2lmICgkaW4gPX4gcy9eKFteIidcXFwvXSspLy8pIHsgICAgICAgICAg ICAjIFBhc3N0aHJvdWdoCisgICAgICAgICAgICAgICAgJG91dCAgICAuPSAkMTsKKyAgICAgICAg ICAgIH0gZWxzaWYgKCRpbiA9fiBzL14oXFwuKS8vKSB7ICAgICAgICAgICAgICAgICAgICMgXC4u LgorICAgICAgICAgICAgICAgICRvdXQgICAgLj0gJDE7CisgICAgICAgICAgICB9IGVsc2lmICgk aW4gPX4gcy9eKCcoXFwufFteJ1xcXSkqJykvLykgeyAgICAgICAjICcuLi4KKyAgICAgICAgICAg ICAgICAkb3V0ICAgIC49ICQxOworICAgICAgICAgICAgfSBlbHNpZiAoJGluID1+IHMvXigiKFxc LnxbXiJcXF0pKiIpLy8pIHsgICAgICAgIyAiLi4uCisgICAgICAgICAgICAgICAgJG91dCAgICAu PSAkMTsKKyAgICAgICAgICAgIH0gZWxzaWYgKCRpbiA9fiBzL15cL1wvLiovLykgeyAgICAgICAg ICAgICAgICAgICMgLy8uLi4KKyAgICAgICAgICAgICAgICAjIGZhbGwgdGhyb3VnaAorICAgICAg ICAgICAgfSBlbHNpZiAoJGluID1+IG0vXlwvXCovKSB7ICAgICAgICAgICAgICAgICAgICAgIyAv Ki4uLgorICAgICAgICAgICAgICAgICMgQyBjb21tZW50IHJlbW92YWwgYWRhcHRlZCBmcm9tIHBl cmxmYXE2OgorICAgICAgICAgICAgICAgIGlmICgkaW4gPX4gcy9eXC9cKlteKl0qXCorKFteXC8q XVteKl0qXCorKSpcLy8vKSB7CisgICAgICAgICAgICAgICAgICAgICRvdXQgICAgLj0gJyAnOwor ICAgICAgICAgICAgICAgIH0gZWxzZSB7ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg ICAgIyBJbmNvbXBsZXRlIC8qICovCisgICAgICAgICAgICAgICAgICAgIG5leHQgUkVBRDsKKyAg ICAgICAgICAgICAgICB9CisgICAgICAgICAgICB9IGVsc2lmICgkaW4gPX4gcy9eKFwvKS8vKSB7 ICAgICAgICAgICAgICAgICAgICAjIC8uLi4KKyAgICAgICAgICAgICAgICAkb3V0ICAgIC49ICQx OworICAgICAgICAgICAgfSBlbHNpZiAoJGluID1+IHMvXihbXlwnXCJcXFwvXSspLy8pIHsKKyAg ICAgICAgICAgICAgICAkb3V0ICAgIC49ICQxOworICAgICAgICAgICAgfSBlbHNlIHsKKyAgICAg ICAgICAgICAgICBkaWUgIkNhbm5vdCBwYXJzZTpcbiRpblxuIjsKKyAgICAgICAgICAgIH0KKyAg ICAgICAgfQorCisgICAgICAgIGxhc3QgUkVBRCBpZiAkb3V0ID1+IC9cUy87CisgICAgfQorCisg ICAgcmV0dXJuICRvdXQ7Cit9CisKKwogIyBIYW5kbGUgcmVjdXJzaXZlIHN1YmRpcmVjdG9yaWVz IHdpdGhvdXQgZ2V0dGluZyBhIGdyb3Rlc3F1ZWx5IGJpZyBzdGFjay4KICMgQ291bGQgdGhpcyBi ZSBpbXBsZW1lbnRlZCB1c2luZyBGaWxlOjpGaW5kPwogc3ViIG5leHRfZmlsZQpAQCAtNTA1LDcg KzU2Miw3IEBACiAgICAgICAgICAgICB9CiAKICAgICAgICAgICAgIGlmICgkbGluZSA9fiAvXiNc cyppbmNsdWRlXHMrPCguKj8pPi8pIHsKLSAgICAgICAgICAgICAgICBwdXNoKEBBUkdWLCAkMSkg dW5sZXNzICRpc19jb252ZXJ0ZWR7JDF9OworICAgICAgICAgICAgICAgIHB1c2goQEFSR1YsICQx KSB1bmxlc3MgJElzX2NvbnZlcnRlZHskMX07CiAgICAgICAgICAgICB9CiAgICAgICAgIH0KICAg ICBjbG9zZSBIRUFERVI7CkBAIC01NTMsOSArNjEwLDkgQEAKICAgICAgICAgICAgICAgICBwcmlu dCBQUkVBTUJMRSAiIyAkXz0kZGVmaW5leyRffVxuIjsKICAgICAgICAgICAgIH0KIAotICAgICAg ICAgICAgaWYgKCRkZWZpbmV7JF99ID1+IC9eXGQrJC8pIHsKKyAgICAgICAgICAgIGlmICgkZGVm aW5leyRffSA9fiAvXihcZCspVT9MezAsMn0kL2kpIHsKICAgICAgICAgICAgICAgICBwcmludCBQ UkVBTUJMRQotICAgICAgICAgICAgICAgICAgICAidW5sZXNzIChkZWZpbmVkICYkXykgeyBzdWIg JF8oKSB7ICRkZWZpbmV7JF99IH0gfVxuXG4iOworICAgICAgICAgICAgICAgICAgICAidW5sZXNz IChkZWZpbmVkICYkXykgeyBzdWIgJF8oKSB7ICQxIH0gfVxuXG4iOwogICAgICAgICAgICAgfSBl bHNpZiAoJGRlZmluZXskX30gPX4gL15cdyskLykgewogICAgICAgICAgICAgICAgIHByaW50IFBS RUFNQkxFCiAgICAgICAgICAgICAgICAgICAgICJ1bmxlc3MgKGRlZmluZWQgJiRfKSB7IHN1YiAk XygpIHsgJiRkZWZpbmV7JF99IH0gfVxuXG4iOwpAQCAtNTc1LDcgKzYzMiw4IEBACiBzdWIgX2V4 dHJhY3RfY2NfZGVmaW5lcwogewogICAgIG15ICVkZWZpbmU7Ci0gICAgbXkgJGFsbHN5bWJvbHMg PSBqb2luICIgIiwgQENvbmZpZ3tjY3N5bWJvbHMsIGNwcHN5bWJvbHMsIGNwcGNjc3ltYm9sc307 CisgICAgbXkgJGFsbHN5bWJvbHMgID0gam9pbiAiICIsCisgICAgICAgIEBDb25maWd7J2Njc3lt Ym9scycsICdjcHBzeW1ib2xzJywgJ2NwcGNjc3ltYm9scyd9OwogCiAgICAgIyBTcGxpdCBjb21w aWxlciBwcmUtZGVmaW5pdGlvbnMgaW50byBga2V5PXZhbHVlJyBwYWlyczoKICAgICBmb3JlYWNo IChzcGxpdCAvXHMrLywgJGFsbHN5bWJvbHMpIHsKQEAgLTcwOCw4ICs3NjYsNiBAQAogSXQncyBv bmx5IGludGVuZGVkIGFzIGEgcm91Z2ggdG9vbC4KIFlvdSBtYXkgbmVlZCB0byBkaWNrZXIgd2l0 aCB0aGUgZmlsZXMgcHJvZHVjZWQuCiAKLURvZXNuJ3QgcnVuIHdpdGggQzx1c2Ugc3RyaWN0Pgot CiBZb3UgaGF2ZSB0byBydW4gdGhpcyBwcm9ncmFtIGJ5IGhhbmQ7IGl0J3Mgbm90IHJ1biBhcyBw YXJ0IG9mIHRoZSBQZXJsCiBpbnN0YWxsYXRpb24uCiAK UH2PH570 } elsif ( $num < 5.007002 ) { _patch_b64(<<'UH2PH571'); LS0tIHV0aWxzL2gycGguUEwKKysrIHV0aWxzL2gycGguUEwKQEAgLTEwOCwyNCArMTA4LDcgQEAK ICAgICB9CiAKICAgICBwcmludCBPVVQgInJlcXVpcmUgJ19oMnBoX3ByZS5waCc7XG5cbiI7Ci0g ICAgd2hpbGUgKDxJTj4pIHsKLQljaG9wOwotCXdoaWxlICgvXFwkLykgewotCSAgICBjaG9wOwot CSAgICAkXyAuPSA8SU4+OwotCSAgICBjaG9wOwotCX0KLQlwcmludCBPVVQgIiMgJF9cbiIgaWYg JG9wdF9EOwotCi0JaWYgKHM6L1wqOlwyMDA6ZykgewotCSAgICBzOlwqLzpcMjAxOmc7Ci0JICAg IHMvXDIwMFteXDIwMV0qXDIwMS8vZzsJIyBkZWxldGUgc2luZ2xlIGxpbmUgY29tbWVudHMKLQkg ICAgaWYgKHMvXDIwMC4qLy8pIHsJCSMgYmVnaW4gbXVsdGktbGluZSBjb21tZW50PwotCQkkXyAu PSAnLyonOwotCQkkXyAuPSA8SU4+OwotCQlyZWRvOwotCSAgICB9Ci0JfQorICAgIHdoaWxlIChk ZWZpbmVkIChsb2NhbCAkXyA9IG5leHRfbGluZSgpKSkgewogCWlmIChzL15ccypcI1xzKi8vKSB7 CiAJICAgIGlmIChzL15kZWZpbmVccysoXHcrKS8vKSB7CiAJCSRuYW1lID0gJDE7CkBAIC0yNTUs MTUgKzIzOCwxOSBAQAogCSAgICB9IGVsc2lmKC9eaWRlbnRccysoLiopLykgewogCQlwcmludCBP VVQgJHQsICIjICQxXG4iOwogCSAgICB9Ci0gCX0gZWxzaWYoL15ccyoodHlwZWRlZlxzKik/ZW51 bVxzKihccytbYS16QS1aX11cdypccyopP1x7LykgewotCSAgICB1bnRpbCgvXH0uKj87Lykgewot CQljaG9tcCgkbmV4dCA9IDxJTj4pOworCX0gZWxzaWYoL15ccyoodHlwZWRlZlxzKik/ZW51bVxz KihccytbYS16QS1aX11cdypccyopPy8pIHsKKwkgICAgdW50aWwoL1x7W159XSpcfS4qOy8gfHwg LzsvKSB7CisJCWxhc3QgdW5sZXNzIGRlZmluZWQgKCRuZXh0ID0gbmV4dF9saW5lKCkpOworCQlj aG9tcCAkbmV4dDsKKwkJIyBkcm9wICIjZGVmaW5lIEZPTyBGT08iIGluIGVudW1zCisJCSRuZXh0 ID1+IHMvXlxzKiNccypkZWZpbmVccysoXHcrKVxzK1wxXHMqJC8vOwogCQkkXyAuPSAkbmV4dDsK IAkJcHJpbnQgT1VUICIjICRuZXh0XG4iIGlmICRvcHRfRDsKIAkgICAgfQorCSAgICBzLyNccypp Zi4qPyNccyplbmRpZi8vZzsgIyBkcm9wICNpZmRlZnMKIAkgICAgc0AvXCouKj9cKi9AQGc7CiAJ ICAgIHMvXHMrLyAvZzsKLQkgICAgL15ccz8odHlwZWRlZlxzPyk/ZW51bVxzPyhbYS16QS1aX11c dyopP1xzP1x7KC4qKVx9XHM/KFthLXpBLVpfXVx3Kik/XHM/Oy87CisJICAgIG5leHQgdW5sZXNz IC9eXHM/KHR5cGVkZWZccz8pP2VudW1ccz8oW2EtekEtWl9dXHcqKT9ccz9ceyguKilcfVxzPyhb YS16QS1aX11cdyopP1xzPzsvOwogCSAgICAobXkgJGVudW1fc3VicyA9ICQzKSA9fiBzL1xzLy9n OwogCSAgICBteSBAZW51bV9zdWJzID0gc3BsaXQoLywvLCAkZW51bV9zdWJzKTsKIAkgICAgbXkg JGVudW1fdmFsID0gLTE7CkBAIC0zNTEsNyArMzM4LDcgQEAKIAkjIEVsaW1pbmF0ZSB0eXBlZGVm cwogCS9cKChbXHdcc10rKVtcKlxzXSpcKVxzKltcd1woXS8gJiYgZG8gewogCSAgICBmb3JlYWNo IChzcGxpdCAvXHMrLywgJDEpIHsgICMgTWFrZSBzdXJlIGFsbCB0aGUgd29yZHMgYXJlIHR5cGVz LAotCQlsYXN0IHVubGVzcyAoJGlzYXR5cGV7JF99IG9yICRfIGVxICdzdHJ1Y3QnKTsKKwkJbGFz dCB1bmxlc3MgKCRpc2F0eXBleyRffSBvciAkXyBlcSAnc3RydWN0JyBvciAkXyBlcSAndW5pb24n KTsKIAkgICAgfQogCSAgICBzL1woW1x3XHNdK1tcKlxzXSpcKS8vICYmIG5leHQ7ICAgICAgIyB0 aGVuIGVsaW1pbmF0ZSB0aGVtLgogCX07CkBAIC0zNzQsNyArMzYxLDcgQEAKIAl9OwogCXMvXihb X2EtekEtWl1cdyopLy8JJiYgZG8gewogCSAgICBteSAkaWQgPSAkMTsKLQkgICAgaWYgKCRpZCBl cSAnc3RydWN0JykgeworCSAgICBpZiAoJGlkIGVxICdzdHJ1Y3QnIHx8ICRpZCBlcSAndW5pb24n KSB7CiAJCXMvXlxzKyhcdyspLy87CiAJCSRpZCAuPSAnICcgLiAkMTsKIAkJJGlzYXR5cGV7JGlk fSA9IDE7CkBAIC0zODcsOCArMzc0LDggQEAKIAkJJG5ldyAuPSAnLT4nIGlmIC9eW1xbXHtdLzsK IAkgICAgfSBlbHNpZiAoJGlkIGVxICdkZWZpbmVkJykgewogCQkkbmV3IC49ICdkZWZpbmVkJzsK LQkgICAgfSBlbHNpZiAoL15cKC8pIHsKLQkJcy9eXCgoXHcpLC8oIiQxIiwvIGlmICRpZCA9fiAv Xl9JT1tXUl0qJC9pOwkjIGNoZWF0CisJICAgIH0gZWxzaWYgKC9eXHMqXCgvKSB7CisJCXMvXlxz KlwoKFx3KSwvKCIkMSIsLyBpZiAkaWQgPX4gL15fSU9bV1JdKiQvaTsJIyBjaGVhdAogCQkkbmV3 IC49ICIgJiRpZCI7CiAJICAgIH0gZWxzaWYgKCRpc2F0eXBleyRpZH0pIHsKIAkJaWYgKCRuZXcg PX4gL3tccyokLykgewpAQCAtNDE1LDYgKzQwMiw2NiBAQAogfQogCiAKK3N1YiBuZXh0X2xpbmUK K3sKKyAgICBteSAoJGluLCAkb3V0KTsKKyAgICBteSAkcHJlX3N1Yl90cmlfZ3JhcGhzID0gMTsK KworICAgIFJFQUQ6IHdoaWxlIChub3QgZW9mIElOKSB7CisgICAgICAgICRpbiAgLj0gPElOPjsK KyAgICAgICAgY2hvbXAgJGluOworICAgICAgICBuZXh0IHVubGVzcyBsZW5ndGggJGluOworCisg ICAgICAgIHdoaWxlIChsZW5ndGggJGluKSB7CisgICAgICAgICAgICBpZiAoJHByZV9zdWJfdHJp X2dyYXBocykgeworICAgICAgICAgICAgICAgICMgUHJlcHJvY2VzcyBhbGwgdHJpLWdyYXBocyAK KyAgICAgICAgICAgICAgICAjIGluY2x1ZGluZyB0aGluZ3Mgc3R1Y2sgaW4gcXVvdGVkIHN0cmlu ZyBjb25zdGFudHMuCisgICAgICAgICAgICAgICAgJGluID1+IHMvXD9cPz0vIy9nOyAgICAgICAg ICAgICAgICAgICAgICAgICAjIHwgPz89fCAgI3wKKyAgICAgICAgICAgICAgICAkaW4gPX4gcy9c P1w/XCEvfC9nOyAgICAgICAgICAgICAgICAgICAgICAgICMgfCA/PyF8ICB8fAorICAgICAgICAg ICAgICAgICRpbiA9fiBzL1w/XD8nL14vZzsgICAgICAgICAgICAgICAgICAgICAgICAgIyB8ID8/ J3wgIF58CisgICAgICAgICAgICAgICAgJGluID1+IHMvXD9cP1woL1svZzsgICAgICAgICAgICAg ICAgICAgICAgICAjIHwgPz8ofCAgW3wKKyAgICAgICAgICAgICAgICAkaW4gPX4gcy9cP1w/XCkv XS9nOyAgICAgICAgICAgICAgICAgICAgICAgICMgfCA/Pyl8ICBdfAorICAgICAgICAgICAgICAg ICRpbiA9fiBzL1w/XD9cLS9+L2c7ICAgICAgICAgICAgICAgICAgICAgICAgIyB8ID8/LXwgIH58 CisgICAgICAgICAgICAgICAgJGluID1+IHMvXD9cP1wvL1xcL2c7ICAgICAgICAgICAgICAgICAg ICAgICAjIHwgPz8vfCAgXHwKKyAgICAgICAgICAgICAgICAkaW4gPX4gcy9cP1w/PC97L2c7ICAg ICAgICAgICAgICAgICAgICAgICAgICMgfCA/Pzx8ICB7fAorICAgICAgICAgICAgICAgICRpbiA9 fiBzL1w/XD8+L30vZzsgICAgICAgICAgICAgICAgICAgICAgICAgIyB8ID8/PnwgIH18CisgICAg ICAgICAgICB9CisgICAgICAgICAgICBpZiAoJGluID1+IHMvXFwkLy8pIHsgICAgICAgICAgICAg ICAgICAgICAgICAgICAjIFwtbmV3bGluZQorICAgICAgICAgICAgICAgICRvdXQgICAgLj0gJyAn OworICAgICAgICAgICAgICAgIG5leHQgUkVBRDsKKyAgICAgICAgICAgIH0gZWxzaWYgKCRpbiA9 fiBzL14oW14iJ1xcXC9dKykvLykgeyAgICAgICAgICAgICMgUGFzc3Rocm91Z2gKKyAgICAgICAg ICAgICAgICAkb3V0ICAgIC49ICQxOworICAgICAgICAgICAgfSBlbHNpZiAoJGluID1+IHMvXihc XC4pLy8pIHsgICAgICAgICAgICAgICAgICAgIyBcLi4uCisgICAgICAgICAgICAgICAgJG91dCAg ICAuPSAkMTsKKyAgICAgICAgICAgIH0gZWxzaWYgKCRpbiA9fiBzL14oJyhcXC58W14nXFxdKSon KS8vKSB7ICAgICAgICMgJy4uLgorICAgICAgICAgICAgICAgICRvdXQgICAgLj0gJDE7CisgICAg ICAgICAgICB9IGVsc2lmICgkaW4gPX4gcy9eKCIoXFwufFteIlxcXSkqIikvLykgeyAgICAgICAj ICIuLi4KKyAgICAgICAgICAgICAgICAkb3V0ICAgIC49ICQxOworICAgICAgICAgICAgfSBlbHNp ZiAoJGluID1+IHMvXlwvXC8uKi8vKSB7ICAgICAgICAgICAgICAgICAgIyAvLy4uLgorICAgICAg ICAgICAgICAgICMgZmFsbCB0aHJvdWdoCisgICAgICAgICAgICB9IGVsc2lmICgkaW4gPX4gbS9e XC9cKi8pIHsgICAgICAgICAgICAgICAgICAgICAjIC8qLi4uCisgICAgICAgICAgICAgICAgIyBD IGNvbW1lbnQgcmVtb3ZhbCBhZGFwdGVkIGZyb20gcGVybGZhcTY6CisgICAgICAgICAgICAgICAg aWYgKCRpbiA9fiBzL15cL1wqW14qXSpcKisoW15cLypdW14qXSpcKispKlwvLy8pIHsKKyAgICAg ICAgICAgICAgICAgICAgJG91dCAgICAuPSAnICc7CisgICAgICAgICAgICAgICAgfSBlbHNlIHsg ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAjIEluY29tcGxldGUgLyogKi8KKyAg ICAgICAgICAgICAgICAgICAgbmV4dCBSRUFEOworICAgICAgICAgICAgICAgIH0KKyAgICAgICAg ICAgIH0gZWxzaWYgKCRpbiA9fiBzL14oXC8pLy8pIHsgICAgICAgICAgICAgICAgICAgICMgLy4u LgorICAgICAgICAgICAgICAgICRvdXQgICAgLj0gJDE7CisgICAgICAgICAgICB9IGVsc2lmICgk aW4gPX4gcy9eKFteXCdcIlxcXC9dKykvLykgeworICAgICAgICAgICAgICAgICRvdXQgICAgLj0g JDE7CisgICAgICAgICAgICB9IGVsc2UgeworICAgICAgICAgICAgICAgIGRpZSAiQ2Fubm90IHBh cnNlOlxuJGluXG4iOworICAgICAgICAgICAgfQorICAgICAgICB9CisKKyAgICAgICAgbGFzdCBS RUFEIGlmICRvdXQgPX4gL1xTLzsKKyAgICB9CisKKyAgICByZXR1cm4gJG91dDsKK30KKworCiAj IEhhbmRsZSByZWN1cnNpdmUgc3ViZGlyZWN0b3JpZXMgd2l0aG91dCBnZXR0aW5nIGEgZ3JvdGVz cXVlbHkgYmlnIHN0YWNrLgogIyBDb3VsZCB0aGlzIGJlIGltcGxlbWVudGVkIHVzaW5nIEZpbGU6 OkZpbmQ/CiBzdWIgbmV4dF9maWxlCkBAIC01NjMsOSArNjEwLDkgQEAKICAgICAgICAgICAgICAg ICBwcmludCBQUkVBTUJMRSAiIyAkXz0kZGVmaW5leyRffVxuIjsKICAgICAgICAgICAgIH0KIAot ICAgICAgICAgICAgaWYgKCRkZWZpbmV7JF99ID1+IC9eXGQrJC8pIHsKKyAgICAgICAgICAgIGlm ICgkZGVmaW5leyRffSA9fiAvXihcZCspVT9MezAsMn0kL2kpIHsKICAgICAgICAgICAgICAgICBw cmludCBQUkVBTUJMRQotICAgICAgICAgICAgICAgICAgICAidW5sZXNzIChkZWZpbmVkICYkXykg eyBzdWIgJF8oKSB7ICRkZWZpbmV7JF99IH0gfVxuXG4iOworICAgICAgICAgICAgICAgICAgICAi dW5sZXNzIChkZWZpbmVkICYkXykgeyBzdWIgJF8oKSB7ICQxIH0gfVxuXG4iOwogICAgICAgICAg ICAgfSBlbHNpZiAoJGRlZmluZXskX30gPX4gL15cdyskLykgewogICAgICAgICAgICAgICAgIHBy aW50IFBSRUFNQkxFCiAgICAgICAgICAgICAgICAgICAgICJ1bmxlc3MgKGRlZmluZWQgJiRfKSB7 IHN1YiAkXygpIHsgJiRkZWZpbmV7JF99IH0gfVxuXG4iOwo= UH2PH571 } elsif ( $num < 5.007003 ) { _patch_b64(<<'UH2PH572'); LS0tIHV0aWxzL2gycGguUEwKKysrIHV0aWxzL2gycGguUEwKQEAgLTIzOCwxNSArMjM4LDE5IEBA CiAJICAgIH0gZWxzaWYoL15pZGVudFxzKyguKikvKSB7CiAJCXByaW50IE9VVCAkdCwgIiMgJDFc biI7CiAJICAgIH0KLSAJfSBlbHNpZigvXlxzKih0eXBlZGVmXHMqKT9lbnVtXHMqKFxzK1thLXpB LVpfXVx3KlxzKik/XHsvKSB7Ci0JICAgIHVudGlsKC9cfS4qPzsvKSB7Ci0JCWNob21wKCRuZXh0 ID0gPElOPik7CisJfSBlbHNpZigvXlxzKih0eXBlZGVmXHMqKT9lbnVtXHMqKFxzK1thLXpBLVpf XVx3KlxzKik/LykgeworCSAgICB1bnRpbCgvXHtbXn1dKlx9Lio7LyB8fCAvOy8pIHsKKwkJbGFz dCB1bmxlc3MgZGVmaW5lZCAoJG5leHQgPSBuZXh0X2xpbmUoKSk7CisJCWNob21wICRuZXh0Owor CQkjIGRyb3AgIiNkZWZpbmUgRk9PIEZPTyIgaW4gZW51bXMKKwkJJG5leHQgPX4gcy9eXHMqI1xz KmRlZmluZVxzKyhcdyspXHMrXDFccyokLy87CiAJCSRfIC49ICRuZXh0OwogCQlwcmludCBPVVQg IiMgJG5leHRcbiIgaWYgJG9wdF9EOwogCSAgICB9CisJICAgIHMvI1xzKmlmLio/I1xzKmVuZGlm Ly9nOyAjIGRyb3AgI2lmZGVmcwogCSAgICBzQC9cKi4qP1wqL0BAZzsKIAkgICAgcy9ccysvIC9n OwotCSAgICAvXlxzPyh0eXBlZGVmXHM/KT9lbnVtXHM/KFthLXpBLVpfXVx3Kik/XHM/XHsoLiop XH1ccz8oW2EtekEtWl9dXHcqKT9ccz87LzsKKwkgICAgbmV4dCB1bmxlc3MgL15ccz8odHlwZWRl ZlxzPyk/ZW51bVxzPyhbYS16QS1aX11cdyopP1xzP1x7KC4qKVx9XHM/KFthLXpBLVpfXVx3Kik/ XHM/Oy87CiAJICAgIChteSAkZW51bV9zdWJzID0gJDMpID1+IHMvXHMvL2c7CiAJICAgIG15IEBl bnVtX3N1YnMgPSBzcGxpdCgvLC8sICRlbnVtX3N1YnMpOwogCSAgICBteSAkZW51bV92YWwgPSAt MTsKQEAgLTMzNCw3ICszMzgsNyBAQAogCSMgRWxpbWluYXRlIHR5cGVkZWZzCiAJL1woKFtcd1xz XSspW1wqXHNdKlwpXHMqW1x3XChdLyAmJiBkbyB7CiAJICAgIGZvcmVhY2ggKHNwbGl0IC9ccysv LCAkMSkgeyAgIyBNYWtlIHN1cmUgYWxsIHRoZSB3b3JkcyBhcmUgdHlwZXMsCi0JCWxhc3QgdW5s ZXNzICgkaXNhdHlwZXskX30gb3IgJF8gZXEgJ3N0cnVjdCcpOworCQlsYXN0IHVubGVzcyAoJGlz YXR5cGV7JF99IG9yICRfIGVxICdzdHJ1Y3QnIG9yICRfIGVxICd1bmlvbicpOwogCSAgICB9CiAJ ICAgIHMvXChbXHdcc10rW1wqXHNdKlwpLy8gJiYgbmV4dDsgICAgICAjIHRoZW4gZWxpbWluYXRl IHRoZW0uCiAJfTsKQEAgLTM1Nyw3ICszNjEsNyBAQAogCX07CiAJcy9eKFtfYS16QS1aXVx3Kikv LwkmJiBkbyB7CiAJICAgIG15ICRpZCA9ICQxOwotCSAgICBpZiAoJGlkIGVxICdzdHJ1Y3QnKSB7 CisJICAgIGlmICgkaWQgZXEgJ3N0cnVjdCcgfHwgJGlkIGVxICd1bmlvbicpIHsKIAkJcy9eXHMr KFx3KykvLzsKIAkJJGlkIC49ICcgJyAuICQxOwogCQkkaXNhdHlwZXskaWR9ID0gMTsKQEAgLTQz NCw3ICs0MzgsNyBAQAogICAgICAgICAgICAgfSBlbHNpZiAoJGluID1+IHMvXigiKFxcLnxbXiJc XF0pKiIpLy8pIHsgICAgICAgIyAiLi4uCiAgICAgICAgICAgICAgICAgJG91dCAgICAuPSAkMTsK ICAgICAgICAgICAgIH0gZWxzaWYgKCRpbiA9fiBzL15cL1wvLiovLykgeyAgICAgICAgICAgICAg ICAgICMgLy8uLi4KLSAgICAgICAgICAgICAgICBsYXN0IFJFQUQ7CisgICAgICAgICAgICAgICAg IyBmYWxsIHRocm91Z2gKICAgICAgICAgICAgIH0gZWxzaWYgKCRpbiA9fiBtL15cL1wqLykgeyAg ICAgICAgICAgICAgICAgICAgICMgLyouLi4KICAgICAgICAgICAgICAgICAjIEMgY29tbWVudCBy ZW1vdmFsIGFkYXB0ZWQgZnJvbSBwZXJsZmFxNjoKICAgICAgICAgICAgICAgICBpZiAoJGluID1+ IHMvXlwvXCpbXipdKlwqKyhbXlwvKl1bXipdKlwqKykqXC8vLykgewpAQCAtNDUxLDcgKzQ1NSw3 IEBACiAgICAgICAgICAgICB9CiAgICAgICAgIH0KIAotICAgICAgICBsYXN0IFJFQUQ7CisgICAg ICAgIGxhc3QgUkVBRCBpZiAkb3V0ID1+IC9cUy87CiAgICAgfQogCiAgICAgcmV0dXJuICRvdXQ7 CkBAIC02MDYsOSArNjEwLDkgQEAKICAgICAgICAgICAgICAgICBwcmludCBQUkVBTUJMRSAiIyAk Xz0kZGVmaW5leyRffVxuIjsKICAgICAgICAgICAgIH0KIAotICAgICAgICAgICAgaWYgKCRkZWZp bmV7JF99ID1+IC9eXGQrJC8pIHsKKyAgICAgICAgICAgIGlmICgkZGVmaW5leyRffSA9fiAvXihc ZCspVT9MezAsMn0kL2kpIHsKICAgICAgICAgICAgICAgICBwcmludCBQUkVBTUJMRQotICAgICAg ICAgICAgICAgICAgICAidW5sZXNzIChkZWZpbmVkICYkXykgeyBzdWIgJF8oKSB7ICRkZWZpbmV7 JF99IH0gfVxuXG4iOworICAgICAgICAgICAgICAgICAgICAidW5sZXNzIChkZWZpbmVkICYkXykg eyBzdWIgJF8oKSB7ICQxIH0gfVxuXG4iOwogICAgICAgICAgICAgfSBlbHNpZiAoJGRlZmluZXsk X30gPX4gL15cdyskLykgewogICAgICAgICAgICAgICAgIHByaW50IFBSRUFNQkxFCiAgICAgICAg ICAgICAgICAgICAgICJ1bmxlc3MgKGRlZmluZWQgJiRfKSB7IHN1YiAkXygpIHsgJiRkZWZpbmV7 JF99IH0gfVxuXG4iOwo= UH2PH572 } if ( $num < 5.008000 ) { return _patch_b64(<<'UH2PH573'); LS0tIHV0aWxzL2gycGguUEwKKysrIHV0aWxzL2gycGguUEwKQEAgLTQyLDggKzQyLDEzIEBAIHVz ZSBDb25maWc7CiB1c2UgRmlsZTo6UGF0aCBxdyhta3BhdGgpOwogdXNlIEdldG9wdDo6U3RkOwog Ci1nZXRvcHRzKCdEZDpybGhhUScpOwotdXNlIHZhcnMgcXcoJG9wdF9EICRvcHRfZCAkb3B0X3Ig JG9wdF9sICRvcHRfaCAkb3B0X2EgJG9wdF9RKTsKKyMgTWFrZSBzdXJlIHJlYWQgcGVybWlzc2lv bnMgZm9yIGFsbCBhcmUgc2V0OgoraWYgKGRlZmluZWQgdW1hc2sgJiYgKHVtYXNrKCkgJiAwNDQ0 KSkgeworICAgIHVtYXNrICh1bWFzaygpICYgfjA0NDQpOworfQorCitnZXRvcHRzKCdEZDpybGhh UWUnKTsKK3VzZSB2YXJzIHF3KCRvcHRfRCAkb3B0X2QgJG9wdF9yICRvcHRfbCAkb3B0X2ggJG9w dF9hICRvcHRfUSAkb3B0X2UpOwogZGllICItciBhbmQgLWEgb3B0aW9ucyBhcmUgbXV0dWFsbHkg ZXhjbHVzaXZlXG4iIGlmICgkb3B0X3IgYW5kICRvcHRfYSk7CiBteSBAaW5jX2RpcnMgPSBpbmNf ZGlycygpIGlmICRvcHRfYTsKIApAQCAtNjUsMTMgKzcwLDIxIEBAIG15ICVpc2F0eXBlOwogQGlz YXR5cGV7QGlzYXR5cGV9ID0gKDEpIHggQGlzYXR5cGU7CiBteSAkaW5pZiA9IDA7CiBteSAlSXNf Y29udmVydGVkOworbXkgJWJhZF9maWxlID0gKCk7CiAKIEBBUkdWID0gKCctJykgdW5sZXNzIEBB UkdWOwogCiBidWlsZF9wcmVhbWJsZV9pZl9uZWNlc3NhcnkoKTsKIAorc3ViIHJlaW5kZW50KCQp IHsKKyAgICBteSgkdGV4dCkgPSBzaGlmdDsKKyAgICAkdGV4dCA9fiBzL1xuL1xuICAgIC9nOwor ICAgICR0ZXh0ID1+IHMvICAgICAgICAvXHQvZzsKKyAgICAkdGV4dDsKK30KKwogbXkgKCR0LCAk dGFiLCAlY3VyYXJncywgJG5ldywgJGV2YWxfaW5kZXgsICRkaXIsICRuYW1lLCAkYXJncywgJG91 dGZpbGUpOwotbXkgKCRpbmNsLCAkbmV4dCk7CitteSAoJGluY2wsICRpbmNsX3R5cGUsICRpbmNs X3F1b3RlLCAkbmV4dCk7CiB3aGlsZSAoZGVmaW5lZCAobXkgJGZpbGUgPSBuZXh0X2ZpbGUoKSkp IHsKICAgICBpZiAoLWwgJGZpbGUgYW5kIC1kICRmaWxlKSB7CiAgICAgICAgIGxpbmtfaWZfcG9z c2libGUoJGZpbGUpIGlmICgkb3B0X2wpOwpAQCAtMTA3LDEzICsxMjAsMTcgQEAgd2hpbGUgKGRl ZmluZWQgKG15ICRmaWxlID0gbmV4dF9maWxlKCkpKSB7CiAJb3BlbihPVVQsIj4kRGVzdF9kaXIv JG91dGZpbGUiKSB8fCBkaWUgIkNhbid0IGNyZWF0ZSAkb3V0ZmlsZTogJCFcbiI7CiAgICAgfQog Ci0gICAgcHJpbnQgT1VUICJyZXF1aXJlICdfaDJwaF9wcmUucGgnO1xuXG4iOwotICAgIHdoaWxl IChkZWZpbmVkIChsb2NhbCAkXyA9IG5leHRfbGluZSgpKSkgeworICAgIHByaW50IE9VVAorICAg ICAgICAicmVxdWlyZSAnX2gycGhfcHJlLnBoJztcblxuIiwKKyAgICAgICAgIm5vIHdhcm5pbmdz ICdyZWRlZmluZSc7XG5cbiI7CisKKyAgICB3aGlsZSAoZGVmaW5lZCAobG9jYWwgJF8gPSBuZXh0 X2xpbmUoJGZpbGUpKSkgewogCWlmIChzL15ccypcI1xzKi8vKSB7CiAJICAgIGlmIChzL15kZWZp bmVccysoXHcrKS8vKSB7CiAJCSRuYW1lID0gJDE7CiAJCSRuZXcgPSAnJzsKIAkJcy9ccyskLy87 CisJCXMvXChcdytccypcKFwqXClccypcKFx3KlwpXClccyooLT9cZCspLyQxLzsgIyAoaW50ICgq KShmb29fdCkpMAogCQlpZiAocy9eXCgoW1x3LFxzXSopXCkvLykgewogCQkgICAgJGFyZ3MgPSAk MTsKICAgICAJICAgIAkgICAgbXkgJHByb3RvID0gJygpICc7CkBAIC0xNjcsMjIgKzE4NCwzMiBA QCB3aGlsZSAoZGVmaW5lZCAobXkgJGZpbGUgPSBuZXh0X2ZpbGUoKSkpIHsKICAgICAgICAgICAg ICAgICAgICAgICBwcmludCBPVVQgJHQsInVubGVzcyhkZWZpbmVkKFwmJG5hbWUpKSB7XG4gICAg c3ViICRuYW1lICgpIHtcdCIsJG5ldywiO31cbn1cbiI7CiAJCSAgICB9CiAJCX0KLQkgICAgfSBl bHNpZiAoL14oaW5jbHVkZXxpbXBvcnQpXHMqWzwiXSguKilbPiJdLykgewotCQkoJGluY2wgPSAk MikgPX4gcy9cLmgkLy5waC87Ci0JCXByaW50IE9VVCAkdCwicmVxdWlyZSAnJGluY2wnO1xuIjsK LQkgICAgfSBlbHNpZigvXmluY2x1ZGVfbmV4dFxzKls8Il0oLiopWz4iXS8pIHsKLQkJKCRpbmNs ID0gJDEpID1+IHMvXC5oJC8ucGgvOworCSAgICB9IGVsc2lmICgvXihpbmNsdWRlfGltcG9ydHxp bmNsdWRlX25leHQpXHMqKFs8XCJdKSguKilbPlwiXS8pIHsKKyAgICAgICAgICAgICAgICAkaW5j bF90eXBlID0gJDE7CisgICAgICAgICAgICAgICAgJGluY2xfcXVvdGUgPSAkMjsKKyAgICAgICAg ICAgICAgICAkaW5jbCA9ICQzOworICAgICAgICAgICAgICAgIGlmICgoJGluY2xfdHlwZSBlcSAn aW5jbHVkZV9uZXh0JykgfHwKKyAgICAgICAgICAgICAgICAgICAgKCRvcHRfZSAmJiBleGlzdHMo JGJhZF9maWxleyRpbmNsfSkpKSB7CisgICAgICAgICAgICAgICAgICAgICRpbmNsID1+IHMvXC5o JC8ucGgvOwogCQlwcmludCBPVVQgKCR0LAogCQkJICAgImV2YWwge1xuIik7CiAgICAgICAgICAg ICAgICAgJHRhYiArPSA0OwogICAgICAgICAgICAgICAgICR0ID0gIlx0IiB4ICgkdGFiIC8gOCkg LiAnICcgeCAoJHRhYiAlIDgpOworICAgICAgICAgICAgICAgICAgICBwcmludCBPVVQgKCR0LCAi bXkoXEBSRU0pO1xuIik7CisgICAgICAgICAgICAgICAgICAgIGlmICgkaW5jbF90eXBlIGVxICdp bmNsdWRlX25leHQnKSB7CiAJCXByaW50IE9VVCAoJHQsCiAJCQkgICAibXkoXCVJTkNEKSA9IG1h cCB7IFwkSU5De1wkX30gPT4gMSB9ICIsCi0JCQkgICAiKGdyZXAgeyBcJF8gZXEgXCIkaW5jbFwi IH0ga2V5cyhcJUlOQykpO1xuIik7CisJCQkgICAgICAgICAgICIoZ3JlcCB7IFwkXyBlcSBcIiRp bmNsXCIgfSAiLAorICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAia2V5cyhcJUlO QykpO1xuIik7CiAJCXByaW50IE9VVCAoJHQsCi0JCQkgICAibXkoXEBSRU0pID0gbWFwIHsgXCJc JF8vJGluY2xcIiB9ICIsCisJCQkgICAgICAgICAgICJcQFJFTSA9IG1hcCB7IFwiXCRfLyRpbmNs XCIgfSAiLAogCQkJICAgIihncmVwIHsgbm90IGV4aXN0cyhcJElOQ0R7XCJcJF8vJGluY2xcIn0p IiwKLQkJCSAgICJhbmQgLWYgXCJcJF8vJGluY2xcIiB9IFxASU5DKTtcbiIpOworCQkJICAgICAg ICAgICAiIGFuZCAtZiBcIlwkXy8kaW5jbFwiIH0gXEBJTkMpO1xuIik7CisgICAgICAgICAgICAg ICAgICAgIH0gZWxzZSB7CisgICAgICAgICAgICAgICAgICAgICAgICBwcmludCBPVVQgKCR0LAor ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAiXEBSRU0gPSBtYXAgeyBcIlwkXy8k aW5jbFwiIH0gIiwKKyAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIihncmVwIHst ciBcIlwkXy8kaW5jbFwiIH0gXEBJTkMpO1xuIik7CisgICAgICAgICAgICAgICAgICAgIH0KIAkJ cHJpbnQgT1VUICgkdCwKIAkJCSAgICJyZXF1aXJlIFwiXCRSRU1bMF1cIiBpZiBcQFJFTTtcbiIp OwogICAgICAgICAgICAgICAgICR0YWIgLT0gNDsKQEAgLTE5MSw2ICsyMTgsMTQgQEAgd2hpbGUg KGRlZmluZWQgKG15ICRmaWxlID0gbmV4dF9maWxlKCkpKSB7CiAJCQkgICAifTtcbiIpOwogCQlw cmludCBPVVQgKCR0LAogCQkJICAgIndhcm4oXCRcQCkgaWYgXCRcQDtcbiIpOworICAgICAgICAg ICAgICAgIH0gZWxzZSB7CisgICAgICAgICAgICAgICAgICAgICRpbmNsID1+IHMvXC5oJC8ucGgv OworICAgICAgICAgICAgICAgICAgICAjIGNvcHkgdGhlIHByZWZpeCBpbiB0aGUgcXVvdGUgc3lu dGF4ICgjaW5jbHVkZSAieC5oIikgY2FzZQorICAgICAgICAgICAgICAgICAgICBpZiAoJGluY2wg IX4gbXwvfCAmJiAkaW5jbF9xdW90ZSBlcSBxeyJ9ICYmICRmaWxlID1+IG18XiguKikvfCkgewor ICAgICAgICAgICAgICAgICAgICAgICAgJGluY2wgPSAiJDEvJGluY2wiOworICAgICAgICAgICAg ICAgICAgICB9CisJCSAgICBwcmludCBPVVQgJHQsInJlcXVpcmUgJyRpbmNsJztcbiI7CisgICAg ICAgICAgICAgICAgfQogCSAgICB9IGVsc2lmICgvXmlmZGVmXHMrKFx3KykvKSB7CiAJCXByaW50 IE9VVCAkdCwiaWYoZGVmaW5lZCgmJDEpKSB7XG4iOwogCQkkdGFiICs9IDQ7CkBAIC0yNDAsNyAr Mjc1LDcgQEAgd2hpbGUgKGRlZmluZWQgKG15ICRmaWxlID0gbmV4dF9maWxlKCkpKSB7CiAJICAg IH0KIAl9IGVsc2lmKC9eXHMqKHR5cGVkZWZccyopP2VudW1ccyooXHMrW2EtekEtWl9dXHcqXHMq KT8vKSB7CiAJICAgIHVudGlsKC9ce1tefV0qXH0uKjsvIHx8IC87LykgewotCQlsYXN0IHVubGVz cyBkZWZpbmVkICgkbmV4dCA9IG5leHRfbGluZSgpKTsKKwkJbGFzdCB1bmxlc3MgZGVmaW5lZCAo JG5leHQgPSBuZXh0X2xpbmUoJGZpbGUpKTsKIAkJY2hvbXAgJG5leHQ7CiAJCSMgZHJvcCAiI2Rl ZmluZSBGT08gRk9PIiBpbiBlbnVtcwogCQkkbmV4dCA9fiBzL15ccyojXHMqZGVmaW5lXHMrKFx3 KylccytcMVxzKiQvLzsKQEAgLTI3MiwyMiArMzA3LDIyIEBAIHdoaWxlIChkZWZpbmVkIChteSAk ZmlsZSA9IG5leHRfZmlsZSgpKSkgewogCSAgICB9CiAJfQogICAgIH0KLSAgICBwcmludCBPVVQg IjE7XG4iOwotCiAgICAgJElzX2NvbnZlcnRlZHskZmlsZX0gPSAxOworICAgIGlmICgkb3B0X2Ug JiYgZXhpc3RzKCRiYWRfZmlsZXskZmlsZX0pKSB7CisgICAgICAgIHVubGluaygkRGVzdF9kaXIg LiAnLycgLiAkb3V0ZmlsZSk7CisgICAgICAgICRuZXh0ID0gJyc7CisgICAgfSBlbHNlIHsKKyAg ICAgICAgcHJpbnQgT1VUICIxO1xuIjsKICAgICBxdWV1ZV9pbmNsdWRlc19mcm9tKCRmaWxlKSBp ZiAoJG9wdF9hKTsKKyAgICB9CiB9CiAKLWV4aXQgJEV4aXQ7Ci0KLQotc3ViIHJlaW5kZW50KCQp IHsKLSAgICBteSgkdGV4dCkgPSBzaGlmdDsKLSAgICAkdGV4dCA9fiBzL1xuL1xuICAgIC9nOwot ICAgICR0ZXh0ID1+IHMvICAgICAgICAvXHQvZzsKLSAgICAkdGV4dDsKK2lmICgkb3B0X2UgJiYg KHNjYWxhcihrZXlzICViYWRfZmlsZSkgPiAwKSkgeworICAgIHdhcm4gIldhcyB1bmFibGUgdG8g Y29udmVydCB0aGUgZm9sbG93aW5nIGZpbGVzOlxuIjsKKyAgICB3YXJuICJcdCIgLiBqb2luKCJc blx0Iixzb3J0KGtleXMgJWJhZF9maWxlKSkgLiAiXG4iOwogfQogCitleGl0ICRFeGl0OwogCiBz dWIgZXhwciB7CiAgICAgbXkgJGpvaW5lZF9hcmdzOwpAQCAtMjk4LDggKzMzMywyMSBAQCBzdWIg ZXhwciB7CiAJcy9eXCZcJi8vICYmIGRvIHsgJG5ldyAuPSAiICYmIjsgbmV4dDt9OyAjIGhhbmRs ZSAmJiBvcGVyYXRvcgogCXMvXlwmKFtcKGEtelwpXSspLyQxL2k7CSMgaGFjayBmb3IgdGhpbmdz IHRoYXQgdGFrZSB0aGUgYWRkcmVzcyBvZgogCXMvXihccyspLy8JCSYmIGRvIHskbmV3IC49ICcg JzsgbmV4dDt9OwotCXMvXigwWFswLTlBLUZdKylbVUxdKi8vaQkmJiBkbyB7JG5ldyAuPSBsYygk MSk7IG5leHQ7fTsKLQlzL14oLT9cZCtcLlxkK0VbLStdXGQrKUY/Ly9pCSYmIGRvIHskbmV3IC49 ICQxOyBuZXh0O307CisJcy9eMFgoWzAtOUEtRl0rKVtVTF0qLy9pIAorCSAgICAmJiBkbyB7bXkg JGhleCA9ICQxOworCQkgICAkaGV4ID1+IHMvXjArLy87CisJCSAgIGlmIChsZW5ndGggJGhleCA+ IDggJiYgISRDb25maWd7dXNlNjRiaXRpbnR9KSB7CisJCSAgICAgICAjIENyb2FrIGlmIG52X3By ZXNlcnZlc191dl9iaXRzIDwgNjQgPworCQkgICAgICAgJG5ldyAuPSAgICAgICAgIGhleChzdWJz dHIoJGhleCwgLTgpKSArCisJCQkgICAgICAgMioqMzIgKiBoZXgoc3Vic3RyKCRoZXgsICAwLCAt OCkpOworCQkgICAgICAgIyBUaGUgYWJvdmUgd2lsbCBwcm9kdWNlICJlcnJvcm5ldXMiIGNvZGUK KwkJICAgICAgICMgaWYgdGhlIGhleCBjb25zdGFudCB3YXMgZS5nLiBpbnNpZGUgVUlOVDY0X0MK KwkJICAgICAgICMgbWFjcm8sIGJ1dCB0aGVuIGFnYWluLCBoMnBoIGlzIGFuIGFwcHJveGltYXRp b24uCisJCSAgIH0gZWxzZSB7CisJCSAgICAgICAkbmV3IC49IGxjKCIweCRoZXgiKTsKKwkJICAg fQorCQkgICBuZXh0O307CisJcy9eKC0/XGQrXC5cZCtFWy0rXT9cZCspW0ZMXT8vL2kJJiYgZG8g eyRuZXcgLj0gJDE7IG5leHQ7fTsKIAlzL14oXGQrKVxzKltMVV0qLy9pCSYmIGRvIHskbmV3IC49 ICQxOyBuZXh0O307CiAJcy9eKCIoXFwifFteIl0pKiIpLy8JJiYgZG8geyRuZXcgLj0gJDE7IG5l eHQ7fTsKIAlzL14nKChcXCJ8W14iXSkqKScvLwkmJiBkbyB7CkBAIC0zODgsNyArNDM2LDcgQEAg c3ViIGV4cHIgewogCQl9CiAJICAgIH0gZWxzZSB7CiAJCWlmICgkaW5pZiAmJiAkbmV3ICF+IC9k ZWZpbmVkXHMqXCgkLykgewotCQkgICAgJG5ldyAuPSAnKGRlZmluZWQoJicgLiAkaWQgLiAnKSA/ ICYnIC4gJGlkIC4gJyA6IDApJzsKKwkJICAgICRuZXcgLj0gJyhkZWZpbmVkKCYnIC4gJGlkIC4g JykgPyAmJyAuICRpZCAuICcgOiB1bmRlZiknOwogCQl9IGVsc2lmICgvXlxbLykgewogCQkgICAg JG5ldyAuPSAiIFwkJGlkIjsKIAkJfSBlbHNlIHsKQEAgLTQwNCw2ICs0NTIsNyBAQCBzdWIgZXhw ciB7CiAKIHN1YiBuZXh0X2xpbmUKIHsKKyAgICBteSAkZmlsZSA9IHNoaWZ0OwogICAgIG15ICgk aW4sICRvdXQpOwogICAgIG15ICRwcmVfc3ViX3RyaV9ncmFwaHMgPSAxOwogCkBAIC00MjYsNiAr NDc1LDIwIEBAIHN1YiBuZXh0X2xpbmUKICAgICAgICAgICAgICAgICAkaW4gPX4gcy9cP1w/PC97 L2c7ICAgICAgICAgICAgICAgICAgICAgICAgICMgfCA/Pzx8ICB7fAogICAgICAgICAgICAgICAg ICRpbiA9fiBzL1w/XD8+L30vZzsgICAgICAgICAgICAgICAgICAgICAgICAgIyB8ID8/PnwgIH18 CiAgICAgICAgICAgICB9CisJICAgIGlmICgkaW4gPX4gL15cI2lmZGVmIF9fTEFOR1VBR0VfUEFT Q0FMX18vKSB7CisgICAgICAgICAgICAgICAgIyBUcnU2NCBkaXNhc3NlbWJsZXIuaCBldmlsbmVz czogbWl4ZWQgQyBhbmQgUGFzY2FsLgorCQl3aGlsZSAoPElOPikgeworCQkgICAgbGFzdCBpZiAv XlwjZW5kaWYvOyAKKwkJfQorCQluZXh0IFJFQUQ7CisJICAgIH0KKwkgICAgaWYgKCRpbiA9fiAv XmV4dGVybiBpbmxpbmUgLyAmJiAjIElubGluZWQgYXNzZW1ibGVyLgorCQkkXk8gZXEgJ2xpbnV4 JyAmJiAkZmlsZSA9fiBtISg/Ol58Lylhc20vW14vXStcLmgkISkgeworIAkJd2hpbGUgKDxJTj4p IHsKKwkJICAgIGxhc3QgaWYgL159LzsgCisJCX0KKwkJbmV4dCBSRUFEOworCSAgICB9CiAgICAg ICAgICAgICBpZiAoJGluID1+IHMvXFwkLy8pIHsgICAgICAgICAgICAgICAgICAgICAgICAgICAj IFwtbmV3bGluZQogICAgICAgICAgICAgICAgICRvdXQgICAgLj0gJyAnOwogICAgICAgICAgICAg ICAgIG5leHQgUkVBRDsKQEAgLTQzMywxMCArNDk2LDE4IEBAIHN1YiBuZXh0X2xpbmUKICAgICAg ICAgICAgICAgICAkb3V0ICAgIC49ICQxOwogICAgICAgICAgICAgfSBlbHNpZiAoJGluID1+IHMv XihcXC4pLy8pIHsgICAgICAgICAgICAgICAgICAgIyBcLi4uCiAgICAgICAgICAgICAgICAgJG91 dCAgICAuPSAkMTsKLSAgICAgICAgICAgIH0gZWxzaWYgKCRpbiA9fiBzL14oJyhcXC58W14nXFxd KSonKS8vKSB7ICAgICAgICMgJy4uLgotICAgICAgICAgICAgICAgICRvdXQgICAgLj0gJDE7Ci0g ICAgICAgICAgICB9IGVsc2lmICgkaW4gPX4gcy9eKCIoXFwufFteIlxcXSkqIikvLykgeyAgICAg ICAjICIuLi4KLSAgICAgICAgICAgICAgICAkb3V0ICAgIC49ICQxOworICAgICAgICAgICAgfSBl bHNpZiAoJGluID1+IC9eJy8pIHsgICAgICAgICAgICAgICAgICAgICAgICAgIyAnLi4uCisgICAg ICAgICAgICAgICAgaWYgKCRpbiA9fiBzL14oJyhcXC58W14nXFxdKSonKS8vKSB7CisgICAgICAg ICAgICAgICAgICAgICRvdXQgICAgLj0gJDE7CisgICAgICAgICAgICAgICAgfSBlbHNlIHsKKyAg ICAgICAgICAgICAgICAgICAgbmV4dCBSRUFEOworICAgICAgICAgICAgICAgIH0KKyAgICAgICAg ICAgIH0gZWxzaWYgKCRpbiA9fiAvXiIvKSB7ICAgICAgICAgICAgICAgICAgICAgICAgICMgIi4u LgorICAgICAgICAgICAgICAgIGlmICgkaW4gPX4gcy9eKCIoXFwufFteIlxcXSkqIikvLykgewor ICAgICAgICAgICAgICAgICAgICAkb3V0ICAgIC49ICQxOworICAgICAgICAgICAgICAgIH0gZWxz ZSB7CisgICAgICAgICAgICAgICAgICAgIG5leHQgUkVBRDsKKyAgICAgICAgICAgICAgICB9CiAg ICAgICAgICAgICB9IGVsc2lmICgkaW4gPX4gcy9eXC9cLy4qLy8pIHsgICAgICAgICAgICAgICAg ICAjIC8vLi4uCiAgICAgICAgICAgICAgICAgIyBmYWxsIHRocm91Z2gKICAgICAgICAgICAgIH0g ZWxzaWYgKCRpbiA9fiBtL15cL1wqLykgeyAgICAgICAgICAgICAgICAgICAgICMgLyouLi4KQEAg LTQ1MCw4ICs1MjEsMjAgQEAgc3ViIG5leHRfbGluZQogICAgICAgICAgICAgICAgICRvdXQgICAg Lj0gJDE7CiAgICAgICAgICAgICB9IGVsc2lmICgkaW4gPX4gcy9eKFteXCdcIlxcXC9dKykvLykg ewogICAgICAgICAgICAgICAgICRvdXQgICAgLj0gJDE7CisgICAgICAgICAgICB9IGVsc2lmICgk Xk8gZXEgJ2xpbnV4JyAmJgorICAgICAgICAgICAgICAgICAgICAgJGZpbGUgPX4gbSEoPzpefC8p bGludXgvYnl0ZW9yZGVyL3BkcF9lbmRpYW5cLmgkISAmJgorICAgICAgICAgICAgICAgICAgICAg JGluICAgPX4gcyFcJ1QgS05PVyEhKSB7CisgICAgICAgICAgICAgICAgJG91dCAgICA9fiBzIUkg RE9OJCFJX0RPX05PVF9LTk9XITsKICAgICAgICAgICAgIH0gZWxzZSB7Ci0gICAgICAgICAgICAg ICAgZGllICJDYW5ub3QgcGFyc2U6XG4kaW5cbiI7CisgICAgICAgICAgICAgICAgaWYgKCRvcHRf ZSkgeworICAgICAgICAgICAgICAgICAgICB3YXJuICJDYW5ub3QgcGFyc2UgJGZpbGU6XG4kaW5c biI7CisgICAgICAgICAgICAgICAgICAgICRiYWRfZmlsZXskZmlsZX0gPSAxOworICAgICAgICAg ICAgICAgICAgICAkaW4gPSAnJzsKKyAgICAgICAgICAgICAgICAgICAgJG91dCA9IHVuZGVmOwor ICAgICAgICAgICAgICAgICAgICBsYXN0IFJFQUQ7CisgICAgICAgICAgICAgICAgfSBlbHNlIHsK KwkJZGllICJDYW5ub3QgcGFyc2U6XG4kaW5cbiI7CisgICAgICAgICAgICAgICAgfQogICAgICAg ICAgICAgfQogICAgICAgICB9CiAKQEAgLTU2MSw4ICs2NDQsMTMgQEAgc3ViIHF1ZXVlX2luY2x1 ZGVzX2Zyb20KICAgICAgICAgICAgICAgICAkbGluZSAuPSA8SEVBREVSPjsKICAgICAgICAgICAg IH0KIAotICAgICAgICAgICAgaWYgKCRsaW5lID1+IC9eI1xzKmluY2x1ZGVccys8KC4qPyk+Lykg ewotICAgICAgICAgICAgICAgIHB1c2goQEFSR1YsICQxKSB1bmxlc3MgJElzX2NvbnZlcnRlZHsk MX07CisgICAgICAgICAgICBpZiAoJGxpbmUgPX4gL14jXHMqaW5jbHVkZVxzKyhbPCJdKSguKj8p Wz4iXS8pIHsKKyAgICAgICAgICAgICAgICBteSAoJGRlbGltaXRlciwgJG5ld19maWxlKSA9ICgk MSwgJDIpOworICAgICAgICAgICAgICAgICMgY29weSB0aGUgcHJlZml4IGluIHRoZSBxdW90ZSBz eW50YXggKCNpbmNsdWRlICJ4LmgiKSBjYXNlCisgICAgICAgICAgICAgICAgaWYgKCRkZWxpbWl0 ZXIgZXEgcXsifSAmJiAkZmlsZSA9fiBtfF4oLiopL3wpIHsKKyAgICAgICAgICAgICAgICAgICAg JG5ld19maWxlID0gIiQxLyRuZXdfZmlsZSI7CisgICAgICAgICAgICAgICAgfQorICAgICAgICAg ICAgICAgIHB1c2goQEFSR1YsICRuZXdfZmlsZSkgdW5sZXNzICRJc19jb252ZXJ0ZWR7JG5ld19m aWxlfTsKICAgICAgICAgICAgIH0KICAgICAgICAgfQogICAgIGNsb3NlIEhFQURFUjsKQEAgLTYw MywyNSArNjkxLDUwIEBAIHN1YiBidWlsZF9wcmVhbWJsZV9pZl9uZWNlc3NhcnkKICAgICBteSAo JWRlZmluZSkgPSBfZXh0cmFjdF9jY19kZWZpbmVzKCk7CiAKICAgICBvcGVuICBQUkVBTUJMRSwg Ij4kcHJlYW1ibGUiIG9yIGRpZSAiQ2Fubm90IG9wZW4gJHByZWFtYmxlOiAgJCEiOwotICAgICAg ICBwcmludCBQUkVBTUJMRSAiIyBUaGlzIGZpbGUgd2FzIGNyZWF0ZWQgYnkgaDJwaCB2ZXJzaW9u ICRWRVJTSU9OXG4iOwotCi0gICAgICAgIGZvcmVhY2ggKHNvcnQga2V5cyAlZGVmaW5lKSB7Ci0g ICAgICAgICAgICBpZiAoJG9wdF9EKSB7Ci0gICAgICAgICAgICAgICAgcHJpbnQgUFJFQU1CTEUg IiMgJF89JGRlZmluZXskX31cbiI7Ci0gICAgICAgICAgICB9Ci0KLSAgICAgICAgICAgIGlmICgk ZGVmaW5leyRffSA9fiAvXihcZCspVT9MezAsMn0kL2kpIHsKLSAgICAgICAgICAgICAgICBwcmlu dCBQUkVBTUJMRQotICAgICAgICAgICAgICAgICAgICAidW5sZXNzIChkZWZpbmVkICYkXykgeyBz dWIgJF8oKSB7ICQxIH0gfVxuXG4iOwotICAgICAgICAgICAgfSBlbHNpZiAoJGRlZmluZXskX30g PX4gL15cdyskLykgewotICAgICAgICAgICAgICAgIHByaW50IFBSRUFNQkxFCi0gICAgICAgICAg ICAgICAgICAgICJ1bmxlc3MgKGRlZmluZWQgJiRfKSB7IHN1YiAkXygpIHsgJiRkZWZpbmV7JF99 IH0gfVxuXG4iOwotICAgICAgICAgICAgfSBlbHNlIHsKKwlwcmludCBQUkVBTUJMRSAiIyBUaGlz IGZpbGUgd2FzIGNyZWF0ZWQgYnkgaDJwaCB2ZXJzaW9uICRWRVJTSU9OXG4iOworICAgICAgICAj IFByZXZlbnQgbm9uLXBvcnRhYmxlIGhleCBjb25zdGFudHMgZnJvbSB3YXJuaW5nLgorICAgICAg ICAjCisgICAgICAgICMgV2Ugc3RpbGwgcHJvZHVjZSBhbiBvdmVyZmxvdyB3YXJuaW5nIGlmIHdl IGNhbid0IHJlcHJlc2VudAorICAgICAgICAjIGEgaGV4IGNvbnN0YW50IGFzIGFuIGludGVnZXIu CisgICAgICAgIHByaW50IFBSRUFNQkxFICJubyB3YXJuaW5ncyBxdyhwb3J0YWJsZSk7XG4iOwor CisJZm9yZWFjaCAoc29ydCBrZXlzICVkZWZpbmUpIHsKKwkgICAgaWYgKCRvcHRfRCkgeworCQlw cmludCBQUkVBTUJMRSAiIyAkXz0kZGVmaW5leyRffVxuIjsKKwkgICAgfQorCSAgICBpZiAoJGRl ZmluZXskX30gPX4gL15cKCguKilcKSQvKSB7CisJCSMgcGFyZW50aGVzaXplZCB2YWx1ZTogIGQ9 KHYpCisJCSRkZWZpbmV7JF99ID0gJDE7CisJICAgIH0KKwkgICAgaWYgKCRkZWZpbmV7JF99ID1+ IC9eKFsrLV0/KFxkKyk/XC5cZCsoW2VFXVsrLV0/XGQrKT8pW0ZMXT8kLykgeworCQkjIGZsb2F0 OgorCQlwcmludCBQUkVBTUJMRQorCQkgICAgInVubGVzcyAoZGVmaW5lZCAmJF8pIHsgc3ViICRf KCkgeyAkMSB9IH1cblxuIjsKKwkgICAgfSBlbHNpZiAoJGRlZmluZXskX30gPX4gL14oWystXT9c ZCspVT9MezAsMn0kL2kpIHsKKwkJIyBpbnRlZ2VyOgorCQlwcmludCBQUkVBTUJMRQorCQkgICAg InVubGVzcyAoZGVmaW5lZCAmJF8pIHsgc3ViICRfKCkgeyAkMSB9IH1cblxuIjsKKyAgICAgICAg ICAgIH0gZWxzaWYgKCRkZWZpbmV7JF99ID1+IC9eKFsrLV0/MHhbXGRhLWZdKylVP0x7MCwyfSQv aSkgeworICAgICAgICAgICAgICAgICMgaGV4IGludGVnZXIKKyAgICAgICAgICAgICAgICAjIFNw ZWNpYWwgY2FzZWQsIHNpbmNlIHBlcmwgd2FybnMgb24gaGV4IGludGVnZXJzCisgICAgICAgICAg ICAgICAgIyB0aGF0IGNhbid0IGJlIHJlcHJlc2VudGVkIGluIGEgVVYuCisgICAgICAgICAgICAg ICAgIworICAgICAgICAgICAgICAgICMgVGhpcyB3YXkgd2UgZ2V0IHRoZSB3YXJuaW5nIGF0IHRp bWUgb2YgdXNlLCBzbyB0aGUgdXNlcgorICAgICAgICAgICAgICAgICMgb25seSBnZXRzIHRoZSB3 YXJuaW5nIGlmIHRoZXkgaGFwcGVuIHRvIHVzZSB0aGlzCisgICAgICAgICAgICAgICAgIyBwbGF0 Zm9ybS1zcGVjaWZpYyBkZWZpbml0aW9uLgorICAgICAgICAgICAgICAgIG15ICRjb2RlID0gJDE7 CisgICAgICAgICAgICAgICAgJGNvZGUgPSAiaGV4KCckY29kZScpIiBpZiBsZW5ndGggJGNvZGUg PiAxMDsKICAgICAgICAgICAgICAgICBwcmludCBQUkVBTUJMRQotICAgICAgICAgICAgICAgICAg ICAidW5sZXNzIChkZWZpbmVkICYkXykgeyBzdWIgJF8oKSB7IFwiIiwKLSAgICAgICAgICAgICAg ICAgICAgcXVvdGVtZXRhKCRkZWZpbmV7JF99KSwgIlwiIH0gfVxuXG4iOwotICAgICAgICAgICAg fQotICAgICAgICB9CisgICAgICAgICAgICAgICAgICAgICJ1bmxlc3MgKGRlZmluZWQgJiRfKSB7 IHN1YiAkXygpIHsgJGNvZGUgfSB9XG5cbiI7CisJICAgIH0gZWxzaWYgKCRkZWZpbmV7JF99ID1+ IC9eXHcrJC8pIHsKKwkJcHJpbnQgUFJFQU1CTEUKKwkJICAgICJ1bmxlc3MgKGRlZmluZWQgJiRf KSB7IHN1YiAkXygpIHsgJiRkZWZpbmV7JF99IH0gfVxuXG4iOworCSAgICB9IGVsc2UgeworCQlw cmludCBQUkVBTUJMRQorCQkgICAgInVubGVzcyAoZGVmaW5lZCAmJF8pIHsgc3ViICRfKCkgeyBc IiIsCisJCSAgICBxdW90ZW1ldGEoJGRlZmluZXskX30pLCAiXCIgfSB9XG5cbiI7CisJICAgIH0K Kwl9CiAgICAgY2xvc2UgUFJFQU1CTEUgICAgICAgICAgICAgICBvciBkaWUgIkNhbm5vdCBjbG9z ZSAkcHJlYW1ibGU6ICAkISI7CiB9CiAKQEAgLTYzMywxNSArNzQ2LDE0IEBAIHN1YiBfZXh0cmFj dF9jY19kZWZpbmVzCiB7CiAgICAgbXkgJWRlZmluZTsKICAgICBteSAkYWxsc3ltYm9scyAgPSBq b2luICIgIiwKLSAgICAgICAgQENvbmZpZ3snY2NzeW1ib2xzJywgJ2NwcHN5bWJvbHMnLCAnY3Bw Y2NzeW1ib2xzJ307CisJQENvbmZpZ3snY2NzeW1ib2xzJywgJ2NwcHN5bWJvbHMnLCAnY3BwY2Nz eW1ib2xzJ307CiAKICAgICAjIFNwbGl0IGNvbXBpbGVyIHByZS1kZWZpbml0aW9ucyBpbnRvIGBr ZXk9dmFsdWUnIHBhaXJzOgotICAgIGZvcmVhY2ggKHNwbGl0IC9ccysvLCAkYWxsc3ltYm9scykg ewotICAgICAgICAvKC4rPyk9KC4rKS8gYW5kICRkZWZpbmV7JDF9ID0gJDI7Ci0KLSAgICAgICAg aWYgKCRvcHRfRCkgewotICAgICAgICAgICAgcHJpbnQgU1RERVJSICIkXzogICQxIC0+ICQyXG4i OwotICAgICAgICB9CisgICAgd2hpbGUgKCRhbGxzeW1ib2xzID1+IC8oW15cc10rKT0oKFxcXHN8 W15cc10pKykvZykgeworCSRkZWZpbmV7JDF9ID0gJDI7CisJaWYgKCRvcHRfRCkgeworCSAgICBw cmludCBTVERFUlIgIiRfOiAgJDEgLT4gJDJcbiI7CisJfQogICAgIH0KIAogICAgIHJldHVybiAl ZGVmaW5lOwpAQCAtNjcwLDYgKzc4MiwxMCBAQCBJdCBpcyBtb3N0IGVhc2lseSBydW4gd2hpbGUg aW4gL3Vzci9pbmNsdWRlOgogCiAJY2QgL3Vzci9pbmNsdWRlOyBoMnBoICogc3lzLyoKIAorb3IK KworCWNkIC91c3IvaW5jbHVkZTsgaDJwaCAqIHN5cy8qIGFycGEvKiBuZXRpbmV0LyoKKwogb3IK IAogCWNkIC91c3IvaW5jbHVkZTsgaDJwaCAtciAtbCAuCkBAIC02ODcsNyArODAzLDcgQEAgSWYg cnVuIHdpdGggbm8gYXJndW1lbnRzLCBmaWx0ZXJzIHN0YW5kYXJkIGlucHV0IHRvIHN0YW5kYXJk IG91dHB1dC4KID1pdGVtIC1kIGRlc3RpbmF0aW9uX2RpcgogCiBQdXQgdGhlIHJlc3VsdGluZyBC PC5waD4gZmlsZXMgYmVuZWF0aCBCPGRlc3RpbmF0aW9uX2Rpcj4sIGluc3RlYWQgb2YKLWJlbmVh dGggdGhlIGRlZmF1bHQgUGVybCBsaWJyYXJ5IGxvY2F0aW9uIChDPCRDb25maWd7J2luc3RhbGxz aXRzZWFyY2gnfT4pLgorYmVuZWF0aCB0aGUgZGVmYXVsdCBQZXJsIGxpYnJhcnkgbG9jYXRpb24g KEM8JENvbmZpZ3snaW5zdGFsbHNpdGVhcmNoJ30+KS4KIAogPWl0ZW0gLXIKIApAQCAtNzcyLDEw ICs4ODgsMTAgQEAgaW5zdGFsbGF0aW9uLgogRG9lc24ndCBoYW5kbGUgY29tcGxpY2F0ZWQgZXhw cmVzc2lvbnMgYnVpbHQgcGllY2VtZWFsLCBhIGxhOgogCiAgICAgZW51bSB7Ci0gICAgICAgIEZJ UlNUX1ZBTFVFLAotICAgICAgICBTRUNPTkRfVkFMVUUsCisJRklSU1RfVkFMVUUsCisJU0VDT05E X1ZBTFVFLAogICAgICNpZmRlZiBBQkMKLSAgICAgICAgVEhJUkRfVkFMVUUKKwlUSElSRF9WQUxV RQogICAgICNlbmRpZgogICAgIH07CiAK UH2PH573 } if ( $num < 5.008001 ) { return _patch_b64(<<'UH2PH580'); LS0tIHV0aWxzL2gycGguUEwKKysrIHV0aWxzL2gycGguUEwKQEAgLTQyLDggKzQyLDEzIEBAIHVz ZSBDb25maWc7CiB1c2UgRmlsZTo6UGF0aCBxdyhta3BhdGgpOwogdXNlIEdldG9wdDo6U3RkOwog Ci1nZXRvcHRzKCdEZDpybGhhUScpOwotdXNlIHZhcnMgcXcoJG9wdF9EICRvcHRfZCAkb3B0X3Ig JG9wdF9sICRvcHRfaCAkb3B0X2EgJG9wdF9RKTsKKyMgTWFrZSBzdXJlIHJlYWQgcGVybWlzc2lv bnMgZm9yIGFsbCBhcmUgc2V0OgoraWYgKGRlZmluZWQgdW1hc2sgJiYgKHVtYXNrKCkgJiAwNDQ0 KSkgeworICAgIHVtYXNrICh1bWFzaygpICYgfjA0NDQpOworfQorCitnZXRvcHRzKCdEZDpybGhh UWUnKTsKK3VzZSB2YXJzIHF3KCRvcHRfRCAkb3B0X2QgJG9wdF9yICRvcHRfbCAkb3B0X2ggJG9w dF9hICRvcHRfUSAkb3B0X2UpOwogZGllICItciBhbmQgLWEgb3B0aW9ucyBhcmUgbXV0dWFsbHkg ZXhjbHVzaXZlXG4iIGlmICgkb3B0X3IgYW5kICRvcHRfYSk7CiBteSBAaW5jX2RpcnMgPSBpbmNf ZGlycygpIGlmICRvcHRfYTsKIApAQCAtNjUsMTMgKzcwLDIxIEBAIG15ICVpc2F0eXBlOwogQGlz YXR5cGV7QGlzYXR5cGV9ID0gKDEpIHggQGlzYXR5cGU7CiBteSAkaW5pZiA9IDA7CiBteSAlSXNf Y29udmVydGVkOworbXkgJWJhZF9maWxlID0gKCk7CiAKIEBBUkdWID0gKCctJykgdW5sZXNzIEBB UkdWOwogCiBidWlsZF9wcmVhbWJsZV9pZl9uZWNlc3NhcnkoKTsKIAorc3ViIHJlaW5kZW50KCQp IHsKKyAgICBteSgkdGV4dCkgPSBzaGlmdDsKKyAgICAkdGV4dCA9fiBzL1xuL1xuICAgIC9nOwor ICAgICR0ZXh0ID1+IHMvICAgICAgICAvXHQvZzsKKyAgICAkdGV4dDsKK30KKwogbXkgKCR0LCAk dGFiLCAlY3VyYXJncywgJG5ldywgJGV2YWxfaW5kZXgsICRkaXIsICRuYW1lLCAkYXJncywgJG91 dGZpbGUpOwotbXkgKCRpbmNsLCAkbmV4dCk7CitteSAoJGluY2wsICRpbmNsX3R5cGUsICRpbmNs X3F1b3RlLCAkbmV4dCk7CiB3aGlsZSAoZGVmaW5lZCAobXkgJGZpbGUgPSBuZXh0X2ZpbGUoKSkp IHsKICAgICBpZiAoLWwgJGZpbGUgYW5kIC1kICRmaWxlKSB7CiAgICAgICAgIGxpbmtfaWZfcG9z c2libGUoJGZpbGUpIGlmICgkb3B0X2wpOwpAQCAtMTA3LDcgKzEyMCw5IEBAIHdoaWxlIChkZWZp bmVkIChteSAkZmlsZSA9IG5leHRfZmlsZSgpKSkgewogCW9wZW4oT1VULCI+JERlc3RfZGlyLyRv dXRmaWxlIikgfHwgZGllICJDYW4ndCBjcmVhdGUgJG91dGZpbGU6ICQhXG4iOwogICAgIH0KIAot ICAgIHByaW50IE9VVCAicmVxdWlyZSAnX2gycGhfcHJlLnBoJztcblxuIjsKKyAgICBwcmludCBP VVQKKyAgICAgICAgInJlcXVpcmUgJ19oMnBoX3ByZS5waCc7XG5cbiIsCisgICAgICAgICJubyB3 YXJuaW5ncyAncmVkZWZpbmUnO1xuXG4iOwogCiAgICAgd2hpbGUgKGRlZmluZWQgKGxvY2FsICRf ID0gbmV4dF9saW5lKCRmaWxlKSkpIHsKIAlpZiAocy9eXHMqXCNccyovLykgewpAQCAtMTY5LDIy ICsxODQsMzIgQEAgd2hpbGUgKGRlZmluZWQgKG15ICRmaWxlID0gbmV4dF9maWxlKCkpKSB7CiAg ICAgICAgICAgICAgICAgICAgICAgcHJpbnQgT1VUICR0LCJ1bmxlc3MoZGVmaW5lZChcJiRuYW1l KSkge1xuICAgIHN1YiAkbmFtZSAoKSB7XHQiLCRuZXcsIjt9XG59XG4iOwogCQkgICAgfQogCQl9 Ci0JICAgIH0gZWxzaWYgKC9eKGluY2x1ZGV8aW1wb3J0KVxzKls8Il0oLiopWz4iXS8pIHsKLQkJ KCRpbmNsID0gJDIpID1+IHMvXC5oJC8ucGgvOwotCQlwcmludCBPVVQgJHQsInJlcXVpcmUgJyRp bmNsJztcbiI7Ci0JICAgIH0gZWxzaWYoL15pbmNsdWRlX25leHRccypbPCJdKC4qKVs+Il0vKSB7 Ci0JCSgkaW5jbCA9ICQxKSA9fiBzL1wuaCQvLnBoLzsKKwkgICAgfSBlbHNpZiAoL14oaW5jbHVk ZXxpbXBvcnR8aW5jbHVkZV9uZXh0KVxzKihbPFwiXSkoLiopWz5cIl0vKSB7CisgICAgICAgICAg ICAgICAgJGluY2xfdHlwZSA9ICQxOworICAgICAgICAgICAgICAgICRpbmNsX3F1b3RlID0gJDI7 CisgICAgICAgICAgICAgICAgJGluY2wgPSAkMzsKKyAgICAgICAgICAgICAgICBpZiAoKCRpbmNs X3R5cGUgZXEgJ2luY2x1ZGVfbmV4dCcpIHx8CisgICAgICAgICAgICAgICAgICAgICgkb3B0X2Ug JiYgZXhpc3RzKCRiYWRfZmlsZXskaW5jbH0pKSkgeworICAgICAgICAgICAgICAgICAgICAkaW5j bCA9fiBzL1wuaCQvLnBoLzsKIAkJcHJpbnQgT1VUICgkdCwKIAkJCSAgICJldmFsIHtcbiIpOwog ICAgICAgICAgICAgICAgICR0YWIgKz0gNDsKICAgICAgICAgICAgICAgICAkdCA9ICJcdCIgeCAo JHRhYiAvIDgpIC4gJyAnIHggKCR0YWIgJSA4KTsKKyAgICAgICAgICAgICAgICAgICAgcHJpbnQg T1VUICgkdCwgIm15KFxAUkVNKTtcbiIpOworICAgICAgICAgICAgICAgICAgICBpZiAoJGluY2xf dHlwZSBlcSAnaW5jbHVkZV9uZXh0JykgewogCQlwcmludCBPVVQgKCR0LAogCQkJICAgIm15KFwl SU5DRCkgPSBtYXAgeyBcJElOQ3tcJF99ID0+IDEgfSAiLAotCQkJICAgIihncmVwIHsgXCRfIGVx IFwiJGluY2xcIiB9IGtleXMoXCVJTkMpKTtcbiIpOworCQkJICAgICAgICAgICAiKGdyZXAgeyBc JF8gZXEgXCIkaW5jbFwiIH0gIiwKKyAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg ImtleXMoXCVJTkMpKTtcbiIpOwogCQlwcmludCBPVVQgKCR0LAotCQkJICAgIm15KFxAUkVNKSA9 IG1hcCB7IFwiXCRfLyRpbmNsXCIgfSAiLAorCQkJICAgICAgICAgICAiXEBSRU0gPSBtYXAgeyBc IlwkXy8kaW5jbFwiIH0gIiwKIAkJCSAgICIoZ3JlcCB7IG5vdCBleGlzdHMoXCRJTkNEe1wiXCRf LyRpbmNsXCJ9KSIsCi0JCQkgICAiYW5kIC1mIFwiXCRfLyRpbmNsXCIgfSBcQElOQyk7XG4iKTsK KwkJCSAgICAgICAgICAgIiBhbmQgLWYgXCJcJF8vJGluY2xcIiB9IFxASU5DKTtcbiIpOworICAg ICAgICAgICAgICAgICAgICB9IGVsc2UgeworICAgICAgICAgICAgICAgICAgICAgICAgcHJpbnQg T1VUICgkdCwKKyAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIlxAUkVNID0gbWFw IHsgXCJcJF8vJGluY2xcIiB9ICIsCisgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg ICIoZ3JlcCB7LXIgXCJcJF8vJGluY2xcIiB9IFxASU5DKTtcbiIpOworICAgICAgICAgICAgICAg ICAgICB9CiAJCXByaW50IE9VVCAoJHQsCiAJCQkgICAicmVxdWlyZSBcIlwkUkVNWzBdXCIgaWYg XEBSRU07XG4iKTsKICAgICAgICAgICAgICAgICAkdGFiIC09IDQ7CkBAIC0xOTMsNiArMjE4LDE0 IEBAIHdoaWxlIChkZWZpbmVkIChteSAkZmlsZSA9IG5leHRfZmlsZSgpKSkgewogCQkJICAgIn07 XG4iKTsKIAkJcHJpbnQgT1VUICgkdCwKIAkJCSAgICJ3YXJuKFwkXEApIGlmIFwkXEA7XG4iKTsK KyAgICAgICAgICAgICAgICB9IGVsc2UgeworICAgICAgICAgICAgICAgICAgICAkaW5jbCA9fiBz L1wuaCQvLnBoLzsKKyAgICAgICAgICAgICAgICAgICAgIyBjb3B5IHRoZSBwcmVmaXggaW4gdGhl IHF1b3RlIHN5bnRheCAoI2luY2x1ZGUgInguaCIpIGNhc2UKKyAgICAgICAgICAgICAgICAgICAg aWYgKCRpbmNsICF+IG18L3wgJiYgJGluY2xfcXVvdGUgZXEgcXsifSAmJiAkZmlsZSA9fiBtfF4o LiopL3wpIHsKKyAgICAgICAgICAgICAgICAgICAgICAgICRpbmNsID0gIiQxLyRpbmNsIjsKKyAg ICAgICAgICAgICAgICAgICAgfQorCQkgICAgcHJpbnQgT1VUICR0LCJyZXF1aXJlICckaW5jbCc7 XG4iOworICAgICAgICAgICAgICAgIH0KIAkgICAgfSBlbHNpZiAoL15pZmRlZlxzKyhcdyspLykg ewogCQlwcmludCBPVVQgJHQsImlmKGRlZmluZWQoJiQxKSkge1xuIjsKIAkJJHRhYiArPSA0OwpA QCAtMjc0LDIyICszMDcsMjIgQEAgd2hpbGUgKGRlZmluZWQgKG15ICRmaWxlID0gbmV4dF9maWxl KCkpKSB7CiAJICAgIH0KIAl9CiAgICAgfQotICAgIHByaW50IE9VVCAiMTtcbiI7Ci0KICAgICAk SXNfY29udmVydGVkeyRmaWxlfSA9IDE7CisgICAgaWYgKCRvcHRfZSAmJiBleGlzdHMoJGJhZF9m aWxleyRmaWxlfSkpIHsKKyAgICAgICAgdW5saW5rKCREZXN0X2RpciAuICcvJyAuICRvdXRmaWxl KTsKKyAgICAgICAgJG5leHQgPSAnJzsKKyAgICB9IGVsc2UgeworICAgICAgICBwcmludCBPVVQg IjE7XG4iOwogICAgIHF1ZXVlX2luY2x1ZGVzX2Zyb20oJGZpbGUpIGlmICgkb3B0X2EpOworICAg IH0KIH0KIAotZXhpdCAkRXhpdDsKLQotCi1zdWIgcmVpbmRlbnQoJCkgewotICAgIG15KCR0ZXh0 KSA9IHNoaWZ0OwotICAgICR0ZXh0ID1+IHMvXG4vXG4gICAgL2c7Ci0gICAgJHRleHQgPX4gcy8g ICAgICAgIC9cdC9nOwotICAgICR0ZXh0OworaWYgKCRvcHRfZSAmJiAoc2NhbGFyKGtleXMgJWJh ZF9maWxlKSA+IDApKSB7CisgICAgd2FybiAiV2FzIHVuYWJsZSB0byBjb252ZXJ0IHRoZSBmb2xs b3dpbmcgZmlsZXM6XG4iOworICAgIHdhcm4gIlx0IiAuIGpvaW4oIlxuXHQiLHNvcnQoa2V5cyAl YmFkX2ZpbGUpKSAuICJcbiI7CiB9CiAKK2V4aXQgJEV4aXQ7CiAKIHN1YiBleHByIHsKICAgICBt eSAkam9pbmVkX2FyZ3M7CkBAIC00MDMsNyArNDM2LDcgQEAgc3ViIGV4cHIgewogCQl9CiAJICAg IH0gZWxzZSB7CiAJCWlmICgkaW5pZiAmJiAkbmV3ICF+IC9kZWZpbmVkXHMqXCgkLykgewotCQkg ICAgJG5ldyAuPSAnKGRlZmluZWQoJicgLiAkaWQgLiAnKSA/ICYnIC4gJGlkIC4gJyA6IDApJzsK KwkJICAgICRuZXcgLj0gJyhkZWZpbmVkKCYnIC4gJGlkIC4gJykgPyAmJyAuICRpZCAuICcgOiB1 bmRlZiknOwogCQl9IGVsc2lmICgvXlxbLykgewogCQkgICAgJG5ldyAuPSAiIFwkJGlkIjsKIAkJ fSBlbHNlIHsKQEAgLTQ2MywxMCArNDk2LDE4IEBAIHN1YiBuZXh0X2xpbmUKICAgICAgICAgICAg ICAgICAkb3V0ICAgIC49ICQxOwogICAgICAgICAgICAgfSBlbHNpZiAoJGluID1+IHMvXihcXC4p Ly8pIHsgICAgICAgICAgICAgICAgICAgIyBcLi4uCiAgICAgICAgICAgICAgICAgJG91dCAgICAu PSAkMTsKLSAgICAgICAgICAgIH0gZWxzaWYgKCRpbiA9fiBzL14oJyhcXC58W14nXFxdKSonKS8v KSB7ICAgICAgICMgJy4uLgotICAgICAgICAgICAgICAgICRvdXQgICAgLj0gJDE7Ci0gICAgICAg ICAgICB9IGVsc2lmICgkaW4gPX4gcy9eKCIoXFwufFteIlxcXSkqIikvLykgeyAgICAgICAjICIu Li4KLSAgICAgICAgICAgICAgICAkb3V0ICAgIC49ICQxOworICAgICAgICAgICAgfSBlbHNpZiAo JGluID1+IC9eJy8pIHsgICAgICAgICAgICAgICAgICAgICAgICAgIyAnLi4uCisgICAgICAgICAg ICAgICAgaWYgKCRpbiA9fiBzL14oJyhcXC58W14nXFxdKSonKS8vKSB7CisgICAgICAgICAgICAg ICAgICAgICRvdXQgICAgLj0gJDE7CisgICAgICAgICAgICAgICAgfSBlbHNlIHsKKyAgICAgICAg ICAgICAgICAgICAgbmV4dCBSRUFEOworICAgICAgICAgICAgICAgIH0KKyAgICAgICAgICAgIH0g ZWxzaWYgKCRpbiA9fiAvXiIvKSB7ICAgICAgICAgICAgICAgICAgICAgICAgICMgIi4uLgorICAg ICAgICAgICAgICAgIGlmICgkaW4gPX4gcy9eKCIoXFwufFteIlxcXSkqIikvLykgeworICAgICAg ICAgICAgICAgICAgICAkb3V0ICAgIC49ICQxOworICAgICAgICAgICAgICAgIH0gZWxzZSB7Cisg ICAgICAgICAgICAgICAgICAgIG5leHQgUkVBRDsKKyAgICAgICAgICAgICAgICB9CiAgICAgICAg ICAgICB9IGVsc2lmICgkaW4gPX4gcy9eXC9cLy4qLy8pIHsgICAgICAgICAgICAgICAgICAjIC8v Li4uCiAgICAgICAgICAgICAgICAgIyBmYWxsIHRocm91Z2gKICAgICAgICAgICAgIH0gZWxzaWYg KCRpbiA9fiBtL15cL1wqLykgeyAgICAgICAgICAgICAgICAgICAgICMgLyouLi4KQEAgLTQ4NSw3 ICs1MjYsMTUgQEAgc3ViIG5leHRfbGluZQogICAgICAgICAgICAgICAgICAgICAgJGluICAgPX4g cyFcJ1QgS05PVyEhKSB7CiAgICAgICAgICAgICAgICAgJG91dCAgICA9fiBzIUkgRE9OJCFJX0RP X05PVF9LTk9XITsKICAgICAgICAgICAgIH0gZWxzZSB7CisgICAgICAgICAgICAgICAgaWYgKCRv cHRfZSkgeworICAgICAgICAgICAgICAgICAgICB3YXJuICJDYW5ub3QgcGFyc2UgJGZpbGU6XG4k aW5cbiI7CisgICAgICAgICAgICAgICAgICAgICRiYWRfZmlsZXskZmlsZX0gPSAxOworICAgICAg ICAgICAgICAgICAgICAkaW4gPSAnJzsKKyAgICAgICAgICAgICAgICAgICAgJG91dCA9IHVuZGVm OworICAgICAgICAgICAgICAgICAgICBsYXN0IFJFQUQ7CisgICAgICAgICAgICAgICAgfSBlbHNl IHsKIAkJZGllICJDYW5ub3QgcGFyc2U6XG4kaW5cbiI7CisgICAgICAgICAgICAgICAgfQogICAg ICAgICAgICAgfQogICAgICAgICB9CiAKQEAgLTU5NSw4ICs2NDQsMTMgQEAgc3ViIHF1ZXVlX2lu Y2x1ZGVzX2Zyb20KICAgICAgICAgICAgICAgICAkbGluZSAuPSA8SEVBREVSPjsKICAgICAgICAg ICAgIH0KIAotICAgICAgICAgICAgaWYgKCRsaW5lID1+IC9eI1xzKmluY2x1ZGVccys8KC4qPyk+ LykgewotICAgICAgICAgICAgICAgIHB1c2goQEFSR1YsICQxKSB1bmxlc3MgJElzX2NvbnZlcnRl ZHskMX07CisgICAgICAgICAgICBpZiAoJGxpbmUgPX4gL14jXHMqaW5jbHVkZVxzKyhbPCJdKSgu Kj8pWz4iXS8pIHsKKyAgICAgICAgICAgICAgICBteSAoJGRlbGltaXRlciwgJG5ld19maWxlKSA9 ICgkMSwgJDIpOworICAgICAgICAgICAgICAgICMgY29weSB0aGUgcHJlZml4IGluIHRoZSBxdW90 ZSBzeW50YXggKCNpbmNsdWRlICJ4LmgiKSBjYXNlCisgICAgICAgICAgICAgICAgaWYgKCRkZWxp bWl0ZXIgZXEgcXsifSAmJiAkZmlsZSA9fiBtfF4oLiopL3wpIHsKKyAgICAgICAgICAgICAgICAg ICAgJG5ld19maWxlID0gIiQxLyRuZXdfZmlsZSI7CisgICAgICAgICAgICAgICAgfQorICAgICAg ICAgICAgICAgIHB1c2goQEFSR1YsICRuZXdfZmlsZSkgdW5sZXNzICRJc19jb252ZXJ0ZWR7JG5l d19maWxlfTsKICAgICAgICAgICAgIH0KICAgICAgICAgfQogICAgIGNsb3NlIEhFQURFUjsKQEAg LTYzNywyNSArNjkxLDUwIEBAIHN1YiBidWlsZF9wcmVhbWJsZV9pZl9uZWNlc3NhcnkKICAgICBt eSAoJWRlZmluZSkgPSBfZXh0cmFjdF9jY19kZWZpbmVzKCk7CiAKICAgICBvcGVuICBQUkVBTUJM RSwgIj4kcHJlYW1ibGUiIG9yIGRpZSAiQ2Fubm90IG9wZW4gJHByZWFtYmxlOiAgJCEiOwotICAg ICAgICBwcmludCBQUkVBTUJMRSAiIyBUaGlzIGZpbGUgd2FzIGNyZWF0ZWQgYnkgaDJwaCB2ZXJz aW9uICRWRVJTSU9OXG4iOwotCi0gICAgICAgIGZvcmVhY2ggKHNvcnQga2V5cyAlZGVmaW5lKSB7 Ci0gICAgICAgICAgICBpZiAoJG9wdF9EKSB7Ci0gICAgICAgICAgICAgICAgcHJpbnQgUFJFQU1C TEUgIiMgJF89JGRlZmluZXskX31cbiI7Ci0gICAgICAgICAgICB9Ci0KLSAgICAgICAgICAgIGlm ICgkZGVmaW5leyRffSA9fiAvXihcZCspVT9MezAsMn0kL2kpIHsKLSAgICAgICAgICAgICAgICBw cmludCBQUkVBTUJMRQotICAgICAgICAgICAgICAgICAgICAidW5sZXNzIChkZWZpbmVkICYkXykg eyBzdWIgJF8oKSB7ICQxIH0gfVxuXG4iOwotICAgICAgICAgICAgfSBlbHNpZiAoJGRlZmluZXsk X30gPX4gL15cdyskLykgewotICAgICAgICAgICAgICAgIHByaW50IFBSRUFNQkxFCi0gICAgICAg ICAgICAgICAgICAgICJ1bmxlc3MgKGRlZmluZWQgJiRfKSB7IHN1YiAkXygpIHsgJiRkZWZpbmV7 JF99IH0gfVxuXG4iOwotICAgICAgICAgICAgfSBlbHNlIHsKKwlwcmludCBQUkVBTUJMRSAiIyBU aGlzIGZpbGUgd2FzIGNyZWF0ZWQgYnkgaDJwaCB2ZXJzaW9uICRWRVJTSU9OXG4iOworICAgICAg ICAjIFByZXZlbnQgbm9uLXBvcnRhYmxlIGhleCBjb25zdGFudHMgZnJvbSB3YXJuaW5nLgorICAg ICAgICAjCisgICAgICAgICMgV2Ugc3RpbGwgcHJvZHVjZSBhbiBvdmVyZmxvdyB3YXJuaW5nIGlm IHdlIGNhbid0IHJlcHJlc2VudAorICAgICAgICAjIGEgaGV4IGNvbnN0YW50IGFzIGFuIGludGVn ZXIuCisgICAgICAgIHByaW50IFBSRUFNQkxFICJubyB3YXJuaW5ncyBxdyhwb3J0YWJsZSk7XG4i OworCisJZm9yZWFjaCAoc29ydCBrZXlzICVkZWZpbmUpIHsKKwkgICAgaWYgKCRvcHRfRCkgewor CQlwcmludCBQUkVBTUJMRSAiIyAkXz0kZGVmaW5leyRffVxuIjsKKwkgICAgfQorCSAgICBpZiAo JGRlZmluZXskX30gPX4gL15cKCguKilcKSQvKSB7CisJCSMgcGFyZW50aGVzaXplZCB2YWx1ZTog IGQ9KHYpCisJCSRkZWZpbmV7JF99ID0gJDE7CisJICAgIH0KKwkgICAgaWYgKCRkZWZpbmV7JF99 ID1+IC9eKFsrLV0/KFxkKyk/XC5cZCsoW2VFXVsrLV0/XGQrKT8pW0ZMXT8kLykgeworCQkjIGZs b2F0OgorCQlwcmludCBQUkVBTUJMRQorCQkgICAgInVubGVzcyAoZGVmaW5lZCAmJF8pIHsgc3Vi ICRfKCkgeyAkMSB9IH1cblxuIjsKKwkgICAgfSBlbHNpZiAoJGRlZmluZXskX30gPX4gL14oWyst XT9cZCspVT9MezAsMn0kL2kpIHsKKwkJIyBpbnRlZ2VyOgorCQlwcmludCBQUkVBTUJMRQorCQkg ICAgInVubGVzcyAoZGVmaW5lZCAmJF8pIHsgc3ViICRfKCkgeyAkMSB9IH1cblxuIjsKKyAgICAg ICAgICAgIH0gZWxzaWYgKCRkZWZpbmV7JF99ID1+IC9eKFsrLV0/MHhbXGRhLWZdKylVP0x7MCwy fSQvaSkgeworICAgICAgICAgICAgICAgICMgaGV4IGludGVnZXIKKyAgICAgICAgICAgICAgICAj IFNwZWNpYWwgY2FzZWQsIHNpbmNlIHBlcmwgd2FybnMgb24gaGV4IGludGVnZXJzCisgICAgICAg ICAgICAgICAgIyB0aGF0IGNhbid0IGJlIHJlcHJlc2VudGVkIGluIGEgVVYuCisgICAgICAgICAg ICAgICAgIworICAgICAgICAgICAgICAgICMgVGhpcyB3YXkgd2UgZ2V0IHRoZSB3YXJuaW5nIGF0 IHRpbWUgb2YgdXNlLCBzbyB0aGUgdXNlcgorICAgICAgICAgICAgICAgICMgb25seSBnZXRzIHRo ZSB3YXJuaW5nIGlmIHRoZXkgaGFwcGVuIHRvIHVzZSB0aGlzCisgICAgICAgICAgICAgICAgIyBw bGF0Zm9ybS1zcGVjaWZpYyBkZWZpbml0aW9uLgorICAgICAgICAgICAgICAgIG15ICRjb2RlID0g JDE7CisgICAgICAgICAgICAgICAgJGNvZGUgPSAiaGV4KCckY29kZScpIiBpZiBsZW5ndGggJGNv ZGUgPiAxMDsKICAgICAgICAgICAgICAgICBwcmludCBQUkVBTUJMRQotICAgICAgICAgICAgICAg ICAgICAidW5sZXNzIChkZWZpbmVkICYkXykgeyBzdWIgJF8oKSB7IFwiIiwKLSAgICAgICAgICAg ICAgICAgICAgcXVvdGVtZXRhKCRkZWZpbmV7JF99KSwgIlwiIH0gfVxuXG4iOwotICAgICAgICAg ICAgfQotICAgICAgICB9CisgICAgICAgICAgICAgICAgICAgICJ1bmxlc3MgKGRlZmluZWQgJiRf KSB7IHN1YiAkXygpIHsgJGNvZGUgfSB9XG5cbiI7CisJICAgIH0gZWxzaWYgKCRkZWZpbmV7JF99 ID1+IC9eXHcrJC8pIHsKKwkJcHJpbnQgUFJFQU1CTEUKKwkJICAgICJ1bmxlc3MgKGRlZmluZWQg JiRfKSB7IHN1YiAkXygpIHsgJiRkZWZpbmV7JF99IH0gfVxuXG4iOworCSAgICB9IGVsc2Ugewor CQlwcmludCBQUkVBTUJMRQorCQkgICAgInVubGVzcyAoZGVmaW5lZCAmJF8pIHsgc3ViICRfKCkg eyBcIiIsCisJCSAgICBxdW90ZW1ldGEoJGRlZmluZXskX30pLCAiXCIgfSB9XG5cbiI7CisJICAg IH0KKwl9CiAgICAgY2xvc2UgUFJFQU1CTEUgICAgICAgICAgICAgICBvciBkaWUgIkNhbm5vdCBj bG9zZSAkcHJlYW1ibGU6ICAkISI7CiB9CiAKQEAgLTY2NywxNSArNzQ2LDE0IEBAIHN1YiBfZXh0 cmFjdF9jY19kZWZpbmVzCiB7CiAgICAgbXkgJWRlZmluZTsKICAgICBteSAkYWxsc3ltYm9scyAg PSBqb2luICIgIiwKLSAgICAgICAgQENvbmZpZ3snY2NzeW1ib2xzJywgJ2NwcHN5bWJvbHMnLCAn Y3BwY2NzeW1ib2xzJ307CisJQENvbmZpZ3snY2NzeW1ib2xzJywgJ2NwcHN5bWJvbHMnLCAnY3Bw Y2NzeW1ib2xzJ307CiAKICAgICAjIFNwbGl0IGNvbXBpbGVyIHByZS1kZWZpbml0aW9ucyBpbnRv IGBrZXk9dmFsdWUnIHBhaXJzOgotICAgIGZvcmVhY2ggKHNwbGl0IC9ccysvLCAkYWxsc3ltYm9s cykgewotICAgICAgICAvKC4rPyk9KC4rKS8gYW5kICRkZWZpbmV7JDF9ID0gJDI7Ci0KLSAgICAg ICAgaWYgKCRvcHRfRCkgewotICAgICAgICAgICAgcHJpbnQgU1RERVJSICIkXzogICQxIC0+ICQy XG4iOwotICAgICAgICB9CisgICAgd2hpbGUgKCRhbGxzeW1ib2xzID1+IC8oW15cc10rKT0oKFxc XHN8W15cc10pKykvZykgeworCSRkZWZpbmV7JDF9ID0gJDI7CisJaWYgKCRvcHRfRCkgeworCSAg ICBwcmludCBTVERFUlIgIiRfOiAgJDEgLT4gJDJcbiI7CisJfQogICAgIH0KIAogICAgIHJldHVy biAlZGVmaW5lOwpAQCAtNzI1LDcgKzgwMyw3IEBAIElmIHJ1biB3aXRoIG5vIGFyZ3VtZW50cywg ZmlsdGVycyBzdGFuZGFyZCBpbnB1dCB0byBzdGFuZGFyZCBvdXRwdXQuCiA9aXRlbSAtZCBkZXN0 aW5hdGlvbl9kaXIKIAogUHV0IHRoZSByZXN1bHRpbmcgQjwucGg+IGZpbGVzIGJlbmVhdGggQjxk ZXN0aW5hdGlvbl9kaXI+LCBpbnN0ZWFkIG9mCi1iZW5lYXRoIHRoZSBkZWZhdWx0IFBlcmwgbGli cmFyeSBsb2NhdGlvbiAoQzwkQ29uZmlneydpbnN0YWxsc2l0c2VhcmNoJ30+KS4KK2JlbmVhdGgg dGhlIGRlZmF1bHQgUGVybCBsaWJyYXJ5IGxvY2F0aW9uIChDPCRDb25maWd7J2luc3RhbGxzaXRl YXJjaCd9PikuCiAKID1pdGVtIC1yCiAKQEAgLTgxMCwxMCArODg4LDEwIEBAIGluc3RhbGxhdGlv bi4KIERvZXNuJ3QgaGFuZGxlIGNvbXBsaWNhdGVkIGV4cHJlc3Npb25zIGJ1aWx0IHBpZWNlbWVh bCwgYSBsYToKIAogICAgIGVudW0gewotICAgICAgICBGSVJTVF9WQUxVRSwKLSAgICAgICAgU0VD T05EX1ZBTFVFLAorCUZJUlNUX1ZBTFVFLAorCVNFQ09ORF9WQUxVRSwKICAgICAjaWZkZWYgQUJD Ci0gICAgICAgIFRISVJEX1ZBTFVFCisJVEhJUkRfVkFMVUUKICAgICAjZW5kaWYKICAgICB9Owog Cg== UH2PH580 } if ( $num < 5.008009 ) { return _patch_b64(<<'UH2PH588'); LS0tIHV0aWxzL2gycGguUEwKKysrIHV0aWxzL2gycGguUEwKQEAgLTg0LDcgKzg0LDcgQEAgc3Vi IHJlaW5kZW50KCQpIHsKIH0KIAogbXkgKCR0LCAkdGFiLCAlY3VyYXJncywgJG5ldywgJGV2YWxf aW5kZXgsICRkaXIsICRuYW1lLCAkYXJncywgJG91dGZpbGUpOwotbXkgKCRpbmNsLCAkaW5jbF90 eXBlLCAkbmV4dCk7CitteSAoJGluY2wsICRpbmNsX3R5cGUsICRpbmNsX3F1b3RlLCAkbmV4dCk7 CiB3aGlsZSAoZGVmaW5lZCAobXkgJGZpbGUgPSBuZXh0X2ZpbGUoKSkpIHsKICAgICBpZiAoLWwg JGZpbGUgYW5kIC1kICRmaWxlKSB7CiAgICAgICAgIGxpbmtfaWZfcG9zc2libGUoJGZpbGUpIGlm ICgkb3B0X2wpOwpAQCAtMTg0LDkgKzE4NCwxMCBAQCB3aGlsZSAoZGVmaW5lZCAobXkgJGZpbGUg PSBuZXh0X2ZpbGUoKSkpIHsKICAgICAgICAgICAgICAgICAgICAgICBwcmludCBPVVQgJHQsInVu bGVzcyhkZWZpbmVkKFwmJG5hbWUpKSB7XG4gICAgc3ViICRuYW1lICgpIHtcdCIsJG5ldywiO31c bn1cbiI7CiAJCSAgICB9CiAJCX0KLQkgICAgfSBlbHNpZiAoL14oaW5jbHVkZXxpbXBvcnR8aW5j bHVkZV9uZXh0KVxzKls8XCJdKC4qKVs+XCJdLykgeworCSAgICB9IGVsc2lmICgvXihpbmNsdWRl fGltcG9ydHxpbmNsdWRlX25leHQpXHMqKFs8XCJdKSguKilbPlwiXS8pIHsKICAgICAgICAgICAg ICAgICAkaW5jbF90eXBlID0gJDE7Ci0gICAgICAgICAgICAgICAgJGluY2wgPSAkMjsKKyAgICAg ICAgICAgICAgICAkaW5jbF9xdW90ZSA9ICQyOworICAgICAgICAgICAgICAgICRpbmNsID0gJDM7 CiAgICAgICAgICAgICAgICAgaWYgKCgkaW5jbF90eXBlIGVxICdpbmNsdWRlX25leHQnKSB8fAog ICAgICAgICAgICAgICAgICAgICAoJG9wdF9lICYmIGV4aXN0cygkYmFkX2ZpbGV7JGluY2x9KSkp IHsKICAgICAgICAgICAgICAgICAgICAgJGluY2wgPX4gcy9cLmgkLy5waC87CkBAIC0yMTksNiAr MjIwLDEwIEBAIHdoaWxlIChkZWZpbmVkIChteSAkZmlsZSA9IG5leHRfZmlsZSgpKSkgewogCQkJ ICAgIndhcm4oXCRcQCkgaWYgXCRcQDtcbiIpOwogICAgICAgICAgICAgICAgIH0gZWxzZSB7CiAg ICAgICAgICAgICAgICAgICAgICRpbmNsID1+IHMvXC5oJC8ucGgvOworICAgICAgICAgICAgICAg ICAgICAjIGNvcHkgdGhlIHByZWZpeCBpbiB0aGUgcXVvdGUgc3ludGF4ICgjaW5jbHVkZSAieC5o IikgY2FzZQorICAgICAgICAgICAgICAgICAgICBpZiAoJGluY2wgIX4gbXwvfCAmJiAkaW5jbF9x dW90ZSBlcSBxeyJ9ICYmICRmaWxlID1+IG18XiguKikvfCkgeworICAgICAgICAgICAgICAgICAg ICAgICAgJGluY2wgPSAiJDEvJGluY2wiOworICAgICAgICAgICAgICAgICAgICB9CiAJCSAgICBw cmludCBPVVQgJHQsInJlcXVpcmUgJyRpbmNsJztcbiI7CiAgICAgICAgICAgICAgICAgfQogCSAg ICB9IGVsc2lmICgvXmlmZGVmXHMrKFx3KykvKSB7CkBAIC00MzEsNyArNDM2LDcgQEAgc3ViIGV4 cHIgewogCQl9CiAJICAgIH0gZWxzZSB7CiAJCWlmICgkaW5pZiAmJiAkbmV3ICF+IC9kZWZpbmVk XHMqXCgkLykgewotCQkgICAgJG5ldyAuPSAnKGRlZmluZWQoJicgLiAkaWQgLiAnKSA/ICYnIC4g JGlkIC4gJyA6IDApJzsKKwkJICAgICRuZXcgLj0gJyhkZWZpbmVkKCYnIC4gJGlkIC4gJykgPyAm JyAuICRpZCAuICcgOiB1bmRlZiknOwogCQl9IGVsc2lmICgvXlxbLykgewogCQkgICAgJG5ldyAu PSAiIFwkJGlkIjsKIAkJfSBlbHNlIHsKQEAgLTYzOSw4ICs2NDQsMTMgQEAgc3ViIHF1ZXVlX2lu Y2x1ZGVzX2Zyb20KICAgICAgICAgICAgICAgICAkbGluZSAuPSA8SEVBREVSPjsKICAgICAgICAg ICAgIH0KIAotICAgICAgICAgICAgaWYgKCRsaW5lID1+IC9eI1xzKmluY2x1ZGVccys8KC4qPyk+ LykgewotICAgICAgICAgICAgICAgIHB1c2goQEFSR1YsICQxKSB1bmxlc3MgJElzX2NvbnZlcnRl ZHskMX07CisgICAgICAgICAgICBpZiAoJGxpbmUgPX4gL14jXHMqaW5jbHVkZVxzKyhbPCJdKSgu Kj8pWz4iXS8pIHsKKyAgICAgICAgICAgICAgICBteSAoJGRlbGltaXRlciwgJG5ld19maWxlKSA9 ICgkMSwgJDIpOworICAgICAgICAgICAgICAgICMgY29weSB0aGUgcHJlZml4IGluIHRoZSBxdW90 ZSBzeW50YXggKCNpbmNsdWRlICJ4LmgiKSBjYXNlCisgICAgICAgICAgICAgICAgaWYgKCRkZWxp bWl0ZXIgZXEgcXsifSAmJiAkZmlsZSA9fiBtfF4oLiopL3wpIHsKKyAgICAgICAgICAgICAgICAg ICAgJG5ld19maWxlID0gIiQxLyRuZXdfZmlsZSI7CisgICAgICAgICAgICAgICAgfQorICAgICAg ICAgICAgICAgIHB1c2goQEFSR1YsICRuZXdfZmlsZSkgdW5sZXNzICRJc19jb252ZXJ0ZWR7JG5l d19maWxlfTsKICAgICAgICAgICAgIH0KICAgICAgICAgfQogICAgIGNsb3NlIEhFQURFUjsKQEAg LTY4MSwyNSArNjkxLDUwIEBAIHN1YiBidWlsZF9wcmVhbWJsZV9pZl9uZWNlc3NhcnkKICAgICBt eSAoJWRlZmluZSkgPSBfZXh0cmFjdF9jY19kZWZpbmVzKCk7CiAKICAgICBvcGVuICBQUkVBTUJM RSwgIj4kcHJlYW1ibGUiIG9yIGRpZSAiQ2Fubm90IG9wZW4gJHByZWFtYmxlOiAgJCEiOwotICAg ICAgICBwcmludCBQUkVBTUJMRSAiIyBUaGlzIGZpbGUgd2FzIGNyZWF0ZWQgYnkgaDJwaCB2ZXJz aW9uICRWRVJTSU9OXG4iOwotCi0gICAgICAgIGZvcmVhY2ggKHNvcnQga2V5cyAlZGVmaW5lKSB7 Ci0gICAgICAgICAgICBpZiAoJG9wdF9EKSB7Ci0gICAgICAgICAgICAgICAgcHJpbnQgUFJFQU1C TEUgIiMgJF89JGRlZmluZXskX31cbiI7Ci0gICAgICAgICAgICB9Ci0KLSAgICAgICAgICAgIGlm ICgkZGVmaW5leyRffSA9fiAvXihcZCspVT9MezAsMn0kL2kpIHsKLSAgICAgICAgICAgICAgICBw cmludCBQUkVBTUJMRQotICAgICAgICAgICAgICAgICAgICAidW5sZXNzIChkZWZpbmVkICYkXykg eyBzdWIgJF8oKSB7ICQxIH0gfVxuXG4iOwotICAgICAgICAgICAgfSBlbHNpZiAoJGRlZmluZXsk X30gPX4gL15cdyskLykgewotICAgICAgICAgICAgICAgIHByaW50IFBSRUFNQkxFCi0gICAgICAg ICAgICAgICAgICAgICJ1bmxlc3MgKGRlZmluZWQgJiRfKSB7IHN1YiAkXygpIHsgJiRkZWZpbmV7 JF99IH0gfVxuXG4iOwotICAgICAgICAgICAgfSBlbHNlIHsKKwlwcmludCBQUkVBTUJMRSAiIyBU aGlzIGZpbGUgd2FzIGNyZWF0ZWQgYnkgaDJwaCB2ZXJzaW9uICRWRVJTSU9OXG4iOworICAgICAg ICAjIFByZXZlbnQgbm9uLXBvcnRhYmxlIGhleCBjb25zdGFudHMgZnJvbSB3YXJuaW5nLgorICAg ICAgICAjCisgICAgICAgICMgV2Ugc3RpbGwgcHJvZHVjZSBhbiBvdmVyZmxvdyB3YXJuaW5nIGlm IHdlIGNhbid0IHJlcHJlc2VudAorICAgICAgICAjIGEgaGV4IGNvbnN0YW50IGFzIGFuIGludGVn ZXIuCisgICAgICAgIHByaW50IFBSRUFNQkxFICJubyB3YXJuaW5ncyBxdyhwb3J0YWJsZSk7XG4i OworCisJZm9yZWFjaCAoc29ydCBrZXlzICVkZWZpbmUpIHsKKwkgICAgaWYgKCRvcHRfRCkgewor CQlwcmludCBQUkVBTUJMRSAiIyAkXz0kZGVmaW5leyRffVxuIjsKKwkgICAgfQorCSAgICBpZiAo JGRlZmluZXskX30gPX4gL15cKCguKilcKSQvKSB7CisJCSMgcGFyZW50aGVzaXplZCB2YWx1ZTog IGQ9KHYpCisJCSRkZWZpbmV7JF99ID0gJDE7CisJICAgIH0KKwkgICAgaWYgKCRkZWZpbmV7JF99 ID1+IC9eKFsrLV0/KFxkKyk/XC5cZCsoW2VFXVsrLV0/XGQrKT8pW0ZMXT8kLykgeworCQkjIGZs b2F0OgorCQlwcmludCBQUkVBTUJMRQorCQkgICAgInVubGVzcyAoZGVmaW5lZCAmJF8pIHsgc3Vi ICRfKCkgeyAkMSB9IH1cblxuIjsKKwkgICAgfSBlbHNpZiAoJGRlZmluZXskX30gPX4gL14oWyst XT9cZCspVT9MezAsMn0kL2kpIHsKKwkJIyBpbnRlZ2VyOgorCQlwcmludCBQUkVBTUJMRQorCQkg ICAgInVubGVzcyAoZGVmaW5lZCAmJF8pIHsgc3ViICRfKCkgeyAkMSB9IH1cblxuIjsKKyAgICAg ICAgICAgIH0gZWxzaWYgKCRkZWZpbmV7JF99ID1+IC9eKFsrLV0/MHhbXGRhLWZdKylVP0x7MCwy fSQvaSkgeworICAgICAgICAgICAgICAgICMgaGV4IGludGVnZXIKKyAgICAgICAgICAgICAgICAj IFNwZWNpYWwgY2FzZWQsIHNpbmNlIHBlcmwgd2FybnMgb24gaGV4IGludGVnZXJzCisgICAgICAg ICAgICAgICAgIyB0aGF0IGNhbid0IGJlIHJlcHJlc2VudGVkIGluIGEgVVYuCisgICAgICAgICAg ICAgICAgIworICAgICAgICAgICAgICAgICMgVGhpcyB3YXkgd2UgZ2V0IHRoZSB3YXJuaW5nIGF0 IHRpbWUgb2YgdXNlLCBzbyB0aGUgdXNlcgorICAgICAgICAgICAgICAgICMgb25seSBnZXRzIHRo ZSB3YXJuaW5nIGlmIHRoZXkgaGFwcGVuIHRvIHVzZSB0aGlzCisgICAgICAgICAgICAgICAgIyBw bGF0Zm9ybS1zcGVjaWZpYyBkZWZpbml0aW9uLgorICAgICAgICAgICAgICAgIG15ICRjb2RlID0g JDE7CisgICAgICAgICAgICAgICAgJGNvZGUgPSAiaGV4KCckY29kZScpIiBpZiBsZW5ndGggJGNv ZGUgPiAxMDsKICAgICAgICAgICAgICAgICBwcmludCBQUkVBTUJMRQotICAgICAgICAgICAgICAg ICAgICAidW5sZXNzIChkZWZpbmVkICYkXykgeyBzdWIgJF8oKSB7IFwiIiwKLSAgICAgICAgICAg ICAgICAgICAgcXVvdGVtZXRhKCRkZWZpbmV7JF99KSwgIlwiIH0gfVxuXG4iOwotICAgICAgICAg ICAgfQotICAgICAgICB9CisgICAgICAgICAgICAgICAgICAgICJ1bmxlc3MgKGRlZmluZWQgJiRf KSB7IHN1YiAkXygpIHsgJGNvZGUgfSB9XG5cbiI7CisJICAgIH0gZWxzaWYgKCRkZWZpbmV7JF99 ID1+IC9eXHcrJC8pIHsKKwkJcHJpbnQgUFJFQU1CTEUKKwkJICAgICJ1bmxlc3MgKGRlZmluZWQg JiRfKSB7IHN1YiAkXygpIHsgJiRkZWZpbmV7JF99IH0gfVxuXG4iOworCSAgICB9IGVsc2Ugewor CQlwcmludCBQUkVBTUJMRQorCQkgICAgInVubGVzcyAoZGVmaW5lZCAmJF8pIHsgc3ViICRfKCkg eyBcIiIsCisJCSAgICBxdW90ZW1ldGEoJGRlZmluZXskX30pLCAiXCIgfSB9XG5cbiI7CisJICAg IH0KKwl9CiAgICAgY2xvc2UgUFJFQU1CTEUgICAgICAgICAgICAgICBvciBkaWUgIkNhbm5vdCBj bG9zZSAkcHJlYW1ibGU6ICAkISI7CiB9CiAKQEAgLTcxMSwxNSArNzQ2LDE0IEBAIHN1YiBfZXh0 cmFjdF9jY19kZWZpbmVzCiB7CiAgICAgbXkgJWRlZmluZTsKICAgICBteSAkYWxsc3ltYm9scyAg PSBqb2luICIgIiwKLSAgICAgICAgQENvbmZpZ3snY2NzeW1ib2xzJywgJ2NwcHN5bWJvbHMnLCAn Y3BwY2NzeW1ib2xzJ307CisJQENvbmZpZ3snY2NzeW1ib2xzJywgJ2NwcHN5bWJvbHMnLCAnY3Bw Y2NzeW1ib2xzJ307CiAKICAgICAjIFNwbGl0IGNvbXBpbGVyIHByZS1kZWZpbml0aW9ucyBpbnRv IGBrZXk9dmFsdWUnIHBhaXJzOgotICAgIGZvcmVhY2ggKHNwbGl0IC9ccysvLCAkYWxsc3ltYm9s cykgewotICAgICAgICAvKC4rPyk9KC4rKS8gYW5kICRkZWZpbmV7JDF9ID0gJDI7Ci0KLSAgICAg ICAgaWYgKCRvcHRfRCkgewotICAgICAgICAgICAgcHJpbnQgU1RERVJSICIkXzogICQxIC0+ICQy XG4iOwotICAgICAgICB9CisgICAgd2hpbGUgKCRhbGxzeW1ib2xzID1+IC8oW15cc10rKT0oKFxc XHN8W15cc10pKykvZykgeworCSRkZWZpbmV7JDF9ID0gJDI7CisJaWYgKCRvcHRfRCkgeworCSAg ICBwcmludCBTVERFUlIgIiRfOiAgJDEgLT4gJDJcbiI7CisJfQogICAgIH0KIAogICAgIHJldHVy biAlZGVmaW5lOwpAQCAtNzY5LDcgKzgwMyw3IEBAIElmIHJ1biB3aXRoIG5vIGFyZ3VtZW50cywg ZmlsdGVycyBzdGFuZGFyZCBpbnB1dCB0byBzdGFuZGFyZCBvdXRwdXQuCiA9aXRlbSAtZCBkZXN0 aW5hdGlvbl9kaXIKIAogUHV0IHRoZSByZXN1bHRpbmcgQjwucGg+IGZpbGVzIGJlbmVhdGggQjxk ZXN0aW5hdGlvbl9kaXI+LCBpbnN0ZWFkIG9mCi1iZW5lYXRoIHRoZSBkZWZhdWx0IFBlcmwgbGli cmFyeSBsb2NhdGlvbiAoQzwkQ29uZmlneydpbnN0YWxsc2l0c2VhcmNoJ30+KS4KK2JlbmVhdGgg dGhlIGRlZmF1bHQgUGVybCBsaWJyYXJ5IGxvY2F0aW9uIChDPCRDb25maWd7J2luc3RhbGxzaXRl YXJjaCd9PikuCiAKID1pdGVtIC1yCiAKQEAgLTg1NCwxMCArODg4LDEwIEBAIGluc3RhbGxhdGlv bi4KIERvZXNuJ3QgaGFuZGxlIGNvbXBsaWNhdGVkIGV4cHJlc3Npb25zIGJ1aWx0IHBpZWNlbWVh bCwgYSBsYToKIAogICAgIGVudW0gewotICAgICAgICBGSVJTVF9WQUxVRSwKLSAgICAgICAgU0VD T05EX1ZBTFVFLAorCUZJUlNUX1ZBTFVFLAorCVNFQ09ORF9WQUxVRSwKICAgICAjaWZkZWYgQUJD Ci0gICAgICAgIFRISVJEX1ZBTFVFCisJVEhJUkRfVkFMVUUKICAgICAjZW5kaWYKICAgICB9Owog Cg== UH2PH588 } if ( $num > 5.008009 and $num < 5.009002 ) { _patch_b64(<<'UH2PH592'); LS0tIHV0aWxzL2gycGguUEwKKysrIHV0aWxzL2gycGguUEwKQEAgLTU4LDEzICs1OCwxNCBAQAog ZGllICJEZXN0aW5hdGlvbiBkaXJlY3RvcnkgJERlc3RfZGlyIGRvZXNuJ3QgZXhpc3Qgb3IgaXNu J3QgYSBkaXJlY3RvcnlcbiIKICAgICB1bmxlc3MgLWQgJERlc3RfZGlyOwogCi1teSBAaXNhdHlw ZSA9IHNwbGl0KCcgJyw8PEVORCk7CitteSBAaXNhdHlwZSA9IHF3KAogCWNoYXIJdWNoYXIJdV9j aGFyCiAJc2hvcnQJdXNob3J0CXVfc2hvcnQKIAlpbnQJdWludAl1X2ludAogCWxvbmcJdWxvbmcJ dV9sb25nCiAJRklMRQlrZXlfdAljYWRkcl90Ci1FTkQKKwlmbG9hdAlkb3VibGUJc2l6ZV90Cisp OwogCiBteSAlaXNhdHlwZTsKIEBpc2F0eXBle0Bpc2F0eXBlfSA9ICgxKSB4IEBpc2F0eXBlOwpA QCAtMTMzLDE5ICsxMzQsMjAgQEAKIAkJcy9cKFx3K1xzKlwoXCpcKVxzKlwoXHcqXClcKVxzKigt P1xkKykvJDEvOyAjIChpbnQgKCopKGZvb190KSkwCiAJCWlmIChzL15cKChbXHcsXHNdKilcKS8v KSB7CiAJCSAgICAkYXJncyA9ICQxOwotICAgIAkgICAgCSAgICBteSAkcHJvdG8gPSAnKCkgJzsK KwkJICAgIG15ICRwcm90byA9ICcoKSAnOwogCQkgICAgaWYgKCRhcmdzIG5lICcnKSB7Ci0gICAg CSAgICAJICAgIAkkcHJvdG8gPSAnJzsKKwkJCSRwcm90byA9ICcnOwogCQkJZm9yZWFjaCBteSAk YXJnIChzcGxpdCgvLFxzKi8sJGFyZ3MpKSB7CiAJCQkgICAgJGFyZyA9fiBzL15ccyooW15cc10u KlteXHNdKVxzKiQvJDEvOwogCQkJICAgICRjdXJhcmdzeyRhcmd9ID0gMTsKIAkJCX0KIAkJCSRh cmdzID1+IHMvXGIoXHcpL1wkJDEvZzsKLQkJCSRhcmdzID0gImxvY2FsKCRhcmdzKSA9IFxAXztc biR0ICAgICI7CisJCQkkYXJncyA9ICJteSgkYXJncykgPSBcQF87XG4kdCAgICAiOwogCQkgICAg fQogCQkgICAgcy9eXHMrLy87CiAJCSAgICBleHByKCk7CiAJCSAgICAkbmV3ID1+IHMvKFsiXFxd KS9cXCQxL2c7ICAgICAgICMiXSk7CisJCSAgRU1JVDoKIAkJICAgICRuZXcgPSByZWluZGVudCgk bmV3KTsKIAkJICAgICRhcmdzID0gcmVpbmRlbnQoJGFyZ3MpOwogCQkgICAgaWYgKCR0IG5lICcn KSB7CkBAIC0yNjgsMTIgKzI3MCwxNCBAQAogCSAgICB9IGVsc2lmKC9eaWRlbnRccysoLiopLykg ewogCQlwcmludCBPVVQgJHQsICIjICQxXG4iOwogCSAgICB9Ci0JfSBlbHNpZigvXlxzKih0eXBl ZGVmXHMqKT9lbnVtXHMqKFxzK1thLXpBLVpfXVx3KlxzKik/LykgeworCX0gZWxzaWYgKC9eXHMq KHR5cGVkZWZccyopP2VudW1ccyooXHMrW2EtekEtWl9dXHcqXHMqKT8vKSB7ICMgeyBmb3IgdmkK IAkgICAgdW50aWwoL1x7W159XSpcfS4qOy8gfHwgLzsvKSB7CiAJCWxhc3QgdW5sZXNzIGRlZmlu ZWQgKCRuZXh0ID0gbmV4dF9saW5lKCRmaWxlKSk7CiAJCWNob21wICRuZXh0OwogCQkjIGRyb3Ag IiNkZWZpbmUgRk9PIEZPTyIgaW4gZW51bXMKIAkJJG5leHQgPX4gcy9eXHMqI1xzKmRlZmluZVxz KyhcdyspXHMrXDFccyokLy87CisJCSMgI2RlZmluZXMgaW4gZW51bXMgKGFsaWFzZXMpCisJCSRu ZXh0ID1+IHMvXlxzKiNccypkZWZpbmVccysoXHcrKVxzKyhcdyspXHMqJC8kMSA9ICQyLC87CiAJ CSRfIC49ICRuZXh0OwogCQlwcmludCBPVVQgIiMgJG5leHRcbiIgaWYgJG9wdF9EOwogCSAgICB9 CkBAIC0yODYsNiArMjkwLDcgQEAKIAkgICAgbXkgJGVudW1fdmFsID0gLTE7CiAJICAgIGZvcmVh Y2ggbXkgJGVudW0gKEBlbnVtX3N1YnMpIHsKIAkJbXkgKCRlbnVtX25hbWUsICRlbnVtX3ZhbHVl KSA9ICRlbnVtID1+IC9eKFthLXpBLVpfXVx3KikoPS4rKT8kLzsKKwkJJGVudW1fbmFtZSBvciBu ZXh0OwogCQkkZW51bV92YWx1ZSA9fiBzL149Ly87CiAJCSRlbnVtX3ZhbCA9IChsZW5ndGgoJGVu dW1fdmFsdWUpID8gJGVudW1fdmFsdWUgOiAkZW51bV92YWwgKyAxKTsKIAkJaWYgKCRvcHRfaCkg ewpAQCAtMzAwLDYgKzMwNSw3NSBAQAogCQkJICAgICAgICJ1bmxlc3MgZGVmaW5lZChcJiRlbnVt X25hbWUpO1xuIik7CiAJCX0KIAkgICAgfQorCX0gZWxzaWYgKC9eKD86X19leHRlbnNpb25fX1xz Kyk/KD86ZXh0ZXJufHN0YXRpYylccysoPzpfXyk/aW5saW5lKD86X18pP1xzKy8KKwkgICAgYW5k ICEvO1xzKiQvIGFuZCAhL3tccyp9XHMqJC8pCisJeyAjIHsgZm9yIHZpCisJICAgICMgVGhpcyBp cyBhIGhhY2sgdG8gcGFyc2UgdGhlIGlubGluZSBmdW5jdGlvbnMgaW4gdGhlIGdsaWJjIGhlYWRl cnMuCisJICAgICMgV2FybmluZzogbWFzc2l2ZSBrbHVkZ2UgYWhlYWQuIFdlIHN1cHBvc2UgaW5s aW5lIGZ1bmN0aW9ucworCSAgICAjIGFyZSBtYWlubHkgY29uc3RydWN0ZWQgbGlrZSBtYWNyb3Mu CisJICAgIHdoaWxlICgxKSB7CisJCWxhc3QgdW5sZXNzIGRlZmluZWQgKCRuZXh0ID0gbmV4dF9s aW5lKCRmaWxlKSk7CisJCWNob21wICRuZXh0OworCQl1bmRlZiAkXywgbGFzdCBpZiAkbmV4dCA9 fiAvX19USFJPV1xzKjsvCisJCQkgICAgICAgb3IgJG5leHQgPX4gL14oX19leHRlbnNpb25fX3xl eHRlcm58c3RhdGljKVxiLzsKKwkJJF8gLj0gIiAkbmV4dCI7CisJCXByaW50IE9VVCAiIyAkbmV4 dFxuIiBpZiAkb3B0X0Q7CisJCWxhc3QgaWYgJG5leHQgPX4gL159fF57Lip9XHMqJC87CisJICAg IH0KKwkgICAgbmV4dCBpZiBub3QgZGVmaW5lZDsgIyBiZWNhdXNlIGl0J3Mgb25seSBhIHByb3Rv dHlwZQorCSAgICBzL1xiKF9fZXh0ZW5zaW9uX198ZXh0ZXJufHN0YXRpY3woPzpfXyk/aW5saW5l KD86X18pPylcYi8vZzsKKwkgICAgIyB2aW9sZW50bHkgZHJvcCAjaWZkZWZzCisJICAgIHMvI1xz KmlmLio/I1xzKmVuZGlmLy9nCisJCWFuZCBwcmludCBPVVQgIiMgc29tZSAjaWZkZWYgd2VyZSBk cm9wcGVkIGhlcmUgLS0gZmlsbCBpbiB0aGUgYmxhbmtzXG4iOworCSAgICBpZiAocy9eKD86XHd8 XHN8XCopKlxzKFx3KylccyovLykgeworCQkkbmFtZSA9ICQxOworCSAgICB9IGVsc2UgeworCQl3 YXJuICJuYW1lIG5vdCBmb3VuZCI7IG5leHQ7ICMgc2hvdWxkbid0IG9jY3VyLi4uCisJICAgIH0K KwkgICAgbXkgQGFyZ3M7CisJICAgIGlmIChzL15cKChbXigpXSopXClccyooXHcrXHMqKSovLykg eworCQlmb3IgbXkgJGFyZyAoc3BsaXQgLywvLCAkMSkgeworCQkgICAgaWYgKCRhcmcgPX4gLyhc dyspXHMqJC8pIHsKKwkJCSRjdXJhcmdzeyQxfSA9IDE7CisJCQlwdXNoIEBhcmdzLCAkMTsKKwkJ ICAgIH0KKwkJfQorCSAgICB9CisJICAgICRhcmdzID0gKAorCQlAYXJncworCQk/ICJteSgiIC4g KGpvaW4gJywnLCBtYXAgIlwkJF8iLCBAYXJncykgLiAiKSA9IFxAXztcbiR0ICAgICIKKwkJOiAi IgorCSAgICApOworCSAgICBteSAkcHJvdG8gPSBAYXJncyA/ICcnIDogJygpICc7CisJICAgICRu ZXcgPSAnJzsKKwkgICAgcy9cYnJldHVyblxiLy9nOyAjICJyZXR1cm4iIGRvZXNuJ3Qgb2NjdXIg aW4gbWFjcm9zIHVzdWFsbHkuLi4KKwkgICAgZXhwcigpOworCSAgICAjIHRyeSB0byBmaW5kIGFu ZCBwZXJsaWZ5IGxvY2FsIEMgdmFyaWFibGVzCisJICAgIG91ciBAbG9jYWxfdmFyaWFibGVzID0g KCk7ICMgbmVlZHMgdG8gYmUgYSBvdXIoKTogKD97Li4ufSkgYnVnIHdvcmthcm91bmQKKwkgICAg eworCQl1c2UgcmUgImV2YWwiOworCQlteSAkdHlwZWxpc3QgPSBqb2luICd8Jywga2V5cyAlaXNh dHlwZTsKKwkJJG5ldyA9fiBzWycKKwkJICAoPzooPzp1bik/c2lnbmVkXHMrKT8KKwkJICAoPzps b25nXHMrKT8KKwkJICAoPzokdHlwZWxpc3QpXHMrCisJCSAgKFx3KykKKwkJICAoP3sgcHVzaCBA bG9jYWxfdmFyaWFibGVzLCAkMSB9KQorCQkgICddCisJCSBbbXkgXCQkMV1neDsKKwkJJG5ldyA9 fiBzWycKKwkJICAoPzooPzp1bik/c2lnbmVkXHMrKT8KKwkJICAoPzpsb25nXHMrKT8KKwkJICAo PzokdHlwZWxpc3QpXHMrCisJCSAgJyBccysgJihcdyspIFxzKiA7CisJCSAgKD97IHB1c2ggQGxv Y2FsX3ZhcmlhYmxlcywgJDEgfSkKKwkJICBdCisJCSBbbXkgXCQkMTtdZ3g7CisJICAgICB9CisJ ICAgICRuZXcgPX4gcy8mJF9cYi9cJCRfL2cgZm9yIEBsb2NhbF92YXJpYWJsZXM7CisJICAgICRu ZXcgPX4gcy8oWyJcXF0pL1xcJDEvZzsgICAgICAgIyJdKTsKKwkgICAgIyBub3cgdGhhdCdzIGFs bW9zdCBsaWtlIGEgbWFjcm8gKHdlIGhvcGUpCisJICAgIGdvdG8gRU1JVDsKIAl9CiAgICAgfQog ICAgICRJc19jb252ZXJ0ZWR7JGZpbGV9ID0gMTsKQEAgLTMwOCw3ICszODIsNyBAQAogICAgICAg ICAkbmV4dCA9ICcnOwogICAgIH0gZWxzZSB7CiAgICAgICAgIHByaW50IE9VVCAiMTtcbiI7Ci0g ICAgcXVldWVfaW5jbHVkZXNfZnJvbSgkZmlsZSkgaWYgKCRvcHRfYSk7CisJcXVldWVfaW5jbHVk ZXNfZnJvbSgkZmlsZSkgaWYgJG9wdF9hOwogICAgIH0KIH0KIApAQCAtMzIwLDYgKzM5NCw3IEBA CiBleGl0ICRFeGl0OwogCiBzdWIgZXhwciB7CisgICAgJG5ldyA9ICciKGFzc2VtYmx5IGNvZGUp IicgYW5kIHJldHVybiBpZiAvXGJfX2FzbV9fXGIvOyAjIGZyZWFrIG91dC4KICAgICBteSAkam9p bmVkX2FyZ3M7CiAgICAgaWYoa2V5cyglY3VyYXJncykpIHsKIAkkam9pbmVkX2FyZ3MgPSBqb2lu KCd8Jywga2V5cyglY3VyYXJncykpOwpAQCAtMzI4LDcgKzQwMyw3IEBACiAJcy9eXCZcJi8vICYm IGRvIHsgJG5ldyAuPSAiICYmIjsgbmV4dDt9OyAjIGhhbmRsZSAmJiBvcGVyYXRvcgogCXMvXlwm KFtcKGEtelwpXSspLyQxL2k7CSMgaGFjayBmb3IgdGhpbmdzIHRoYXQgdGFrZSB0aGUgYWRkcmVz cyBvZgogCXMvXihccyspLy8JCSYmIGRvIHskbmV3IC49ICcgJzsgbmV4dDt9OwotCXMvXjBYKFsw LTlBLUZdKylbVUxdKi8vaSAKKwlzL14wWChbMC05QS1GXSspW1VMXSovL2kKIAkgICAgJiYgZG8g e215ICRoZXggPSAkMTsKIAkJICAgJGhleCA9fiBzL14wKy8vOwogCQkgICBpZiAobGVuZ3RoICRo ZXggPiA4ICYmICEkQ29uZmlne3VzZTY0Yml0aW50fSkgewpAQCAtMzgwLDEwICs0NTUsMTYgQEAK ICAgICAgICAgfTsKIAkjIEVsaW1pbmF0ZSB0eXBlZGVmcwogCS9cKChbXHdcc10rKVtcKlxzXSpc KVxzKltcd1woXS8gJiYgZG8geworCSAgICBteSAkZG9pdCA9IDE7CiAJICAgIGZvcmVhY2ggKHNw bGl0IC9ccysvLCAkMSkgeyAgIyBNYWtlIHN1cmUgYWxsIHRoZSB3b3JkcyBhcmUgdHlwZXMsCi0J CWxhc3QgdW5sZXNzICgkaXNhdHlwZXskX30gb3IgJF8gZXEgJ3N0cnVjdCcgb3IgJF8gZXEgJ3Vu aW9uJyk7CisJICAgICAgICB1bmxlc3MoJGlzYXR5cGV7JF99IG9yICRfIGVxICdzdHJ1Y3QnIG9y ICRfIGVxICd1bmlvbicpeworCQkgICAgJGRvaXQgPSAwOworCQkgICAgbGFzdDsKKwkJfQorCSAg ICB9CisJICAgIGlmKCAkZG9pdCApeworCQlzL1woW1x3XHNdK1tcKlxzXSpcKS8vICYmIG5leHQ7 ICAgICAgIyB0aGVuIGVsaW1pbmF0ZSB0aGVtLgogCSAgICB9Ci0JICAgIHMvXChbXHdcc10rW1wq XHNdKlwpLy8gJiYgbmV4dDsgICAgICAjIHRoZW4gZWxpbWluYXRlIHRoZW0uCiAJfTsKIAkjIHN0 cnVjdC91bmlvbiBtZW1iZXIsIGluY2x1ZGluZyBhcnJheXM6CiAJcy9eKFtfQS1aXVx3KihcW1te XF1dK1xdKT8oKFwufC0+KVtfQS1aXVx3KihcW1teXF1dK1xdKT8pKykvL2kgJiYgZG8gewpAQCAt NDU4LDcgKzUzOSw3IEBACiAKICAgICAgICAgd2hpbGUgKGxlbmd0aCAkaW4pIHsKICAgICAgICAg ICAgIGlmICgkcHJlX3N1Yl90cmlfZ3JhcGhzKSB7Ci0gICAgICAgICAgICAgICAgIyBQcmVwcm9j ZXNzIGFsbCB0cmktZ3JhcGhzIAorICAgICAgICAgICAgICAgICMgUHJlcHJvY2VzcyBhbGwgdHJp LWdyYXBocwogICAgICAgICAgICAgICAgICMgaW5jbHVkaW5nIHRoaW5ncyBzdHVjayBpbiBxdW90 ZWQgc3RyaW5nIGNvbnN0YW50cy4KICAgICAgICAgICAgICAgICAkaW4gPX4gcy9cP1w/PS8jL2c7 ICAgICAgICAgICAgICAgICAgICAgICAgICMgfCA/Pz18ICAjfAogICAgICAgICAgICAgICAgICRp biA9fiBzL1w/XD9cIS98L2c7ICAgICAgICAgICAgICAgICAgICAgICAgIyB8ID8/IXwgIHx8CkBA IC00NzEsMTcgKzU1MiwxOSBAQAogICAgICAgICAgICAgICAgICRpbiA9fiBzL1w/XD8+L30vZzsg ICAgICAgICAgICAgICAgICAgICAgICAgIyB8ID8/PnwgIH18CiAgICAgICAgICAgICB9CiAJICAg IGlmICgkaW4gPX4gL15cI2lmZGVmIF9fTEFOR1VBR0VfUEFTQ0FMX18vKSB7Ci0gICAgICAgICAg ICAgICAgIyBUcnU2NCBkaXNhc3NlbWJsZXIuaCBldmlsbmVzczogbWl4ZWQgQyBhbmQgUGFzY2Fs LgorCQkjIFRydTY0IGRpc2Fzc2VtYmxlci5oIGV2aWxuZXNzOiBtaXhlZCBDIGFuZCBQYXNjYWwu CiAJCXdoaWxlICg8SU4+KSB7Ci0JCSAgICBsYXN0IGlmIC9eXCNlbmRpZi87IAorCQkgICAgbGFz dCBpZiAvXlwjZW5kaWYvOwogCQl9CisJCSRpbiA9ICIiOwogCQluZXh0IFJFQUQ7CiAJICAgIH0K IAkgICAgaWYgKCRpbiA9fiAvXmV4dGVybiBpbmxpbmUgLyAmJiAjIElubGluZWQgYXNzZW1ibGVy LgogCQkkXk8gZXEgJ2xpbnV4JyAmJiAkZmlsZSA9fiBtISg/Ol58Lylhc20vW14vXStcLmgkISkg ewotIAkJd2hpbGUgKDxJTj4pIHsKLQkJICAgIGxhc3QgaWYgL159LzsgCisJCXdoaWxlICg8SU4+ KSB7CisJCSAgICBsYXN0IGlmIC9efS87CiAJCX0KKwkJJGluID0gIiI7CiAJCW5leHQgUkVBRDsK IAkgICAgfQogICAgICAgICAgICAgaWYgKCRpbiA9fiBzL1xcJC8vKSB7ICAgICAgICAgICAgICAg ICAgICAgICAgICAgIyBcLW5ld2xpbmUK UH2PH592 } if ( $num > 5.008009 and $num < 5.009003 ) { _patch_b64(<<'UH2PH593'); LS0tIHV0aWxzL2gycGguUEwKKysrIHV0aWxzL2gycGguUEwKQEAgLTM1NCw2ICszNTQsNyBAQAog CQl1c2UgcmUgImV2YWwiOwogCQlteSAkdHlwZWxpc3QgPSBqb2luICd8Jywga2V5cyAlaXNhdHlw ZTsKIAkJJG5ldyA9fiBzWycKKwkJICAoPzooPzpfXyk/Y29uc3QoPzpfXyk/XHMrKT8KIAkJICAo PzooPzp1bik/c2lnbmVkXHMrKT8KIAkJICAoPzpsb25nXHMrKT8KIAkJICAoPzokdHlwZWxpc3Qp XHMrCkBAIC0zNjIsNiArMzYzLDcgQEAKIAkJICAnXQogCQkgW215IFwkJDFdZ3g7CiAJCSRuZXcg PX4gc1snCisJCSAgKD86KD86X18pP2NvbnN0KD86X18pP1xzKyk/CiAJCSAgKD86KD86dW4pP3Np Z25lZFxzKyk/CiAJCSAgKD86bG9uZ1xzKyk/CiAJCSAgKD86JHR5cGVsaXN0KVxzKwpAQCAtNzM0 LDkgKzczNiwxNSBAQAogIyBub24tR0NDPykgQyBjb21waWxlcnMsIGJ1dCBnY2MgdXNlcyBhbiBh ZGRpdGlvbmFsIGluY2x1ZGUgZGlyZWN0b3J5Lgogc3ViIGluY19kaXJzCiB7Ci0gICAgbXkgJGZy b21fZ2NjICAgID0gYCRDb25maWd7Y2N9IC12IDI+JjFgOwotICAgICRmcm9tX2djYyAgICAgICA9 fiBzOl5SZWFkaW5nIHNwZWNzIGZyb20gKC4qPykvc3BlY3NcYi4qOiQxL2luY2x1ZGU6czsKLQor ICAgIG15ICRmcm9tX2djYyAgICA9IGBMQ19BTEw9QyAkQ29uZmlne2NjfSAtdiAyPiYxYDsKKyAg ICBpZiggISggJGZyb21fZ2NjID1+IHM6XlJlYWRpbmcgc3BlY3MgZnJvbSAoLio/KS9zcGVjc1xi Lio6JDEvaW5jbHVkZTpzICkgKQorICAgIHsgIyBnY2MtNCsgOgorICAgICAgICRmcm9tX2djYyAg ID0gYExDX0FMTD1DICRDb25maWd7Y2N9IC1wcmludC1zZWFyY2gtZGlycyAyPiYxYDsKKyAgICAg ICBpZiAoICEoJGZyb21fZ2NjID1+IHMvXmluc3RhbGw6XHMqKFteXHNdK1teXHNcL10pKFtcc1wv XSopLiokLyQxXC9pbmNsdWRlL3MpICkKKyAgICAgICB7CisgICAgICAgICAgICRmcm9tX2djYyA9 ICcnOworICAgICAgIH07CisgICAgfTsKICAgICBsZW5ndGgoJGZyb21fZ2NjKSA/ICgkZnJvbV9n Y2MsICRDb25maWd7dXNyaW5jfSkgOiAoJENvbmZpZ3t1c3JpbmN9KTsKIH0KIAo= UH2PH593 } if ( $num > 5.008009 and $num < 5.009004 ) { _patch_b64(<<'UH2PH594'); LS0tIHV0aWxzL2gycGguUEwKKysrIHV0aWxzL2gycGguUEwKQEAgLTUxNCw3ICs1MTQsNyBAQAog CQl9CiAJICAgIH0gZWxzZSB7CiAJCWlmICgkaW5pZiAmJiAkbmV3ICF+IC9kZWZpbmVkXHMqXCgk LykgewotCQkgICAgJG5ldyAuPSAnKGRlZmluZWQoJicgLiAkaWQgLiAnKSA/ICYnIC4gJGlkIC4g JyA6IDApJzsKKwkJICAgICRuZXcgLj0gJyhkZWZpbmVkKCYnIC4gJGlkIC4gJykgPyAmJyAuICRp ZCAuICcgOiB1bmRlZiknOwogCQl9IGVsc2lmICgvXlxbLykgewogCQkgICAgJG5ldyAuPSAiIFwk JGlkIjsKIAkJfSBlbHNlIHsKQEAgLTc3MiwyNSArNzcyLDMzIEBACiAgICAgbXkgKCVkZWZpbmUp ID0gX2V4dHJhY3RfY2NfZGVmaW5lcygpOwogCiAgICAgb3BlbiAgUFJFQU1CTEUsICI+JHByZWFt YmxlIiBvciBkaWUgIkNhbm5vdCBvcGVuICRwcmVhbWJsZTogICQhIjsKLSAgICAgICAgcHJpbnQg UFJFQU1CTEUgIiMgVGhpcyBmaWxlIHdhcyBjcmVhdGVkIGJ5IGgycGggdmVyc2lvbiAkVkVSU0lP TlxuIjsKKwlwcmludCBQUkVBTUJMRSAiIyBUaGlzIGZpbGUgd2FzIGNyZWF0ZWQgYnkgaDJwaCB2 ZXJzaW9uICRWRVJTSU9OXG4iOwogCi0gICAgICAgIGZvcmVhY2ggKHNvcnQga2V5cyAlZGVmaW5l KSB7Ci0gICAgICAgICAgICBpZiAoJG9wdF9EKSB7Ci0gICAgICAgICAgICAgICAgcHJpbnQgUFJF QU1CTEUgIiMgJF89JGRlZmluZXskX31cbiI7Ci0gICAgICAgICAgICB9Ci0KLSAgICAgICAgICAg IGlmICgkZGVmaW5leyRffSA9fiAvXihcZCspVT9MezAsMn0kL2kpIHsKLSAgICAgICAgICAgICAg ICBwcmludCBQUkVBTUJMRQotICAgICAgICAgICAgICAgICAgICAidW5sZXNzIChkZWZpbmVkICYk XykgeyBzdWIgJF8oKSB7ICQxIH0gfVxuXG4iOwotICAgICAgICAgICAgfSBlbHNpZiAoJGRlZmlu ZXskX30gPX4gL15cdyskLykgewotICAgICAgICAgICAgICAgIHByaW50IFBSRUFNQkxFCi0gICAg ICAgICAgICAgICAgICAgICJ1bmxlc3MgKGRlZmluZWQgJiRfKSB7IHN1YiAkXygpIHsgJiRkZWZp bmV7JF99IH0gfVxuXG4iOwotICAgICAgICAgICAgfSBlbHNlIHsKLSAgICAgICAgICAgICAgICBw cmludCBQUkVBTUJMRQotICAgICAgICAgICAgICAgICAgICAidW5sZXNzIChkZWZpbmVkICYkXykg eyBzdWIgJF8oKSB7IFwiIiwKLSAgICAgICAgICAgICAgICAgICAgcXVvdGVtZXRhKCRkZWZpbmV7 JF99KSwgIlwiIH0gfVxuXG4iOwotICAgICAgICAgICAgfQotICAgICAgICB9CisJZm9yZWFjaCAo c29ydCBrZXlzICVkZWZpbmUpIHsKKwkgICAgaWYgKCRvcHRfRCkgeworCQlwcmludCBQUkVBTUJM RSAiIyAkXz0kZGVmaW5leyRffVxuIjsKKwkgICAgfQorCSAgICBpZiAoJGRlZmluZXskX30gPX4g L15cKCguKilcKSQvKSB7CisJCSMgcGFyZW50aGVzaXplZCB2YWx1ZTogIGQ9KHYpCisJCSRkZWZp bmV7JF99ID0gJDE7CisJICAgIH0KKwkgICAgaWYgKCRkZWZpbmV7JF99ID1+IC9eKFsrLV0/KFxk Kyk/XC5cZCsoW2VFXVsrLV0/XGQrKT8pW0ZMXT8kLykgeworCQkjIGZsb2F0OgorCQlwcmludCBQ UkVBTUJMRQorCQkgICAgInVubGVzcyAoZGVmaW5lZCAmJF8pIHsgc3ViICRfKCkgeyAkMSB9IH1c blxuIjsKKwkgICAgfSBlbHNpZiAoJGRlZmluZXskX30gPX4gL14oWystXT9cZCspVT9MezAsMn0k L2kpIHsKKwkJIyBpbnRlZ2VyOgorCQlwcmludCBQUkVBTUJMRQorCQkgICAgInVubGVzcyAoZGVm aW5lZCAmJF8pIHsgc3ViICRfKCkgeyAkMSB9IH1cblxuIjsKKwkgICAgfSBlbHNpZiAoJGRlZmlu ZXskX30gPX4gL15cdyskLykgeworCQlwcmludCBQUkVBTUJMRQorCQkgICAgInVubGVzcyAoZGVm aW5lZCAmJF8pIHsgc3ViICRfKCkgeyAmJGRlZmluZXskX30gfSB9XG5cbiI7CisJICAgIH0gZWxz ZSB7CisJCXByaW50IFBSRUFNQkxFCisJCSAgICAidW5sZXNzIChkZWZpbmVkICYkXykgeyBzdWIg JF8oKSB7IFwiIiwKKwkJICAgIHF1b3RlbWV0YSgkZGVmaW5leyRffSksICJcIiB9IH1cblxuIjsK KwkgICAgfQorCX0KICAgICBjbG9zZSBQUkVBTUJMRSAgICAgICAgICAgICAgIG9yIGRpZSAiQ2Fu bm90IGNsb3NlICRwcmVhbWJsZTogICQhIjsKIH0KIApAQCAtODAyLDE1ICs4MTAsMTQgQEAKIHsK ICAgICBteSAlZGVmaW5lOwogICAgIG15ICRhbGxzeW1ib2xzICA9IGpvaW4gIiAiLAotICAgICAg ICBAQ29uZmlneydjY3N5bWJvbHMnLCAnY3Bwc3ltYm9scycsICdjcHBjY3N5bWJvbHMnfTsKKwlA Q29uZmlneydjY3N5bWJvbHMnLCAnY3Bwc3ltYm9scycsICdjcHBjY3N5bWJvbHMnfTsKIAogICAg ICMgU3BsaXQgY29tcGlsZXIgcHJlLWRlZmluaXRpb25zIGludG8gYGtleT12YWx1ZScgcGFpcnM6 Ci0gICAgZm9yZWFjaCAoc3BsaXQgL1xzKy8sICRhbGxzeW1ib2xzKSB7Ci0gICAgICAgIC8oLis/ KT0oLispLyBhbmQgJGRlZmluZXskMX0gPSAkMjsKLQotICAgICAgICBpZiAoJG9wdF9EKSB7Ci0g ICAgICAgICAgICBwcmludCBTVERFUlIgIiRfOiAgJDEgLT4gJDJcbiI7Ci0gICAgICAgIH0KKyAg ICB3aGlsZSAoJGFsbHN5bWJvbHMgPX4gLyhbXlxzXSspPSgoXFxcc3xbXlxzXSkrKS9nKSB7CisJ JGRlZmluZXskMX0gPSAkMjsKKwlpZiAoJG9wdF9EKSB7CisJICAgIHByaW50IFNUREVSUiAiJF86 ICAkMSAtPiAkMlxuIjsKKwl9CiAgICAgfQogCiAgICAgcmV0dXJuICVkZWZpbmU7CkBAIC05NDUs MTAgKzk1MiwxMCBAQAogRG9lc24ndCBoYW5kbGUgY29tcGxpY2F0ZWQgZXhwcmVzc2lvbnMgYnVp bHQgcGllY2VtZWFsLCBhIGxhOgogCiAgICAgZW51bSB7Ci0gICAgICAgIEZJUlNUX1ZBTFVFLAot ICAgICAgICBTRUNPTkRfVkFMVUUsCisJRklSU1RfVkFMVUUsCisJU0VDT05EX1ZBTFVFLAogICAg ICNpZmRlZiBBQkMKLSAgICAgICAgVEhJUkRfVkFMVUUKKwlUSElSRF9WQUxVRQogICAgICNlbmRp ZgogICAgIH07CiAK UH2PH594 } # All the rest _patch(<<'UH2PH'); --- utils/h2ph.PL +++ utils/h2ph.PL @@ -788,6 +788,11 @@ sub build_preamble_if_necessary open PREAMBLE, ">$preamble" or die "Cannot open $preamble: $!"; print PREAMBLE "# This file was created by h2ph version $VERSION\n"; + # Prevent non-portable hex constants from warning. + # + # We still produce an overflow warning if we can't represent + # a hex constant as an integer. + print PREAMBLE "no warnings qw(portable);\n"; foreach (sort keys %define) { if ($opt_D) { @@ -814,6 +819,18 @@ DEFINE # integer: print PREAMBLE "unless (defined &$_) { sub $_() { $1 } }\n\n"; + } elsif ($define{$_} =~ /^([+-]?0x[\da-f]+)U?L{0,2}$/i) { + # hex integer + # Special cased, since perl warns on hex integers + # that can't be represented in a UV. + # + # This way we get the warning at time of use, so the user + # only gets the warning if they happen to use this + # platform-specific definition. + my $code = $1; + $code = "hex('$code')" if length $code > 10; + print PREAMBLE + "unless (defined &$_) { sub $_() { $code } }\n\n"; } elsif ($define{$_} =~ /^\w+$/) { my $def = $define{$_}; if ($isatype{$def}) { UH2PH } sub _patch_lib_h2ph { my $perlver = shift; my $num = _norm_ver( $perlver ); return unless $num < 5.021010; return if $num == 5.020003; if ( $num >= 5.013005 ) { _patch(<<'LH2PH1'); --- lib/h2ph.t +++ lib/h2ph.t @@ -48,7 +48,7 @@ $result = runperl( progfile => '_h2ph_pre.ph', stderr => 1 ); like( $result, qr/syntax OK$/, "preamble compiles"); -$result = runperl( switches => ["-w"], +$result = runperl( switches => ['-I.', "-w"], stderr => 1, prog => <<'PROG' ); $SIG{__WARN__} = sub { die $_[0] }; require q(lib/h2ph.pht); LH2PH1 } elsif ( $num >= 5.013001 ) { _patch(<<'LH2PH2'); --- lib/h2ph.t +++ lib/h2ph.t @@ -48,7 +48,7 @@ $result = runperl( progfile => '_h2ph_pre.ph', stderr => 1 ); like( $result, qr/syntax OK$/, "preamble compiles"); -$result = runperl( switches => ["-w"], +$result = runperl( switches => ['-I.', "-w"], stderr => 1, prog => <<'PROG' ); $SIG{__WARN__} = sub { die $_[0] }; require q(lib/h2ph.pht); LH2PH2 } elsif ( $num >= 5.010001 ) { _patch(<<'LH2PH3'); --- lib/h2ph.t +++ lib/h2ph.t @@ -41,7 +41,7 @@ $result = runperl( progfile => 'lib/h2ph.pht', stderr => 1 ); like( $result, qr/syntax OK$/, "output compiles"); -$result = runperl( switches => ["-w"], +$result = runperl( switches => ['-I.',"-w"], prog => '$SIG{__WARN__} = sub { die $_[0] }; require q(lib/h2ph.pht);'); is( $result, '', "output free of warnings" ); LH2PH3 } } sub _patch_sdbm_file_c { my $perlver = shift; my $num = _norm_ver( $perlver ); return unless $num > 5.010000; return unless $num < 5.014004; _patch_b64(<<'SDBMFILEC'); LS0tIGV4dC9TREJNX0ZpbGUvc2RibS9zZGJtLmMKKysrIGV4dC9TREJNX0ZpbGUvc2RibS9zZGJt LmMKQEAgLTc4LDggKzc4LDggQEAgc2RibV9vcGVuKHJlZ2lzdGVyIGNoYXIgKmZpbGUsIHJlZ2lz dGVyIGludCBmbGFncywgcmVnaXN0ZXIgaW50IG1vZGUpCiAJcmVnaXN0ZXIgY2hhciAqZGlybmFt ZTsKIAlyZWdpc3RlciBjaGFyICpwYWduYW1lOwogCXNpemVfdCBmaWxlbGVuOwotCWNvbnN0IHNp emVfdCBkaXJmZXh0X2xlbiA9IHNpemVvZihESVJGRVhUICIiKTsKLQljb25zdCBzaXplX3QgcGFn ZmV4dF9sZW4gPSBzaXplb2YoUEFHRkVYVCAiIik7CisJY29uc3Qgc2l6ZV90IGRpcmZleHRfc2l6 ZSA9IHNpemVvZihESVJGRVhUICIiKTsKKwljb25zdCBzaXplX3QgcGFnZmV4dF9zaXplID0gc2l6 ZW9mKFBBR0ZFWFQgIiIpOwogCiAJaWYgKGZpbGUgPT0gTlVMTCB8fCAhKmZpbGUpCiAJCXJldHVy biBlcnJubyA9IEVJTlZBTCwgKERCTSAqKSBOVUxMOwpAQCAtODgsMTcgKzg4LDE3IEBAIHNkYm1f b3BlbihyZWdpc3RlciBjaGFyICpmaWxlLCByZWdpc3RlciBpbnQgZmxhZ3MsIHJlZ2lzdGVyIGlu dCBtb2RlKQogICovCiAJZmlsZWxlbiA9IHN0cmxlbihmaWxlKTsKIAotCWlmICgoZGlybmFtZSA9 IChjaGFyICopIG1hbGxvYyhmaWxlbGVuICsgZGlyZmV4dF9sZW4gKyAxCi0JCQkJICAgICAgICsg ZmlsZWxlbiArIHBhZ2ZleHRfbGVuICsgMSkpID09IE5VTEwpCisJaWYgKChkaXJuYW1lID0gKGNo YXIgKikgbWFsbG9jKGZpbGVsZW4gKyBkaXJmZXh0X3NpemUKKwkJCQkgICAgICAgKyBmaWxlbGVu ICsgcGFnZmV4dF9zaXplKSkgPT0gTlVMTCkKIAkJcmV0dXJuIGVycm5vID0gRU5PTUVNLCAoREJN ICopIE5VTEw7CiAvKgogICogYnVpbGQgdGhlIGZpbGUgbmFtZXMKICAqLwogCW1lbWNweShkaXJu YW1lLCBmaWxlLCBmaWxlbGVuKTsKLQltZW1jcHkoZGlybmFtZSArIGZpbGVsZW4sIERJUkZFWFQs IGRpcmZleHRfbGVuICsgMSk7Ci0JcGFnbmFtZSA9IGRpcm5hbWUgKyBmaWxlbGVuICsgZGlyZmV4 dF9sZW4gKyAxOworCW1lbWNweShkaXJuYW1lICsgZmlsZWxlbiwgRElSRkVYVCwgZGlyZmV4dF9z aXplKTsKKwlwYWduYW1lID0gZGlybmFtZSArIGZpbGVsZW4gKyBkaXJmZXh0X3NpemU7CiAJbWVt Y3B5KHBhZ25hbWUsIGZpbGUsIGZpbGVsZW4pOwotCW1lbWNweShwYWduYW1lICsgZmlsZWxlbiwg UEFHRkVYVCwgcGFnZmV4dF9sZW4gKyAxKTsKKwltZW1jcHkocGFnbmFtZSArIGZpbGVsZW4sIFBB R0ZFWFQsIHBhZ2ZleHRfc2l6ZSk7CiAKIAlkYiA9IHNkYm1fcHJlcChkaXJuYW1lLCBwYWduYW1l LCBmbGFncywgbW9kZSk7CiAJZnJlZSgoY2hhciAqKSBkaXJuYW1lKTsK SDBMFILEC } sub _patch_mmaix_pm { my $perlver = shift; return unless $^O eq 'aix'; my $num = _norm_ver( $perlver ); return unless $num > 5.027000; return unless $num < 5.031001; _patch_b64(<<'MMAIXPM'); LS0tIGNwYW4vRXh0VXRpbHMtTWFrZU1ha2VyL2xpYi9FeHRVdGlscy9NTV9BSVgucG0KKysrIGNw YW4vRXh0VXRpbHMtTWFrZU1ha2VyL2xpYi9FeHRVdGlscy9NTV9BSVgucG0KQEAgLTUwLDcgKzUw LDkgQEAgc3ViIHhzX2Rsc3ltc19leHQgewogCiBzdWIgeHNfZGxzeW1zX2FyZyB7CiAgICAgbXko JHNlbGYsICRmaWxlKSA9IEBfOwotICAgIHJldHVybiBxcXstYkU6JHtmaWxlfX07CisgICAgbXkg JGFyZyA9IHFxey1iRToke2ZpbGV9fTsKKyAgICAkYXJnID0gJy1XbCwnLiRhcmcgaWYgJENvbmZp Z3tsZGRsZmxhZ3N9ID1+IC8tV2wsLWJFOi87CisgICAgcmV0dXJuICRhcmc7CiB9CiAKIHN1YiBp bml0X290aGVycyB7Cg== MMAIXPM } sub _patch_time_local_t { my $perlver = shift; my $num = _norm_ver( $perlver ); if ( $num < 5.029000 && $num > 5.025003 ) { return _patch_b64(<<'TIMELOCALT1'); LS0tIGNwYW4vVGltZS1Mb2NhbC90L0xvY2FsLnQKKysrIGNwYW4vVGltZS1Mb2NhbC90L0xvY2Fs LnQKQEAgLTg1LDE5ICs4NSwxNyBAQCBteSAkZXBvY2hfaXNfNjQKIAogZm9yICggQHRpbWUsIEBu ZWdfdGltZSApIHsKICAgICBteSAoICR5ZWFyLCAkbW9uLCAkbWRheSwgJGhvdXIsICRtaW4sICRz ZWMgKSA9IEAkXzsKLSAgICAkeWVhciAtPSAxOTAwOwogICAgICRtb24tLTsKIAogU0tJUDogewog ICAgICAgICBza2lwICcxOTcwIHRlc3Qgb24gVk9TIGZhaWxzLicsIDEyCi0gICAgICAgICAgICBp ZiAkXk8gZXEgJ3ZvcycgJiYgJHllYXIgPT0gNzA7CisgICAgICAgICAgICBpZiAkXk8gZXEgJ3Zv cycgJiYgJHllYXIgPT0gMTk3MDsKICAgICAgICAgc2tpcCAndGhpcyBwbGF0Zm9ybSBkb2VzIG5v dCBzdXBwb3J0IG5lZ2F0aXZlIGVwb2Nocy4nLCAxMgotICAgICAgICAgICAgaWYgJHllYXIgPCA3 MCAmJiAhJG5lZ19lcG9jaF9vazsKKyAgICAgICAgICAgIGlmICR5ZWFyIDwgMTk3MCAmJiAhJG5l Z19lcG9jaF9vazsKIAogICAgICAgICAjIFRlc3QgdGltZWxvY2FsKCkKICAgICAgICAgewotICAg ICAgICAgICAgbXkgJHllYXJfaW4gPSAkeWVhciA8IDcwID8gJHllYXIgKyAxOTAwIDogJHllYXI7 Ci0gICAgICAgICAgICBteSAkdGltZSA9IHRpbWVsb2NhbCggJHNlYywgJG1pbiwgJGhvdXIsICRt ZGF5LCAkbW9uLCAkeWVhcl9pbiApOworICAgICAgICAgICAgbXkgJHRpbWUgPSB0aW1lbG9jYWwo ICRzZWMsICRtaW4sICRob3VyLCAkbWRheSwgJG1vbiwgJHllYXIgKTsKIAogICAgICAgICAgICAg bXkgKCAkcywgJG0sICRoLCAkRCwgJE0sICRZICkgPSBsb2NhbHRpbWUoJHRpbWUpOwogCkBAIC0x MDYsMTMgKzEwNCwxMiBAQCBTS0lQOiB7CiAgICAgICAgICAgICBpcyggJGgsICRob3VyLCAgICAg InRpbWVsb2NhbCBob3VyIGZvciBAJF8iICk7CiAgICAgICAgICAgICBpcyggJEQsICRtZGF5LCAg ICAgInRpbWVsb2NhbCBkYXkgZm9yIEAkXyIgKTsKICAgICAgICAgICAgIGlzKCAkTSwgJG1vbiwg ICAgICAidGltZWxvY2FsIG1vbnRoIGZvciBAJF8iICk7Ci0gICAgICAgICAgICBpcyggJFksICR5 ZWFyLCAgICAgInRpbWVsb2NhbCB5ZWFyIGZvciBAJF8iICk7CisgICAgICAgICAgICBpcyggJFks ICR5ZWFyIC0gMTkwMCwgICAgICJ0aW1lbG9jYWwgeWVhciBmb3IgQCRfIiApOwogICAgICAgICB9 CiAKICAgICAgICAgIyBUZXN0IHRpbWVnbSgpCiAgICAgICAgIHsKLSAgICAgICAgICAgIG15ICR5 ZWFyX2luID0gJHllYXIgPCA3MCA/ICR5ZWFyICsgMTkwMCA6ICR5ZWFyOwotICAgICAgICAgICAg bXkgJHRpbWUgPSB0aW1lZ20oICRzZWMsICRtaW4sICRob3VyLCAkbWRheSwgJG1vbiwgJHllYXJf aW4gKTsKKyAgICAgICAgICAgIG15ICR0aW1lID0gdGltZWdtKCAkc2VjLCAkbWluLCAkaG91ciwg JG1kYXksICRtb24sICR5ZWFyICk7CiAKICAgICAgICAgICAgIG15ICggJHMsICRtLCAkaCwgJEQs ICRNLCAkWSApID0gZ210aW1lKCR0aW1lKTsKIApAQCAtMTIxLDE0ICsxMTgsMTMgQEAgU0tJUDog ewogICAgICAgICAgICAgaXMoICRoLCAkaG91ciwgICAgICJ0aW1lZ20gaG91ciBmb3IgQCRfIiAp OwogICAgICAgICAgICAgaXMoICRELCAkbWRheSwgICAgICJ0aW1lZ20gZGF5IGZvciBAJF8iICk7 CiAgICAgICAgICAgICBpcyggJE0sICRtb24sICAgICAgInRpbWVnbSBtb250aCBmb3IgQCRfIiAp OwotICAgICAgICAgICAgaXMoICRZLCAkeWVhciwgICAgICJ0aW1lZ20geWVhciBmb3IgQCRfIiAp OworICAgICAgICAgICAgaXMoICRZLCAkeWVhciAtIDE5MDAsICAgICAidGltZWdtIHllYXIgZm9y IEAkXyIgKTsKICAgICAgICAgfQogICAgIH0KIH0KIAogZm9yIChAYmFkX3RpbWUpIHsKICAgICBt eSAoICR5ZWFyLCAkbW9uLCAkbWRheSwgJGhvdXIsICRtaW4sICRzZWMgKSA9IEAkXzsKLSAgICAk eWVhciAtPSAxOTAwOwogICAgICRtb24tLTsKIAogICAgIGV2YWwgeyB0aW1lZ20oICRzZWMsICRt aW4sICRob3VyLCAkbWRheSwgJG1vbiwgJHllYXIgKSB9OwpAQCAtMjI5LDYgKzIyNSwzMCBAQCBT S0lQOgogICAgICk7CiB9CiAKKyMgMi1kaWdpdCB5ZWFycworeworCW15ICRjdXJyZW50X3llYXIg PSAoIGxvY2FsdGltZSgpIClbNV07CisJbXkgJHByZV9icmVhayAgICA9ICggJGN1cnJlbnRfeWVh ciArIDQ5ICkgLSAxMDA7CisJbXkgJGJyZWFrICAgICAgICA9ICggJGN1cnJlbnRfeWVhciArIDUw ICkgLSAxMDA7CisJbXkgJHBvc3RfYnJlYWsgICA9ICggJGN1cnJlbnRfeWVhciArIDUxICkgLSAx MDA7CisKKwlpcygKKwkJKCAoIGxvY2FsdGltZSggdGltZWxvY2FsKCAwLCAwLCAwLCAxLCAxLCAk cHJlX2JyZWFrICkgKSApWzVdICksCisJCSRwcmVfYnJlYWsgKyAxMDAsCisJCSJ5ZWFyICRwcmVf YnJlYWsgaXMgdHJlYXRlZCBhcyBuZXh0IGNlbnR1cnkiLAorCSk7CisJaXMoCisJCSggKCBsb2Nh bHRpbWUoIHRpbWVsb2NhbCggMCwgMCwgMCwgMSwgMSwgJGJyZWFrICkgKSApWzVdICksCisJCSRi cmVhayArIDEwMCwKKwkJInllYXIgJGJyZWFrIGlzIHRyZWF0ZWQgYXMgbmV4dCBjZW50dXJ5IiwK KwkpOworCWlzKAorCQkoICggbG9jYWx0aW1lKCB0aW1lbG9jYWwoIDAsIDAsIDAsIDEsIDEsICRw b3N0X2JyZWFrICkgKSApWzVdICksCisJCSRwb3N0X2JyZWFrLAorCQkieWVhciAkcG9zdF9icmVh ayBpcyB0cmVhdGVkIGFzIGN1cnJlbnQgY2VudHVyeSIsCisJKTsKK30KKwogU0tJUDoKIHsKICAg ICBza2lwICdUaGVzZSB0ZXN0cyBvbmx5IHJ1biBmb3IgdGhlIHBhY2thZ2UgbWFpbnRhaW5lci4n LCA4Cg== TIMELOCALT1 } if ( $num < 5.025004 && $num > 5.013008 ) { return _patch_b64(<<'TIMELOCALT2'); LS0tIGNwYW4vVGltZS1Mb2NhbC90L0xvY2FsLnQKKysrIGNwYW4vVGltZS1Mb2NhbC90L0xvY2Fs LnQKQEAgLTkxLDcgKzkxLDcgQEAgZm9yIChAdGltZSwgQG5lZ190aW1lKSB7CiAKICAgICAgICAg IyBUZXN0IHRpbWVsb2NhbCgpCiAgICAgICAgIHsKLSAgICAgICAgICAgIG15ICR5ZWFyX2luID0g JHllYXIgPCA3MCA/ICR5ZWFyICsgMTkwMCA6ICR5ZWFyOworICAgICAgICAgICAgbXkgJHllYXJf aW4gPSAkeWVhciArIDE5MDA7CiAgICAgICAgICAgICBteSAkdGltZSA9IHRpbWVsb2NhbCgkc2Vj LCRtaW4sJGhvdXIsJG1kYXksJG1vbiwkeWVhcl9pbik7CiAKICAgICAgICAgICAgIG15KCRzLCRt LCRoLCRELCRNLCRZKSA9IGxvY2FsdGltZSgkdGltZSk7CkBAIC0xMDcsNyArMTA3LDcgQEAgZm9y IChAdGltZSwgQG5lZ190aW1lKSB7CiAKICAgICAgICAgIyBUZXN0IHRpbWVnbSgpCiAgICAgICAg IHsKLSAgICAgICAgICAgIG15ICR5ZWFyX2luID0gJHllYXIgPCA3MCA/ICR5ZWFyICsgMTkwMCA6 ICR5ZWFyOworICAgICAgICAgICAgbXkgJHllYXJfaW4gPSAkeWVhciArIDE5MDA7CiAgICAgICAg ICAgICBteSAkdGltZSA9IHRpbWVnbSgkc2VjLCRtaW4sJGhvdXIsJG1kYXksJG1vbiwkeWVhcl9p bik7CiAKICAgICAgICAgICAgIG15KCRzLCRtLCRoLCRELCRNLCRZKSA9IGdtdGltZSgkdGltZSk7 CkBAIC0xMjUsNyArMTI1LDYgQEAgZm9yIChAdGltZSwgQG5lZ190aW1lKSB7CiAKIGZvciAoQGJh ZF90aW1lKSB7CiAgICAgbXkoJHllYXIsICRtb24sICRtZGF5LCAkaG91ciwgJG1pbiwgJHNlYykg PSBAJF87Ci0gICAgJHllYXIgLT0gMTkwMDsKICAgICAkbW9uLS07CiAKICAgICBldmFsIHsgdGlt ZWdtKCRzZWMsJG1pbiwkaG91ciwkbWRheSwkbW9uLCR5ZWFyKSB9OwpAQCAtMTM0LDE0ICsxMzMs MTQgQEAgZm9yIChAYmFkX3RpbWUpIHsKIH0KIAogewotICAgIGlzKHRpbWVsb2NhbCgwLDAsMSwx LDAsOTApIC0gdGltZWxvY2FsKDAsMCwwLDEsMCw5MCksIDM2MDAsCisgICAgaXModGltZWxvY2Fs KDAsMCwxLDEsMCwxOTkwKSAtIHRpbWVsb2NhbCgwLDAsMCwxLDAsMTk5MCksIDM2MDAsCiAgICAg ICAgJ29uZSBob3VyIGRpZmZlcmVuY2UgYmV0d2VlbiB0d28gY2FsbHMgdG8gdGltZWxvY2FsJyk7 CiAKLSAgICBpcyh0aW1lbG9jYWwoMSwyLDMsMSwwLDEwMCkgLSB0aW1lbG9jYWwoMSwyLDMsMzEs MTEsOTkpLCAyNCAqIDM2MDAsCisgICAgaXModGltZWxvY2FsKDEsMiwzLDEsMCwyMDAwKSAtIHRp bWVsb2NhbCgxLDIsMywzMSwxMSwxOTk5KSwgMjQgKiAzNjAwLAogICAgICAgICdvbmUgZGF5IGRp ZmZlcmVuY2UgYmV0d2VlbiB0d28gY2FsbHMgdG8gdGltZWxvY2FsJyk7CiAKICAgICAjIERpZmYg YmV3ZWVuIEphbiAxLCAxOTgwIGFuZCBNYXIgMSwgMTk4MCA9ICgzMSArIDI5ID0gNjAgZGF5cykK LSAgICBpcyh0aW1lZ20oMCwwLDAsIDEsIDIsIDgwKSAtIHRpbWVnbSgwLDAsMCwgMSwgMCwgODAp LCA2MCAqIDI0ICogMzYwMCwKKyAgICBpcyh0aW1lZ20oMCwwLDAsIDEsIDIsIDE5ODApIC0gdGlt ZWdtKDAsMCwwLCAxLCAwLCAxOTgwKSwgNjAgKiAyNCAqIDM2MDAsCiAgICAgICAgJzYwIGRheSBk aWZmZXJlbmNlIGJldHdlZW4gdHdvIGNhbGxzIHRvIHRpbWVnbScpOwogfQogCg== TIMELOCALT2 } if ( $num < 5.013009 && $num > 5.010001 ) { return _patch_b64(<<'TIMELOCALT3'); LS0tIGV4dC9UaW1lLUxvY2FsL3QvTG9jYWwudAorKysgZXh0L1RpbWUtTG9jYWwvdC9Mb2NhbC50 CkBAIC04NCw3ICs4NCw3IEBAIGZvciAoQHRpbWUsIEBuZWdfdGltZSkgewogCiAgICAgIyBUZXN0 IHRpbWVsb2NhbCgpCiAgICAgewotICAgICAgICBteSAkeWVhcl9pbiA9ICR5ZWFyIDwgNzAgPyAk eWVhciArIDE5MDAgOiAkeWVhcjsKKyAgICAgICAgbXkgJHllYXJfaW4gPSAkeWVhciArIDE5MDA7 CiAgICAgICAgIG15ICR0aW1lID0gdGltZWxvY2FsKCRzZWMsJG1pbiwkaG91ciwkbWRheSwkbW9u LCR5ZWFyX2luKTsKIAogICAgICAgICBteSgkcywkbSwkaCwkRCwkTSwkWSkgPSBsb2NhbHRpbWUo JHRpbWUpOwpAQCAtMTAwLDcgKzEwMCw3IEBAIGZvciAoQHRpbWUsIEBuZWdfdGltZSkgewogCiAg ICAgIyBUZXN0IHRpbWVnbSgpCiAgICAgewotICAgICAgICBteSAkeWVhcl9pbiA9ICR5ZWFyIDwg NzAgPyAkeWVhciArIDE5MDAgOiAkeWVhcjsKKyAgICAgICAgbXkgJHllYXJfaW4gPSAkeWVhciAr IDE5MDA7CiAgICAgICAgIG15ICR0aW1lID0gdGltZWdtKCRzZWMsJG1pbiwkaG91ciwkbWRheSwk bW9uLCR5ZWFyX2luKTsKIAogICAgICAgICBteSgkcywkbSwkaCwkRCwkTSwkWSkgPSBnbXRpbWUo JHRpbWUpOwpAQCAtMTE3LDcgKzExNyw2IEBAIGZvciAoQHRpbWUsIEBuZWdfdGltZSkgewogCiBm b3IgKEBiYWRfdGltZSkgewogICAgIG15KCR5ZWFyLCAkbW9uLCAkbWRheSwgJGhvdXIsICRtaW4s ICRzZWMpID0gQCRfOwotICAgICR5ZWFyIC09IDE5MDA7CiAgICAgJG1vbi0tOwogCiAgICAgZXZh bCB7IHRpbWVnbSgkc2VjLCRtaW4sJGhvdXIsJG1kYXksJG1vbiwkeWVhcikgfTsKQEAgLTEyNiwx NCArMTI1LDE0IEBAIGZvciAoQGJhZF90aW1lKSB7CiB9CiAKIHsKLSAgICBpcyh0aW1lbG9jYWwo MCwwLDEsMSwwLDkwKSAtIHRpbWVsb2NhbCgwLDAsMCwxLDAsOTApLCAzNjAwLAorICAgIGlzKHRp bWVsb2NhbCgwLDAsMSwxLDAsMTk5MCkgLSB0aW1lbG9jYWwoMCwwLDAsMSwwLDE5OTApLCAzNjAw LAogICAgICAgICdvbmUgaG91ciBkaWZmZXJlbmNlIGJldHdlZW4gdHdvIGNhbGxzIHRvIHRpbWVs b2NhbCcpOwogCi0gICAgaXModGltZWxvY2FsKDEsMiwzLDEsMCwxMDApIC0gdGltZWxvY2FsKDEs MiwzLDMxLDExLDk5KSwgMjQgKiAzNjAwLAorICAgIGlzKHRpbWVsb2NhbCgxLDIsMywxLDAsMjAw MCkgLSB0aW1lbG9jYWwoMSwyLDMsMzEsMTEsMTk5OSksIDI0ICogMzYwMCwKICAgICAgICAnb25l IGRheSBkaWZmZXJlbmNlIGJldHdlZW4gdHdvIGNhbGxzIHRvIHRpbWVsb2NhbCcpOwogCiAgICAg IyBEaWZmIGJld2VlbiBKYW4gMSwgMTk4MCBhbmQgTWFyIDEsIDE5ODAgPSAoMzEgKyAyOSA9IDYw IGRheXMpCi0gICAgaXModGltZWdtKDAsMCwwLCAxLCAyLCA4MCkgLSB0aW1lZ20oMCwwLDAsIDEs IDAsIDgwKSwgNjAgKiAyNCAqIDM2MDAsCisgICAgaXModGltZWdtKDAsMCwwLCAxLCAyLCAxOTgw KSAtIHRpbWVnbSgwLDAsMCwgMSwgMCwgMTk4MCksIDYwICogMjQgKiAzNjAwLAogICAgICAgICc2 MCBkYXkgZGlmZmVyZW5jZSBiZXR3ZWVuIHR3byBjYWxscyB0byB0aW1lZ20nKTsKIH0KIAo= TIMELOCALT3 } if ( ( $num <= 5.010001 && $num > 5.009003 ) || $num == 5.008009 ) { return _patch_b64(<<'TIMELOCALT4'); LS0tIGxpYi9UaW1lL0xvY2FsLnQKKysrIGxpYi9UaW1lL0xvY2FsLnQKQEAgLTk2LDcgKzk2LDcg QEAgZm9yIChAdGltZSwgQG5lZ190aW1lKSB7CiAgICAgICAgICAgICBpZiAkeWVhciA8IDcwICYm ICEgJG5lZ19lcG9jaF9vazsKIAogICAgICAgICB7Ci0gICAgICAgICAgICBteSAkeWVhcl9pbiA9 ICR5ZWFyIDwgNzAgPyAkeWVhciArIDE5MDAgOiAkeWVhcjsKKyAgICAgICAgICAgIG15ICR5ZWFy X2luID0gJHllYXIgKyAxOTAwOwogICAgICAgICAgICAgbXkgJHRpbWUgPSB0aW1lbG9jYWwoJHNl YywkbWluLCRob3VyLCRtZGF5LCRtb24sJHllYXJfaW4pOwogCiAgICAgICAgICAgICBteSgkcywk bSwkaCwkRCwkTSwkWSkgPSBsb2NhbHRpbWUoJHRpbWUpOwpAQCAtMTEwLDcgKzExMCw3IEBAIGZv ciAoQHRpbWUsIEBuZWdfdGltZSkgewogICAgICAgICB9CiAKICAgICAgICAgewotICAgICAgICAg ICAgbXkgJHllYXJfaW4gPSAkeWVhciA8IDcwID8gJHllYXIgKyAxOTAwIDogJHllYXI7CisgICAg ICAgICAgICBteSAkeWVhcl9pbiA9ICR5ZWFyICsgMTkwMDsKICAgICAgICAgICAgIG15ICR0aW1l ID0gdGltZWdtKCRzZWMsJG1pbiwkaG91ciwkbWRheSwkbW9uLCR5ZWFyX2luKTsKIAogICAgICAg ICAgICAgbXkoJHMsJG0sJGgsJEQsJE0sJFkpID0gZ210aW1lKCR0aW1lKTsKQEAgLTEyNyw3ICsx MjcsNiBAQCBmb3IgKEB0aW1lLCBAbmVnX3RpbWUpIHsKIAogZm9yIChAYmFkX3RpbWUpIHsKICAg ICBteSgkeWVhciwgJG1vbiwgJG1kYXksICRob3VyLCAkbWluLCAkc2VjKSA9IEAkXzsKLSAgICAk eWVhciAtPSAxOTAwOwogICAgICRtb24tLTsKIAogICAgIGV2YWwgeyB0aW1lZ20oJHNlYywkbWlu LCRob3VyLCRtZGF5LCRtb24sJHllYXIpIH07CkBAIC0xMzYsMTQgKzEzNSwxNCBAQCBmb3IgKEBi YWRfdGltZSkgewogfQogCiB7Ci0gICAgaXModGltZWxvY2FsKDAsMCwxLDEsMCw5MCkgLSB0aW1l bG9jYWwoMCwwLDAsMSwwLDkwKSwgMzYwMCwKKyAgICBpcyh0aW1lbG9jYWwoMCwwLDEsMSwwLDE5 OTApIC0gdGltZWxvY2FsKDAsMCwwLDEsMCwxOTkwKSwgMzYwMCwKICAgICAgICAnb25lIGhvdXIg ZGlmZmVyZW5jZSBiZXR3ZWVuIHR3byBjYWxscyB0byB0aW1lbG9jYWwnKTsKIAotICAgIGlzKHRp bWVsb2NhbCgxLDIsMywxLDAsMTAwKSAtIHRpbWVsb2NhbCgxLDIsMywzMSwxMSw5OSksIDI0ICog MzYwMCwKKyAgICBpcyh0aW1lbG9jYWwoMSwyLDMsMSwwLDIwMDApIC0gdGltZWxvY2FsKDEsMiwz LDMxLDExLDE5OTkpLCAyNCAqIDM2MDAsCiAgICAgICAgJ29uZSBkYXkgZGlmZmVyZW5jZSBiZXR3 ZWVuIHR3byBjYWxscyB0byB0aW1lbG9jYWwnKTsKIAogICAgICMgRGlmZiBiZXdlZW4gSmFuIDEs IDE5ODAgYW5kIE1hciAxLCAxOTgwID0gKDMxICsgMjkgPSA2MCBkYXlzKQotICAgIGlzKHRpbWVn bSgwLDAsMCwgMSwgMiwgODApIC0gdGltZWdtKDAsMCwwLCAxLCAwLCA4MCksIDYwICogMjQgKiAz NjAwLAorICAgIGlzKHRpbWVnbSgwLDAsMCwgMSwgMiwgMTk4MCkgLSB0aW1lZ20oMCwwLDAsIDEs IDAsIDE5ODApLCA2MCAqIDI0ICogMzYwMCwKICAgICAgICAnNjAgZGF5IGRpZmZlcmVuY2UgYmV0 d2VlbiB0d28gY2FsbHMgdG8gdGltZWdtJyk7CiB9CiAK TIMELOCALT4 } if ( ( $num == 5.009002 || $num == 5.009003 ) || ( $num == 5.008008 || $num == 5.008007 ) ) { return _patch_b64(<<'TIMELOCALT5'); LS0tIGxpYi9UaW1lL0xvY2FsLnQKKysrIGxpYi9UaW1lL0xvY2FsLnQKQEAgLTgzLDcgKzgzLDcg QEAgZm9yIChAdGltZSwgQG5lZ190aW1lKSB7CiAgICAgfSBlbHNpZiAoJHllYXIgPCA3MCAmJiAh ICRuZWdfZXBvY2hfb2spIHsKICAgICAgICAgc2tpcCgxLCAic2tpcHBpbmcgbmVnYXRpdmUgZXBv Y2guXG4iKSBmb3IgMS4uNjsKICAgICB9IGVsc2UgewotICAgICAgICBteSAkeWVhcl9pbiA9ICR5 ZWFyIDwgNzAgPyAkeWVhciArIDE5MDAgOiAkeWVhcjsKKyAgICAgICAgbXkgJHllYXJfaW4gPSAk eWVhciArIDE5MDA7CiAgICAgICAgIG15ICR0aW1lID0gdGltZWxvY2FsKCRzZWMsJG1pbiwkaG91 ciwkbWRheSwkbW9uLCR5ZWFyX2luKTsKIAogICAgICAgICBteSgkcywkbSwkaCwkRCwkTSwkWSkg PSBsb2NhbHRpbWUoJHRpbWUpOwpAQCAtMTAxLDcgKzEwMSw3IEBAIGZvciAoQHRpbWUsIEBuZWdf dGltZSkgewogICAgIH0gZWxzaWYgKCR5ZWFyIDwgNzAgJiYgISAkbmVnX2Vwb2NoX29rKSB7CiAg ICAgICAgIHNraXAoMSwgInNraXBwaW5nIG5lZ2F0aXZlIGVwb2NoLlxuIikgZm9yIDEuLjY7CiAg ICAgfSBlbHNlIHsKLSAgICAgICAgbXkgJHllYXJfaW4gPSAkeWVhciA8IDcwID8gJHllYXIgKyAx OTAwIDogJHllYXI7CisgICAgICAgIG15ICR5ZWFyX2luID0gJHllYXIgKyAxOTAwOwogICAgICAg ICBteSAkdGltZSA9IHRpbWVnbSgkc2VjLCRtaW4sJGhvdXIsJG1kYXksJG1vbiwkeWVhcl9pbik7 CiAKICAgICAgICAgbXkoJHMsJG0sJGgsJEQsJE0sJFkpID0gZ210aW1lKCR0aW1lKTsKQEAgLTEx Nyw3ICsxMTcsNiBAQCBmb3IgKEB0aW1lLCBAbmVnX3RpbWUpIHsKIAogZm9yIChAYmFkX3RpbWUp IHsKICAgICBteSgkeWVhciwgJG1vbiwgJG1kYXksICRob3VyLCAkbWluLCAkc2VjKSA9IEAkXzsK LSAgICAkeWVhciAtPSAxOTAwOwogICAgICRtb24tLTsKIAogICAgIGV2YWwgeyB0aW1lZ20oJHNl YywkbWluLCRob3VyLCRtZGF5LCRtb24sJHllYXIpIH07CkBAIC0xMjUsMTQgKzEyNCwxNCBAQCBm b3IgKEBiYWRfdGltZSkgewogICAgIG9rKCRALCBxci8uKm91dCBvZiByYW5nZS4qLywgJ2ludmFs aWQgdGltZSBjYXVzZWQgYW4gZXJyb3InKTsKIH0KIAotb2sodGltZWxvY2FsKDAsMCwxLDEsMCw5 MCkgLSB0aW1lbG9jYWwoMCwwLDAsMSwwLDkwKSwgMzYwMCwKK29rKHRpbWVsb2NhbCgwLDAsMSwx LDAsMTk5MCkgLSB0aW1lbG9jYWwoMCwwLDAsMSwwLDE5OTApLCAzNjAwLAogICAgJ29uZSBob3Vy IGRpZmZlcmVuY2UgYmV0d2VlbiB0d28gY2FsbHMgdG8gdGltZWxvY2FsJyk7CiAKLW9rKHRpbWVs b2NhbCgxLDIsMywxLDAsMTAwKSAtIHRpbWVsb2NhbCgxLDIsMywzMSwxMSw5OSksIDI0ICogMzYw MCwKK29rKHRpbWVsb2NhbCgxLDIsMywxLDAsMjAwMCkgLSB0aW1lbG9jYWwoMSwyLDMsMzEsMTEs MTk5OSksIDI0ICogMzYwMCwKICAgICdvbmUgZGF5IGRpZmZlcmVuY2UgYmV0d2VlbiB0d28gY2Fs bHMgdG8gdGltZWxvY2FsJyk7CiAKICMgRGlmZiBiZXdlZW4gSmFuIDEsIDE5ODAgYW5kIE1hciAx LCAxOTgwID0gKDMxICsgMjkgPSA2MCBkYXlzKQotb2sodGltZWdtKDAsMCwwLCAxLCAyLCA4MCkg LSB0aW1lZ20oMCwwLDAsIDEsIDAsIDgwKSwgNjAgKiAyNCAqIDM2MDAsCitvayh0aW1lZ20oMCww LDAsIDEsIDIsIDE5ODApIC0gdGltZWdtKDAsMCwwLCAxLCAwLCAxOTgwKSwgNjAgKiAyNCAqIDM2 MDAsCiAgICAnNjAgZGF5IGRpZmZlcmVuY2UgYmV0d2VlbiB0d28gY2FsbHMgdG8gdGltZWdtJyk7 CiAKICMgYnVnaWQgIzE5MzkzCg== TIMELOCALT5 } } sub _patch_pp_c_libc { my $perlver = shift; my $num = _norm_ver( $perlver ); return unless $num > 5.008000; return unless $num < 5.028000; _patch_b64(<<'PPCLIBC'); LS0tIHBwLmMKKysrIHBwLmMKQEAgLTM2NTMsOCArMzY1MywxMiBAQCBQUChwcF9jcnlwdCkKICNp ZiBkZWZpbmVkKF9fR0xJQkNfXykgfHwgZGVmaW5lZChfX0VNWF9fKQogCWlmIChQTF9yZWVudHJh bnRfYnVmZmVyLT5fY3J5cHRfc3RydWN0X2J1ZmZlcikgewogCSAgICBQTF9yZWVudHJhbnRfYnVm ZmVyLT5fY3J5cHRfc3RydWN0X2J1ZmZlci0+aW5pdGlhbGl6ZWQgPSAwOwotCSAgICAvKiB3b3Jr IGFyb3VuZCBnbGliYy0yLjIuNSBidWcgKi8KKyNpZiAoZGVmaW5lZChfX0dMSUJDX18pICYmIF9f R0xJQkNfXyA9PSAyKSAmJiBcCisgICAgKGRlZmluZWQoX19HTElCQ19NSU5PUl9fKSAmJiBfX0dM SUJDX01JTk9SX18gPj0gMiAmJiBfX0dMSUJDX01JTk9SX18gPCA0KQorCSAgICAvKiB3b3JrIGFy b3VuZCBnbGliYy0yLjIuNSBidWcsIGhhcyBiZWVuIGZpeGVkIGF0IHNvbWUKKwkgICAgICogdGlt ZSBpbiBnbGliYy0yLjMuWCAqLwogCSAgICBQTF9yZWVudHJhbnRfYnVmZmVyLT5fY3J5cHRfc3Ry dWN0X2J1ZmZlci0+Y3VycmVudF9zYWx0Yml0cyA9IDA7CisjZW5kaWYKIAl9CiAjZW5kaWYKICAg ICB9Cg== PPCLIBC } sub _patch_conf_gcc10 { my $perlver = shift; my $num = _norm_ver( $perlver ); return unless $num < 5.031006; return if $num >= 5.030002; if ( $num <= 5.006001 or ( $num >= 5.00700 and $num < 5.00800 ) ) { return _patch_b64(<<'CONFGCC10561'); LS0tIENvbmZpZ3VyZQorKysgQ29uZmlndXJlCkBAIC0zMTQ5LDcgKzMxNDksNyBAQCBlbHNlCiBm aQogJHJtIC1mIGdjY3ZlcnMqCiBjYXNlICIkZ2NjdmVyc2lvbiIgaW4KLTEqKSBjcHA9YC4vbG9j IGdjYy1jcHAgJGNwcCAkcHRoYCA7OworMS4qKSBjcHA9YC4vbG9jIGdjYy1jcHAgJGNwcCAkcHRo YCA7OwogZXNhYwogY2FzZSAiJGdjY3ZlcnNpb24iIGluCiAnJykgZ2Njb3NhbmR2ZXJzPScnIDs7 CkBAIC0zOTIzLDEzICszOTIzLDEzIEBAIGRmbHQ9JycKIGNhc2UgIiRoaW50IiBpbgogZGVmYXVs dHxyZWNvbW1lbmRlZCkKIAljYXNlICIkZ2NjdmVyc2lvbiIgaW4KLQkxKikgZGZsdD0nLWZwY2Mt c3RydWN0LXJldHVybicgOzsKKwkxLiopIGRmbHQ9Jy1mcGNjLXN0cnVjdC1yZXR1cm4nIDs7CiAJ ZXNhYwogCWNhc2UgIiRvcHRpbWl6ZSIgaW4KIAkqLWcqKSBkZmx0PSIkZGZsdCAtRERFQlVHR0lO RyI7OwogCWVzYWMKIAljYXNlICIkZ2NjdmVyc2lvbiIgaW4KLQkyKikgaWYgdGVzdCAtZCAvZXRj L2NvbmYva2NvbmZpZy5kICYmCisJMi4qKSBpZiB0ZXN0IC1kIC9ldGMvY29uZi9rY29uZmlnLmQg JiYKIAkJCSRjb250YWlucyBfUE9TSVhfVkVSU0lPTiAkdXNyaW5jL3N5cy91bmlzdGQuaCA+L2Rl di9udWxsIDI+JjEKIAkJdGhlbgogCQkJZGZsdD0iJGRmbHQgLXBvc2l4IgpAQCAtMzkzNyw3ICsz OTM3LDcgQEAgZGVmYXVsdHxyZWNvbW1lbmRlZCkKIAkJOzsKIAllc2FjCiAJY2FzZSAiJGdjY3Zl cnNpb24iIGluCi0JMSopIDs7CisJMS4qKSA7OwogCTIuWzAtOF0qKSA7OwogCT8qKSAJZWNobyAi ICIKIAkJZWNobyAiQ2hlY2tpbmcgaWYgeW91ciBjb21waWxlciBhY2NlcHRzIC1mbm8tc3RyaWN0 LWFsaWFzaW5nIiAyPiYxCkBAIC00MDI4LDcgKzQwMjgsNyBAQCBlc2FjCiA6IHRoZSBmb2xsb3dp bmcgd2VlZHMgb3B0aW9ucyBmcm9tIGNjZmxhZ3MgdGhhdCBhcmUgb2Ygbm8gaW50ZXJlc3QgdG8g Y3BwCiBjcHBmbGFncz0iJGNjZmxhZ3MiCiBjYXNlICIkZ2NjdmVyc2lvbiIgaW4KLTEqKSBjcHBm bGFncz0iJGNwcGZsYWdzIC1EX19HTlVDX18iCisxLiopIGNwcGZsYWdzPSIkY3BwZmxhZ3MgLURf X0dOVUNfXyIKIGVzYWMKIGNhc2UgIiRtaXBzX3R5cGUiIGluCiAnJyk7Owo= CONFGCC10561 } if ( $num <= 5.008008 or ( $num > 5.008009 and $num < 5.009004 ) ) { return _patch_b64(<<'CONFGCC10588'); LS0tIENvbmZpZ3VyZQorKysgQ29uZmlndXJlCkBAIC0zOTA5LDcgKzM5MDksNyBAQCBlbHNlCiBm aQogJHJtIC1mIHRyeSB0cnkuKgogY2FzZSAiJGdjY3ZlcnNpb24iIGluCi0xKikgY3BwPWAuL2xv YyBnY2MtY3BwICRjcHAgJHB0aGAgOzsKKzEuKikgY3BwPWAuL2xvYyBnY2MtY3BwICRjcHAgJHB0 aGAgOzsKIGVzYWMKIGNhc2UgIiRnY2N2ZXJzaW9uIiBpbgogJycpIGdjY29zYW5kdmVycz0nJyA7 OwpAQCAtMzk0OSw3ICszOTQ5LDcgQEAgZXNhYwogIyBnY2MgMy4qIGNvbXBsYWluIGFib3V0IGFk ZGluZyAtSWRpcmVjdG9yaWVzIHRoYXQgdGhleSBhbHJlYWR5IGtub3cgYWJvdXQsCiAjIHNvIHdl IHdpbGwgdGFrZSB0aG9zZSBvZmYgZnJvbSBsb2NpbmNwdGguCiBjYXNlICIkZ2NjdmVyc2lvbiIg aW4KLTMqKQorMy4qKQogICAgIGVjaG8gIm1haW4oKXt9Ij50cnkuYwogICAgIGZvciBpbmNkaXIg aW4gJGxvY2luY3B0aDsgZG8KICAgICAgICB3YXJuPWAkY2MgJGNjZmxhZ3MgLUkkaW5jZGlyIC1j IHRyeS5jIDI+JjEgfCBcCkBAIC00NzI0LDEzICs0NzI0LDEzIEBAIGRmbHQ9JycKIGNhc2UgIiRo aW50IiBpbgogZGVmYXVsdHxyZWNvbW1lbmRlZCkKIAljYXNlICIkZ2NjdmVyc2lvbiIgaW4KLQkx KikgZGZsdD0nLWZwY2Mtc3RydWN0LXJldHVybicgOzsKKwkxLiopIGRmbHQ9Jy1mcGNjLXN0cnVj dC1yZXR1cm4nIDs7CiAJZXNhYwogCWNhc2UgIiRvcHRpbWl6ZSIgaW4KIAkqLWcqKSBkZmx0PSIk ZGZsdCAtRERFQlVHR0lORyI7OwogCWVzYWMKIAljYXNlICIkZ2NjdmVyc2lvbiIgaW4KLQkyKikg aWYgdGVzdCAtZCAvZXRjL2NvbmYva2NvbmZpZy5kICYmCisJMi4qKSBpZiB0ZXN0IC1kIC9ldGMv Y29uZi9rY29uZmlnLmQgJiYKIAkJCSRjb250YWlucyBfUE9TSVhfVkVSU0lPTiAkdXNyaW5jL3N5 cy91bmlzdGQuaCA+L2Rldi9udWxsIDI+JjEKIAkJdGhlbgogCQkJIyBJbnRlcmFjdGl2ZSBTeXN0 ZW1zIChJU0MpIFBPU0lYIG1vZGUuCkBAIC00NzM5LDcgKzQ3MzksNyBAQCBkZWZhdWx0fHJlY29t bWVuZGVkKQogCQk7OwogCWVzYWMKIAljYXNlICIkZ2NjdmVyc2lvbiIgaW4KLQkxKikgOzsKKwkx LiopIDs7CiAJMi5bMC04XSopIDs7CiAJPyopIAllY2hvICIgIgogCQllY2hvICJDaGVja2luZyBp ZiB5b3VyIGNvbXBpbGVyIGFjY2VwdHMgLWZuby1zdHJpY3QtYWxpYXNpbmciIDI+JjEKQEAgLTQ4 NjcsNyArNDg2Nyw3IEBAIGNhc2UgIiRjcHBmbGFncyIgaW4KICopICBjcHBmbGFncz0iJGNwcGZs YWdzICRjY2ZsYWdzIiA7OwogZXNhYwogY2FzZSAiJGdjY3ZlcnNpb24iIGluCi0xKikgY3BwZmxh Z3M9IiRjcHBmbGFncyAtRF9fR05VQ19fIgorMS4qKSBjcHBmbGFncz0iJGNwcGZsYWdzIC1EX19H TlVDX18iCiBlc2FjCiBjYXNlICIkbWlwc190eXBlIiBpbgogJycpOzsK CONFGCC10588 } if ( $num <= 5.010000 ) { return _patch_b64(<<'CONFGCC10510'); LS0tIENvbmZpZ3VyZQorKysgQ29uZmlndXJlCkBAIC00NDg1LDcgKzQ0ODUsNyBAQCBlbHNlCiBm aQogJHJtIC1mIHRyeSB0cnkuKgogY2FzZSAiJGdjY3ZlcnNpb24iIGluCi0xKikgY3BwPWAuL2xv YyBnY2MtY3BwICRjcHAgJHB0aGAgOzsKKzEuKikgY3BwPWAuL2xvYyBnY2MtY3BwICRjcHAgJHB0 aGAgOzsKIGVzYWMKIGNhc2UgIiRnY2N2ZXJzaW9uIiBpbgogJycpIGdjY29zYW5kdmVycz0nJyA7 OwpAQCAtNDUyNSw3ICs0NTI1LDcgQEAgZXNhYwogIyBnY2MgMy4qIGNvbXBsYWluIGFib3V0IGFk ZGluZyAtSWRpcmVjdG9yaWVzIHRoYXQgdGhleSBhbHJlYWR5IGtub3cgYWJvdXQsCiAjIHNvIHdl IHdpbGwgdGFrZSB0aG9zZSBvZmYgZnJvbSBsb2NpbmNwdGguCiBjYXNlICIkZ2NjdmVyc2lvbiIg aW4KLTMqKQorMy4qKQogICAgIGVjaG8gIm1haW4oKXt9Ij50cnkuYwogICAgIGZvciBpbmNkaXIg aW4gJGxvY2luY3B0aDsgZG8KICAgICAgICB3YXJuPWAkY2MgJGNjZmxhZ3MgLUkkaW5jZGlyIC1j IHRyeS5jIDI+JjEgfCBcCkBAIC01MDUwLDEzICs1MDUwLDEzIEBAIGVzYWMKIGNhc2UgIiRoaW50 IiBpbgogZGVmYXVsdHxyZWNvbW1lbmRlZCkKIAljYXNlICIkZ2NjdmVyc2lvbiIgaW4KLQkxKikg ZGZsdD0iJGRmbHQgLWZwY2Mtc3RydWN0LXJldHVybiIgOzsKKwkxLiopIGRmbHQ9IiRkZmx0IC1m cGNjLXN0cnVjdC1yZXR1cm4iIDs7CiAJZXNhYwogCWNhc2UgIiRvcHRpbWl6ZTokREVCVUdHSU5H IiBpbgogCSotZyo6b2xkKSBkZmx0PSIkZGZsdCAtRERFQlVHR0lORyI7OwogCWVzYWMKIAljYXNl ICIkZ2NjdmVyc2lvbiIgaW4KLQkyKikgaWYgdGVzdCAtZCAvZXRjL2NvbmYva2NvbmZpZy5kICYm CisJMi4qKSBpZiB0ZXN0IC1kIC9ldGMvY29uZi9rY29uZmlnLmQgJiYKIAkJCSRjb250YWlucyBf UE9TSVhfVkVSU0lPTiAkdXNyaW5jL3N5cy91bmlzdGQuaCA+L2Rldi9udWxsIDI+JjEKIAkJdGhl bgogCQkJIyBJbnRlcmFjdGl2ZSBTeXN0ZW1zIChJU0MpIFBPU0lYIG1vZGUuCkBAIC01MDY1LDcg KzUwNjUsNyBAQCBkZWZhdWx0fHJlY29tbWVuZGVkKQogCQk7OwogCWVzYWMKIAljYXNlICIkZ2Nj dmVyc2lvbiIgaW4KLQkxKikgOzsKKwkxLiopIDs7CiAJMi5bMC04XSopIDs7CiAJPyopIAllY2hv ICIgIgogCQllY2hvICJDaGVja2luZyBpZiB5b3VyIGNvbXBpbGVyIGFjY2VwdHMgLWZuby1zdHJp Y3QtYWxpYXNpbmciIDI+JjEKQEAgLTUxNzksNyArNTE3OSw3IEBAIGNhc2UgIiRjcHBmbGFncyIg aW4KICopICBjcHBmbGFncz0iJGNwcGZsYWdzICRjY2ZsYWdzIiA7OwogZXNhYwogY2FzZSAiJGdj Y3ZlcnNpb24iIGluCi0xKikgY3BwZmxhZ3M9IiRjcHBmbGFncyAtRF9fR05VQ19fIgorMS4qKSBj cHBmbGFncz0iJGNwcGZsYWdzIC1EX19HTlVDX18iCiBlc2FjCiBjYXNlICIkbWlwc190eXBlIiBp bgogJycpOzsK CONFGCC10510 } if ( $num < 5.021002 ) { return _patch_b64(<<'CONFGCC10520'); LS0tIENvbmZpZ3VyZQorKysgQ29uZmlndXJlCkBAIC00NTkxLDcgKzQ1OTEsNyBAQCBlbHNlCiBm aQogJHJtIC1mIHRyeSB0cnkuKgogY2FzZSAiJGdjY3ZlcnNpb24iIGluCi0xKikgY3BwPWAuL2xv YyBnY2MtY3BwICRjcHAgJHB0aGAgOzsKKzEuKikgY3BwPWAuL2xvYyBnY2MtY3BwICRjcHAgJHB0 aGAgOzsKIGVzYWMKIGNhc2UgIiRnY2N2ZXJzaW9uIiBpbgogJycpIGdjY29zYW5kdmVycz0nJyA7 OwpAQCAtNDYzMSw3ICs0NjMxLDcgQEAgZXNhYwogIyBnY2MgMy4qIGNvbXBsYWluIGFib3V0IGFk ZGluZyAtSWRpcmVjdG9yaWVzIHRoYXQgdGhleSBhbHJlYWR5IGtub3cgYWJvdXQsCiAjIHNvIHdl IHdpbGwgdGFrZSB0aG9zZSBvZmYgZnJvbSBsb2NpbmNwdGguCiBjYXNlICIkZ2NjdmVyc2lvbiIg aW4KLTMqKQorMy4qKQogICAgIGVjaG8gIm1haW4oKXt9Ij50cnkuYwogICAgIGZvciBpbmNkaXIg aW4gJGxvY2luY3B0aDsgZG8KICAgICAgICB3YXJuPWAkY2MgJGNjZmxhZ3MgLUkkaW5jZGlyIC1j IHRyeS5jIDI+JjEgfCBcCkBAIC01MzI4LDEzICs1MzI4LDEzIEBAIGZpCiBjYXNlICIkaGludCIg aW4KIGRlZmF1bHR8cmVjb21tZW5kZWQpCiAJY2FzZSAiJGdjY3ZlcnNpb24iIGluCi0JMSopIGRm bHQ9IiRkZmx0IC1mcGNjLXN0cnVjdC1yZXR1cm4iIDs7CisJMS4qKSBkZmx0PSIkZGZsdCAtZnBj Yy1zdHJ1Y3QtcmV0dXJuIiA7OwogCWVzYWMKIAljYXNlICIkb3B0aW1pemU6JERFQlVHR0lORyIg aW4KIAkqLWcqOm9sZCkgZGZsdD0iJGRmbHQgLURERUJVR0dJTkciOzsKIAllc2FjCiAJY2FzZSAi JGdjY3ZlcnNpb24iIGluCi0JMiopIGlmICR0ZXN0IC1kIC9ldGMvY29uZi9rY29uZmlnLmQgJiYK KwkyLiopIGlmICR0ZXN0IC1kIC9ldGMvY29uZi9rY29uZmlnLmQgJiYKIAkJCSRjb250YWlucyBf UE9TSVhfVkVSU0lPTiAkdXNyaW5jL3N5cy91bmlzdGQuaCA+L2Rldi9udWxsIDI+JjEKIAkJdGhl bgogCQkJIyBJbnRlcmFjdGl2ZSBTeXN0ZW1zIChJU0MpIFBPU0lYIG1vZGUuCkBAIC01MzQzLDcg KzUzNDMsNyBAQCBkZWZhdWx0fHJlY29tbWVuZGVkKQogCQk7OwogCWVzYWMKIAljYXNlICIkZ2Nj dmVyc2lvbiIgaW4KLQkxKikgOzsKKwkxLiopIDs7CiAJMi5bMC04XSopIDs7CiAJPyopCXNldCBz dHJpY3QtYWxpYXNpbmcgLWZuby1zdHJpY3QtYWxpYXNpbmcKIAkJZXZhbCAkY2hlY2tjY2ZsYWcK QEAgLTU0NDUsNyArNTQ0NSw3IEBAIGNhc2UgIiRjcHBmbGFncyIgaW4KICopICBjcHBmbGFncz0i JGNwcGZsYWdzICRjY2ZsYWdzIiA7OwogZXNhYwogY2FzZSAiJGdjY3ZlcnNpb24iIGluCi0xKikg Y3BwZmxhZ3M9IiRjcHBmbGFncyAtRF9fR05VQ19fIgorMS4qKSBjcHBmbGFncz0iJGNwcGZsYWdz IC1EX19HTlVDX18iCiBlc2FjCiBjYXNlICIkbWlwc190eXBlIiBpbgogJycpOzsK CONFGCC10520 } if ( $num < 5.023005 and ! ( $num >= 5.022002 and $num < 5.023000 ) ) { return _patch_b64(<<'CONFGCC10522'); LS0tIENvbmZpZ3VyZQorKysgQ29uZmlndXJlCkBAIC00NjU3LDcgKzQ2NTcsNyBAQCBlbHNlCiBm aQogJHJtIC1mIHRyeSB0cnkuKgogY2FzZSAiJGdjY3ZlcnNpb24iIGluCi0xKikgY3BwPWAuL2xv YyBnY2MtY3BwICRjcHAgJHB0aGAgOzsKKzEuKikgY3BwPWAuL2xvYyBnY2MtY3BwICRjcHAgJHB0 aGAgOzsKIGVzYWMKIGNhc2UgIiRnY2N2ZXJzaW9uIiBpbgogJycpIGdjY29zYW5kdmVycz0nJyA7 OwpAQCAtNDY5Nyw3ICs0Njk3LDcgQEAgZXNhYwogIyBnY2MgMy4qIGNvbXBsYWluIGFib3V0IGFk ZGluZyAtSWRpcmVjdG9yaWVzIHRoYXQgdGhleSBhbHJlYWR5IGtub3cgYWJvdXQsCiAjIHNvIHdl IHdpbGwgdGFrZSB0aG9zZSBvZmYgZnJvbSBsb2NpbmNwdGguCiBjYXNlICIkZ2NjdmVyc2lvbiIg aW4KLTMqKQorMy4qKQogICAgIGVjaG8gIm1haW4oKXt9Ij50cnkuYwogICAgIGZvciBpbmNkaXIg aW4gJGxvY2luY3B0aDsgZG8KICAgICAgICB3YXJuPWAkY2MgJGNjZmxhZ3MgLUkkaW5jZGlyIC1j IHRyeS5jIDI+JjEgfCBcCkBAIC01NDA5LDEzICs1NDA5LDEzIEBAIGZpCiBjYXNlICIkaGludCIg aW4KIGRlZmF1bHR8cmVjb21tZW5kZWQpCiAJY2FzZSAiJGdjY3ZlcnNpb24iIGluCi0JMSopIGRm bHQ9IiRkZmx0IC1mcGNjLXN0cnVjdC1yZXR1cm4iIDs7CisJMS4qKSBkZmx0PSIkZGZsdCAtZnBj Yy1zdHJ1Y3QtcmV0dXJuIiA7OwogCWVzYWMKIAljYXNlICIkb3B0aW1pemU6JERFQlVHR0lORyIg aW4KIAkqLWcqOm9sZCkgZGZsdD0iJGRmbHQgLURERUJVR0dJTkciOzsKIAllc2FjCiAJY2FzZSAi JGdjY3ZlcnNpb24iIGluCi0JMiopIGlmICR0ZXN0IC1kIC9ldGMvY29uZi9rY29uZmlnLmQgJiYK KwkyLiopIGlmICR0ZXN0IC1kIC9ldGMvY29uZi9rY29uZmlnLmQgJiYKIAkJCSRjb250YWlucyBf UE9TSVhfVkVSU0lPTiAkdXNyaW5jL3N5cy91bmlzdGQuaCA+L2Rldi9udWxsIDI+JjEKIAkJdGhl bgogCQkJIyBJbnRlcmFjdGl2ZSBTeXN0ZW1zIChJU0MpIFBPU0lYIG1vZGUuCkBAIC01NDI0LDcg KzU0MjQsNyBAQCBkZWZhdWx0fHJlY29tbWVuZGVkKQogCQk7OwogCWVzYWMKIAljYXNlICIkZ2Nj dmVyc2lvbiIgaW4KLQkxKikgOzsKKwkxLiopIDs7CiAJMi5bMC04XSopIDs7CiAJPyopCXNldCBz dHJpY3QtYWxpYXNpbmcgLWZuby1zdHJpY3QtYWxpYXNpbmcKIAkJZXZhbCAkY2hlY2tjY2ZsYWcK QEAgLTU1MzMsNyArNTUzMyw3IEBAIGNhc2UgIiRjcHBmbGFncyIgaW4KICopICBjcHBmbGFncz0i JGNwcGZsYWdzICRjY2ZsYWdzIiA7OwogZXNhYwogY2FzZSAiJGdjY3ZlcnNpb24iIGluCi0xKikg Y3BwZmxhZ3M9IiRjcHBmbGFncyAtRF9fR05VQ19fIgorMS4qKSBjcHBmbGFncz0iJGNwcGZsYWdz IC1EX19HTlVDX18iCiBlc2FjCiBjYXNlICIkbWlwc190eXBlIiBpbgogJycpOzsKQEAgLTIyOTYx LDcgKzIyOTYxLDcgQEAgZmkKIAogOiBhZGQgLURfRk9SVElGWV9TT1VSQ0UgaWYgZmVhc2libGUg YW5kIG5vdCBhbHJlYWR5IHRoZXJlCiBjYXNlICIkZ2NjdmVyc2lvbiIgaW4KLTQuKikJY2FzZSAi JG9wdGltaXplJGNjZmxhZ3MiIGluCitbNDU2Nzg5XS4qfFsxLTldWzAtOV0qKQljYXNlICIkb3B0 aW1pemUkY2NmbGFncyIgaW4KIAkqLU8qKQljYXNlICIkY2NmbGFncyRjcHBzeW1ib2xzIiBpbgog CQkqX0ZPUlRJRllfU09VUkNFPSopICMgRG9uJ3QgYWRkIGl0IGFnYWluLgogCQkJZWNobyAiWW91 IHNlZW0gdG8gaGF2ZSAtRF9GT1JUSUZZX1NPVVJDRSBhbHJlYWR5LCBub3QgYWRkaW5nIGl0LiIg PiY0Cg== CONFGCC10522 } if ( ( $num <= 5.026000 or ( $num >= 5.027000 and $num < 5.027003 ) ) and ! ( $num >= 5.024003 and $num < 5.025000 ) ) { return _patch_b64(<<'CONFGCC10526'); LS0tIENvbmZpZ3VyZQorKysgQ29uZmlndXJlCkBAIC00NzAzLDcgKzQ3MDMsNyBAQCBlbHNlCiBm aQogJHJtIC1mIHRyeSB0cnkuKgogY2FzZSAiJGdjY3ZlcnNpb24iIGluCi0xKikgY3BwPWAuL2xv YyBnY2MtY3BwICRjcHAgJHB0aGAgOzsKKzEuKikgY3BwPWAuL2xvYyBnY2MtY3BwICRjcHAgJHB0 aGAgOzsKIGVzYWMKIGNhc2UgIiRnY2N2ZXJzaW9uIiBpbgogJycpIGdjY29zYW5kdmVycz0nJyA7 OwpAQCAtNDc0Myw3ICs0NzQzLDcgQEAgZXNhYwogIyBnY2MgMy4qIGNvbXBsYWluIGFib3V0IGFk ZGluZyAtSWRpcmVjdG9yaWVzIHRoYXQgdGhleSBhbHJlYWR5IGtub3cgYWJvdXQsCiAjIHNvIHdl IHdpbGwgdGFrZSB0aG9zZSBvZmYgZnJvbSBsb2NpbmNwdGguCiBjYXNlICIkZ2NjdmVyc2lvbiIg aW4KLTMqKQorMy4qKQogICAgIGVjaG8gIm1haW4oKXt9Ij50cnkuYwogICAgIGZvciBpbmNkaXIg aW4gJGxvY2luY3B0aDsgZG8KICAgICAgICB3YXJuPWAkY2MgJGNjZmxhZ3MgLUkkaW5jZGlyIC1j IHRyeS5jIDI+JjEgfCBcCkBAIC01NDY5LDEzICs1NDY5LDEzIEBAIGZpCiBjYXNlICIkaGludCIg aW4KIGRlZmF1bHR8cmVjb21tZW5kZWQpCiAJY2FzZSAiJGdjY3ZlcnNpb24iIGluCi0JMSopIGRm bHQ9IiRkZmx0IC1mcGNjLXN0cnVjdC1yZXR1cm4iIDs7CisJMS4qKSBkZmx0PSIkZGZsdCAtZnBj Yy1zdHJ1Y3QtcmV0dXJuIiA7OwogCWVzYWMKIAljYXNlICIkb3B0aW1pemU6JERFQlVHR0lORyIg aW4KIAkqLWcqOm9sZCkgZGZsdD0iJGRmbHQgLURERUJVR0dJTkciOzsKIAllc2FjCiAJY2FzZSAi JGdjY3ZlcnNpb24iIGluCi0JMiopIGlmICR0ZXN0IC1kIC9ldGMvY29uZi9rY29uZmlnLmQgJiYK KwkyLiopIGlmICR0ZXN0IC1kIC9ldGMvY29uZi9rY29uZmlnLmQgJiYKIAkJCSRjb250YWlucyBf UE9TSVhfVkVSU0lPTiAkdXNyaW5jL3N5cy91bmlzdGQuaCA+L2Rldi9udWxsIDI+JjEKIAkJdGhl bgogCQkJIyBJbnRlcmFjdGl2ZSBTeXN0ZW1zIChJU0MpIFBPU0lYIG1vZGUuCkBAIC01NDg0LDcg KzU0ODQsNyBAQCBkZWZhdWx0fHJlY29tbWVuZGVkKQogCQk7OwogCWVzYWMKIAljYXNlICIkZ2Nj dmVyc2lvbiIgaW4KLQkxKikgOzsKKwkxLiopIDs7CiAJMi5bMC04XSopIDs7CiAJPyopCXNldCBz dHJpY3QtYWxpYXNpbmcgLWZuby1zdHJpY3QtYWxpYXNpbmcKIAkJZXZhbCAkY2hlY2tjY2ZsYWcK QEAgLTU2MDIsNyArNTYwMiw3IEBAIGNhc2UgIiRjcHBmbGFncyIgaW4KICAgICA7OwogZXNhYwog Y2FzZSAiJGdjY3ZlcnNpb24iIGluCi0xKikgY3BwZmxhZ3M9IiRjcHBmbGFncyAtRF9fR05VQ19f IgorMS4qKSBjcHBmbGFncz0iJGNwcGZsYWdzIC1EX19HTlVDX18iCiBlc2FjCiBjYXNlICIkbWlw c190eXBlIiBpbgogJycpOzsKQEAgLTIzNjEyLDcgKzIzNjEyLDcgQEAgZmkKIAogOiBhZGQgLURf Rk9SVElGWV9TT1VSQ0UgaWYgZmVhc2libGUgYW5kIG5vdCBhbHJlYWR5IHRoZXJlCiBjYXNlICIk Z2NjdmVyc2lvbiIgaW4KLVs0NV0uKikJY2FzZSAiJG9wdGltaXplJGNjZmxhZ3MiIGluCitbNDU2 Nzg5XS4qfFsxLTldWzAtOV0qKQljYXNlICIkb3B0aW1pemUkY2NmbGFncyIgaW4KIAkqLU8qKQlj YXNlICIkY2NmbGFncyRjcHBzeW1ib2xzIiBpbgogCQkqX0ZPUlRJRllfU09VUkNFPSopICMgRG9u J3QgYWRkIGl0IGFnYWluLgogCQkJZWNobyAiWW91IHNlZW0gdG8gaGF2ZSAtRF9GT1JUSUZZX1NP VVJDRSBhbHJlYWR5LCBub3QgYWRkaW5nIGl0LiIgPiY0Cg== CONFGCC10526 } if ( $num < 5.029003 ) { return _patch_b64(<<'CONFGCC10528'); LS0tIENvbmZpZ3VyZQorKysgQ29uZmlndXJlCkBAIC00Njg5LDcgKzQ2ODksNyBAQCBlbHNlCiBm aQogJHJtIC1mIHRyeSB0cnkuKgogY2FzZSAiJGdjY3ZlcnNpb24iIGluCi0xKikgY3BwPWAuL2xv YyBnY2MtY3BwICRjcHAgJHB0aGAgOzsKKzEuKikgY3BwPWAuL2xvYyBnY2MtY3BwICRjcHAgJHB0 aGAgOzsKIGVzYWMKIGNhc2UgIiRnY2N2ZXJzaW9uIiBpbgogJycpIGdjY29zYW5kdmVycz0nJyA7 OwpAQCAtNDcyOSw3ICs0NzI5LDcgQEAgZXNhYwogIyBnY2MgMy4qIGNvbXBsYWluIGFib3V0IGFk ZGluZyAtSWRpcmVjdG9yaWVzIHRoYXQgdGhleSBhbHJlYWR5IGtub3cgYWJvdXQsCiAjIHNvIHdl IHdpbGwgdGFrZSB0aG9zZSBvZmYgZnJvbSBsb2NpbmNwdGguCiBjYXNlICIkZ2NjdmVyc2lvbiIg aW4KLTMqKQorMy4qKQogICAgIGVjaG8gIm1haW4oKXt9Ij50cnkuYwogICAgIGZvciBpbmNkaXIg aW4gJGxvY2luY3B0aDsgZG8KICAgICAgICB3YXJuPWAkY2MgJGNjZmxhZ3MgLUkkaW5jZGlyIC1j IHRyeS5jIDI+JjEgfCBcCkBAIC01NDU1LDEzICs1NDU1LDEzIEBAIGZpCiBjYXNlICIkaGludCIg aW4KIGRlZmF1bHR8cmVjb21tZW5kZWQpCiAJY2FzZSAiJGdjY3ZlcnNpb24iIGluCi0JMSopIGRm bHQ9IiRkZmx0IC1mcGNjLXN0cnVjdC1yZXR1cm4iIDs7CisJMS4qKSBkZmx0PSIkZGZsdCAtZnBj Yy1zdHJ1Y3QtcmV0dXJuIiA7OwogCWVzYWMKIAljYXNlICIkb3B0aW1pemU6JERFQlVHR0lORyIg aW4KIAkqLWcqOm9sZCkgZGZsdD0iJGRmbHQgLURERUJVR0dJTkciOzsKIAllc2FjCiAJY2FzZSAi JGdjY3ZlcnNpb24iIGluCi0JMiopIGlmICR0ZXN0IC1kIC9ldGMvY29uZi9rY29uZmlnLmQgJiYK KwkyLiopIGlmICR0ZXN0IC1kIC9ldGMvY29uZi9rY29uZmlnLmQgJiYKIAkJCSRjb250YWlucyBf UE9TSVhfVkVSU0lPTiAkdXNyaW5jL3N5cy91bmlzdGQuaCA+L2Rldi9udWxsIDI+JjEKIAkJdGhl bgogCQkJIyBJbnRlcmFjdGl2ZSBTeXN0ZW1zIChJU0MpIFBPU0lYIG1vZGUuCkBAIC01NDcwLDcg KzU0NzAsNyBAQCBkZWZhdWx0fHJlY29tbWVuZGVkKQogCQk7OwogCWVzYWMKIAljYXNlICIkZ2Nj dmVyc2lvbiIgaW4KLQkxKikgOzsKKwkxLiopIDs7CiAJMi5bMC04XSopIDs7CiAJPyopCXNldCBz dHJpY3QtYWxpYXNpbmcgLWZuby1zdHJpY3QtYWxpYXNpbmcKIAkJZXZhbCAkY2hlY2tjY2ZsYWcK QEAgLTU1ODgsNyArNTU4OCw3IEBAIGNhc2UgIiRjcHBmbGFncyIgaW4KICAgICA7OwogZXNhYwog Y2FzZSAiJGdjY3ZlcnNpb24iIGluCi0xKikgY3BwZmxhZ3M9IiRjcHBmbGFncyAtRF9fR05VQ19f IgorMS4qKSBjcHBmbGFncz0iJGNwcGZsYWdzIC1EX19HTlVDX18iCiBlc2FjCiBjYXNlICIkbWlw c190eXBlIiBpbgogJycpOzsKQEAgLTIzMDI2LDcgKzIzMDI2LDcgQEAgZmkKIAogOiBhZGQgLURf Rk9SVElGWV9TT1VSQ0UgaWYgZmVhc2libGUgYW5kIG5vdCBhbHJlYWR5IHRoZXJlCiBjYXNlICIk Z2NjdmVyc2lvbiIgaW4KLVs0NTY3XS4qKQljYXNlICIkb3B0aW1pemUkY2NmbGFncyIgaW4KK1s0 NTY3ODldLip8WzEtOV1bMC05XSopCWNhc2UgIiRvcHRpbWl6ZSRjY2ZsYWdzIiBpbgogCSotTyop CWNhc2UgIiRjY2ZsYWdzJGNwcHN5bWJvbHMiIGluCiAJCSpfRk9SVElGWV9TT1VSQ0U9KikgIyBE b24ndCBhZGQgaXQgYWdhaW4uCiAJCQllY2hvICJZb3Ugc2VlbSB0byBoYXZlIC1EX0ZPUlRJRllf U09VUkNFIGFscmVhZHksIG5vdCBhZGRpbmcgaXQuIiA+JjQK CONFGCC10528 } _patch_b64(<<'CONFGCC10'); LS0tIENvbmZpZ3VyZQorKysgQ29uZmlndXJlCkBAIC00NzAzLDcgKzQ3MDMsNyBAQCBlbHNlCiBm aQogJHJtIC1mIHRyeSB0cnkuKgogY2FzZSAiJGdjY3ZlcnNpb24iIGluCi0xKikgY3BwPWAuL2xv YyBnY2MtY3BwICRjcHAgJHB0aGAgOzsKKzEuKikgY3BwPWAuL2xvYyBnY2MtY3BwICRjcHAgJHB0 aGAgOzsKIGVzYWMKIGNhc2UgIiRnY2N2ZXJzaW9uIiBpbgogJycpIGdjY29zYW5kdmVycz0nJyA7 OwpAQCAtNDc0Myw3ICs0NzQzLDcgQEAgZXNhYwogIyBnY2MgMy4qIGNvbXBsYWluIGFib3V0IGFk ZGluZyAtSWRpcmVjdG9yaWVzIHRoYXQgdGhleSBhbHJlYWR5IGtub3cgYWJvdXQsCiAjIHNvIHdl IHdpbGwgdGFrZSB0aG9zZSBvZmYgZnJvbSBsb2NpbmNwdGguCiBjYXNlICIkZ2NjdmVyc2lvbiIg aW4KLTMqKQorMy4qKQogICAgIGVjaG8gIm1haW4oKXt9Ij50cnkuYwogICAgIGZvciBpbmNkaXIg aW4gJGxvY2luY3B0aDsgZG8KICAgICAgICB3YXJuPWAkY2MgJGNjZmxhZ3MgLUkkaW5jZGlyIC1j IHRyeS5jIDI+JjEgfCBcCkBAIC01NDY5LDEzICs1NDY5LDEzIEBAIGZpCiBjYXNlICIkaGludCIg aW4KIGRlZmF1bHR8cmVjb21tZW5kZWQpCiAJY2FzZSAiJGdjY3ZlcnNpb24iIGluCi0JMSopIGRm bHQ9IiRkZmx0IC1mcGNjLXN0cnVjdC1yZXR1cm4iIDs7CisJMS4qKSBkZmx0PSIkZGZsdCAtZnBj Yy1zdHJ1Y3QtcmV0dXJuIiA7OwogCWVzYWMKIAljYXNlICIkb3B0aW1pemU6JERFQlVHR0lORyIg aW4KIAkqLWcqOm9sZCkgZGZsdD0iJGRmbHQgLURERUJVR0dJTkciOzsKIAllc2FjCiAJY2FzZSAi JGdjY3ZlcnNpb24iIGluCi0JMiopIGlmICR0ZXN0IC1kIC9ldGMvY29uZi9rY29uZmlnLmQgJiYK KwkyLiopIGlmICR0ZXN0IC1kIC9ldGMvY29uZi9rY29uZmlnLmQgJiYKIAkJCSRjb250YWlucyBf UE9TSVhfVkVSU0lPTiAkdXNyaW5jL3N5cy91bmlzdGQuaCA+L2Rldi9udWxsIDI+JjEKIAkJdGhl bgogCQkJIyBJbnRlcmFjdGl2ZSBTeXN0ZW1zIChJU0MpIFBPU0lYIG1vZGUuCkBAIC01NDg0LDcg KzU0ODQsNyBAQCBkZWZhdWx0fHJlY29tbWVuZGVkKQogCQk7OwogCWVzYWMKIAljYXNlICIkZ2Nj dmVyc2lvbiIgaW4KLQkxKikgOzsKKwkxLiopIDs7CiAJMi5bMC04XSopIDs7CiAJPyopCXNldCBz dHJpY3QtYWxpYXNpbmcgLWZuby1zdHJpY3QtYWxpYXNpbmcKIAkJZXZhbCAkY2hlY2tjY2ZsYWcK QEAgLTU2MDIsNyArNTYwMiw3IEBAIGNhc2UgIiRjcHBmbGFncyIgaW4KICAgICA7OwogZXNhYwog Y2FzZSAiJGdjY3ZlcnNpb24iIGluCi0xKikgY3BwZmxhZ3M9IiRjcHBmbGFncyAtRF9fR05VQ19f IgorMS4qKSBjcHBmbGFncz0iJGNwcGZsYWdzIC1EX19HTlVDX18iCiBlc2FjCiBjYXNlICIkbWlw c190eXBlIiBpbgogJycpOzsKQEAgLTIzMjI5LDcgKzIzMjI5LDcgQEAgZmkKIAogOiBhZGQgLURf Rk9SVElGWV9TT1VSQ0UgaWYgZmVhc2libGUgYW5kIG5vdCBhbHJlYWR5IHRoZXJlCiBjYXNlICIk Z2NjdmVyc2lvbiIgaW4KLVs0NTY3ODldLiopCWNhc2UgIiRvcHRpbWl6ZSRjY2ZsYWdzIiBpbgor WzQ1Njc4OV0uKnxbMS05XVswLTldKikJY2FzZSAiJG9wdGltaXplJGNjZmxhZ3MiIGluCiAJKi1P KikJY2FzZSAiJGNjZmxhZ3MkY3Bwc3ltYm9scyIgaW4KIAkJKl9GT1JUSUZZX1NPVVJDRT0qKSAj IERvbid0IGFkZCBpdCBhZ2Fpbi4KIAkJCWVjaG8gIllvdSBzZWVtIHRvIGhhdmUgLURfRk9SVElG WV9TT1VSQ0UgYWxyZWFkeSwgbm90IGFkZGluZyBpdC4iID4mNAo= CONFGCC10 } sub _patch_dynaloader_mac { return unless $^O eq 'darwin'; my $perlver = shift; my $num = _norm_ver( $perlver ); return if ( $num > 5.032000 && $num < 5.033000 ) or $num > 5.033005; # Reevaluate if v5.30.4 appears _patch_b64(<<'BIGSURDL'); LS0tIGV4dC9EeW5hTG9hZGVyL0R5bmFMb2FkZXJfcG0uUEwKKysrIGV4dC9EeW5hTG9hZGVyL0R5 bmFMb2FkZXJfcG0uUEwKQEAgLTQ5NCwxMiArNDk0LDE4IEBAIHN1YiBkbF9maW5kZmlsZSB7CiAg ICAgICAgICAgICBmb3JlYWNoICRuYW1lIChAbmFtZXMpIHsKIAkJbXkoJGZpbGUpID0gIiRkaXIk ZGlyc2VwJG5hbWUiOwogICAgICAgICAgICAgICAgIHByaW50IFNUREVSUiAiIGNoZWNraW5nIGlu ICRkaXIgZm9yICRuYW1lXG4iIGlmICRkbF9kZWJ1ZzsKLQkJJGZpbGUgPSAoJGRvX2V4cGFuZCkg PyBkbF9leHBhbmRzcGVjKCRmaWxlKSA6ICgtZiAkZmlsZSAmJiAkZmlsZSk7Ci0JCSMkZmlsZSA9 IF9jaGVja19maWxlKCRmaWxlKTsKLQkJaWYgKCRmaWxlKSB7CisJCWlmICgkZG9fZXhwYW5kICYm ICgkZmlsZSA9IGRsX2V4cGFuZHNwZWMoJGZpbGUpKSkgeworICAgICAgICAgICAgICAgICAgICBw dXNoIEBmb3VuZCwgJGZpbGU7CisgICAgICAgICAgICAgICAgICAgIG5leHQgYXJnOyAjIG5vIG5l ZWQgdG8gbG9vayBhbnkgZnVydGhlcgorCQl9CisJCWVsc2lmICgtZiAkZmlsZSkgewogICAgICAg ICAgICAgICAgICAgICBwdXNoKEBmb3VuZCwgJGZpbGUpOwogICAgICAgICAgICAgICAgICAgICBu ZXh0IGFyZzsgIyBubyBuZWVkIHRvIGxvb2sgYW55IGZ1cnRoZXIKICAgICAgICAgICAgICAgICB9 CisJCWVsc2lmIChkbF9sb2FkX2ZpbGUoJGZpbGUsIDApKSB7CisgICAgICAgICAgICAgICAgICAg IHB1c2ggQGZvdW5kLCAkZmlsZTsKKyAgICAgICAgICAgICAgICAgICAgbmV4dCBhcmc7ICMgbm8g bmVlZCB0byBsb29rIGFueSBmdXJ0aGVyCisJCX0KICAgICAgICAgICAgIH0KICAgICAgICAgfQog ICAgIH0K BIGSURDL } sub _patch_eumm_darwin { return unless $^O eq 'darwin'; my $perlver = shift; my $num = _norm_ver( $perlver ); return if ( $num > 5.032000 && $num < 5.033000 ) or $num > 5.033005; # Reevaluate if v5.30.4 appears if ( $num != 5.006002 && $num < 5.008000 ) { return _patch_b64(<<'EUMMBIGSUR580'); LS0tIGxpYi9FeHRVdGlscy9MaWJsaXN0LnBtCisrKyBsaWIvRXh0VXRpbHMvTGlibGlzdC5wbQpA QCAtMTQyLDYgKzE0Miw4IEBAIHN1YiBfdW5peF9vczJfZXh0IHsKICAgICAgICAgICAgICAgICAg JiYgKCEgJENvbmZpZ3snYXJjaG5hbWUnfSA9fiAvUk1cZFxkXGQtc3ZyNC8pCiAJCSAmJiAoJHRo aXNsaWIgLj0gIl9zIikgKXsgIyB3ZSBtdXN0IGV4cGxpY2l0bHkgdXNlIF9zIHZlcnNpb24KIAkg ICAgfSBlbHNpZiAoLWYgKCRmdWxsbmFtZT0iJHRoaXNwdGgvbGliJHRoaXNsaWIkQ29uZmlnX2xp YmV4dCIpKXsKKyAgICAgIH0gZWxzaWYgKCReTyBlcSAnZGFyd2luJyAmJiByZXF1aXJlIER5bmFM b2FkZXIgJiYgZGVmaW5lZCAmRHluYUxvYWRlcjo6ZGxfbG9hZF9maWxlCisgICAgICAgICAgICAg ICAgICYmIER5bmFMb2FkZXI6OmRsX2xvYWRfZmlsZSggJGZ1bGxuYW1lID0gIiR0aGlzcHRoL2xp YiR0aGlzbGliLiRzbyIsIDAgKSl7CiAJICAgIH0gZWxzaWYgKC1mICgkZnVsbG5hbWU9IiR0aGlz cHRoLyR0aGlzbGliJENvbmZpZ19saWJleHQiKSl7CiAJICAgIH0gZWxzaWYgKC1mICgkZnVsbG5h bWU9IiR0aGlzcHRoL1NsaWIkdGhpc2xpYiRDb25maWdfbGliZXh0IikpewogCSAgICB9IGVsc2lm ICgkXk8gZXEgJ2RndXgnCg== EUMMBIGSUR580 } if ( $num < 5.011000 ) { return _patch_b64(<<'EUMMBIGSUR511'); LS0tIGxpYi9FeHRVdGlscy9MaWJsaXN0L0tpZC5wbQorKysgbGliL0V4dFV0aWxzL0xpYmxpc3Qv S2lkLnBtCkBAIC0xMzAsNiArMTMwLDggQEAgc3ViIF91bml4X29zMl9leHQgewogICAgICAgICAg ICAgICAgICAmJiAoJENvbmZpZ3snYXJjaG5hbWUnfSAhfiAvUk1cZFxkXGQtc3ZyNC8pCiAJCSAm JiAoJHRoaXNsaWIgLj0gIl9zIikgKXsgIyB3ZSBtdXN0IGV4cGxpY2l0bHkgdXNlIF9zIHZlcnNp b24KIAkgICAgfSBlbHNpZiAoLWYgKCRmdWxsbmFtZT0iJHRoaXNwdGgvbGliJHRoaXNsaWIkQ29u ZmlnX2xpYmV4dCIpKXsKKyAgICAgIH0gZWxzaWYgKCAkXk8gZXEgJ2RhcndpbicgJiYgcmVxdWly ZSBEeW5hTG9hZGVyICYmIGRlZmluZWQgJkR5bmFMb2FkZXI6OmRsX2xvYWRfZmlsZQorICAgICAg ICAgICAgICAgICAmJiBEeW5hTG9hZGVyOjpkbF9sb2FkX2ZpbGUoICRmdWxsbmFtZSA9ICIkdGhp c3B0aC9saWIkdGhpc2xpYi4kc28iLCAwICkpewogCSAgICB9IGVsc2lmICgtZiAoJGZ1bGxuYW1l PSIkdGhpc3B0aC8kdGhpc2xpYiRDb25maWdfbGliZXh0IikpewogICAgICAgICAgICAgfSBlbHNp ZiAoLWYgKCRmdWxsbmFtZT0iJHRoaXNwdGgvbGliJHRoaXNsaWIuZGxsJENvbmZpZ19saWJleHQi KSl7CiAJICAgIH0gZWxzaWYgKC1mICgkZnVsbG5hbWU9IiR0aGlzcHRoL1NsaWIkdGhpc2xpYiRD b25maWdfbGliZXh0Iikpewo= EUMMBIGSUR511 } if ( $num < 5.013005 ) { return _patch_b64(<<'EUMMBIGSUR513'); LS0tIGNwYW4vRXh0VXRpbHMtTWFrZU1ha2VyL2xpYi9FeHRVdGlscy9MaWJsaXN0L0tpZC5wbQor KysgY3Bhbi9FeHRVdGlscy1NYWtlTWFrZXIvbGliL0V4dFV0aWxzL0xpYmxpc3QvS2lkLnBtCkBA IC0xMzAsNiArMTMwLDggQEAgc3ViIF91bml4X29zMl9leHQgewogICAgICAgICAgICAgICAgICAm JiAoJENvbmZpZ3snYXJjaG5hbWUnfSAhfiAvUk1cZFxkXGQtc3ZyNC8pCiAJCSAmJiAoJHRoaXNs aWIgLj0gIl9zIikgKXsgIyB3ZSBtdXN0IGV4cGxpY2l0bHkgdXNlIF9zIHZlcnNpb24KIAkgICAg fSBlbHNpZiAoLWYgKCRmdWxsbmFtZT0iJHRoaXNwdGgvbGliJHRoaXNsaWIkQ29uZmlnX2xpYmV4 dCIpKXsKKyAgICAgIH0gZWxzaWYgKCAkXk8gZXEgJ2RhcndpbicgJiYgcmVxdWlyZSBEeW5hTG9h ZGVyICYmIGRlZmluZWQgJkR5bmFMb2FkZXI6OmRsX2xvYWRfZmlsZQorICAgICAgICAgICAgICAg ICAmJiBEeW5hTG9hZGVyOjpkbF9sb2FkX2ZpbGUoICRmdWxsbmFtZSA9ICIkdGhpc3B0aC9saWIk dGhpc2xpYi4kc28iLCAwICkpewogCSAgICB9IGVsc2lmICgtZiAoJGZ1bGxuYW1lPSIkdGhpc3B0 aC8kdGhpc2xpYiRDb25maWdfbGliZXh0IikpewogICAgICAgICAgICAgfSBlbHNpZiAoLWYgKCRm dWxsbmFtZT0iJHRoaXNwdGgvbGliJHRoaXNsaWIuZGxsJENvbmZpZ19saWJleHQiKSl7CiAJICAg IH0gZWxzaWYgKC1mICgkZnVsbG5hbWU9IiR0aGlzcHRoL1NsaWIkdGhpc2xpYiRDb25maWdfbGli ZXh0Iikpewo= EUMMBIGSUR513 } if ( $num < 5.015001 ) { return _patch_b64(<<'EUMMBIGSUR515'); LS0tIGNwYW4vRXh0VXRpbHMtTWFrZU1ha2VyL2xpYi9FeHRVdGlscy9MaWJsaXN0L0tpZC5wbQor KysgY3Bhbi9FeHRVdGlscy1NYWtlTWFrZXIvbGliL0V4dFV0aWxzL0xpYmxpc3QvS2lkLnBtCkBA IC0xMzMsNiArMTMzLDggQEAgc3ViIF91bml4X29zMl9leHQgewogCSAgICB9IGVsc2lmICgtZiAo JGZ1bGxuYW1lPSIkdGhpc3B0aC9saWIkdGhpc2xpYiRDb25maWdfbGliZXh0IikpewogCSAgICB9 IGVsc2lmIChkZWZpbmVkKCRDb25maWdfZGxleHQpCiAgICAgICAgICAgICAgICAgICYmIC1mICgk ZnVsbG5hbWU9IiR0aGlzcHRoL2xpYiR0aGlzbGliLiRDb25maWdfZGxleHQiKSl7CisgICAgICB9 IGVsc2lmICgkXk8gZXEgJ2RhcndpbicgJiYgcmVxdWlyZSBEeW5hTG9hZGVyICYmIGRlZmluZWQg JkR5bmFMb2FkZXI6OmRsX2xvYWRfZmlsZQorICAgICAgICAgICAgICAgICAmJiBEeW5hTG9hZGVy OjpkbF9sb2FkX2ZpbGUoICRmdWxsbmFtZSA9ICIkdGhpc3B0aC9saWIkdGhpc2xpYi4kc28iLCAw ICkpewogCSAgICB9IGVsc2lmICgtZiAoJGZ1bGxuYW1lPSIkdGhpc3B0aC8kdGhpc2xpYiRDb25m aWdfbGliZXh0IikpewogCSAgICB9IGVsc2lmICgtZiAoJGZ1bGxuYW1lPSIkdGhpc3B0aC9saWIk dGhpc2xpYi5kbGwkQ29uZmlnX2xpYmV4dCIpKXsKIAkgICAgfSBlbHNpZiAoLWYgKCRmdWxsbmFt ZT0iJHRoaXNwdGgvU2xpYiR0aGlzbGliJENvbmZpZ19saWJleHQiKSl7Cg== EUMMBIGSUR515 } _patch_b64(<<'EUMMBIGSUR'); LS0tIGNwYW4vRXh0VXRpbHMtTWFrZU1ha2VyL2xpYi9FeHRVdGlscy9MaWJsaXN0L0tpZC5wbQor KysgY3Bhbi9FeHRVdGlscy1NYWtlTWFrZXIvbGliL0V4dFV0aWxzL0xpYmxpc3QvS2lkLnBtCkBA IC0xNzQsNiArMTc0LDEwIEBAIHN1YiBfdW5peF9vczJfZXh0IHsKICAgICAgICAgICAgICAgICAm JiAtZiAoICRmdWxsbmFtZSA9ICIkdGhpc3B0aC9saWIkdGhpc2xpYi4kQ29uZmlnX2RsZXh0IiAp ICkKICAgICAgICAgICAgIHsKICAgICAgICAgICAgIH0KKyAgICAgICAgICAgIGVsc2lmICggJF5P IGVxICdkYXJ3aW4nICYmIHJlcXVpcmUgRHluYUxvYWRlciAmJiBkZWZpbmVkICZEeW5hTG9hZGVy OjpkbF9sb2FkX2ZpbGUKKyAgICAgICAgICAgICAgICAmJiBEeW5hTG9hZGVyOjpkbF9sb2FkX2Zp bGUoICRmdWxsbmFtZSA9ICIkdGhpc3B0aC9saWIkdGhpc2xpYi4kc28iLCAwICkgKQorICAgICAg ICAgICAgeworICAgICAgICAgICAgfQogICAgICAgICAgICAgZWxzaWYgKCAtZiAoICRmdWxsbmFt ZSA9ICIkdGhpc3B0aC8kdGhpc2xpYiRDb25maWdfbGliZXh0IiApICkgewogICAgICAgICAgICAg fQogICAgICAgICAgICAgZWxzaWYgKCAtZiAoICRmdWxsbmFtZSA9ICIkdGhpc3B0aC9saWIkdGhp c2xpYi5kbGwkQ29uZmlnX2xpYmV4dCIgKSApIHsK EUMMBIGSUR } sub _patch_useshrplib { # from https://github.com/Perl/perl5/commit/191f8909fa4eca1db16a91ada42dd4a065c04890 _patch(<<'END'); diff --git a/Makefile.SH b/Makefile.SH index 6e4d5ee684f..bebe50dc131 100755 --- Makefile.SH +++ Makefile.SH @@ -67,8 +67,16 @@ true) -compatibility_version \ ${api_revision}.${api_version}.${api_subversion} \ -current_version \ - ${revision}.${patchlevel}.${subversion} \ - -install_name \$(shrpdir)/\$@" + ${revision}.${patchlevel}.${subversion}" + case "$osvers" in + 1[5-9]*|[2-9]*) + shrpldflags="$shrpldflags -install_name `pwd`/\$@ -Xlinker -headerpad_max_install_names" + exeldflags="-Xlinker -headerpad_max_install_names" + ;; + *) + shrpldflags="$shrpldflags -install_name \$(shrpdir)/\$@" + ;; + esac ;; cygwin*) shrpldflags="$shrpldflags -Wl,--out-implib=libperl.dll.a -Wl,--image-base,0x52000000" @@ -339,6 +347,14 @@ MANIFEST_SRT = MANIFEST.srt !GROK!THIS! +case "$useshrplib$osname" in +truedarwin) + $spitshell >>$Makefile <>$Makefile <>$Makefile <<'!NO!SUBS!' + $(SHRPENV) $(CC) -o perl $(PERL_EXE_LDFLAGS) $(CLDFLAGS) $(CCDLFLAGS) $(perlmain_objs) $(static_ext) $(LLIBPERL) `cat ext.libs` $(libs) +!NO!SUBS! + ;; + *) $spitshell >>$Makefile <<'!NO!SUBS!' + $(SHRPENV) $(CC) -o perl $(CLDFLAGS) $(CCDLFLAGS) $(perlmain_objs) $(static_ext) $(LLIBPERL) `cat ext.libs` $(libs) +!NO!SUBS! + ;; + esac + ;; + *) $spitshell >>$Makefile <<'!NO!SUBS!' $(SHRPENV) $(CC) -o perl $(CLDFLAGS) $(CCDLFLAGS) $(perlmain_objs) $(static_ext) $(LLIBPERL) `cat ext.libs` $(libs) !NO!SUBS! diff --git a/installperl b/installperl index 3bf79d2d6fc..6cd65a09238 100755 --- installperl +++ installperl @@ -304,6 +304,7 @@ elsif ($^O ne 'dos') { safe_unlink("$installbin/$perl_verbase$ver$exe_ext"); copy("perl$exe_ext", "$installbin/$perl_verbase$ver$exe_ext"); strip("$installbin/$perl_verbase$ver$exe_ext"); + fix_dep_names("$installbin/$perl_verbase$ver$exe_ext"); chmod(0755, "$installbin/$perl_verbase$ver$exe_ext"); } else { @@ -388,6 +389,7 @@ foreach my $file (@corefiles) { if (copy_if_diff($file,"$installarchlib/CORE/$file")) { if ($file =~ /\.(\Q$so\E|\Q$dlext\E)$/) { strip("-S", "$installarchlib/CORE/$file") if $^O eq 'darwin'; + fix_dep_names("$installarchlib/CORE/$file"); chmod($SO_MODE, "$installarchlib/CORE/$file"); } else { chmod($NON_SO_MODE, "$installarchlib/CORE/$file"); @@ -791,4 +793,27 @@ sub strip } } +sub fix_dep_names { + my $file = shift; + + $^O eq "darwin" && $Config{osvers} =~ /^(1[5-9]|[2-9])/ + && $Config{useshrplib} + or return; + + my @opts; + my $so = $Config{so}; + my $libperl = "$Config{archlibexp}/CORE/libperl.$Config{so}"; + if ($file =~ /\blibperl.\Q$Config{so}\E$/a) { + push @opts, -id => $libperl; + } + else { + push @opts, -change => getcwd . "/libperl.$so", $libperl; + } + push @opts, $file; + + $opts{verbose} and print " install_name_tool @opts\n"; + system "install_name_tool", @opts + and die "Cannot update $file dependency paths\n"; +} + # ex: set ts=8 sts=4 sw=4 et: END } qq[patchin']; __END__ =pod =encoding UTF-8 =head1 NAME Devel::PatchPerl - Patch perl source a la Devel::PPPort's buildperl.pl =head1 VERSION version 2.08 =head1 SYNOPSIS use strict; use warnings; use Devel::PatchPerl; Devel::PatchPerl->patch_source( '5.6.1', '/path/to/untarred/perl/source/perl-5.6.1' ); =head1 DESCRIPTION Devel::PatchPerl is a modularisation of the patching code contained in L's C. It does not build perls, it merely provides an interface to the source patching functionality. =head1 FUNCTION =over =item C Takes two parameters, a C version and the path to unwrapped perl source for that version. It dies on any errors. If you don't supply a C version, it will attempt to auto-determine the C version from the specified path. If you don't supply the path to unwrapped perl source, it will assume the current working directory. =item C Takes one optional parameter, the path to unwrapped perl source. It returns the perl version of the source code at the given location. It returns undef on error. If you don't supply the path to unwrapped perl source, it will assume the current working directory. =back =head1 PLUGIN SYSTEM See L for details of Devel::PatchPerl's plugin system. =head1 PATCHLEVEL Devel::PatchPerl will normally update the C file in the perl source tree to indicate that it has applied local patches. This behaviour is negated if it is detected that it is operating in a git repository. To override this and update C when in a Git repository, set the env var C to a true value. Alternatively, call C with the C<--patchlevel> option. =head1 CAVEAT Devel::PatchPerl is intended only to facilitate the C of perls, not to facilitate the C of perls. This means that it will not patch failing tests in the perl testsuite. =head1 SEE ALSO L L =head1 AUTHOR Chris Williams =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2021 by Chris Williams and Marcus Holland-Moritz. 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 DEVEL_PATCHPERL $fatpacked{"Devel/PatchPerl/Hints.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DEVEL_PATCHPERL_HINTS'; package Devel::PatchPerl::Hints; $Devel::PatchPerl::Hints::VERSION = '2.08'; #ABSTRACT: replacement 'hints' files use strict; use warnings; use MIME::Base64 qw[decode_base64]; use File::Spec; our @ISA = qw[Exporter]; our @EXPORT_OK = qw[hint_file hints]; my %hints = ( 'bitrig' => 'IyBoaW50cy9vcGVuYnNkLnNoCiMKIyBoaW50cyBmaWxlIGZvciBPcGVuQlNEOyBUb2RkIE1pbGxl ciA8bWlsbGVydEBvcGVuYnNkLm9yZz4KIyBFZGl0ZWQgdG8gYWxsb3cgQ29uZmlndXJlIGNvbW1h bmQtbGluZSBvdmVycmlkZXMgYnkKIyAgQW5keSBEb3VnaGVydHkgPGRvdWdoZXJhQGxhZmF5ZXR0 ZS5lZHU+CiMKIyBUbyBidWlsZCB3aXRoIGRpc3RyaWJ1dGlvbiBwYXRocywgdXNlOgojCS4vQ29u ZmlndXJlIC1kZXMgLURvcGVuYnNkX2Rpc3RyaWJ1dGlvbj1kZWZpbmVkCiMKCiMgT3BlbkJTRCBo YXMgYSBiZXR0ZXIgbWFsbG9jIHRoYW4gcGVybC4uLgp0ZXN0ICIkdXNlbXltYWxsb2MiIHx8IHVz ZW15bWFsbG9jPSduJwoKIyBDdXJyZW50bHksIHZmb3JrKDIpIGlzIG5vdCBhIHJlYWwgd2luIG92 ZXIgZm9yaygyKS4KdXNldmZvcms9IiR1bmRlZiIKCiMKIyBOb3QgYWxsIHBsYXRmb3JtcyBzdXBw b3J0IGR5bmFtaWMgbG9hZGluZy4uLgojIEZvciB0aGUgY2FzZSBvZiAiJG9wZW5ic2RfZGlzdHJp YnV0aW9uIiwgdGhlIGhpbnRzIGZpbGUKIyBuZWVkcyB0byBrbm93IHdoZXRoZXIgd2UgYXJlIHVz aW5nIGR5bmFtaWMgbG9hZGluZyBzbyB0aGF0CiMgaXQgY2FuIHNldCB0aGUgbGlicGVybCBuYW1l IGFwcHJvcHJpYXRlbHkuCiMgQWxsb3cgY29tbWFuZCBsaW5lIG92ZXJyaWRlcy4KIwojQVJDSD1g YXJjaCB8IHNlZCAncy9eT3BlbkJTRC4vLydgCkFSQ0g9YGFyY2ggfCBzZWQgJ3MvXkJpdHJpZy4v LydgCmNhc2UgIiR7QVJDSH0tJHtvc3ZlcnN9IiBpbgoqKQoJdGVzdCAteiAiJHVzZWRsIiAmJiB1 c2VkbD0kZGVmaW5lCgkjIFdlIHVzZSAtZlBJQyBoZXJlIGJlY2F1c2UgLWZwaWMgaXMgKk5PVCog ZW5vdWdoIGZvciBzb21lIG9mIHRoZQoJIyBleHRlbnNpb25zIGxpa2UgVGsgb24gc29tZSBPcGVu QlNEIHBsYXRmb3JtcyAoaWU6IHNwYXJjKQoJY2NjZGxmbGFncz0iLURQSUMgLWZQSUMgJGNjY2Rs ZmxhZ3MiCgljYXNlICIkb3N2ZXJzIiBpbgoJKikgIyBmcm9tIDMuMSBvbndhcmRzCgkJbGQ9JHtj YzotY2N9CgkJbGRkbGZsYWdzPSItc2hhcmVkIC1mUElDICRsZGRsZmxhZ3MiCgkJbGlic3dhbnRl ZD1gZWNobyAkbGlic3dhbnRlZCB8IHNlZCAncy8gZGwgLyAvJ2AKCQk7OwoJZXNhYwoKCSMgV2Ug bmVlZCB0byBmb3JjZSBsZCB0byBleHBvcnQgc3ltYm9scyBvbiBFTEYgcGxhdGZvcm1zLgoJIyBX aXRob3V0IHRoaXMsIGRsb3BlbigpIGlzIGNyaXBwbGVkLgoJRUxGPWAke2NjOi1jY30gLWRNIC1F IC0gPC9kZXYvbnVsbCB8IGdyZXAgX19FTEZfX2AKCXRlc3QgLW4gIiRFTEYiICYmIGxkZmxhZ3M9 Ii1XbCwtRSAkbGRmbGFncyIKCTs7CmVzYWMKCiMgbWFsbG9jIHdyYXAgY2F1c2VzIHByb2JsZW1z IG9uIG02OGsKaWYgWyBYIiR1c2VtYWxsb2N3cmFwIiA9IFgiIiBdOyB0aGVuCgljYXNlICIke0FS Q0h9IiBpbgoJKikgICAgdXNlbWFsbG9jd3JhcD0iZGVmaW5lIiA7OwoJZXNhYwpmaQoKIyBPcGVu QlNEIGRvZXNuJ3QgbmVlZCBsaWJjcnlwdCBidXQgbWFueSBmb2xrcyBrZWVwIGEgc3R1YiBsaWIK IyBhcm91bmQgZm9yIG9sZCBOZXRCU0QgYmluYXJpZXMuCmxpYnN3YW50ZWQ9YGVjaG8gJGxpYnN3 YW50ZWQgfCBzZWQgJ3MvIGNyeXB0IC8gLydgCgojIENvbmZpZ3VyZSBjYW4ndCBmaWd1cmUgdGhp cyBvdXQgbm9uLWludGVyYWN0aXZlbHkKZF9zdWlkc2FmZT0kZGVmaW5lCgojIGNjIGlzIGdjYyBz byB3ZSBjYW4gZG8gYmV0dGVyIHRoYW4gLU8KIyBBbGxvdyBhIGNvbW1hbmQtbGluZSBvdmVycmlk ZSwgc3VjaCBhcyAtRG9wdGltaXplPS1nCmNhc2UgIiR7QVJDSH0tJHtvc3ZlcnN9IiBpbgoqKQog ICB0ZXN0ICIkb3B0aW1pemUiIHx8IG9wdGltaXplPSctTzInCiAgIDs7CmVzYWMKCiMgVGhpcyBz Y3JpcHQgVVUvdXNldGhyZWFkcy5jYnUgd2lsbCBnZXQgJ2NhbGxlZC1iYWNrJyBieSBDb25maWd1 cmUgCiMgYWZ0ZXIgaXQgaGFzIHByb21wdGVkIHRoZSB1c2VyIGZvciB3aGV0aGVyIHRvIHVzZSB0 aHJlYWRzLgpjYXQgPiBVVS91c2V0aHJlYWRzLmNidSA8PCdFT0NCVScKY2FzZSAiJHVzZXRocmVh ZHMiIGluCiRkZWZpbmV8dHJ1ZXxbeVldKikKCSMgYW55IG9wZW5ic2QgdmVyc2lvbiBkZXBlbmRl bmNpZXMgd2l0aCBwdGhyZWFkcz8KCWNjZmxhZ3M9Ii1wdGhyZWFkICRjY2ZsYWdzIgoJbGRmbGFn cz0iLXB0aHJlYWQgJGxkZmxhZ3MiCmVzYWMKRU9DQlUKCiMgV2hlbiBidWlsZGluZyBpbiB0aGUg T3BlbkJTRCB0cmVlIHdlIHVzZSBkaWZmZXJlbnQgcGF0aHMKIyBUaGlzIGlzIG9ubHkgcGFydCBv ZiB0aGUgc3RvcnksIHRoZSByZXN0IGNvbWVzIGZyb20gY29uZmlnLm92ZXIKY2FzZSAiJG9wZW5i c2RfZGlzdHJpYnV0aW9uIiBpbgonJ3wkdW5kZWZ8ZmFsc2UpIDs7CiopCgkjIFdlIHB1dCB0aGlu Z3MgaW4gL3Vzciwgbm90IC91c3IvbG9jYWwKCXByZWZpeD0nL3VzcicKCXByZWZpeGV4cD0nL3Vz cicKCXN5c21hbj0nL3Vzci9zaGFyZS9tYW4vbWFuMScKCWxpYnB0aD0nL3Vzci9saWInCglnbGli cHRoPScvdXNyL2xpYicKCSMgTG9jYWwgdGhpbmdzLCBob3dldmVyLCBkbyBnbyBpbiAvdXNyL2xv Y2FsCglzaXRlcHJlZml4PScvdXNyL2xvY2FsJwoJc2l0ZXByZWZpeGV4cD0nL3Vzci9sb2NhbCcK CSMgUG9ydHMgaW5zdGFsbHMgbm9uLXN0ZCBsaWJzIGluIC91c3IvbG9jYWwvbGliIHNvIGxvb2sg dGhlcmUgdG9vCglsb2NpbmNwdGg9Jy91c3IvbG9jYWwvaW5jbHVkZScKCWxvY2xpYnB0aD0nL3Vz ci9sb2NhbC9saWInCgkjIExpbmsgcGVybCB3aXRoIHNoYXJlZCBsaWJwZXJsCglpZiBbICIkdXNl ZGwiID0gIiRkZWZpbmUiIC1hIC1yICRzcmMvc2hsaWJfdmVyc2lvbiBdOyB0aGVuCgkJdXNlc2hy cGxpYj10cnVlCgkJbGlicGVybD1gLiAkc3JjL3NobGliX3ZlcnNpb247IGVjaG8gbGlicGVybC5z by4ke21ham9yfS4ke21pbm9yfWAKCWZpCgk7Owplc2FjCgojIGVuZAo=', 'cygwin' => 'IyEgL2Jpbi9zaAojIGN5Z3dpbi5zaCAtIGhpbnRzIGZvciBidWlsZGluZyBwZXJsIHVzaW5nIHRo ZSBDeWd3aW4gZW52aXJvbm1lbnQgZm9yIFdpbjMyCiMKCiMgbm90IG90aGVyd2lzZSBzZXR0YWJs ZQpleGVfZXh0PScuZXhlJwpmaXJzdG1ha2VmaWxlPSdHTlVtYWtlZmlsZScKY2FzZSAiJGxkbGli cHRobmFtZSIgaW4KJycpIGxkbGlicHRobmFtZT1QQVRIIDs7CmVzYWMKYXJjaG9ianM9J2N5Z3dp bi5vJwoKIyBtYW5kYXRvcnkgKG92ZXJyaWRlcyBpbmNvcnJlY3QgZGVmYXVsdHMpCnRlc3QgLXog IiRjYyIgJiYgY2M9J2djYycKaWYgdGVzdCAteiAiJHBsaWJwdGgiCnRoZW4KICAgIHBsaWJwdGg9 YGdjYyAtcHJpbnQtZmlsZS1uYW1lPWxpYmMuYWAKICAgIHBsaWJwdGg9YGRpcm5hbWUgJHBsaWJw dGhgCiAgICBwbGlicHRoPWBjZCAkcGxpYnB0aCAmJiBwd2RgCmZpCnNvPSdkbGwnCiMgLSBlbGlt aW5hdGUgLWxjLCBpbXBsaWVkIGJ5IGdjYyBhbmQgYSBzeW1saW5rIHRvIGxpYmN5Z3dpbi5hCmxp YnN3YW50ZWQ9YGVjaG8gIiAkbGlic3dhbnRlZCAiIHwgc2VkIC1lICdzLyBjIC8gL2cnYAojIC0g ZWxpbWluYXRlIC1sbSwgc3ltbGluayB0byBsaWJjeWd3aW4uYQpsaWJzd2FudGVkPWBlY2hvICIg JGxpYnN3YW50ZWQgIiB8IHNlZCAtZSAncy8gbSAvIC9nJ2AKIyAtIGVsaW1pbmF0ZSAtbHV0aWws IHN5bWJvbHMgYXJlIGFsbCBpbiBsaWJjeWd3aW4uYQpsaWJzd2FudGVkPWBlY2hvICIgJGxpYnN3 YW50ZWQgIiB8IHNlZCAtZSAncy8gdXRpbCAvIC9nJ2AKIyAtIGFkZCBsaWJnZGJtX2NvbXBhdCAk bGlic3dhbnRlZApsaWJzd2FudGVkPSIkbGlic3dhbnRlZCBnZGJtX2NvbXBhdCIKdGVzdCAteiAi JG9wdGltaXplIiAmJiBvcHRpbWl6ZT0nLU8zJwptYW4zZXh0PSczcG0nCnRlc3QgLXogIiR1c2U2 NGJpdGludCIgJiYgdXNlNjRiaXRpbnQ9J2RlZmluZScKdGVzdCAteiAiJHVzZWl0aHJlYWRzIiAm JiB1c2VpdGhyZWFkcz0nZGVmaW5lJwpjY2ZsYWdzPSIkY2NmbGFncyAtRFBFUkxfVVNFX1NBRkVf UFVURU5WIC1VX19TVFJJQ1RfQU5TSV9fIC1EX0dOVV9TT1VSQ0UiCiMgLSBvdGhlcndpc2UgaTY4 Ni1jeWd3aW4KYXJjaG5hbWU9J2N5Z3dpbicKCiMgZHluYW1pYyBsb2FkaW5nCiMgLSBvdGhlcndp c2UgLWZwaWMKY2NjZGxmbGFncz0nICcKbGRkbGZsYWdzPScgLS1zaGFyZWQnCnRlc3QgLXogIiRs ZCIgJiYgbGQ9J2crKycKCmNhc2UgIiRvc3ZlcnMiIGluCiAgICAjIENvbmZpZ3VyZSBnZXRzIHRo ZXNlIHdyb25nIGlmIHRoZSBJUEMgc2VydmVyIGlzbid0IHlldCBydW5uaW5nOgogICAgIyBvbmx5 IHVzZSBmb3IgMS41LjcgYW5kIG9ud2FyZHMKICAgIFsyLTldKnwxLls2LTldKnwxLlsxLTVdWzAt OV0qfDEuNS5bNy05XSp8MS41LlsxLTZdWzAtOV0qKQogICAgICAgIGRfc2VtY3RsX3NlbWlkX2Rz PSdkZWZpbmUnCiAgICAgICAgZF9zZW1jdGxfc2VtdW49J2RlZmluZScKICAgICAgICA7Owplc2Fj CgpjYXNlICIkb3N2ZXJzIiBpbgogICAgWzItOV0qfDEuWzYtOV0qKQogICAgICAgICMgSVB2NiBv bmx5IHNpbmNlIDEuNwogICAgICAgIGRfaW5ldG50b3A9J2RlZmluZScKICAgICAgICBkX2luZXRw dG9uPSdkZWZpbmUnCiAgICAgICAgOzsKICAgICopCiAgICAgICAgIyBJUHY2IG5vdCBpbXBsZW1l bnRlZCBiZWZvcmUgY3lnd2luLTEuNwogICAgICAgIGRfaW5ldG50b3A9J3VuZGVmJwogICAgICAg IGRfaW5ldHB0b249J3VuZGVmJwplc2FjCgojIGNvbXBpbGUgV2luMzJDT1JFICJtb2R1bGUiIGFz IHN0YXRpYy4gdHJ5IHRvIGF2b2lkIHRoZSBzcGFjZS4KaWYgdGVzdCAteiAiJHN0YXRpY19leHQi OyB0aGVuCiAgc3RhdGljX2V4dD0iV2luMzJDT1JFIgplbHNlCiAgc3RhdGljX2V4dD0iJHN0YXRp Y19leHQgV2luMzJDT1JFIgpmaQoKIyBXaW45eCBwcm9ibGVtIHdpdGggbm9uLWJsb2NraW5nIHJl YWQgZnJvbSBhIGNsb3NlZCBwaXBlCmRfZW9mbmJsaz0nZGVmaW5lJwoKIyBzdXBwcmVzcyBhdXRv LWltcG9ydCB3YXJuaW5ncwpsZGZsYWdzPSIkbGRmbGFncyAtV2wsLS1lbmFibGUtYXV0by1pbXBv cnQgLVdsLC0tZXhwb3J0LWFsbC1zeW1ib2xzIC1XbCwtLWVuYWJsZS1hdXRvLWltYWdlLWJhc2Ui CmxkZGxmbGFncz0iJGxkZGxmbGFncyAkbGRmbGFncyIKCiMgc3RyaXAgZXhlJ3MgYW5kIGRsbCdz LCBiZXR0ZXIgZG8gaXQgYWZ0ZXJ3YXJkcwojbGRmbGFncz0iJGxkZmxhZ3MgLXMiCiNjY2RsZmxh Z3M9IiRjY2RsZmxhZ3MgLXMiCiNsZGRsZmxhZ3M9IiRsZGRsZmxhZ3MgLXMiCg==', 'darwin' => 'IyMKIyBEYXJ3aW4gKE1hYyBPUykgaGludHMKIyBXaWxmcmVkbyBTYW5jaGV6IDx3c2FuY2hlekB3 c2FuY2hlei5uZXQ+CiMjCgojIwojIFBhdGhzCiMjCgojIENvbmZpZ3VyZSBoYXNuJ3QgZmlndXJl ZCBvdXQgdGhlIHZlcnNpb24gbnVtYmVyIHlldC4gIEJ1bW1lci4KcGVybF9yZXZpc2lvbj1gYXdr ICcvZGVmaW5lWyAJXStQRVJMX1JFVklTSU9OLyB7cHJpbnQgJDN9JyAkc3JjL3BhdGNobGV2ZWwu aGAKcGVybF92ZXJzaW9uPWBhd2sgJy9kZWZpbmVbIAldK1BFUkxfVkVSU0lPTi8ge3ByaW50ICQz fScgJHNyYy9wYXRjaGxldmVsLmhgCnBlcmxfc3VidmVyc2lvbj1gYXdrICcvZGVmaW5lWyAJXStQ RVJMX1NVQlZFUlNJT04vIHtwcmludCAkM30nICRzcmMvcGF0Y2hsZXZlbC5oYAp2ZXJzaW9uPSIk e3BlcmxfcmV2aXNpb259LiR7cGVybF92ZXJzaW9ufS4ke3Blcmxfc3VidmVyc2lvbn0iCgojIFBy ZXRlbmQgdGhhdCBEYXJ3aW4gZG9lc24ndCBrbm93IGFib3V0IHRob3NlIHN5c3RlbSBjYWxscyBp biBUaWdlcgojICgxMC40L2RhcndpbiA4KSBhbmQgZWFybGllciBbcGVybCAjMjQxMjJdCmNhc2Ug IiRvc3ZlcnMiIGluClsxLThdLiopCiAgICBkX3NldHJlZ2lkPSd1bmRlZicKICAgIGRfc2V0cmV1 aWQ9J3VuZGVmJwogICAgZF9zZXRyZ2lkPSd1bmRlZicKICAgIGRfc2V0cnVpZD0ndW5kZWYnCiAg ICA7Owplc2FjCgojIGZpbml0ZSgpIGRlcHJlY2F0ZWQgaW4gMTAuOSwgdXNlIGlzZmluaXRlKCkg aW5zdGVhZC4KY2FzZSAiJG9zdmVycyIgaW4KWzEtOF0uKikgOzsKKikgZF9maW5pdGU9J3VuZGVm JyA7Owplc2FjCgojIFRoaXMgd2FzIHByZXZpb3VzbHkgdXNlZCBpbiBhbGwgYnV0IGNhdXNlcyB0 aHJlZSBjYXNlcwojIChubyAtRGRwcmVmaXg9LCAtRHByZWZpeD0vdXNyLCAtRHByZWZpeD0vc29t ZS90aGluZy9lbHNlKQojIGJ1dCB0aGF0IGNhdXNlZCB0b28gbXVjaCBncmllZi4KIyB2ZW5kb3Js aWI9Ii9TeXN0ZW0vTGlicmFyeS9QZXJsLyR7dmVyc2lvbn0iOyAjIEFwcGxlLXN1cHBsaWVkIG1v ZHVsZXMKCmNhc2UgIiRkYXJ3aW5fZGlzdHJpYnV0aW9uIiBpbgokZGVmaW5lKSAjIFdlIGFyZSBi dWlsZGluZy9yZXBsYWNpbmcgdGhlIGJ1aWx0LWluIHBlcmwKCXByZWZpeD0nL3Vzcic7CglpbnN0 YWxscHJlZml4PScvdXNyJzsKCWJpbj0nL3Vzci9iaW4nOwoJc2l0ZXByZWZpeD0nL3Vzci9sb2Nh bCc7CgkjIFdlIGRvbid0IHdhbnQgL3Vzci9iaW4vSEVBRCBpc3N1ZXMuCglzaXRlYmluPScvdXNy L2xvY2FsL2Jpbic7CglzaXRlc2NyaXB0PScvdXNyL2xvY2FsL2Jpbic7CglpbnN0YWxsdXNyYmlu cGVybD0nZGVmaW5lJzsgIyBZb3Uga25ldyB3aGF0IHlvdSB3ZXJlIGRvaW5nLgoJcHJpdmxpYj0i L1N5c3RlbS9MaWJyYXJ5L1BlcmwvJHt2ZXJzaW9ufSI7CglzaXRlbGliPSIvTGlicmFyeS9QZXJs LyR7dmVyc2lvbn0iOwoJdmVuZG9ycHJlZml4PScvJzsKCXVzZXZlbmRvcnByZWZpeD0nZGVmaW5l JzsKCXZlbmRvcmJpbj0nL3Vzci9iaW4nOwoJdmVuZG9yc2NyaXB0PScvdXNyL2Jpbic7Cgl2ZW5k b3JsaWI9Ii9OZXR3b3JrL0xpYnJhcnkvUGVybC8ke3ZlcnNpb259IjsKCSMgNEJTRCB1c2VzICR7 cHJlZml4fS9zaGFyZS9tYW4sIG5vdCAke3ByZWZpeH0vbWFuLgoJbWFuMWRpcj0nL3Vzci9zaGFy ZS9tYW4vbWFuMSc7CgltYW4zZGlyPScvdXNyL3NoYXJlL21hbi9tYW4zJzsKCSMgQnV0IHVzZXJz JyBpbnN0YWxscyBzaG91bGRuJ3QgdG91Y2ggdGhlIHN5c3RlbSBtYW4gcGFnZXMuCgkjIFRyYW5z aWVudCBvYnNvbGV0ZWQgc3R5bGUuCglzaXRlbWFuMT0nL3Vzci9sb2NhbC9zaGFyZS9tYW4vbWFu MSc7CglzaXRlbWFuMz0nL3Vzci9sb2NhbC9zaGFyZS9tYW4vbWFuMyc7CgkjIE5ldyBzdHlsZS4K CXNpdGVtYW4xZGlyPScvdXNyL2xvY2FsL3NoYXJlL21hbi9tYW4xJzsKCXNpdGVtYW4zZGlyPScv dXNyL2xvY2FsL3NoYXJlL21hbi9tYW4zJzsKCTs7CmVzYWMKCiMjCiMgVG9vbCBjaGFpbiBzZXR0 aW5ncwojIwoKIyBTaW5jZSB3ZSBjYW4gYnVpbGQgZmF0LCB0aGUgYXJjaG5hbWUgZG9lc24ndCBu ZWVkIHRoZSBwcm9jZXNzb3IgdHlwZQphcmNobmFtZT0nZGFyd2luJzsKCiMgbm0gaXNuJ3Qga25v d24gdG8gd29yayBhZnRlciBTbm93IExlb3BhcmQgYW5kIFhDb2RlIDQ7IHRlc3Rpbmcgd2l0aCBP UyBYIDEwLjUKIyBhbmQgWGNvZGUgMyBzaG93cyBhIHdvcmtpbmcgbm0sIGJ1dCBwcmV0ZW5kaW5n IGl0IGRvZXNuJ3Qgd29yayBwcm9kdWNlcyBubwojIHByb2JsZW1zLgp1c2VubT0nZmFsc2UnOwoK Y2FzZSAiJG9wdGltaXplIiBpbgonJykKIyAgICBPcHRpbWl6aW5nIGZvciBzaXplIGFsc28gbWVh biBsZXNzIHJlc2lkZW50IG1lbW9yeSB1c2FnZSBvbiB0aGUgcGFydAojIG9mIFBlcmwuICBBcHBs ZSBhc3NlcnRzIHRoYXQgdGhpcyBpcyBhIG1vcmUgaW1wb3J0YW50IG9wdGltaXphdGlvbiB0aGFu CiMgc2F2aW5nIG9uIENQVSBjeWNsZXMuICBHaXZlbiB0aGF0IG1lbW9yeSBzcGVlZCBoYXMgbm90 IGluY3JlYXNlZCBhdAojIHBhY2Ugd2l0aCBDUFUgc3BlZWQgb3ZlciB0aW1lIChvbiBhbnkgcGxh dGZvcm0pLCB0aGlzIGlzIHByb2JhYmx5IGEKIyByZWFzb25hYmxlIGFzc2VydGlvbi4KaWYgWyAt eiAiJHtvcHRpbWl6ZX0iIF07IHRoZW4KICBjYXNlICJgJHtjYzotZ2NjfSAtdiAyPiYxYCIgaW4K ICAgICoiZ2NjIHZlcnNpb24gMy4iKikgb3B0aW1pemU9Jy1PcycgOzsKICAgICopIG9wdGltaXpl PSctTzMnIDs7CiAgZXNhYwplbHNlCiAgb3B0aW1pemU9Jy1PMycKZmkKOzsKZXNhYwoKIyAtZm5v LWNvbW1vbiBiZWNhdXNlIGNvbW1vbiBzeW1ib2xzIGFyZSBub3QgYWxsb3dlZCBpbiBNSF9EWUxJ QgojIC1EUEVSTF9EQVJXSU46IGFwcGFyZW50bHkgdGhlIF9fQVBQTEVfXyBpcyBub3Qgc2FuY3Rp b25lZCBieSBBcHBsZQojIGFzIHRoZSB3YXkgdG8gZGlmZmVyZW50aWF0ZSBNYWMgT1MgWC4gIChU aGUgb2ZmaWNpYWwgbGluZSBpcyB0aGF0CiMgKm5vKiBjcHAgc3ltYm9sIGRvZXMgZGlmZmVyZW50 aWF0ZSBNYWMgT1MgWC4pCmNjZmxhZ3M9IiR7Y2NmbGFnc30gLWZuby1jb21tb24gLURQRVJMX0RB UldJTiIKCiMgQXQgbGVhc3Qgb24gRGFyd2luIDEuMy54OgojCiMgIyBkZWZpbmUgSU5UMzJfTUlO IC0yMTQ3NDgzNjQ4CiMgaW50IG1haW4gKCkgewojICBkb3VibGUgYSA9IElOVDMyX01JTjsKIyAg cHJpbnRmICgiSU5UMzJfTUlOPSVnXG4iLCBhKTsKIyAgcmV0dXJuIDA7CiMgfQojIHdpbGwgb3V0 cHV0OgojIElOVDMyX01JTj0yLjE0NzQ4ZSswOQojIE5vdGUgdGhhdCB0aGUgSU5UMzJfTUlOIGhh cyBiZWNvbWUgcG9zaXRpdmUuCiMgSU5UMzJfTUlOIGlzIHNldCBpbiAvdXNyL2luY2x1ZGUvc3Rk aW50LmggYnk6CiMgI2RlZmluZSBJTlQzMl9NSU4gICAgICAgIC0yMTQ3NDgzNjQ4CiMgd2hpY2gg c2VlbXMgdG8gYnJlYWsgdGhlIGdjYy4gIERlZmluaW5nIElOVDMyX01JTiBhcyAoLTIxNDc0ODM2 NDctMSkKIyBzZWVtcyB0byB3b3JrLiAgSU5UNjRfTUlOIHNlZW1zIHRvIGJlIHNpbWlsYXJseSBi cm9rZW4uCiMgLS0gTmljaG9sYXMgQ2xhcmssIEtlbiBXaWxsaWFtcywgYW5kIEVkd2FyZCBNb3kK IwojIFRoaXMgc2VlbXMgdG8gaGF2ZSBiZWVuIGZpeGVkIHNpbmNlIGF0IGxlYXN0IE1hYyBPUyBY IDEwLjEuMywKIyBzdGRpbnQuaCBkZWZpbmluZyBJTlQzMl9NSU4gYXMgKC1JTlQzMl9NQVgtMSkK IyAtLSBFZHdhcmQgTW95CiMKaWYgdGVzdCAtZiAvdXNyL2luY2x1ZGUvc3RkaW50Lmg7IHRoZW4K ICBjYXNlICIkKGdyZXAgJ14jZGVmaW5lIElOVDMyX01JTicgL3Vzci9pbmNsdWRlL3N0ZGludC5o KSIgaW4KICAqLTIxNDc0ODM2NDgpIGNjZmxhZ3M9IiR7Y2NmbGFnc30gLURJTlQzMl9NSU5fQlJP S0VOIC1ESU5UNjRfTUlOX0JST0tFTiIgOzsKICBlc2FjCmZpCgojIEF2b2lkIEFwcGxlJ3MgY3Bw IHByZWNvbXBpbGVyLCBiZXR0ZXIgZm9yIGV4dGVuc2lvbnMKaWYgWyAiWGBlY2hvIHwgJHtjY30g LW5vLWNwcC1wcmVjb21wIC1FIC0gMj4mMSA+L2Rldi9udWxsYCIgPSAiWCIgXTsgdGhlbgogICAg Y3BwZmxhZ3M9IiR7Y3BwZmxhZ3N9IC1uby1jcHAtcHJlY29tcCIKCiAgICAjIFRoaXMgaXMgbmVj ZXNzYXJ5IGJlY2F1c2UgcGVybCdzIGJ1aWxkIHN5c3RlbSBkb2Vzbid0CiAgICAjIGFwcGx5IGNw cGZsYWdzIHRvIGNjIGNvbXBpbGUgbGluZXMgYXMgaXQgc2hvdWxkLgogICAgY2NmbGFncz0iJHtj Y2ZsYWdzfSAke2NwcGZsYWdzfSIKZmkKCiMgS25vd24gb3B0aW1pemVyIHByb2JsZW1zLgpjYXNl ICJgY2MgLXYgMj4mMWAiIGluCiAgKiIzLjEgMjAwMjAxMDUiKikgdG9rZV9jZmxhZ3M9J29wdGlt aXplPSIiJyA7Owplc2FjCgojIFNoYXJlZCBsaWJyYXJ5IGV4dGVuc2lvbiBpcyAuZHlsaWIuCiMg QnVuZGxlIGV4dGVuc2lvbiBpcyAuYnVuZGxlLgpzbz0nZHlsaWInOwpkbGV4dD0nYnVuZGxlJzsK dXNlZGw9J2RlZmluZSc7CgojIDEwLjQgY2FuIHVzZSBkbG9wZW4uCiMgMTAuNCBicm9rZSBwb2xs KCkuCmNhc2UgIiRvc3ZlcnMiIGluClsxLTddLiopCiAgICBkbHNyYz0nZGxfZHlsZC54cyc7CiAg ICA7OwoqKQogICAgZGxzcmM9J2RsX2Rsb3Blbi54cyc7CiAgICBkX3BvbGw9J3VuZGVmJzsKICAg IGlfcG9sbD0ndW5kZWYnOwogICAgOzsKZXNhYwoKY2FzZSAiJGNjZGxmbGFncyIgaW4JCSMgSWYg cGFzc2VkIGluIGZyb20gY29tbWFuZCBsaW5lLCBwcmVzdW1lIHVzZXIga25vd3MgYmVzdAonJykK ICAgY2NjZGxmbGFncz0nICc7ICMgc3BhY2UsIG5vdCBlbXB0eSwgYmVjYXVzZSBvdGhlcndpc2Ug d2UgZ2V0IC1mcGljCjs7CmVzYWMKCiMgQWxsb3cgdGhlIHVzZXIgdG8gb3ZlcnJpZGUgbGQsIGJ1 dCBtb2RpZnkgaXQgYXMgbmVjZXNzYXJ5IGJlbG93CmNhc2UgIiRsZCIgaW4KICAgICcnKSBjYXNl ICIkY2MiIGluCiAgICAgICAgIyBJZiB0aGUgY2MgaXMgZXhwbGljaXRseSBzb21ldGhpbmcgZWxz ZSB0aGFuIGNjIChvciBlbXB0eSksCiAgICAgICAgIyBzZXQgdGhlIGxkIHRvIGJlIHRoYXQgZXhw bGljaXRseSBzb21ldGhpbmcgZWxzZS4gIENvbnZlcnNlbHksCiAgICAgICAgIyBpZiB0aGUgY2Mg aXMgJ2NjJyAob3IgZW1wdHkpLCBzZXQgdGhlIGxkIHRvIGJlICdjYycuCiAgICAgICAgY2N8Jycp IGxkPSdjYyc7OwogICAgICAgICopIGxkPSIkY2MiIDs7CiAgICAgICAgZXNhYwogICAgICAgIDs7 CmVzYWMKCiMgRnJvbSBodHRwOi8vZnRwLm5ldGJzZC5vcmcvcHViL3BrZ3NyYy9jdXJyZW50L3Br Z3NyYy9tay9wbGF0Zm9ybS9EYXJ3aW4ubWsKIyBhbmQgaHR0cHM6Ly90cmFjLm1hY3BvcnRzLm9y Zy93aWtpL1hjb2RlVmVyc2lvbkluZm8KIyBhbmQgaHR0cHM6Ly90cmFjLm1hY3BvcnRzLm9yZy93 aWtpL1VzaW5nVGhlUmlnaHRDb21waWxlcgojIGFuZCBodHRwczovL2dpc3QuZ2l0aHViLmNvbS95 YW1heWEvMjkyNDI5MgojIGFuZCBodHRwOi8vb3BlbnNvdXJjZS5hcHBsZS5jb20vc291cmNlL2Ns YW5nLwojCiMgTm90ZSB0aGF0IFhjb2RlIGdldHMgdXBkYXRlcyBvbiBvbGRlciBzeXN0ZW1zIHNv bWV0aW1lcywgYW5kIGluCiMgZ2VuZXJhbCB0aGF0IHRoZSBPUyBsZXZlbHMgYW5kIFhDb2RlIGxl dmVscyBhcmUgbm90IHN5bmNocm9uaXplZAojIHNpbmNlIG5ldyByZWxlYXNlcyBvZiBYQ29kZSB1 c3VhbGx5IHN1cHBvcnQgYm90aCBzb21lIG5ldyBhbmQgc29tZQojIG9sZCBPUyByZWxlYXNlcy4K IwojIE5vdGUgdGhhdCBBcHBsZSBoaWphY2tzIHRoZSBjbGFuZyBwcmVwcm9jZXNzb3Igc3ltYm9s cyBfX2NsYW5nX21ham9yX18KIyBhbmQgX19jbGFuZ19taW5vcl9fIHNvIHRoZXkgY2Fubm90IGJl IHVzZWQgKGVhc2lseSkgdG8gZGV0ZWN0IHRoZQojIGFjdHVhbCBjbGFuZyByZWxlYXNlLiAgRm9y IGV4YW1wbGU6CiMKIyAiWW9zZW1pdGUgMTAuMTAueCAxNC54LnkgNi4zIChjbGFuZyAzLjYgYXMg Ni4xLzYwMi4wLjQ5KSIKIwojIG1lYW5zIHRoYXQgdGhlIFhjb2RlIDYuMyBwcm92aWRlZCB0aGUg Y2xhbmcgNi4zIGJ1dCBjYWxsZWQgaXQgNi4xCiMgKF9fY2xhbmdfbWFqb3JfXywgX19jbGFuZ19t aW5vcl9fKSBhbmQgaW4gYWRkaXRpb24gdGhlIHByZXByb2Nlc3NvcgojIHN5bWJvbCBfX2FwcGxl X2J1aWxkX3ZlcnNpb25fXyB3YXMgNjAyMDA0OS4KIwojIENvZGVuYW1lICAgICAgICBPUyAgICAg IEtlcm5lbCAgWGNvZGUKIwojIENoZWV0YWggICAgICAgICAxMC4wLnggIDEuMy4xCiMgUHVtYSAg ICAgICAgICAgIDEwLjEgICAgMS40LjEKIyAgICAgICAgICAgICAgICAgMTAuMS54ICA1LngueQoj IEphZ3VhciAgICAgICAgICAxMC4yLnggIDYueC55CiMgUGFudGhlciAgICAgICAgIDEwLjMueCAg Ny54LnkKIyBUaWdlciAgICAgICAgICAgMTAuNC54ICA4LngueSAgIDIuMCAgIChnY2M0IDQuMC4w KQojICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgMi4yICAgKGdjYzQgNC4wLjEpCiMg ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAyLjIuMSAoZ2NjIDMuMykKIyAgICAgICAg ICAgICAgICAgICAgICAgICAgICAgICAgIDIuNSA/CiMgTGVvcGFyZCAgICAgICAgIDEwLjUueCAg OS54LnkgICAzLjAgICAoZ2NjIDQuMC4xIGRlZmF1bHQpCiMgICAgICAgICAgICAgICAgICAgICAg ICAgICAgICAgICAzLjEgICAoZ2NjIDQuMi4xKQojIFNub3cgTGVvcGFyZCAgICAxMC42LnggIDEw LngueSAgMy4yICAgKGxsdm0gZ2NjIDQuMiwgY2xhbmcgMi4zIGFzIDEuMCkKIyAgICAgICAgICAg ICAgICAgICAgICAgICAgICAgICAgIDMuMi4xIChjbGFuZyAxLjAuMSBhcyAxLjAuMS8yNCkKIyAg ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIDMuMi4yIChjbGFuZyAxLjAuMiBhcyAxLjAu Mi8zMikKIyAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIDMuMi4zIChjbGFuZyAxLjUg YXMgMS41LzYwKQojICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgNC4wLjEgKGNsYW5n IDIuOSBhcyAyLjAvMTM4KQojIExpb24gICAgICAgICAgICAxMC43LnggIDExLngueSAgNC4xICAg KGxsdm0gZ2NjIDQuMi4xLCBjbGFuZyAzLjAgYXMgMi4xLzE2My43LjEpCiMgICAgICAgICAgICAg ICAgICAgICAgICAgICAgICAgICA0LjIgICAoY2xhbmcgMy4wIGFzIDMuMC8yMTEuMTAuMSkKIyAg ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIDQuMy4zIChjbGFuZyAzLjEgYXMgMy4xLzMx OC4wLjYxKQojICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgNC40ICAgKGNsYW5nIDMu MSBhcyA0LjAvNDIxLjAuNTcpCiMgTW91bnRhaW4gTGlvbiAgIDEwLjgueCAgMTIueC55ICA0LjUg ICAoY2xhbmcgMy4xIGFzIDQuMS80MjEuMTEuNjUsIHJlYWwgZ2NjIHJlbW92ZWQsIHRoZXJlIGlz IGdjYyBidXQgaXQncyByZWFsbHkgY2xhbmcpCiMgICAgICAgICAgICAgICAgICAgICAgICAgICAg ICAgICA0LjYgICAoY2xhbmcgMy4yIGFzIDQuMi80MjUuMC4yNCkKIyAgICAgICAgICAgICAgICAg ICAgICAgICAgICAgICAgIDUuMCAgIChjbGFuZyAzLjMgYXMgNS4wLzUwMC4yLjc1KQojICAgICAg ICAgICAgICAgICAgICAgICAgICAgICAgICAgNS4xICAgKGNsYW5nIDMuNCBhcyA1LjEvNTAzLjAu MzgpCiMgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICA1LjEuMSAoY2xhbmcgMy40IGFz IDUuMS81MDMuMC40MCkKIyBNYXZlcmlja3MgICAgICAgMTAuOS54ICAxMy54LnkgIDYuMC4xIChj bGFuZyAzLjUgYXMgNi4wLzYwMC4wLjUxKQojICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg ICAgNi4xICAgKGNsYW5nIDMuNSBhcyA2LjAvNjAwLjAuNTQpCiMgICAgICAgICAgICAgICAgICAg ICAgICAgICAgICAgICA2LjEuMSAoY2xhbmcgMy41IGFzIDYuMC82MDAuMC41NikKIyAgICAgICAg ICAgICAgICAgICAgICAgICAgICAgICAgIDYuMiAgIChjbGFuZyAzLjUgYXMgNi4wLzYwMC4wLjU3 KQojIFlvc2VtaXRlICAgICAgICAxMC4xMC54IDE0LngueSAgNi4zICAgKGNsYW5nIDMuNiBhcyA2 LjEvNjAyLjAuNDkpCiMgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICA2LjMuMSAoY2xh bmcgMy42IGFzIDYuMS82MDIuMC40OSkKIyAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg IDYuMy4yIChjbGFuZyAzLjYgYXMgNi4xLzYwMi4wLjUzKQojIEVsIENhcGl0YW4gICAgICAxMC4x MS54IDE1LngueSAgNy4wICAgKGNsYW5nIDMuNyBhcyA3LjAvNzAwLjAuNzIpCiMgICAgICAgICAg ICAgICAgICAgICAgICAgICAgICAgICA3LjEgICAoY2xhbmcgMy43IGFzIDcuMC83MDAuMS43NikK IyAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIDcuMiAgIChjbGFuZyAzLjcgYXMgNy4w LjIvNzAwLjEuODEpCiMgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICA3LjIuMSAoY2xh bmcgMy43IGFzIDcuMC4yLzcwMC4xLjgxKQojICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg ICAgNy4zICAgKGNsYW5nIDMuOCBhcyA3LjMuMC83MDMuMC4yOSkKIyBTaWVycmEgICAgICAgICAg MTAuMTIueCAxNi54LnkgIDguMC4wIChjbGFuZyAzLjggYXMgOC4wLzgwMC4wLjM4KQojCgojIFBy b2Nlc3NvcnMgU3VwcG9ydGVkCiMKIyBQb3dlclBDIChQUEMpOiAgICAgICAxMC4wLnggLSAxMC41 LjggKGZpbmFsIDEwLjUueCkKIyBQb3dlclBDIHZpYSBSb3NldHRhOiAxMC40LjQgLSAxMC42Ljgg KGZpbmFsIDEwLjYueCkKIyBJQS0zMjogICAgICAgICAgICAgICAxMC40LjQgLSAxMC42LjggKHRo b3VnaCBzdGlsbCBzdXBwb3J0ZWQgb24geDg2LTY0KQojIHg4Ni02NDogICAgICAgICAgICAgIDEw LjQuNyAtIGN1cnJlbnQKCiMgTUFDT1NYX0RFUExPWU1FTlRfVEFSR0VUIHNlbGVjdHMgdGhlIG1p bmltdW0gT1MgbGV2ZWwgd2Ugd2FudCB0byBzdXBwb3J0CiMKIyBJdCBpcyBuZWVkZWQgZm9yIE9T IHJlbGVhc2VzIGJlZm9yZSAxMC42LgojCiMgaHR0cHM6Ly9kZXZlbG9wZXIuYXBwbGUuY29tL2xp YnJhcnkvbWFjL2RvY3VtZW50YXRpb24vRGV2ZWxvcGVyVG9vbHMvQ29uY2VwdHVhbC9jcm9zc19k ZXZlbG9wbWVudC9Db25maWd1cmluZy9jb25maWd1cmluZy5odG1sCiMKIyBJZiBpdCBpcyBzZXQs IHdlIGFsc28gcHJvcGFnYXRlIGl0cyB2YWx1ZSB0byBjY2ZsYWdzIGFuZCBsZGZsYWdzCiMgdXNp bmcgdGhlIC1tbWFjb3N4LXZlcnNpb24tbWluIGZsYWcuICBJZiBpdCBpcyBub3Qgc2V0LCB3ZSB1 c2UKIyB0aGUgT1MgWCByZWxlYXNlIGFzIHRoZSBtaW4gdmFsdWUgZm9yIHRoZSBmbGFnLgoKIyBB ZGRzICItbW1hY29zeC12ZXJzaW9uLW1pbj0kMiIgdG8gIiQxIiB1bmxlc3MgaXQgYWxyZWFkeSBp cyB0aGVyZS4KYWRkX21hY29zeF92ZXJzaW9uX21pbiAoKSB7CiAgbG9jYWwgdgogIGV2YWwgInY9 XCQkMSIKICBjYXNlICIgJHYgIiBpbgogICoiLW1tYWNvc3gtdmVyc2lvbi1taW4iKikKICAgICBl Y2hvICJOT1QgYWRkaW5nIC1tbWFjb3N4LXZlcnNpb24tbWluPSQyIHRvICQxICgkdikiID4mNAog ICAgIDs7CiAgKikgZWNobyAiQWRkaW5nIC1tbWFjb3N4LXZlcnNpb24tbWluPSQyIHRvICQxIiA+ JjQKICAgICBldmFsICIkMT0nJHYgLW1tYWNvc3gtdmVyc2lvbi1taW49JDInIgogICAgIDs7CiAg ZXNhYwp9CgojIFBlcmwgYnVuZGxlcyBkbyBub3QgZXhwZWN0IHR3by1sZXZlbCBuYW1lc3BhY2Us IGFkZGVkIGluIERhcndpbiAxLjQuCiMgQnV0IHN0YXJ0aW5nIGZyb20gcGVybCA1LjguMS9EYXJ3 aW4gNyB0aGUgZGVmYXVsdCBpcyB0aGUgdHdvLWxldmVsLgpjYXNlICIkb3N2ZXJzIiBpbiAgIyBO b3RlOiBvc3ZlcnMgaXMgdGhlIGtlcm5lbCB2ZXJzaW9uLCBub3QgdGhlIDEwLngKMS5bMC0zXS4q KSAjIE9TIFggMTAuMC54CiAgIGxkZGxmbGFncz0iJHtsZGZsYWdzfSAtYnVuZGxlIC11bmRlZmlu ZWQgc3VwcHJlc3MiCiAgIDs7CjEuKikgICAgICAgIyBPUyBYIDEwLjEKICAgbGRmbGFncz0iJHts ZGZsYWdzfSAtZmxhdF9uYW1lc3BhY2UiCiAgIGxkZGxmbGFncz0iJHtsZGZsYWdzfSAtYnVuZGxl IC11bmRlZmluZWQgc3VwcHJlc3MiCiAgIDs7ClsyLTZdLiopICAgIyBPUyBYIDEwLjEueCAtIDEw LjIueCAodGhvdWdoIFsyLTRdIG5ldmVyIGV4aXN0ZWQgcHVibGljbHkpCiAgIGxkZmxhZ3M9IiR7 bGRmbGFnc30gLWZsYXRfbmFtZXNwYWNlIgogICBsZGRsZmxhZ3M9IiR7bGRmbGFnc30gLWJ1bmRs ZSAtdW5kZWZpbmVkIHN1cHByZXNzIgogICA7OwpbNy05XS4qKSAgICMgT1MgWCAxMC4zLnggLSAx MC41LngKICAgbGRkbGZsYWdzPSIke2xkZmxhZ3N9IC1idW5kbGUgLXVuZGVmaW5lZCBkeW5hbWlj X2xvb2t1cCIKICAgY2FzZSAiJGxkIiBpbgogICAgICAgKk1BQ09TWF9ERVBMT1lNRU5UX1RBUkdF VCopIDs7CiAgICAgICAqKSBsZD0iZW52IE1BQ09TWF9ERVBMT1lNRU5UX1RBUkdFVD0xMC4zICR7 bGR9IiA7OwogICBlc2FjCiAgIDs7CiopICAgICAgICAjIE9TIFggMTAuNi54IC0gY3VycmVudAog ICAjIFRoZSBNQUNPU1hfREVQTE9ZTUVOVF9UQVJHRVQgaXMgbm90IG5lZWRlZCwKICAgIyBidXQg dGhlIC1tbWFjb3N4LXZlcnNpb24tbWluIG9wdGlvbiBpcyBhbHdheXMgdXNlZC4KCiAgICMgV2Ug bm93IHVzZSBNQUNPU1hfREVQTE9ZTUVOVF9UQVJHRVQsIGlmIHNldCwgYXMgYW4gb3ZlcnJpZGUg YnkKICAgIyBjYXB0dXJpbmcgaXRzIHZhbHVlIGFuZCBhZGRpbmcgaXQgdG8gdGhlIGZsYWdzLgog ICAgY2FzZSAiJE1BQ09TWF9ERVBMT1lNRU5UX1RBUkdFVCIgaW4KICAgIFsxLTldWzAtOV0uKikK ICAgICAgYWRkX21hY29zeF92ZXJzaW9uX21pbiBjY2ZsYWdzICRNQUNPU1hfREVQTE9ZTUVOVF9U QVJHRVQKICAgICAgYWRkX21hY29zeF92ZXJzaW9uX21pbiBsZGZsYWdzICRNQUNPU1hfREVQTE9Z TUVOVF9UQVJHRVQKICAgICAgOzsKICAgICcnKQogICAgICAjIEVtcHR5IE1BQ09TWF9ERVBMT1lN RU5UX1RBUkdFVCBpcyBva2F5LgogICAgICA7OwogICAgKikKICAgICAgY2F0IDw8RU9NID4mNAoK KioqIFVuZXhwZWN0ZWQgTUFDT1NYX0RFUExPWU1FTlRfVEFSR0VUPSRNQUNPU1hfREVQTE9ZTUVO VF9UQVJHRVQKKioqCioqKiBQbGVhc2UgZWl0aGVyIHNldCBpdCB0byBhIHZhbGlkIG1hY09TIHZl cnNpb24gbnVtYmVyIChlLmcuLCAxMC4xNSkgb3IgdG8gZW1wdHkuCgpFT00KICAgICAgZXhpdCAx CiAgICAgIDs7CiAgICBlc2FjCgogICAgIyBLZWVwIHRoZSBwcm9kdmVycyBsZWFkaW5nIHdoaXRl c3BhY2UgKENvbmZpZ3VyZSBtYWdpYykuCiAgICAjIENhbm5vdCB1c2UgJG9zdmVycyBoZXJlIHNp bmNlIHRoYXQgaXMgdGhlIGtlcm5lbCB2ZXJzaW9uLgogICAgIyBzd192ZXJzIG91dHB1dCAgICAg ICAgICAgICAgICAgd2hhdCB3ZSB3YW50CiAgICAjICJQcm9kdWN0VmVyc2lvbjogICAgMTAuMTAu NSIgICAiMTAuMTAiCiAgICAjICJQcm9kdWN0VmVyc2lvbjogICAgMTAuMTEiICAgICAiMTAuMTEi CiAgICAgICAgcHJvZHZlcnM9YHN3X3ZlcnN8YXdrICcvXlByb2R1Y3RWZXJzaW9uOi97cHJpbnQg JDJ9J3xhd2sgLUYuICd7cHJpbnQgJDEiLiIkMn0nYAogICAgY2FzZSAiJHByb2R2ZXJzIiBpbgog ICAgWzEtOV1bMC05XS4qKQogICAgICBhZGRfbWFjb3N4X3ZlcnNpb25fbWluIGNjZmxhZ3MgJHBy b2R2ZXJzCiAgICAgIGFkZF9tYWNvc3hfdmVyc2lvbl9taW4gbGRmbGFncyAkcHJvZHZlcnMKICAg ICAgOzsKICAgICopCiAgICAgIGNhdCA8PEVPTSA+JjQKCioqKiBVbmV4cGVjdGVkIHByb2R1Y3Qg dmVyc2lvbiAkcHJvZHZlcnMuCioqKgoqKiogVHJ5IHJ1bm5pbmcgc3dfdmVycyBhbmQgc2VlIHdo YXQgaXRzIFByb2R1Y3RWZXJzaW9uIHNheXMuCgpFT00KICAgICAgZXhpdCAxCiAgICBlc2FjCgog ICAgZGFyd2luX21ham9yPSQoZWNobyAkb3N2ZXJzfGF3ayAtRi4gJ3twcmludCAkMX0nKQoKICAg ICMgbWFjT1MgMTAuMTIgKGRhcndpbiAxNi4wLjApIGRlcHJlY2F0ZWQgc3lzY2FsbCgpLgogICAg aWYgWyAiJGRhcndpbl9tYWpvciIgLWdlIDE2IF07IHRoZW4KICAgICAgICBkX3N5c2NhbGw9J3Vu ZGVmJwogICAgICAgICMgSWYgZGVwbG95aW5nIHRvIHByZS0xMC4xMiwgc3VwcHJlc3MgVGltZTo6 SGlSZXMncyBkZXRlY3Rpb24gb2YgdGhlIHN5c3RlbSBjbG9ja19nZXR0aW1lKCkKICAgICAgICBj YXNlICIkTUFDT1NYX0RFUExPWU1FTlRfVEFSR0VUIiBpbgogICAgICAgICAgMTAuWzYtOV18MTAu MTB8MTAuMTEpCiAgICAgICAgICBjY2ZsYWdzPSIkY2NmbGFncyAtV2Vycm9yPXBhcnRpYWwtYXZh aWxhYmlsaXR5IC1EX0RBUldJTl9GRUFUVVJFX0NMT0NLX0dFVFRJTUU9MCIKICAgICAgICAgIDs7 CiAgICAgICAgKikKICAgICAgICAgIDs7CiAgICAgICAgZXNhYwogICAgZmkKCiAgIGxkZGxmbGFn cz0iJHtsZGZsYWdzfSAtYnVuZGxlIC11bmRlZmluZWQgZHluYW1pY19sb29rdXAiCiAgIDs7CmVz YWMKCmxkbGlicHRobmFtZT0nRFlMRF9MSUJSQVJZX1BBVEgnOwoKIyB1c2VzaHJwbGliPXRydWUg cmVzdWx0cyBpbiBtdWNoIHNsb3dlciBzdGFydHVwIHRpbWVzLgojICdmYWxzZScgaXMgdGhlIGRl ZmF1bHQgdmFsdWUuICBVc2UgQ29uZmlndXJlIC1EdXNlc2hycGxpYiB0byBvdmVycmlkZS4KCmNh dCA+IFVVL2FyY2huYW1lLmNidSA8PCdFT0NCVScKIyBUaGlzIHNjcmlwdCBVVS9hcmNobmFtZS5j YnUgd2lsbCBnZXQgJ2NhbGxlZC1iYWNrJyBieSBDb25maWd1cmUgCiMgYWZ0ZXIgaXQgaGFzIG90 aGVyd2lzZSBkZXRlcm1pbmVkIHRoZSBhcmNoaXRlY3R1cmUgbmFtZS4KY2FzZSAiJGxkZmxhZ3Mi IGluCioiLWZsYXRfbmFtZXNwYWNlIiopIDs7ICMgQmFja3dhcmQgY29tcGF0LCBiZSBmbGF0Lgoj IElmIHdlIGFyZSB1c2luZyB0d28tbGV2ZWwgbmFtZXNwYWNlLCB3ZSB3aWxsIG11bmdlIHRoZSBh cmNobmFtZSB0byBzaG93IGl0LgoqKSBhcmNobmFtZT0iJHthcmNobmFtZX0tMmxldmVsIiA7Owpl c2FjCkVPQ0JVCgojIDY0LWJpdCBhZGRyZXNzaW5nIHN1cHBvcnQuIEN1cnJlbnRseSBzdHJpY3Rs eSBleHBlcmltZW50YWwuIERGRCAyMDA1LTA2LTA2CmNhc2UgIiR1c2U2NGJpdGFsbCIgaW4KJGRl ZmluZXx0cnVlfFt5WV0qKQpjYXNlICIkb3N2ZXJzIiBpbgpbMS03XS4qKQogICAgIGNhdCA8PEVP TSA+JjQKCgoKKioqIDY0LWJpdCBhZGRyZXNzaW5nIGlzIG5vdCBzdXBwb3J0ZWQgZm9yIE1hYyBP UyBYIHZlcnNpb25zCioqKiBiZWxvdyAxMC40ICgiVGlnZXIiKSBvciBEYXJ3aW4gdmVyc2lvbnMg YmVsb3cgOC4gUGxlYXNlIHRyeQoqKiogYWdhaW4gd2l0aG91dCAtRHVzZTY0Yml0YWxsLiAoLUR1 c2U2NGJpdGludCB3aWxsIHdvcmssIGhvd2V2ZXIuKQoKRU9NCiAgICAgZXhpdCAxCiAgOzsKKikK ICAgIGNhc2UgIiRvc3ZlcnMiIGluCiAgICA4LiopCiAgICAgICAgY2F0IDw8RU9NID4mNAoKCgoq KiogUGVybCA2NC1iaXQgYWRkcmVzc2luZyBzdXBwb3J0IGlzIGV4cGVyaW1lbnRhbCBmb3IgTWFj IE9TIFgKKioqIDEwLjQgKCJUaWdlciIpIGFuZCBEYXJ3aW4gdmVyc2lvbiA4LiBTeXN0ZW0gViBJ UEMgaXMgZGlzYWJsZWQKKioqIGR1ZSB0byBwcm9ibGVtcyB3aXRoIHRoZSA2NC1iaXQgdmVyc2lv bnMgb2YgbXNnY3RsLCBzZW1jdGwsCioqKiBhbmQgc2htY3RsLiBZb3Ugc2hvdWxkIGFsc28gZXhw ZWN0IHRoZSBmb2xsb3dpbmcgdGVzdCBmYWlsdXJlczoKKioqCioqKiAgICBleHQvdGhyZWFkcy1z aGFyZWQvdC93YWl0ICh0aHJlYWRlZCBidWlsZHMgb25seSkKCkVPTQoKICAgICAgICBbICIkZF9t c2djdGwiIF0gfHwgZF9tc2djdGw9J3VuZGVmJwogICAgICAgIFsgIiRkX3NlbWN0bCIgXSB8fCBk X3NlbWN0bD0ndW5kZWYnCiAgICAgICAgWyAiJGRfc2htY3RsIiBdIHx8IGRfc2htY3RsPSd1bmRl ZicKICAgIDs7CiAgICBlc2FjCgogICAgY2FzZSBgdW5hbWUgLXBgIGluIAogICAgcG93ZXJwYykg YXJjaD1wcGM2NCA7OwogICAgaTM4NikgYXJjaD14ODZfNjQgOzsKICAgICopIGNhdCA8PEVPTSA+ JjQKCioqKiBEb24ndCByZWNvZ25pemUgcHJvY2Vzc29yLCBjYW4ndCBzcGVjaWZ5IDY0IGJpdCBj b21waWxhdGlvbi4KCkVPTQogICAgOzsKICAgIGVzYWMKICAgIGZvciB2YXIgaW4gY2NmbGFncyBj cHBmbGFncyBsZCBsZGZsYWdzCiAgICBkbwogICAgICAgZXZhbCAkdmFyPSJcJCR7dmFyfVwgLWFy Y2hcICRhcmNoIgogICAgZG9uZQoKICAgIDs7CmVzYWMKOzsKZXNhYwoKIyMKIyBTeXN0ZW0gbGli cmFyaWVzCiMjCgojIHZmb3JrIHdvcmtzCnVzZXZmb3JrPSd0cnVlJzsKCiMgbWFsbG9jIHdyYXAg d29ya3MKY2FzZSAiJHVzZW1hbGxvY3dyYXAiIGluCicnKSB1c2VtYWxsb2N3cmFwPSdkZWZpbmUn IDs7CmVzYWMKCiMgb3VyIG1hbGxvYyB3b3JrcyAoYnV0IGFsbG93IHVzZXJzIHRvIG92ZXJyaWRl KQpjYXNlICIkdXNlbXltYWxsb2MiIGluCicnKSB1c2VteW1hbGxvYz0nbicgOzsKZXNhYwojIEhv d2V2ZXIgc2JyaygpIHJldHVybnMgLTEgKGZhaWx1cmUpIHNvbWV3aGVyZSBpbiBsaWIvdW5pY29y ZS9ta3RhYmxlcyBhdAojIGFyb3VuZCAxNE0sIHNvIHdlIG5lZWQgdG8gdXNlIHN5c3RlbSBtYWxs b2MoKSBhcyBvdXIgc2JyaygpCiMKIyBzYnJrKCkgaW4gRGFyd2luIGRlcHJlY2F0ZWQgc2luY2Ug TWF2ZXJpY2tzICgxMC45KSwgaXQgc3RpbGwgZXhpc3RzCiMgaW4gWW9zZW1pdGUgKDEwLjEwKSBi dXQgdGhhdCBpcyBqdXN0IGFuIGVtdWxhdGlvbiwgYW5kIGZhaWxzIGZvcgojIGFsbG9jYXRpb25z IGJleW9uZCA0TUIuICBPbmUgc2hvdWxkIHVzZSBlLmcuIG1tYXAgaW5zdGVhZCAob3Igc3lzdGVt CiMgbWFsbG9jLCBhcyBzdWdnZXN0ZWQgYWJvdmUsIHRoYXQgYnV0IGlzIGtpbmQgb2YgYmFja3dh cmQpLgptYWxsb2NfY2ZsYWdzPSdjY2ZsYWdzPSItRFVTRV9QRVJMX1NCUksgLURQRVJMX1NCUktf VklBX01BTExPQyAkY2NmbGFncyInCgojIExvY2FsZXMgYXJlbid0IGZlZWxpbmcgd2VsbC4KTENf QUxMPUM7IGV4cG9ydCBMQ19BTEw7CkxBTkc9QzsgZXhwb3J0IExBTkc7CgojCiMgVGhlIGxpYnJh cmllcyBhcmUgbm90IHRocmVhZHNhZmUgYXMgb2YgT1MgWCAxMC4xLgojCiMgRml4IHdoZW4gQXBw bGUgZml4ZXMgbGliYy4KIwpjYXNlICIkdXNldGhyZWFkcyR1c2VpdGhyZWFkcyIgaW4KICAqZGVm aW5lKikKICBjYXNlICIkb3N2ZXJzIiBpbgogICAgWzEyMzQ1XS4qKSAgICAgY2F0IDw8RU9NID4m NAoKCgoqKiogV2FybmluZywgdGhlcmUgbWlnaHQgYmUgcHJvYmxlbXMgd2l0aCB5b3VyIGxpYnJh cmllcyB3aXRoCioqKiByZWdhcmRzIHRvIHRocmVhZGluZy4gIFRoZSB0ZXN0IGV4dC90aHJlYWRz L3QvbGliYy50IGlzIGxpa2VseQoqKiogdG8gZmFpbC4KCkVPTQogICAgOzsKICAgICopIHVzZXJl ZW50cmFudD0nZGVmaW5lJzs7CiAgZXNhYwoKZXNhYwoKIyBGaW5rIGNhbiBpbnN0YWxsIGEgR0RC TSBsaWJyYXJ5IHRoYXQgY2xhaW1zIHRvIGhhdmUgdGhlIE9EQk0gaW50ZXJmYWNlcwojIGJ1dCBQ ZXJsIGR5bmFsb2FkZXIgY2Fubm90IGZvciBzb21lIHJlYXNvbiB1c2UgdGhhdCBsaWJyYXJ5LiAg V2UgZG9uJ3QKIyByZWFsbHkgbmVlZCBPREJNX0ZJbGUsIHRob3VnaCwgc28gbGV0J3MganVzdCBo aW50IE9EQk0gYXdheS4KaV9kYm09dW5kZWY7CgojIENvbmZpZ3VyZSBkb2Vzbid0IGRldGVjdCBy YW5saWIgb24gVGlnZXIgcHJvcGVybHkuCiMgTmVpbFcgc2F5cyB0aGlzIHNob3VsZCBiZSBhY2Nl cHRhYmxlIG9uIGFsbCBkYXJ3aW4gdmVyc2lvbnMuCnJhbmxpYj0ncmFubGliJwoKIyBDYXRjaCBN YWNQb3J0cyBnY2MvZysrIGV4dHJhIGxpYmRpcgpjYXNlICIkKCRjYyAtdiAyPiYxKSIgaW4KKiJN YWNQb3J0cyBnY2MiKikgbG9jbGlicHRoPSIkbG9jbGlicHRoIC9vcHQvbG9jYWwvbGliL2xpYmdj YyIgOzsKZXNhYwoKIyMKIyBCdWlsZCBwcm9jZXNzCiMjCgojIENhc2UtaW5zZW5zaXRpdmUgZmls ZXN5c3RlbXMgZG9uJ3QgZ2V0IGFsb25nIHdpdGggTWFrZWZpbGUgYW5kCiMgbWFrZWZpbGUgaW4g dGhlIHNhbWUgcGxhY2UuICBTaW5jZSBEYXJ3aW4gdXNlcyBHTlUgbWFrZSwgdGhpcyBkb2RnZXMK IyB0aGUgcHJvYmxlbS4KZmlyc3RtYWtlZmlsZT1HTlVtYWtlZmlsZTsKCiMgUGFydHMgb2YgdGhl IHN5c3RlbSBjYWxsIHNldGVudigpLCBpbiBwYXJ0aWN1bGFyIGluIGFuIGF0Zm9yayBoYW5kbGVy LgojIFRoaXMgY2F1c2VzIHByb2JsZW1zIHdoZW4gdGhlIGNoaWxkIHRyaWVzIHRvIGNsZWFuIHVw IGVudmlyb25bXSwgc28KIyBsZXQgbGliYyBtYW5hZ2UgZW52aXJvbltdLgpjYXQgPj4gY29uZmln Lm92ZXIgPDwnRU9PVkVSJwppZiB0ZXN0ICIkZF91bnNldGVudiIgPSAiJGRlZmluZSIgLWEgXAog ICAgYGV4cHIgIiRjY2ZsYWdzIiA6ICcuKi1EUEVSTF9VU0VfU0FGRV9QVVRFTlYnYCAtZXEgMDsg dGhlbgogICAgICAgIGNjZmxhZ3M9IiRjY2ZsYWdzIC1EUEVSTF9VU0VfU0FGRV9QVVRFTlYiCmZp CkVPT1ZFUgoKIyBpZiB5b3UgdXNlIGEgbmV3ZXIgdG9vbGNoYWluIGJlZm9yZSBPUyBYIDEwLjkg dGhlc2UgZnVuY3Rpb25zIG1heSBiZQojIGluY29ycmVjdGx5IGRldGVjdGVkLCBzbyBkaXNhYmxl IHRoZW0KIyBPUyBYIDEwLjEwLnggY29ycmVzcG9uZHMgdG8ga2VybmVsIDE0LngKY2FzZSAiJG9z dmVycyIgaW4KICAgIFsxLTldLip8MVswLTNdLiopCglkX2xpbmthdD11bmRlZgoJZF9vcGVuYXQ9 dW5kZWYKCWRfcmVuYW1lYXQ9dW5kZWYKCWRfdW5saW5rYXQ9dW5kZWYKCWRfZmNobW9kYXQ9dW5k ZWYKCTs7CmVzYWMKCiMgbWtvc3RlbXAoKSB3YXMgYXV0b2RldGVjdGVkIGFzIHByZXNlbnQgYnV0 IGZvdW5kIHRvIG5vdCBiZSBsaW5rYWJsZQojIG9uIDE1LjYuMC4gIFVua25vd24gd2hhdCBvdGhl ciBPUyB2ZXJzaW9ucyBhcmUgYWZmZWN0ZWQuCmRfbWtvc3RlbXA9dW5kZWYK', 'dragonfly' => 'IyBoaW50cy9kcmFnb25mbHkuc2gKIwojIFRoaXMgZmlsZSBpcyBtb3N0bHkgY29waWVkIGZyb20g aGludHMvZnJlZWJzZC5zaCB3aXRoIHRoZSBPUyB2ZXJzaW9uCiMgaW5mb3JtYXRpb24gdGFrZW4g b3V0IGFuZCBvbmx5IHRoZSBGcmVlQlNELTQgaW5mb3JtYXRpb24gaW50YWN0LgojIFBsZWFzZSBj aGVjayB3aXRoIFRvZGQgV2lsbGV5IDx4dG9kZHhAZ21haWwuY29tPiBiZWZvcmUgbWFraW5nCiMg bW9kaWZpY2F0aW9ucyB0byB0aGlzIGZpbGUuIFNlZSBodHRwOi8vd3d3LmRyYWdvbmZseWJzZC5v cmcvCgpjYXNlICIkb3N2ZXJzIiBpbgoqKSAgdXNldmZvcms9J3RydWUnCiAgICBjYXNlICIkdXNl bXltYWxsb2MiIGluCgkiIikgdXNlbXltYWxsb2M9J24nCgkgICAgOzsKICAgIGVzYWMKICAgIGxp YnN3YW50ZWQ9YGVjaG8gJGxpYnN3YW50ZWQgfCBzZWQgJ3MvIG1hbGxvYyAvIC8nYAogICAgOzsK ZXNhYwoKIyBEeW5hbWljIExvYWRpbmcgZmxhZ3MgaGF2ZSBub3QgY2hhbmdlZCBtdWNoLCBzbyB0 aGV5IGFyZSBzZXBhcmF0ZWQKIyBvdXQgaGVyZSB0byBhdm9pZCBkdXBsaWNhdGluZyB0aGVtIGV2 ZXJ5d2hlcmUuCmNhc2UgIiRvc3ZlcnMiIGluCiopICBvYmpmb3JtYXQ9YC91c3IvYmluL29iamZv cm1hdGAKICAgIGxpYnB0aD0iL3Vzci9saWIgL3Vzci9sb2NhbC9saWIiCiAgICBnbGlicHRoPSIv dXNyL2xpYiAvdXNyL2xvY2FsL2xpYiIKICAgIGxkZmxhZ3M9Ii1XbCwtRSAiCiAgICBsZGRsZmxh Z3M9Ii1zaGFyZWQgIgogICAgY2NjZGxmbGFncz0nLURQSUMgLWZQSUMnCiAgICA7Owplc2FjCgpj YXNlICIkb3N2ZXJzIiBpbgoqKSAgY2NmbGFncz0iJHtjY2ZsYWdzfSAtREhBU19GUFNFVE1BU0sg LURIQVNfRkxPQVRJTkdQT0lOVF9IIgogICAgaWYgL3Vzci9iaW4vZmlsZSAtTCAvdXNyL2xpYi9s aWJjLnNvIHwgL3Vzci9iaW4vZ3JlcCAtdnEgIm5vdCBzdHJpcHBlZCIgOyB0aGVuCgl1c2VubT1m YWxzZQogICAgZmkKICAgIDs7CmVzYWMKCmNhdCA8PCdFT00nID4mNAoKU29tZSB1c2VycyBoYXZl IHJlcG9ydGVkIHRoYXQgQ29uZmlndXJlIGhhbHRzIHdoZW4gdGVzdGluZyBmb3IKdGhlIE9fTk9O QkxPQ0sgc3ltYm9sIHdpdGggYSBzeW50YXggZXJyb3IuICBUaGlzIGlzIGFwcGFyZW50bHkgYQpz aCBlcnJvci4gIFJlcnVubmluZyBDb25maWd1cmUgd2l0aCBrc2ggYXBwYXJlbnRseSBmaXhlcyB0 aGUKcHJvYmxlbS4gIFRyeQogICAgICAga3NoIENvbmZpZ3VyZSBbeW91ciBvcHRpb25zXQoKRU9N CgojIEZyb206IEFudG9uIEJlcmV6aW4gPHRvYmV6QHBsYWIua3UuZGs+CiMgVG86IHBlcmw1LXBv cnRlcnNAcGVybC5vcmcKIyBTdWJqZWN0OiBbUEFUQ0ggNS4wMDVfNTRdIENvbmZpZ3VyZSAtIGhp bnRzL2ZyZWVic2Quc2ggc2lnbmFsIGhhbmRsZXIgdHlwZQojIERhdGU6IDMwIE5vdiAxOTk4IDE5 OjQ2OjI0ICswMTAwCiMgTWVzc2FnZS1JRDogPDg2NHNyaGh2Y3YuZnNmQGxpb24ucGxhYi5rdS5k az4KCnNpZ25hbF90PSd2b2lkJwpkX3ZvaWRzaWc9J2RlZmluZScKCiMgVGhpcyBzY3JpcHQgVVUv dXNldGhyZWFkcy5jYnUgd2lsbCBnZXQgJ2NhbGxlZC1iYWNrJyBieSBDb25maWd1cmUKIyBhZnRl ciBpdCBoYXMgcHJvbXB0ZWQgdGhlIHVzZXIgZm9yIHdoZXRoZXIgdG8gdXNlIHRocmVhZHMuCmNh dCA+IFVVL3VzZXRocmVhZHMuY2J1IDw8J0VPQ0JVJwpjYXNlICIkdXNldGhyZWFkcyIgaW4KJGRl ZmluZXx0cnVlfFt5WV0qKQogICAgY2FzZSAiJG9zdmVycyIgaW4KICAgICopICBsZGZsYWdzPSIt cHRocmVhZCAkbGRmbGFncyIKCgkjIEJvdGggaW4gNC54IGFuZCA1LnggZ2V0aG9zdGJ5YWRkcl9y IGV4aXN0cyBidXQKCSMgaXQgaXMgIlRlbXBvcmFyeSBmdW5jdGlvbiwgbm90IHRocmVhZHNhZmUi Li4uCgkjIFByZXN1bWFibHkgZWFybGllciBpdCBkaWRuJ3QgZXZlbiBleGlzdC4KCWRfZ2V0aG9z dGJ5YWRkcl9yPSJ1bmRlZiIKCWRfZ2V0aG9zdGJ5YWRkcl9yX3Byb3RvPSIwIgoKCTs7CiAgICBl c2FjCmVzYWMKRU9DQlUKCiMgbWFsbG9jIHdyYXAgd29ya3MKY2FzZSAiJHVzZW1hbGxvY3dyYXAi IGluCicnKSB1c2VtYWxsb2N3cmFwPSdkZWZpbmUnIDs7CmVzYWMKCnRlc3QgIiRvcHRpbWl6ZSIg fHwgb3B0aW1pemU9Jy1PMicKCiMgQ29uZmlndXJlIGNhbid0IGZpbmQgZGxvcGVuKCkgd2hlbiB1 c2luZyBnKysKIyBsaW51eCwgZnJlZWJzZCBhbmQgc29sYXJpcyBoaW50cyBoYXZlIHRoZSBzYW1l IHdvcmthcm91bmQKY2FzZSAiJGNjIiBpbgoqZysrKikKICBkX2Rsb3Blbj0nZGVmaW5lJwogIDs7 CmVzYWMK', 'freebsd' => 'IyBPcmlnaW5hbCBiYXNlZCBvbiBpbmZvIGZyb20KIyBDYXJsIE0uIEZvbmdoZWlzZXIgPGNtZkBp bnMuaW5mb25ldC5uZXQ+CiMgRGF0ZTogVGh1LCAyOCBKdWwgMTk5NCAxOToxNzowNSAtMDUwMCAo Q0RUKQojCiMgQWRkaXRpb25hbCAxLjEuNSBkZWZpbmVzIGZyb20gCiMgT2xsaXZpZXIgUm9iZXJ0 IDxPbGxpdmllci5Sb2JlcnRAa2VsdGlhLmZybXVnLmZyLm5ldD4KIyBEYXRlOiBXZWQsIDI4IFNl cCAxOTk0IDAwOjM3OjQ2ICswMTAwIChNRVQpCiMKIyBBZGRpdGlvbmFsIDIuKiBkZWZpbmVzIGZy b20KIyBPbGxpdmllciBSb2JlcnQgPE9sbGl2aWVyLlJvYmVydEBrZWx0aWEuZnJtdWcuZnIubmV0 PgojIERhdGU6IFNhdCwgOCBBcHIgMTk5NSAyMDo1Mzo0MSArMDIwMCAoTUVUIERTVCkKIwojIEFk ZGl0aW9uYWwgMi4wLjUgYW5kIDIuMSBkZWZpbmVkIGZyb20KIyBPbGxpdmllciBSb2JlcnQgPE9s bGl2aWVyLlJvYmVydEBrZWx0aWEuZnJtdWcuZnIubmV0PgojIERhdGU6IEZyaSwgMTIgTWF5IDE5 OTUgMTQ6MzA6MzggKzAyMDAgKE1FVCBEU1QpCiMKIyBBZGRpdGlvbmFsIDIuMiBkZWZpbmVzIGZy b20KIyBNYXJrIE11cnJheSA8bWFya0Bncm9uZGFyLnphPgojIERhdGU6IFdlZCwgNiBOb3YgMTk5 NiAwOTo0NDo1OCArMDIwMCAoTUVUKQojCiMgTW9kaWZpZWQgdG8gZW5zdXJlIHdlIHJlcGxhY2Ug LWxjIHdpdGggLWxjX3IsIGFuZAojIHRvIHB1dCBpbiBwbGFjZS1ob2xkZXJzIGZvciB2YXJpb3Vz IHNwZWNpZmljIGhpbnRzLgojIEFuZHkgRG91Z2hlcnR5IDxkb3VnaGVyYUBsYWZheWV0dGUuZWR1 PgojIERhdGU6IFR1ZSBNYXIgMTAgMTY6MDc6MDAgRVNUIDE5OTgKIwojIFN1cHBvcnQgZm9yIEZy ZWVCU0QvRUxGCiMgT2xsaXZpZXIgUm9iZXJ0IDxyb2JlcnRvQGtlbHRpYS5mcmVlbml4LmZyPgoj IERhdGU6IFdlZCBTZXAgIDIgMTY6MjI6MTIgQ0VTVCAxOTk4CiMKIyBUaGUgdHdvIGZsYWdzICIt ZnBpYyAtRFBJQyIgYXJlIHVzZWQgdG8gaW5kaWNhdGUgYQojIHdpbGwtYmUtc2hhcmVkIG9iamVj dC4gIENvbmZpZ3VyZSB3aWxsIGd1ZXNzIHRoZSAtZnBpYywgKGFuZCB0aGUKIyAtRFBJQyBpcyBu b3QgdXNlZCBieSBwZXJsIHByb3BlcikgYnV0IHRoZSBmdWxsIGRlZmluZSBpcyBpbmNsdWRlZCB0 byAKIyBiZSBjb25zaXN0ZW50IHdpdGggdGhlIEZyZWVCU0QgZ2VuZXJhbCBzaGFyZWQgbGlicyBi dWlsZGluZyBwcm9jZXNzLgojCiMgc2V0cmV1aWQgYW5kIGZyaWVuZHMgYXJlIGluaGVyZW50bHkg YnJva2VuIGluIGFsbCB2ZXJzaW9ucyBvZiBGcmVlQlNECiMgYmVmb3JlIDIuMS1jdXJyZW50IChi ZWZvcmUgYXBwcm94IGRhdGUgNC8xNS85NSkuIEl0IGlzIGZpeGVkIGluIDIuMC41CiMgYW5kIHdo YXQtd2lsbC1iZS0yLjEKIwoKY2FzZSAiJG9zdmVycyIgaW4KMC4qfDEuMCopCgl1c2VkbD0iJHVu ZGVmIgoJOzsKMS4xKikKCW1hbGxvY3R5cGU9J3ZvaWQgKicKCWdyb3Vwc3R5cGU9J2ludCcKCWRf c2V0cmVnaWQ9J3VuZGVmJwoJZF9zZXRyZXVpZD0ndW5kZWYnCglkX3NldHJnaWQ9J3VuZGVmJwoJ ZF9zZXRydWlkPSd1bmRlZicKCTs7CjIuMC1yZWxlYXNlKikKCWRfc2V0cmVnaWQ9J3VuZGVmJwoJ ZF9zZXRyZXVpZD0ndW5kZWYnCglkX3NldHJnaWQ9J3VuZGVmJwoJZF9zZXRydWlkPSd1bmRlZicK CTs7CiMKIyBUcnlpbmcgdG8gY292ZXIgMi4wLjUsIDIuMS1jdXJyZW50IGFuZCBmdXR1cmUgMi4x LzIuMgojIEl0IGRvZXMgbm90IGNvdmVydCBhbGwgMi4xLWN1cnJlbnQgdmVyc2lvbnMgYXMgdGhl IG91dHB1dCBvZiB1bmFtZQojIGNoYW5nZWQgYSBmZXcgdGltZXMuCiMKIyBFdmVuIHRob3VnaCBz ZXRldWlkL3NldGVnaWQgYXJlIGF2YWlsYWJsZSwgdGhleSd2ZSBiZWVuIHR1cm5lZCBvZmYKIyBi ZWNhdXNlIHBlcmwgaXNuJ3QgY29kZWQgd2l0aCBzYXZlZCBzZXRbdWddaWQgdmFyaWFibGVzIGlu IG1pbmQuCiMgSW4gYWRkaXRpb24sIGEgc21hbGwgcGF0Y2ggaXMgcmVxdWlyZWQgdG8gc3VpZHBl cmwgdG8gYXZvaWQgYSBzZWN1cml0eQojIHByb2JsZW0gd2l0aCBGcmVlQlNELgojCjIuMC41Knwy LjAtYnVpbHQqfDIuMSopCiAJdXNldmZvcms9J3RydWUnCgljYXNlICIkdXNlbXltYWxsb2MiIGlu CgkgICAgIiIpIHVzZW15bWFsbG9jPSduJwoJICAgICAgICA7OwoJZXNhYwoJZF9zZXRyZWdpZD0n ZGVmaW5lJwoJZF9zZXRyZXVpZD0nZGVmaW5lJwoJZF9zZXRlZ2lkPSd1bmRlZicKCWRfc2V0ZXVp ZD0ndW5kZWYnCgl0ZXN0IC1yIC4vYnJva2VuLWRiLm1zZyAmJiAuIC4vYnJva2VuLWRiLm1zZwoJ OzsKIwojIDIuMiBhbmQgYWJvdmUgaGF2ZSBwaGttYWxsb2MoMykuCiMgZG9uJ3QgdXNlIC1sbWFs bG9jIChtYXliZSB0aGVyZSdzIGFuIG9sZCBvbmUgZnJvbSAxLjEuNS4xIGZsb2F0aW5nIGFyb3Vu ZCkKMi4yKikKIAl1c2V2Zm9yaz0ndHJ1ZScKCWNhc2UgIiR1c2VteW1hbGxvYyIgaW4KCSAgICAi IikgdXNlbXltYWxsb2M9J24nCgkgICAgICAgIDs7Cgllc2FjCglsaWJzd2FudGVkPWBlY2hvICRs aWJzd2FudGVkIHwgc2VkICdzLyBtYWxsb2MgLyAvJ2AKCWxpYnN3YW50ZWQ9YGVjaG8gJGxpYnN3 YW50ZWQgfCBzZWQgJ3MvIGJpbmQgLyAvJ2AKCSMgaWNvbnYgZ29uZSBpbiBQZXJsIDUuOC4xLCBi dXQgaWYgc29tZW9uZSBjb21waWxlcyA1LjguMCBvciBlYXJsaWVyLgoJbGlic3dhbnRlZD1gZWNo byAkbGlic3dhbnRlZCB8IHNlZCAncy8gaWNvbnYgLyAvJ2AKCWRfc2V0cmVnaWQ9J2RlZmluZScK CWRfc2V0cmV1aWQ9J2RlZmluZScKCWRfc2V0ZWdpZD0nZGVmaW5lJwoJZF9zZXRldWlkPSdkZWZp bmUnCgkjIGRfZG9zdWlkPSdkZWZpbmUnICMgT2Jzb2xldGUuCgk7OwoqKQl1c2V2Zm9yaz0ndHJ1 ZScKCWNhc2UgIiR1c2VteW1hbGxvYyIgaW4KCSAgICAiIikgdXNlbXltYWxsb2M9J24nCgkgICAg ICAgIDs7Cgllc2FjCglsaWJzd2FudGVkPWBlY2hvICRsaWJzd2FudGVkIHwgc2VkICdzLyBtYWxs b2MgLyAvJ2AKCTs7CmVzYWMKCmNhc2UgIiRvc3ZlcnMiIGluCjEwLiopCgkjIGR0cmFjZSBvbiAx MC54IG5lZWRzIGxpYmVsZiBzeW1ib2xzLCBidXQgd2UgZG9uJ3Qga25vdyBpZiB0aGUKCSMgdXNl ciBpcyBnb2luZyB0byByZXF1ZXN0IHVzZWR0cmFjZSBhbmQgdGhlcmUncyBubyAuY2J1IGZvciB1 c2VkdHJhY2UKCWxpYnN3YW50ZWQ9IiRsaWJzd2FudGVkIGVsZiIKCTs7CmVzYWMKCiMgRHluYW1p YyBMb2FkaW5nIGZsYWdzIGhhdmUgbm90IGNoYW5nZWQgbXVjaCwgc28gdGhleSBhcmUgc2VwYXJh dGVkCiMgb3V0IGhlcmUgdG8gYXZvaWQgZHVwbGljYXRpbmcgdGhlbSBldmVyeXdoZXJlLgpjYXNl ICIkb3N2ZXJzIiBpbgowLip8MS4wKikgOzsKCjEuKnwyLiopCgljY2NkbGZsYWdzPSctRFBJQyAt ZnBpYycKCWxkZGxmbGFncz0iLUJzaGFyZWFibGUgJGxkZGxmbGFncyIKCTs7CgozKnw0Knw1Knw2 KikKICAgICAgICBvYmpmb3JtYXQ9YC91c3IvYmluL29iamZvcm1hdGAKICAgICAgICBpZiBbIHgk b2JqZm9ybWF0ID0geGFvdXQgXTsgdGhlbgogICAgICAgICAgICBpZiBbIC1lIC91c3IvbGliL2Fv dXQgXTsgdGhlbgogICAgICAgICAgICAgICAgbGlicHRoPSIvdXNyL2xpYi9hb3V0IC91c3IvbG9j YWwvbGliIC91c3IvbGliIgogICAgICAgICAgICAgICAgZ2xpYnB0aD0iL3Vzci9saWIvYW91dCAv dXNyL2xvY2FsL2xpYiAvdXNyL2xpYiIKICAgICAgICAgICAgZmkKICAgICAgICAgICAgbGRkbGZs YWdzPSctQnNoYXJlYWJsZScKICAgICAgICBlbHNlCiAgICAgICAgICAgIGxpYnB0aD0iL3Vzci9s aWIgL3Vzci9sb2NhbC9saWIiCiAgICAgICAgICAgIGdsaWJwdGg9Ii91c3IvbGliIC91c3IvbG9j YWwvbGliIgogICAgICAgICAgICBsZGZsYWdzPSItV2wsLUUgIgogICAgICAgICAgICBsZGRsZmxh Z3M9Ii1zaGFyZWQgIgogICAgICAgIGZpCiAgICAgICAgY2NjZGxmbGFncz0nLURQSUMgLWZQSUMn CiAgICAgICAgOzsKKikKICAgICAgIGxpYnB0aD0iL3Vzci9saWIgL3Vzci9sb2NhbC9saWIiCiAg ICAgICBnbGlicHRoPSIvdXNyL2xpYiAvdXNyL2xvY2FsL2xpYiIKICAgICAgIGxkZmxhZ3M9Ii1X bCwtRSAiCiAgICAgICAgbGRkbGZsYWdzPSItc2hhcmVkICIKICAgICAgICBjY2NkbGZsYWdzPSct RFBJQyAtZlBJQycKICAgICAgIDs7CmVzYWMKCmNhc2UgIiRvc3ZlcnMiIGluCjAuKnwxLip8Mi4q fDMuKikgOzsKCiopCgljY2ZsYWdzPSIke2NjZmxhZ3N9IC1ESEFTX0ZQU0VUTUFTSyAtREhBU19G TE9BVElOR1BPSU5UX0giCglpZiAvdXNyL2Jpbi9maWxlIC1MIC91c3IvbGliL2xpYmMuc28gfCAv dXNyL2Jpbi9ncmVwIC12cSAibm90IHN0cmlwcGVkIiA7IHRoZW4KCSAgICB1c2VubT1mYWxzZQoJ ZmkKICAgICAgICA7Owplc2FjCgpjYXQgPDwnRU9NJyA+JjQKClNvbWUgdXNlcnMgaGF2ZSByZXBv cnRlZCB0aGF0IENvbmZpZ3VyZSBoYWx0cyB3aGVuIHRlc3RpbmcgZm9yCnRoZSBPX05PTkJMT0NL IHN5bWJvbCB3aXRoIGEgc3ludGF4IGVycm9yLiAgVGhpcyBpcyBhcHBhcmVudGx5IGEKc2ggZXJy b3IuICBSZXJ1bm5pbmcgQ29uZmlndXJlIHdpdGgga3NoIGFwcGFyZW50bHkgZml4ZXMgdGhlCnBy b2JsZW0uICBUcnkKCWtzaCBDb25maWd1cmUgW3lvdXIgb3B0aW9uc10KCkVPTQoKIyBGcm9tOiBB bnRvbiBCZXJlemluIDx0b2JlekBwbGFiLmt1LmRrPgojIFRvOiBwZXJsNS1wb3J0ZXJzQHBlcmwu b3JnCiMgU3ViamVjdDogW1BBVENIIDUuMDA1XzU0XSBDb25maWd1cmUgLSBoaW50cy9mcmVlYnNk LnNoIHNpZ25hbCBoYW5kbGVyIHR5cGUKIyBEYXRlOiAzMCBOb3YgMTk5OCAxOTo0NjoyNCArMDEw MAojIE1lc3NhZ2UtSUQ6IDw4NjRzcmhodmN2LmZzZkBsaW9uLnBsYWIua3UuZGs+CgpzaWduYWxf dD0ndm9pZCcKZF92b2lkc2lnPSdkZWZpbmUnCgojIHNldCBsaWJwZXJsLnNvLlguWCBmb3IgMi4y LlgKY2FzZSAiJG9zdmVycyIgaW4KMi4yKikKICAgICMgdW5mb3J0dW5hdGVseSB0aGlzIGNvZGUg Z2V0cyBleGVjdXRlZCBiZWZvcmUKICAgICMgdGhlIGVxdWl2YWxlbnQgaW4gdGhlIG1haW4gQ29u ZmlndXJlIHNvIHdlIGNvcHkgYSBsaXR0bGUKICAgICMgZnJvbSBDb25maWd1cmUgWFhYIENvbmZp Z3VyZSBzaG91bGQgYmUgZml4ZWQuCiAgICBpZiAkdGVzdCAtciAkc3JjL3BhdGNobGV2ZWwuaDt0 aGVuCiAgICAgICBwYXRjaGxldmVsPWBhd2sgJy9kZWZpbmVbIAldK1BFUkxfVkVSU0lPTi8ge3By aW50ICQzfScgJHNyYy9wYXRjaGxldmVsLmhgCiAgICAgICBzdWJ2ZXJzaW9uPWBhd2sgJy9kZWZp bmVbIAldK1BFUkxfU1VCVkVSU0lPTi8ge3ByaW50ICQzfScgJHNyYy9wYXRjaGxldmVsLmhgCiAg ICBlbHNlCiAgICAgICBwYXRjaGxldmVsPTAKICAgICAgIHN1YnZlcnNpb249MAogICAgZmkKICAg IGxpYnBlcmw9ImxpYnBlcmwuc28uJHBhdGNobGV2ZWwuJHN1YnZlcnNpb24iCiAgICB1bnNldCBw YXRjaGxldmVsCiAgICB1bnNldCBzdWJ2ZXJzaW9uCiAgICA7Owplc2FjCgojIFRoaXMgc2NyaXB0 IFVVL3VzZXRocmVhZHMuY2J1IHdpbGwgZ2V0ICdjYWxsZWQtYmFjaycgYnkgQ29uZmlndXJlIAoj IGFmdGVyIGl0IGhhcyBwcm9tcHRlZCB0aGUgdXNlciBmb3Igd2hldGhlciB0byB1c2UgdGhyZWFk cy4KY2F0ID4gVVUvdXNldGhyZWFkcy5jYnUgPDwnRU9DQlUnCmNhc2UgIiR1c2V0aHJlYWRzIiBp bgokZGVmaW5lfHRydWV8W3lZXSopCiAgICAgICAgbGNfcj1gL3NiaW4vbGRjb25maWcgLXJ8Z3Jl cCAnOi1sY19yJ3xhd2sgJ3twcmludCAkTkZ9J3xzZWQgLW4gJyRwJ2AKICAgICAgICBjYXNlICIk b3N2ZXJzIiBpbiAgCgkwLip8MS4qfDIuMCp8Mi4xKikgICBjYXQgPDxFT00gPiY0CkkgZGlkIG5v dCBrbm93IHRoYXQgRnJlZUJTRCAkb3N2ZXJzIHN1cHBvcnRzIFBPU0lYIHRocmVhZHMuCgpGZWVs IGZyZWUgdG8gcmVwb3J0IHRoYXQgYXQgaHR0cHM6Ly9naXRodWIuY29tL1BlcmwvcGVybDUvaXNz dWVzIG90aGVyd2lzZS4KRU9NCgkgICAgICBleGl0IDEKCSAgICAgIDs7CgogICAgICAgIDIuMi5b MC03XSopCiAgICAgICAgICAgICAgY2F0IDw8RU9NID4mNApQT1NJWCB0aHJlYWRzIGFyZSBub3Qg c3VwcG9ydGVkIHdlbGwgYnkgRnJlZUJTRCAkb3N2ZXJzLgoKUGxlYXNlIGNvbnNpZGVyIHVwZ3Jh ZGluZyB0byBhdCBsZWFzdCBGcmVlQlNEIDIuMi44LApvciBwcmVmZXJhYmx5IHRvIHRoZSBtb3N0 IHJlY2VudCAtUkVMRUFTRSBvciAtU1RBQkxFCnZlcnNpb24gKHNlZSBodHRwOi8vd3d3LmZyZWVi c2Qub3JnL3JlbGVhc2VzLykuCgooV2hpbGUgMi4yLjcgZG9lcyBoYXZlIHB0aHJlYWRzLCBpdCBo YXMgc29tZSBwcm9ibGVtcwogd2l0aCB0aGUgY29tYmluYXRpb24gb2YgdGhyZWFkcyBhbmQgcGlw ZXMgYW5kIHRoZXJlZm9yZQogbWFueSBQZXJsIHRlc3RzIHdpbGwgZWl0aGVyIGhhbmcgb3IgZmFp bC4pCkVPTQoJICAgICAgZXhpdCAxCgkgICAgICA7OwoKCVszLTVdLiopCgkgICAgICBpZiBbICEg LXIgIiRsY19yIiBdOyB0aGVuCgkgICAgICBjYXQgPDxFT00gPiY0ClBPU0lYIHRocmVhZHMgc2hv dWxkIGJlIHN1cHBvcnRlZCBieSBGcmVlQlNEICRvc3ZlcnMgLS0KYnV0IHlvdXIgc3lzdGVtIGlz IG1pc3NpbmcgdGhlIHNoYXJlZCBsaWJjX3IuCigvc2Jpbi9sZGNvbmZpZyAtciBkb2Vzbid0IGZp bmQgYW55KS4KCkNvbnNpZGVyIHVzaW5nIHRoZSBsYXRlc3QgU1RBQkxFIHJlbGVhc2UuCkVPTQoJ CSBleGl0IDEKCSAgICAgIGZpCgkgICAgICAjIDUwMDAxNiBpcyB0aGUgZmlyc3Qgb3NyZWxkYXRl IGluIHdoaWNoIG9uZSBjb3VsZAoJICAgICAgIyBqdXN0IGxpbmsgYWdhaW5zdCBsaWJjX3Igd2l0 aG91dCBkaXNwb3Npbmcgb2YgbGliYwoJICAgICAgIyBhdCB0aGUgc2FtZSB0aW1lLiAgNTAwMDE2 IC4uLiB1cCB0byB3aGF0ZXZlciBpdCB3YXMKCSAgICAgICMgb24gdGhlIDMxc3Qgb2YgQXVndXN0 IDIwMDMgY2FuIHN0aWxsIGJlIHVzZWQgd2l0aCAtcHRocmVhZCwKCSAgICAgICMgYnV0IGl0IGlz IG5vdCBuZWNlc3NhcnkuCgoJICAgICAgIyBBbnRvbiBCZXJlemluIHNheXMgdGhhdCBwb3N0IDUw MHNvbWV0aGluZyB3ZSdyZSB3cm9uZyB0byBiZQoJICAgICAgIyB0byBiZSB1c2luZyAtbGNfciwg YW5kIHNob3VsZCBqdXN0IGJlIHVzaW5nIC1wdGhyZWFkIG9uIHRoZQoJICAgICAgIyBsaW5rZXIg bGluZS4KCSAgICAgICMgU28gcHJlc3VtYWJseSByZWFsbHkgd2Ugc2hvdWxkIGJlIGNoZWNraW5n IHRoYXQgJG9zdmVyIGlzIDUuKikKCSAgICAgICMgYW5kIHRoYXQgYC9zYmluL3N5c2N0bCAtbiBr ZXJuLm9zcmVsZGF0ZWAgLWdlIDUwMDAxNgoJICAgICAgIyBvciAtbHQgNTAwc29tZXRoaW5nIGFu ZCBvbmx5IGluIHRoYXQgcmFuZ2Ugbm90IGRvaW5nIHRoaXM6CgkgICAgICBsZGZsYWdzPSItcHRo cmVhZCAkbGRmbGFncyIKCgkgICAgICAjIEJvdGggaW4gNC54IGFuZCA1LnggZ2V0aG9zdGJ5YWRk cl9yIGV4aXN0cyBidXQKCSAgICAgICMgaXQgaXMgIlRlbXBvcmFyeSBmdW5jdGlvbiwgbm90IHRo cmVhZHNhZmUiLi4uCgkgICAgICAjIFByZXN1bWFibHkgZWFybGllciBpdCBkaWRuJ3QgZXZlbiBl eGlzdC4KCSAgICAgIGRfZ2V0aG9zdGJ5YWRkcl9yPSJ1bmRlZiIKCSAgICAgIGRfZ2V0aG9zdGJ5 YWRkcl9yX3Byb3RvPSIwIgoJICAgICAgOzsKCgkqKQoJICAgICAgIyA3LnggZG9lc24ndCBpbnN0 YWxsIGxpYmNfciBieSBkZWZhdWx0LCBhbmQgQ29uZmlndXJlCgkgICAgICAjIHdvdWxkIGZhaWwg aW4gdGhlIGNvZGUgZm9sbG93aW5nCgkgICAgICAjCgkgICAgICAjIGdldGhvc3RieWFkZHJfcigp IGFwcGVhcnMgdG8gaGF2ZSBiZWVuIGltcGxlbWVudGVkIGluIDYueCsKCSAgICAgIGxkZmxhZ3M9 Ii1wdGhyZWFkICRsZGZsYWdzIgoJICAgICAgOzsKCgllc2FjCgogICAgICAgIGNhc2UgIiRvc3Zl cnMiIGluCiAgICAgICAgWzEtNF0qKQoJICAgIHNldCBgZWNobyBYICIkbGlic3dhbnRlZCAifCBz ZWQgLWUgJ3MvIGMgLyBjX3IgLydgCgkgICAgc2hpZnQKCSAgICBsaWJzd2FudGVkPSIkKiIKCSAg ICA7OwogICAgICAgICopCgkgICAgc2V0IGBlY2hvIFggIiRsaWJzd2FudGVkICJ8IHNlZCAtZSAn cy8gYyAvLydgCgkgICAgc2hpZnQKCSAgICBsaWJzd2FudGVkPSIkKiIKCSAgICA7OwoJZXNhYwoJ ICAgIAoJIyBDb25maWd1cmUgd2lsbCBwcm9iYWJseSBwaWNrIHRoZSB3cm9uZyBsaWJjIHRvIHVz ZSBmb3Igbm0gc2Nhbi4KCSMgVGhlIHNhZmVzdCBxdWljay1maXggaXMganVzdCB0byBub3QgdXNl IG5tIGF0IGFsbC4uLgoJdXNlbm09ZmFsc2UKCiAgICAgICAgY2FzZSAiJG9zdmVycyIgaW4KICAg ICAgICAyLjIuOCopCiAgICAgICAgICAgICMgLi4uIGJ1dCB0aGlzIGRvZXMgbm90IGFwcGx5IGZv ciAyLjIuOCAtIHdlIGtub3cgaXQncyBzYWZlCiAgICAgICAgICAgIGxpYmM9IiRsY19yIgogICAg ICAgICAgICB1c2VubT10cnVlCiAgICAgICAgICAgOzsKICAgICAgICBlc2FjCgogICAgICAgIHVu c2V0IGxjX3IKCgkjIEV2ZW4gd2l0aCB0aGUgbWFsbG9jIG11dGV4ZXMgdGhlIFBlcmwgbWFsbG9j IGRvZXMgbm90CgkjIHNlZW0gdG8gYmUgdGhyZWFkc2FmZSBpbiBGcmVlQlNEPwoJY2FzZSAiJHVz ZW15bWFsbG9jIiBpbgoJJycpIHVzZW15bWFsbG9jPW4gOzsKCWVzYWMKZXNhYwpFT0NCVQoKIyBt YWxsb2Mgd3JhcCB3b3JrcwpjYXNlICIkdXNlbWFsbG9jd3JhcCIgaW4KJycpIHVzZW1hbGxvY3dy YXA9J2RlZmluZScgOzsKZXNhYwoKIyBYWFggVW5kZXIgRnJlZUJTRCA2LjAgKGFuZCBwcm9iYWJs eSBtb3N0IG90aGVyIHNpbWlsYXIgdmVyc2lvbnMpCiMgUGVybF9kaWUoTlVMTCkgZ2VuZXJhdGVz IGEgd2FybmluZzoKIyAgICBwcF9zeXMuYzo0OTE6IHdhcm5pbmc6IG51bGwgZm9ybWF0IHN0cmlu ZwojIENvbmZpZ3VyZSBzdXBwb3NlZGx5IHRlc3RzIGZvciB0aGlzLCBidXQgYXBwYXJlbnRseSB0 aGUgdGVzdCBkb2Vzbid0CiMgd29yay4gIFZvbHVudGVlcnMgd2l0aCBGcmVlQlNEIGFyZSBuZWVk ZWQgdG8gaW1wcm92aW5nIHRoZSBDb25maWd1cmUgdGVzdC4KIyBNZWFud2hpbGUsIHRoZSBmb2xs b3dpbmcgd29ya2Fyb3VuZCBzaG91bGQgYmUgc2FmZSBvbiBhbGwgdmVyc2lvbnMKIyBvZiBGcmVl QlNELgpkX3ByaW50Zl9mb3JtYXRfbnVsbD0ndW5kZWYnCgojIFNlZSBbcGVybCAjMTI4ODY3XQoj IEludGVycHJldGluZzogaHR0cHM6Ly9idWdzLmZyZWVic2Qub3JnL2J1Z3ppbGxhL3Nob3dfYnVn LmNnaT9pZD0yMTE3NDMjYzEwCiMga2h3IHdvcmthcm91bmQgbm8gbG9uZ2VyIG5lZWRlZCBpbiB0 aGUgZm9sbG93aW5nIEZSRUVCU0RfS0VSTkVMX1ZFUlNJT05zCiMxMjAwMDA0IGFuZCB1cAojMTEw MDUwMiA+PSB2ZXJzaW9uIDwgMTIwMDAwMAojMTAwMzUwNyA+PSB2ZXJzaW9uIDwgMTEwMDAwMAoj IEV4cGVyaW1lbnRzIGhhdmUgc2hvd24gdGhhdCB0aGlzIGRvZXNuJ3QgZnVsbHkgd29yay4gIFRo ZSBmaXJzdCBrZXJuZWwgd2Uga25vdyBpdCB3b3JrcyBpcyAxMjAwMDU2CgpGUkVFQlNEX0tFUk5F TF9WRVJTSU9OPWB1bmFtZSAtVWAKI2lmICBbICRGUkVFQlNEX0tFUk5FTF9WRVJTSU9OIC1sdCAx MDAzNTA3IF0gfHwgXAojICAgIFsgJEZSRUVCU0RfS0VSTkVMX1ZFUlNJT04gLWdlIDExMDAwMDAg XSAmJiBbICRGUkVFQlNEX0tFUk5FTF9WRVJTSU9OIC1sdCAxMTAwNTAyIF0gfHwgXAojICAgIFsg JEZSRUVCU0RfS0VSTkVMX1ZFUlNJT04gLWdlIDEyMDAwMDAgXSAmJiBbICRGUkVFQlNEX0tFUk5F TF9WRVJTSU9OIC1sdCAxMjAwMDA0IF0KaWYgIFsgJEZSRUVCU0RfS0VSTkVMX1ZFUlNJT04gLWx0 IDEyMDAwNTYgXQp0aGVuCiAgICBkX3VzZWxvY2FsZT0ndW5kZWYnCmZpCgojIGh0dHBzOi8vZ2l0 aHViLmNvbS9QZXJsL3Blcmw1L2lzc3Vlcy8xNTk4NAojIFJlcG9ydGVkIGluIDExLjAtQ1VSUkVO VCB3aXRoIGcrKy00LjguNToKIyBJZiB1c2luZyBnKyssIHRoZSBDb25maWd1cmUgc2NhbiBmb3Ig ZGxvcGVuKCkgZmFpbHMuCiMgRWFzaWVyIGZvciBub3cgdG8ganVzdCB0byBmb3JjaWJseSBzZXQg aXQuCmNhc2UgIiRjYyIgaW4KKmcrKyopCiAgZF9kbG9wZW49J2RlZmluZScKICA7Owplc2FjCgpj YXNlIGB1bmFtZSAtcGAgaW4KYXJtfG1pcHMpCiAgOzsKKikKICB0ZXN0ICIkb3B0aW1pemUiIHx8 IG9wdGltaXplPSctTzInCiAgOzsKZXNhYwo=', 'gnu' => 'IyBoaW50cy9nbnUuc2gKIyBPcmlnaW5hbGx5IGNvbnRyaWJ1dGVkIGJ5OiAgTWFyayBLZXR0ZW5p cyA8a2V0dGVuaXNAcGh5cy51dmEubmw+IERlYyAxMCAxOTk4CgojIGxpYm5zbCBpcyB1bnVzYWJs ZSBvbiB0aGUgSHVyZC4KIyBYWFggcmVtb3ZlIHRoaXMgb25jZSBTVU5SUEMgaXMgaW1wbGVtZW50 ZWQuCnNldCBgZWNobyBYICIkbGlic3dhbnRlZCAifCBzZWQgLWUgJ3MvIGJzZCAvIC8nIC1lICdz LyBuc2wgLyAvJyAtZSAncy8gYyAvIHB0aHJlYWQgLydgCnNoaWZ0CmxpYnN3YW50ZWQ9IiQqIgoK IyBEZWJpYW4gNC4wIHB1dHMgbmRibSBpbiB0aGUgLWxnZGJtX2NvbXBhdCBsaWJyYXJ5LgpsaWJz d2FudGVkPSIkbGlic3dhbnRlZCBnZGJtX2NvbXBhdCIKCiMgbWFsbG9jIHdyYXAgd29ya3MKY2Fz ZSAiJHVzZW1hbGxvY3dyYXAiIGluCicnKSB1c2VtYWxsb2N3cmFwPSdkZWZpbmUnIDs7CmVzYWMK CiMgVGhlIHN5c3RlbSBtYWxsb2MoKSBpcyBhYm91dCBhcyBmYXN0IGFuZCBhcyBmcnVnYWwgYXMg cGVybCdzLgojIFNpbmNlIHRoZSBzeXN0ZW0gbWFsbG9jKCkgaGFzIGJlZW4gdGhlIGRlZmF1bHQg c2luY2UgYXQgbGVhc3QKIyA1LjAwMSwgd2UgbWlnaHQgYXMgd2VsbCBsZWF2ZSBpdCB0aGF0IHdh eS4gIC0tQUQgIDEwIEphbiAyMDAyCmNhc2UgIiR1c2VteW1hbGxvYyIgaW4KJycpIHVzZW15bWFs bG9jPSduJyA7Owplc2FjCgpjYXNlICIkb3B0aW1pemUiIGluCicnKSBvcHRpbWl6ZT0nLU8yJyA7 Owplc2FjCgpjYXNlICIkcGxpYnB0aCIgaW4KJycpIHBsaWJwdGg9YGdjYyAtcHJpbnQtc2VhcmNo LWRpcnMgfCBncmVwIGxpYnJhcmllcyB8CiAgICAgICAgY3V0IC1mMi0gLWQ9IHwgdHIgJzonICR0 cm5sIHwgZ3JlcCAtdiAnZ2NjJyB8IHNlZCAtZSAnczovJDo6J2AKICAgIHNldCBYICRwbGlicHRo ICMgQ29sbGFwc2UgYWxsIGVudHJpZXMgb24gb25lIGxpbmUKICAgIHNoaWZ0CiAgICBwbGlicHRo PSIkKiIKICAgIDs7CmVzYWMKCmNhc2UgIiRsaWJjIiBpbgonJykKIyBJZiB5b3UgaGF2ZSBnbGli YywgdGhlbiByZXBvcnQgdGhlIHZlcnNpb24gZm9yIC4vbXljb25maWcgYnVnIHJlcG9ydGluZy4K IyAoQ29uZmlndXJlIGRvZXNuJ3QgbmVlZCB0byBrbm93IHRoZSBzcGVjaWZpYyB2ZXJzaW9uIHNp bmNlIGl0IGp1c3QgdXNlcwojIGdjYyB0byBsb2FkIHRoZSBsaWJyYXJ5IGZvciBhbGwgdGVzdHMu KQojIFdlIGRvbid0IHVzZSBfX0dMSUJDX18gYW5kICBfX0dMSUJDX01JTk9SX18gYmVjYXVzZSB0 aGV5CiMgYXJlIGluc3VmZmljaWVudGx5IHByZWNpc2UgdG8gZGlzdGluZ3Vpc2ggdGhpbmdzIGxp a2UKIyBsaWJjLTIuMC42IGFuZCBsaWJjLTIuMC43LgogICAgZm9yIHAgaW4gJHBsaWJwdGgKICAg IGRvCiAgICAgICAgZm9yIHRyeWxpYiBpbiBsaWJjLnNvLjAuMyBsaWJjLnNvCiAgICAgICAgZG8K ICAgICAgICAgICAgaWYgJHRlc3QgLWUgJHAvJHRyeWxpYjsgdGhlbgogICAgICAgICAgICAgICAg bGliYz1gbHMgLWwgJHAvJHRyeWxpYiB8IGF3ayAne3ByaW50ICRORn0nYAogICAgICAgICAgICAg ICAgaWYgJHRlc3QgIlgkbGliYyIgIT0gWDsgdGhlbgogICAgICAgICAgICAgICAgICAgIGJyZWFr CiAgICAgICAgICAgICAgICBmaQogICAgICAgICAgICBmaQogICAgICAgIGRvbmUKICAgICAgICBp ZiAkdGVzdCAiWCRsaWJjIiAhPSBYOyB0aGVuCiAgICAgICAgICAgIGJyZWFrCiAgICAgICAgZmkK ICAgIGRvbmUKICAgIDs7CmVzYWMKCiMgRmxhZ3MgbmVlZGVkIHRvIHByb2R1Y2Ugc2hhcmVkIGxp YnJhcmllcy4KbGRkbGZsYWdzPSctc2hhcmVkJwoKIyBGbGFncyBuZWVkZWQgYnkgcHJvZ3JhbXMg dGhhdCB1c2UgZHluYW1pYyBsaW5raW5nLgpjY2RsZmxhZ3M9Jy1XbCwtRScKCiMgVGhpcyBzY3Jp cHQgVVUvdXNldGhyZWFkcy5jYnUgd2lsbCBnZXQgJ2NhbGxlZC1iYWNrJyBieSBDb25maWd1cmUK IyBhZnRlciBpdCBoYXMgcHJvbXB0ZWQgdGhlIHVzZXIgZm9yIHdoZXRoZXIgdG8gdXNlIHRocmVh ZHMuCmNhdCA+IFVVL3VzZXRocmVhZHMuY2J1IDw8J0VPQ0JVJwpjYXNlICIkdXNldGhyZWFkcyIg aW4KJGRlZmluZXx0cnVlfFt5WV0qKQogICAgICAgIGNjZmxhZ3M9Ii1EX1JFRU5UUkFOVCAtRF9H TlVfU09VUkNFICRjY2ZsYWdzIgogICAgICAgIGlmIGVjaG8gJGxpYnN3YW50ZWQgfCBncmVwIC12 IHB0aHJlYWQgPi9kZXYvbnVsbAogICAgICAgIHRoZW4KICAgICAgICAgICAgc2V0IGBlY2hvIFgg IiRsaWJzd2FudGVkICJ8IHNlZCAtZSAncy8gYyAvIHB0aHJlYWQgYyAvJ2AKICAgICAgICAgICAg c2hpZnQKICAgICAgICAgICAgbGlic3dhbnRlZD0iJCoiCiAgICAgICAgZmkKCgkjIFNvbWVob3cg YXQgbGVhc3QgaW4gRGViaWFuIDIuMiB0aGVzZSBtYW5hZ2UgdG8gZXNjYXBlCgkjIHRoZSAjZGVm aW5lIGZvcmVzdCBvZiA8ZmVhdHVyZXMuaD4gYW5kIDx0aW1lLmg+IHNvIHRoYXQKCSMgdGhlIGhh c3Byb3RvIG1hY3JvIG9mIENvbmZpZ3VyZSBkb2Vzbid0IHNlZSB0aGVzZSBwcm90b3MsCgkjIGV2 ZW4gd2l0aCB0aGUgLURfR05VX1NPVVJDRS4KCglkX2FzY3RpbWVfcl9wcm90bz0iJGRlZmluZSIK CWRfY3J5cHRfcl9wcm90bz0iJGRlZmluZSIKCWRfY3RpbWVfcl9wcm90bz0iJGRlZmluZSIKCWRf Z210aW1lX3JfcHJvdG89IiRkZWZpbmUiCglkX2xvY2FsdGltZV9yX3Byb3RvPSIkZGVmaW5lIgoJ ZF9yYW5kb21fcl9wcm90bz0iJGRlZmluZSIKCgk7Owplc2FjCkVPQ0JVCgpjYXQgPiBVVS91c2Vs YXJnZWZpbGVzLmNidSA8PCdFT0NCVScKIyBUaGlzIHNjcmlwdCBVVS91c2VsYXJnZWZpbGVzLmNi dSB3aWxsIGdldCAnY2FsbGVkLWJhY2snIGJ5IENvbmZpZ3VyZQojIGFmdGVyIGl0IGhhcyBwcm9t cHRlZCB0aGUgdXNlciBmb3Igd2hldGhlciB0byB1c2UgbGFyZ2UgZmlsZXMuCmNhc2UgIiR1c2Vs YXJnZWZpbGVzIiBpbgonJ3wkZGVmaW5lfHRydWV8W3lZXSopCiMgS2VlcCB0aGlzIGluIHRoZSBs ZWZ0IG1hcmdpbi4KY2NmbGFnc191c2VsYXJnZWZpbGVzPSItRF9MQVJHRUZJTEVfU09VUkNFIC1E X0ZJTEVfT0ZGU0VUX0JJVFM9NjQiCgoJY2NmbGFncz0iJGNjZmxhZ3MgJGNjZmxhZ3NfdXNlbGFy Z2VmaWxlcyIKCTs7CmVzYWMKRU9DQlUKCiMgVGhlIGZvbGxvd2luZyByb3V0aW5lcyBhcmUgb25s eSBhdmFpbGFibGUgYXMgc3R1YnMgaW4gR05VIGxpYmMuCiMgWFhYIHJlbW92ZSB0aGlzIG9uY2Ug bWV0YWNvbmYgZGV0ZWN0cyB0aGUgR05VIGxpYmMgc3R1YnMuCmRfbXNnY3RsPSd1bmRlZicKZF9t c2dnZXQ9J3VuZGVmJwpkX21zZ3Jjdj0ndW5kZWYnCmRfbXNnc25kPSd1bmRlZicKZF9zZW1jdGw9 J3VuZGVmJwpkX3NlbWdldD0ndW5kZWYnCmRfc2Vtb3A9J3VuZGVmJwpkX3NobWF0PSd1bmRlZicK ZF9zaG1jdGw9J3VuZGVmJwpkX3NobWR0PSd1bmRlZicKZF9zaG1nZXQ9J3VuZGVmJwo=', 'gnukfreebsd' => 'IyEgL2Jpbi9zaAoKIyBTdXBwb3J0IGZvciBEZWJpYW4gR05VL2tGcmVlQlNEIChrZnJlZWJzZC1n bnUpCiMgQSBwb3J0IG9mIHRoZSBEZWJpYW4gR05VIHN5c3RlbSB1c2luZyB0aGUgRnJlZUJTRCBr ZXJuZWwuCgouIC4vaGludHMvbGludXguc2gKCg==', 'hpux' => 'IyEvdXNyL2Jpbi9zaAoKIyMjIFNZU1RFTSBBUkNISVRFQ1RVUkUKCiMgRGV0ZXJtaW5lIHRoZSBh cmNoaXRlY3R1cmUgdHlwZSBvZiB0aGlzIHN5c3RlbS4KIyBLZWVwIGxlYWRpbmcgdGFiIGJlbG93 IC0tIENvbmZpZ3VyZSBCbGFjayBNYWdpYyAtLSBSQU0sIDAzLzAyLzk3Cgl4eE9zUmV2TWFqb3I9 YHVuYW1lIC1yIHwgc2VkIC1lICdzL15bXjAtOV0qLy8nIHwgY3V0IC1kLiAtZjFgOwoJeHhPc1Jl dk1pbm9yPWB1bmFtZSAtciB8IHNlZCAtZSAncy9eW14wLTldKi8vJyB8IGN1dCAtZC4gLWYyYDsK CXh4T3NSZXY9YGV4cHIgMTAwIFwqICR4eE9zUmV2TWFqb3IgKyAkeHhPc1Jldk1pbm9yYAppZiBb ICIkeHhPc1Jldk1ham9yIiAtZ2UgMTAgXTsgdGhlbgogICAgIyBUaGlzIHN5c3RlbSBpcyBydW5u aW5nID49IDEwLngKCiAgICAjIFRlc3RlZCBvbiAxMC4wMSBQQTEueCBhbmQgMTAuMjAgUEFbMTJd LnguCiAgICAjIElkZWE6IFNjYW4gL3Vzci9pbmNsdWRlL3N5cy91bmlzdGQuaCBmb3IgbWF0Y2hl cyB3aXRoCiAgICAjICIjZGVmaW5lIENQVV8qIGBnZXRjb25mICMgQ1BVX1ZFUlNJT05gIiB0byBk ZXRlcm1pbmUgQ1BVIHR5cGUuCiAgICAjIE5vdGUgdGhlIHRleHQgZm9sbG93aW5nICJDUFVfIiBp cyB1c2VkLCAqTk9UKiB0aGUgY29tbWVudC4KICAgICMKICAgICMgQVNTVU1QVElPTlM6IE51bWJl cnMgd2lsbCBjb250aW51ZSB0byBiZSBkZWZpbmVkIGluIGhleCAtLSBhbmQgaW4KICAgICMgL3Vz ci9pbmNsdWRlL3N5cy91bmlzdGQuaCAtLSBhbmQgdGhlIENQVV8qICNkZWZpbmVzIHdpbGwgYmUg a2VwdAogICAgIyB1cCB0byBkYXRlIHdpdGggbmV3IENQVS9PUyByZWxlYXNlcy4KICAgIHh4Y3B1 PWBnZXRjb25mIENQVV9WRVJTSU9OYDsgIyBHZXQgdGhlIG51bWJlci4KICAgIHh4Y3B1PWBwcmlu dGYgJzB4JXgnICR4eGNwdWA7ICMgY29udmVydCB0byBoZXgKICAgIGFyY2huYW1lPWBzZWQgLW4g LWUgInMvXiNbWzpzcGFjZTpdXSpkZWZpbmVbWzpzcGFjZTpdXSpDUFVfLy9wIiAvdXNyL2luY2x1 ZGUvc3lzL3VuaXN0ZC5oIHwKCXNlZCAtbiAtZSAicy9bWzpzcGFjZTpdXSokeHhjcHVbWzpzcGFj ZTpdXS4qLy9wIiB8CglzZWQgLWUgcy9fUklTQy8tUklTQy8gLWUgcy9IUF8vLyAtZSBzL18vLi8g LWUgInMvW1s6c3BhY2U6XV0qLy9nImA7CmVsc2UKICAgICMgVGhpcyBzeXN0ZW0gaXMgcnVubmlu ZyA8PSA5LngKICAgICMgVGVzdGVkIG9uIDkuMFs1N10gUEEgYW5kIFs3OF0uMCBNQzY4MFsyM10w LiAgSWRlYTogQWZ0ZXIgcmVtb3ZpbmcKICAgICMgTUM2ODg4WzEyXSBmcm9tIGNvbnRleHQgc3Ry aW5nLCB1c2UgZmlyc3QgQ1BVIGlkZW50aWZpZXIuCiAgICAjCiAgICAjIEFTU1VNUFRJT046IE9u bHkgQ1BVIGlkZW50aWZpZXJzIGNvbnRhaW4gbm8gbG93ZXJjYXNlIGxldHRlcnMuCiAgICBhcmNo bmFtZT1gZ2V0Y29udGV4dCB8IHRyICcgJyAnXDAxMicgfCBncmVwIC12ICdbYS16XScgfCBncmVw IC12IE1DNjg4IHwKCXNlZCAtZSAncy9IUC0vLycgLWUgMXFgOwogICAgc2VsZWN0dHlwZT0naW50 IConCiAgICBmaQoKIyBGb3Igc29tZSBzdHJhbmdlIHJlYXNvbiwgdGhlIHUzMmFsaWduIHRlc3Qg ZnJvbSBDb25maWd1cmUgaGFuZ3MgaW4KIyBIUC1VWCAxMC4yMCBzaW5jZSB0aGUgRGVjZW1iZXIg MjAwMSBwYXRjaGVzLiAgU28gaGludCBpdCB0byBhdm9pZAojIHRoZSB0ZXN0LgppZiBbICIkeHhP c1Jldk1ham9yIiAtbGUgMTAgXTsgdGhlbgogICAgZF91MzJhbGlnbj0kZGVmaW5lCiAgICBmaQoK ZWNobyAiQXJjaG5hbWUgaXMgJGFyY2huYW1lIgoKIyBGaXggWFNsaWIgKENQQU4pIGNvbmZ1c2lv biB3aGVuIHJlLXVzaW5nIGEgcHJlZml4IGJ1dCBjaGFuZ2luZyBmcm9tIElMUDMyCiMgdG8gTFA2 NCBidWlsZHMuICBUaGV5J3JlIE5PVCBiaW5hcnkgY29tcGF0aWJsZSwgc28gcXVpdCBjbGFpbWlu ZyB0aGV5IGFyZS4KYXJjaG5hbWU2ND1MUDY0CgoKIyMjIEhQLVVYIE9TIHNwZWNpZmljIGJlaGF2 aW91cgoKIyAtbGRibSBpcyBvYnNvbGV0ZSBhbmQgc2hvdWxkIG5vdCBiZSB1c2VkCiMgLWxCU0Qg Y29udGFpbnMgQlNELXN0eWxlIGR1cGxpY2F0ZXMgb2YgU1ZSNCByb3V0aW5lcyB0aGF0IGNhdXNl IGNvbmZ1c2lvbgojIC1sUFcgaXMgb2Jzb2xldGUgYW5kIHNob3VsZCBub3QgYmUgdXNlZAojIFRo ZSBsaWJyYXJpZXMgY3J5cHQsIG1hbGxvYywgbmRpciwgYW5kIG5ldCBhcmUgZW1wdHkuCnNldCBg ZWNobyAiWCAkbGlic3dhbnRlZCAiIHwgc2VkIC1lICdzLyBsZCAvIC8nIC1lICdzLyBkYm0gLyAv JyAtZSAncy8gQlNEIC8gLycgLWUgJ3MvIFBXIC8gLydgCnNoaWZ0CmxpYnN3YW50ZWQ9IiQqIgoK Y2M9JHtjYzotY2N9CmFyPS91c3IvYmluL2FyCSMgWWVzLCB0cnVseSBvdmVycmlkZS4gIFdlIGRv IG5vdCB3YW50IHRoZSBHTlUgYXIuCmZ1bGxfYXI9JGFyCSMgSSByZXBlYXQsIG5vIEdOVSBhci4g IGFycnIuCgpzZXQgYGVjaG8gIlggJGNjZmxhZ3MgIiB8IHNlZCAtZSAncy8gLUFbZWFdIC8gLycg LWUgJ3MvIC1EX0hQVVhfU09VUkNFIC8gLydgCnNoaWZ0CgljY19jcHBmbGFncz0iJCogLURfSFBV WF9TT1VSQ0UiCmNwcGZsYWdzPSItQWEgLURfX1NURENfRVhUX18gJGNjX2NwcGZsYWdzIgoKY2Fz ZSAiJHByZWZpeCIgaW4KICAgICIiKSBwcmVmaXg9Jy9vcHQvcGVybDUnIDs7CiAgICBlc2FjCgog ICAgZ251X2FzPW5vCiAgICBnbnVfbGQ9bm8KY2FzZSBgJGNjIC12IDI+JjFgIiIgaW4KICAgICpn Y2MqKSAgY2Npc2djYz0iJGRlZmluZSIKCSAgICBjY2ZsYWdzPSIkY2NfY3BwZmxhZ3MiCgkgICAg aWYgWyAiWCRnY2N2ZXJzaW9uIiA9ICJYIiBdOyB0aGVuCgkJIyBEb25lIHRvbyBsYXRlIGluIENv bmZpZ3VyZSBpZiBoaW50ZWQKCQlnY2N2ZXJzaW9uPWAkY2MgLWR1bXB2ZXJzaW9uYAoJCWZpCgkg ICAgY2FzZSAiJGdjY3ZlcnNpb24iIGluCgkJWzAxMl0qKSAjIEhQLVVYIGFuZCBnY2MtMi4qIGJy ZWFrIFVJTlQzMl9NQVggOi0oCgkJICAgIGNjZmxhZ3M9IiRjY2ZsYWdzIC1EVUlOVDMyX01BWF9C Uk9LRU4iCgkJICAgIDs7CgkJWzM0XSopICMgR0NDIChib3RoIDMyYml0IGFuZCA2NGJpdCkgd2ls bCBkZWZpbmUgX19TVERDX0VYVF9fCiAgICAgICAgICAgICAgICAgICAgICAgIyBieSBkZWZhdWx0 IHdoZW4gdXNpbmcgR0NDIDMuMCBhbmQgbmV3ZXIgdmVyc2lvbnMgb2YKICAgICAgICAgICAgICAg ICAgICAgICAjIHRoZSBjb21waWxlci4KCQkgICBjcHBmbGFncz0iJGNjX2NwcGZsYWdzIgoJCSAg IDs7CgkJZXNhYwoJICAgIGNhc2UgImBnZXRjb25mIEtFUk5FTF9CSVRTIDI+L2Rldi9udWxsYCIg aW4KCQkqNjQqKQoJCSAgICBlY2hvICJtYWluKCl7fSI+dHJ5LmMKCQkgICAgY2FzZSAiJGdjY3Zl cnNpb24iIGluCgkJCVszNF0qKQoJCQkgICAgY2FzZSAiJGFyY2huYW1lIiBpbgogICAgICAgICAg ICAgICAgICAgICAgICAgICAgICAgUEEtUklTQyopCiAgICAgICAgICAgICAgICAgICAgICAgICAg ICAgICAgICAgY2FzZSAiJGNjZmxhZ3MiIGluCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAg ICAgICAgICAgICotbXBhLXJpc2MqKSA7OwogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg ICAgICAgICAqKSBjY2ZsYWdzPSIkY2NmbGFncyAtbXBhLXJpc2MtMi0wIiA7OwogICAgICAgICAg ICAgICAgICAgICAgICAgICAgICAgICAgICAgICBlc2FjCiAgICAgICAgICAgICAgICAgICAgICAg ICAgICAgICAgICAgOzsKCQkJCWVzYWMKCQkJICAgIDs7CgkJCSopICAjIGdjYyB3aXRoIGdhcyB3 aWxsIG5vdCBhY2NlcHQgK0RBMi4wCgkJCSAgICBjYXNlICJgJGNjIC1jIC1XYSwrREEyLjAgdHJ5 LmMgMj4mMWAiIGluCgkJCQkqIitEQTIuMCIqKQkJIyBnYXMKCQkJCSAgICBnbnVfYXM9eWVzCgkJ CQkgICAgOzsKCQkJCSopCQkJIyBIUGFzCgkJCQkgICAgY2NmbGFncz0iJGNjZmxhZ3MgLVdhLCtE QTIuMCIKCQkJCSAgICA7OwoJCQkJZXNhYwoJCQkgICAgOzsKCQkJZXNhYwoJCSAgICAjIGdjYyB3 aXRoIGdsZCB3aWxsIG5vdCBhY2NlcHQgK3Zub2NvbXBhdHdhcm5pbmdzCgkJICAgIGNhc2UgImAk Y2MgLW8gdHJ5IC1XbCwrdm5vY29tcGF0d2FybmluZ3MgdHJ5LmMgMj4mMWAiIGluCgkJCSoiK3Zu b2NvbXBhdCIqKQkJIyBnbGQKCQkJICAgIGdudV9sZD15ZXMKCQkJICAgIDs7CgkJCSopCQkJIyBI UGxkCgkJCSAgIGNhc2UgIiRnY2N2ZXJzaW9uIiBpbgoJCQkgICAgICAgWzEyXSopCgkJCQkgICAj IFdoeSBub3QgMyBhcyB3ZWxsIGhlcmU/CgkJCQkgICAjIFNpbmNlIG5vdCByZWxldmFudCB0byBJ QTY0LCBub3QgY2hhbmdlZC4KCQkJCSAgIGxkZmxhZ3M9IiRsZGZsYWdzIC1XbCwrdm5vY29tcGF0 d2FybmluZ3MiCgkJCQkgICBjY2ZsYWdzPSIkY2NmbGFncyAtV2wsK3Zub2NvbXBhdHdhcm5pbmdz IgoJCQkJICAgOzsKCQkJICAgICAgIGVzYWMKCQkJICAgIDs7CgkJCWVzYWMKCQkgICAgcm0gLWYg dHJ5LmMKCQkgICAgOzsKCQllc2FjCgkgICAgOzsKICAgICopICAgICAgY2Npc2djYz0nJwoJICAg ICMgV2hhdCBjYW5ub3QgYmUgdXNlIGluIGNvbWJpbmF0aW9uIHdpdGggY2NhY2hlIGxpbmtzIDoo CgkgICAgY2NfZm91bmQ9IiIKCSAgICBmb3IgcCBpbiBgZWNobyAkUEFUSCB8IHRyIDogJyAnJ2Ag OyBkbwoJCXg9IiRwL2NjIgoJCWlmIFsgLWYgJHggXSAmJiBbIC14ICR4IF07IHRoZW4KCQkgICAg aWYgWyAtaCAkeCBdOyB0aGVuCgkJCWw9YGxzIC1sICR4IHwgc2VkICdzLC4qLT4gLCwnYAoJCQlj YXNlICRsIGluCgkJCSAgICAvKikgeD0kbAkJOzsKCQkJICAgICopICB4PSIkcC8kbCIJOzsKCQkJ ICAgIGVzYWMKCQkJZmkKCQkgICAgeD1gZWNobyAkeCB8IHNlZCAncywvXC4vLC8sZydgCgkJICAg IGNhc2UgJHggaW4KCQkJKmNjYWNoZSopIDs7CgkJCSopIFsgLXogIiRjY19mb3VuZCIgXSAmJiBj Y19mb3VuZD0keCA7OwoJCQllc2FjCgkJICAgIGZpCgkJZG9uZQoJICAgIFsgLXogIiRjY19mb3Vu ZCIgXSAmJiBjY19mb3VuZD1gd2hpY2ggY2NgCgkgICAgd2hhdCAkY2NfZm91bmQgPiY0CgkgICAg Y2N2ZXJzaW9uPWB3aGF0ICRjY19mb3VuZCB8IGF3ayAnL0NvbXBpbGVyL3twcmludCAkMn0vSXRh bml1bS97cHJpbnQgJDYsJDd9L2ZvciBJbnRlZ3JpdHkve3ByaW50ICQ2LCQ3fSdgCgkgICAgY2Fz ZSAiJGNjZmxhZ3MiIGluCiAgICAgICAgICAgICAgICItQWUgIiopIDs7CgkJKikgIGNjZmxhZ3M9 Ii1BZSAtV3AsLUgxNTAwMDAgJGNjX2NwcGZsYWdzIgoJCSAgICAjICt2bm9jb21wYXR3YXJuaW5n cyBub3Qga25vd24gaW4gMTAuMTAgYW5kIG9sZGVyCgkJICAgIGlmIFsgJHh4T3NSZXYgLWdlIDEw MjAgXTsgdGhlbgoJCQljY2ZsYWdzPSIkY2NmbGFncyAtV2wsK3Zub2NvbXBhdHdhcm5pbmdzIgoJ CQlmaQoJCSAgICA7OwogICAgICAgICAgICAgICBlc2FjCgkgICAgIyBOZWVkZWQgYmVjYXVzZSBj cHAgZG9lcyBvbmx5IHN1cHBvcnQgLUFhIChub3QgLUFlKQoJICAgIGNwcGxhc3Q9Jy0nCgkgICAg Y3BwbWludXM9Jy0nCgkgICAgY3Bwc3RkaW49J2NjIC1FIC1BYSAtRF9fU1REQ19FWFRfXycKCSAg ICBjcHBydW49JGNwcHN0ZGluCiMJICAgIGNhc2UgIiRkX2Nhc3RpMzIiIGluCiMJCSIiKSBkX2Nh c3RpMzI9J3VuZGVmJyA7OwojCQllc2FjCgkgICAgOzsKICAgIGVzYWMKCiMgV2hlbiBIUC1VWCBy dW5zIGEgc2NyaXB0IHdpdGggIiMhIiwgaXQgc2V0cyBhcmd2WzBdIHRvIHRoZSBzY3JpcHQgbmFt ZS4KdG9rZV9jZmxhZ3M9J2NjZmxhZ3M9IiRjY2ZsYWdzIC1EQVJHX1pFUk9fSVNfU0NSSVBUIicK CiMjIyA2NCBCSVRORVNTCgojIFNvbWUgZ2NjIHZlcnNpb25zIGRvIG5hdGl2ZSA2NCBiaXQgbG9u ZyAoZS5nLiAyLjktaHBwYS0wMDAzMTAgYW5kIGdjYy0zLjApCiMgV2UgaGF2ZSB0byBmb3JjZSA2 NGJpdG5lc3MgdG8gZ28gc2VhcmNoIHRoZSByaWdodCBsaWJyYXJpZXMKICAgIGdjY182NG5hdGl2 ZT1ubwpjYXNlICIkY2Npc2djYyIgaW4KICAgICRkZWZpbmV8dHJ1ZXxbWXldKQoJZWNobyAnI2lu Y2x1ZGUgPHN0ZGlvLmg+XG5pbnQgbWFpbigpe2xvbmcgbDtwcmludGYoIiVkXFxuIixzaXplb2Yo bCkpO30nPnRyeS5jCgkkY2MgLW8gdHJ5ICRjY2ZsYWdzICRsZGZsYWdzIHRyeS5jCglpZiBbICJg dHJ5YCIgPSAiOCIgXTsgdGhlbgoJICAgIGNhc2UgIiR1c2U2NGJpdGFsbCIgaW4KCQkkZGVmaW5l fHRydWV8W1l5XSkgOzsKCQkqKSAgY2F0IDw8RU9NID4mNAoKKioqIFRoaXMgdmVyc2lvbiBvZiBn Y2MgdXNlcyA2NCBiaXQgbG9uZ3MuIC1EdXNlNjRiaXRhbGwgaXMKKioqIGltcGxpY2l0bHkgc2V0 IHRvIGVuYWJsZSBjb250aW51YXRpb24KRU9NCgkJZXNhYwoJICAgIHVzZTY0Yml0YWxsPSRkZWZp bmUKCSAgICBnY2NfNjRuYXRpdmU9eWVzCgkgICAgZmkKCTs7CiAgICBlc2FjCgpjYXNlICIkdXNl NjRiaXRhbGwiIGluCiAgICAkZGVmaW5lfHRydWV8W3lZXSopIHVzZTY0Yml0aW50PSIkZGVmaW5l IiA7OwogICAgZXNhYwoKY2FzZSAiJHVzZW1vcmViaXRzIiBpbgogICAgJGRlZmluZXx0cnVlfFt5 WV0qKSB1c2U2NGJpdGludD0iJGRlZmluZSI7IHVzZWxvbmdkb3VibGU9IiRkZWZpbmUiIDs7CiAg ICBlc2FjCgojIFRoZXJlIGlzIGEgd2VpcmQgcHJlLUM5OSBsb25nIGRvdWJsZSAoYSBzdHJ1Y3Qg b2YgZm91ciB1aW4zMl90KQojIGluIEhQLVVYIDEwLjIwIGJ1dCBiZXlvbmQgc3RydG9sZCgpIHRo ZXJlJ3Mgbm8gc3VwcG9ydCBmb3IgdGhlbQojIGZvciBleGFtcGxlIGluIDxtYXRoLmg+LgpjYXNl ICIkdXNlbG9uZ2RvdWJsZSIgaW4KICAgICRkZWZpbmV8dHJ1ZXxbeVldKikKCWlmIFsgIiR4eE9z UmV2TWFqb3IiIC1sdCAxMSBdOyB0aGVuCgkgICAgY2F0IDw8RU9NID4mNAoKKioqIHVzZWxvbmdk b3VibGUgKG9yIHVzZW1vcmViaXRzKSBpcyBub3Qgc3VwcG9ydGVkIG9uIEhQLVVYICR4eE9zUmV2 TWFqb3IuCioqKiBZb3UgbmVlZCBhdCBsZWFzdCBIUC1VWCAxMS4wLgoqKiogQ2Fubm90IGNvbnRp bnVlLCBhYm9ydGluZy4KRU9NCgkgICAgZXhpdCAxCglmaQoJOzsKICAgIGVzYWMKCiMgQ29uZmln dXJlIGxvbmcgZG91YmxlIHNjYW4gd2lsbCBkZXRlY3QgdGhlIEhQLVVYIDEwLjIwICJsb25nIGRv dWJsZSIKIyAoYSBzdHJ1Y3Qgb2YgZm91ciB1aW4zMl90KSBhbmQgdGhpbmsgaXQgaXMgSUVFRSBx dWFkLiAgTWFrZSBpdCBub3Qgc28uCmlmIFsgIiR4eE9zUmV2TWFqb3IiIC1sdCAxMSBdOyB0aGVu CiAgICBkX2xvbmdkYmw9IiR1bmRlZiIKICAgIGxvbmdkYmxzaXplPTggIyBNYWtlIGl0IGRvdWJs ZS4KZmkKCmNhc2UgIiRhcmNobmFtZSIgaW4KICAgIElBNjQqKQoJIyBXaGlsZSBoZXJlLCBvdmVy cmlkZSBzbz1zbCBhdXRvLWRldGVjdGlvbgoJc289J3NvJwoJOzsKICAgIGVzYWMKCmNhc2UgIiR1 c2U2NGJpdGFsbCIgaW4KICAgICRkZWZpbmV8dHJ1ZXxbWXldKQoKCWlmIFsgIiR4eE9zUmV2TWFq b3IiIC1sdCAxMSBdOyB0aGVuCgkgICAgY2F0IDw8RU9NID4mNAoKKioqIDY0LWJpdCBjb21waWxh dGlvbiBpcyBub3Qgc3VwcG9ydGVkIG9uIEhQLVVYICR4eE9zUmV2TWFqb3IuCioqKiBZb3UgbmVl ZCBhdCBsZWFzdCBIUC1VWCAxMS4wLgoqKiogQ2Fubm90IGNvbnRpbnVlLCBhYm9ydGluZy4KRU9N CgkgICAgZXhpdCAxCgkgICAgZmkKCglpZiBbICR4eE9zUmV2IC1lcSAxMTAwIF07IHRoZW4KCSAg ICAjIEhQLVVYIDExLjAwIHVzZXMgb25seSA0OCBiaXRzIGludGVybmFsbHkgaW4gNjRiaXQgbW9k ZSwgbm90IDY0CgkgICAgIyBmb3JjZSBtaW4vbWF4IHRvIDIqKjQ3LTEKCSAgICBzR01USU1FX21h eD0xNDA3Mzc0ODgzNTUzMjcKCSAgICBzR01USU1FX21pbj0tNjIxNjcyMTkyMDAKCSAgICBzTE9D QUxUSU1FX21heD0xNDA3Mzc0ODgzNTUzMjcKCSAgICBzTE9DQUxUSU1FX21pbj0tNjIxNjcyMTky MDAKCSAgICBmaQoKCSMgU2V0IGxpYmMgYW5kIHRoZSBsaWJyYXJ5IHBhdGhzCgljYXNlICIkYXJj aG5hbWUiIGluCgkgICAgUEEtUklTQyopCgkJbG9jbGlicHRoPSIkbG9jbGlicHRoIC9saWIvcGEy MF82NCIKCQlsaWJjPScvbGliL3BhMjBfNjQvbGliYy5zbCcgOzsKCSAgICBJQTY0KikKCQlsb2Ns aWJwdGg9IiRsb2NsaWJwdGggL3Vzci9saWIvaHB1eDY0IgoJCWxpYmM9Jy91c3IvbGliL2hwdXg2 NC9saWJjLnNvJyA7OwoJICAgIGVzYWMKCWlmIFsgISAtZiAiJGxpYmMiIF07IHRoZW4KCSAgICBj YXQgPDxFT00gPiY0CgoqKiogWW91IGRvIG5vdCBzZWVtIHRvIGhhdmUgdGhlIDY0LWJpdCBsaWJj LgoqKiogSSBjYW5ub3QgZmluZCB0aGUgZmlsZSAkbGliYy4KKioqIENhbm5vdCBjb250aW51ZSwg YWJvcnRpbmcuCkVPTQoJICAgIGV4aXQgMQoJICAgIGZpCgoJY2FzZSAiJGNjaXNnY2MiIGluCgkg ICAgJGRlZmluZXx0cnVlfFtZeV0pCgkJIyBUaGUgZml4ZWQgc29ja2V0LmggaGVhZGVyIGZpbGUg aXMgd3JvbmcgZm9yIGdjYy00LngKCQkjIG9uIFBBLVJJU0MyLjBXLCBzbyBTb2NrX3R5cGVfdCBp cyBzaXplX3Qgd2hpY2ggaXMKCQkjIHVuc2lnbmVkIGxvbmcgd2hpY2ggaXMgNjRiaXQgd2hpY2gg aXMgdG9vIGxvbmcKCQljYXNlICIkZ2NjdmVyc2lvbiIgaW4KCQkgICAgNCopIGNhc2UgIiRhcmNo bmFtZSIgaW4KCQkJICAgIFBBLVJJU0MqKSBzb2Nrc2l6ZXR5cGU9aW50IDs7CgkJCSAgICBlc2Fj CgkJCTs7CgkJICAgIGVzYWMKCgkJIyBGb3IgdGhlIG1vbWVudCwgZG9uJ3QgY2FyZSB0aGF0IGl0 IGFpbid0IHN1cHBvcnRlZCAoeWV0KQoJCSMgYnkgZ2NjICh1cCB0byBhbmQgaW5jbHVkaW5nIDIu OTUuMyksIGNhdXNlIGl0J2xsIGNyYXNoCgkJIyBhbnl3YXkuIEV4cGVjdCBhdXRvLWRldGVjdGlv biBvZiA2NC1iaXQgZW5hYmxlZCBnY2Mgb24KCQkjIEhQLVVYIHNvb24sIGluY2x1ZGluZyBhIHVz ZXItZnJpZW5kbHkgZXhpdAoJCWNhc2UgJGdjY182NG5hdGl2ZSBpbgoJCSAgICBubykgY2FzZSAi JGdjY3ZlcnNpb24iIGluCgkJCSAgICBbMTIzNF0qKQoJCQkJY2NmbGFncz0iJGNjZmxhZ3MgLW1s cDY0IgoJCQkJY2FzZSAiJGFyY2huYW1lIiBpbgoJCQkJICAgIFBBLVJJU0MqKQoJCQkJCWxkZmxh Z3M9IiRsZGZsYWdzIC1XbCwrREQ2NCIKCQkJCQk7OwoJCQkJICAgIElBNjQqKQoJCQkJCWxkZmxh Z3M9IiRsZGZsYWdzIC1tbHA2NCIKCQkJCQk7OwoJCQkJICAgIGVzYWMKCQkJCTs7CgkJCSAgICBl c2FjCgkJCTs7CgkJICAgIGVzYWMKCQk7OwoJICAgICopCgkJY2FzZSAiJHVzZTY0Yml0YWxsIiBp bgoJCSAgICAkZGVmaW5lfHRydWV8W3lZXSopCgkJCWNjZmxhZ3M9IiRjY2ZsYWdzICtERDY0IgoJ CQlsZGZsYWdzPSIkbGRmbGFncyArREQ2NCIKCQkJOzsKCQkgICAgZXNhYwoJCTs7CgkgICAgZXNh YwoKCSMgUmVzZXQgdGhlIGxpYnJhcnkgY2hlY2tlciB0byBtYWtlIHN1cmUgbGlicmFyaWVzCgkj IGFyZSB0aGUgcmlnaHQgdHlwZQoJIyAoTk9URTogb24gSUE2NCwgdGhpcyBkb2Vzbid0IHdvcmsg d2l0aCAuYSBmaWxlcy4pCglsaWJzY2hlY2s9J2Nhc2UgImAvdXNyL2Jpbi9maWxlICR4eHhgIiBp bgoJCSAgICAgICAqRUxGLTY0KnwqTFA2NCp8KlBBLVJJU0MyLjAqKSA7OwoJCSAgICAgICAqKSB4 eHg9L25vLzY0LWJpdCR4eHggOzsKCQkgICAgICAgZXNhYycKCgk7OwoKICAgICopCSMgTm90IGlu IDY0LWJpdCBtb2RlCgoJY2FzZSAiJGFyY2huYW1lIiBpbgoJICAgIFBBLVJJU0MqKQoJCWxpYmM9 Jy9saWIvbGliYy5zbCcgOzsKCSAgICBJQTY0KikKCQlsb2NsaWJwdGg9IiRsb2NsaWJwdGggL3Vz ci9saWIvaHB1eDMyIgoJCWxpYmM9Jy91c3IvbGliL2hwdXgzMi9saWJjLnNvJyA7OwoJICAgIGVz YWMKCTs7CiAgICBlc2FjCgojIEJ5IHNldHRpbmcgdGhlIGRlZmVycmVkIGZsYWcgYmVsb3csIHRo aXMgbWVhbnMgdGhhdCBpZiB5b3UgcnVuIHBlcmwKIyBvbiBhIHN5c3RlbSB0aGF0IGRvZXMgbm90 IGhhdmUgdGhlIHJlcXVpcmVkIHNoYXJlZCBsaWJyYXJ5IHRoYXQgeW91CiMgbGlua2VkIGl0IHdp dGgsIGl0IHdpbGwgZGllIHdoZW4geW91IHRyeSB0byBhY2Nlc3MgYSBzeW1ib2wgaW4gdGhlCiMg KG1pc3NpbmcpIHNoYXJlZCBsaWJyYXJ5LiAgSWYgeW91IHdvdWxkIHJhdGhlciBrbm93IGF0IHBl cmwgc3RhcnR1cAojIHRpbWUgdGhhdCB5b3UgYXJlIG1pc3NpbmcgYW4gaW1wb3J0YW50IHNoYXJl ZCBsaWJyYXJ5LCBzd2l0Y2ggdGhlCiMgY29tbWVudHMgc28gdGhhdCBpbW1lZGlhdGUsIHJhdGhl ciB0aGFuIGRlZmVycmVkIGxvYWRpbmcgaXMKIyBwZXJmb3JtZWQuICBFdmVuIHdpdGggaW1tZWRp YXRlIGxvYWRpbmcsIHlvdSBjYW4gcG9zdHBvbmUgZXJyb3JzIGZvcgojIHVuZGVmaW5lZCAob3Ig bXVsdGlwbHkgZGVmaW5lZCkgcm91dGluZXMgdW50aWwgYWN0dWFsIGFjY2VzcyBieQojIGFkZGlu ZyB0aGUgIm5vbmZhdGFsIiBvcHRpb24uCiMgY2NkbGZsYWdzPSItV2wsLUUgLVdsLC1CLGltbWVk aWF0ZSAkY2NkbGZsYWdzIgojIGNjZGxmbGFncz0iLVdsLC1FIC1XbCwtQixpbW1lZGlhdGUsLUIs bm9uZmF0YWwgJGNjZGxmbGFncyIKaWYgWyAiJGdudV9sZCIgPSAieWVzIiBdOyB0aGVuCiAgICBj Y2RsZmxhZ3M9Ii1XbCwtRSAkY2NkbGZsYWdzIgplbHNlCiAgICBjY2RsZmxhZ3M9Ii1XbCwtRSAt V2wsLUIsZGVmZXJyZWQgJGNjZGxmbGFncyIKICAgIGZpCgoKIyMjIENPTVBJTEVSIFNQRUNJRklD UwoKIyMgTG9jYWwgcmVzdHJpY3Rpb25zIChwb2ludCB0byBSRUFETUUuaHB1eCB0byBsaWZ0IHRo ZXNlKQoKIyMgT3B0aW1pemF0aW9uIGxpbWl0cwpjYXQgPnRyeS5jIDw8RU9GCiNpbmNsdWRlIDxz dGRpby5oPgojaW5jbHVkZSA8c3lzL3Jlc291cmNlLmg+CgppbnQgbWFpbiAoKQp7CiAgICBzdHJ1 Y3QgcmxpbWl0IHJsOwogICAgaW50IGkgPSBnZXRybGltaXQgKFJMSU1JVF9EQVRBLCAmcmwpOwog ICAgcHJpbnRmICgiJWRcbiIsIChpbnQpKHJsLnJsaW1fY3VyIC8gKDEwMjQgKiAxMDI0KSkpOwog ICAgfSAvKiBtYWluICovCkVPRgokY2MgLW8gdHJ5ICRjY2ZsYWdzICRsZGZsYWdzIHRyeS5jCglt YXhkc2l6PWB0cnlgCnJtIC1mIHRyeSB0cnkuYyBjb3JlCmlmIFsgJG1heGRzaXogLWxlIDY0IF07 IHRoZW4KICAgICMgNjQgTWIgaXMgcHJvYmFibHkgbm90IGVub3VnaCB0byBvcHRpbWl6ZSB0b2tl LmMKICAgICMgYW5kIHJlZ2V4cC5jIHdpdGggLU8yCiAgICBjYXQgPDxFT00gPiY0CllvdXIga2Vy bmVsIGxpbWl0cyB0aGUgZGF0YSBzZWN0aW9uIG9mIHlvdXIgcHJvZ3JhbXMgdG8gJG1heGRzaXog TWIsCndoaWNoIGlzIChzYWRseSkgbm90IGVub3VnaCB0byBmdWxseSBvcHRpbWl6ZSBzb21lIHBh cnRzIG9mIHRoZQpwZXJsIGJpbmFyeS4gSSdsbCB0cnkgdG8gdXNlIGEgbG93ZXIgb3B0aW1pemF0 aW9uIGxldmVsIGZvcgp0aG9zZSBwYXJ0cy4gSWYgeW91IGFyZSBhIHN5c2FkbWluLCBhbmQgeW91 ICpkbyogd2FudCBmdWxsCm9wdGltaXphdGlvbiwgcmFpc2UgdGhlICdtYXhkc2l6JyBrZXJuZWwg Y29uZmlndXJhdGlvbiBwYXJhbWV0ZXIKdG8gYXQgbGVhc3QgMHgwODAwMDAwMCAoMTI4IE1iKSBh bmQgcmVidWlsZCB5b3VyIGtlcm5lbC4KRU9NCnJlZ2V4ZWNfY2ZsYWdzPScnCmRvb3BfY2ZsYWdz PScnCm9wX2NmbGFncz0nJwpvcG1pbmlfY2ZsYWdzPScnCnBlcmxtYWluX2NmbGFncz0nJwpwcF9w YWNrX2NmbGFncz0nJwogICAgZmkKCmNhc2UgIiRjY2lzZ2NjIiBpbgogICAgJGRlZmluZXx0cnVl fFtZeV0pCgoJY2FzZSAiJG9wdGltaXplIiBpbgoJICAgICIiKSAgICAgICAgICAgb3B0aW1pemU9 Ii1nIC1PIiA7OwoJICAgICpPWzM0NTY3ODldKikgb3B0aW1pemU9YGVjaG8gIiRvcHRpbWl6ZSIg fCBzZWQgLWUgJ3MvT1szLTldL08yLydgIDs7CgkgICAgZXNhYwoJI2xkPSIkY2MiCglsZD0vdXNy L2Jpbi9sZAoJY2NjZGxmbGFncz0nLWZQSUMnCgkjbGRkbGZsYWdzPSctc2hhcmVkJwoJbGRkbGZs YWdzPSctYicKCWNhc2UgIiRvcHRpbWl6ZSIgaW4KCSAgICAqLWcqLU8qfCotTyotZyopCgkJIyBn Y2Mgd2l0aG91dCBnYXMgd2lsbCBub3QgYWNjZXB0IC1nCgkJZWNobyAibWFpbigpe30iPnRyeS5j CgkJY2FzZSAiYCRjYyAkb3B0aW1pemUgLWMgdHJ5LmMgMj4mMWAiIGluCgkJICAgICoiLWcgb3B0 aW9uIGRpc2FibGVkIiopCgkJCXNldCBgZWNobyAiWCAkb3B0aW1pemUgIiB8IHNlZCAtZSAncy8g LWcgLyAvJ2AKCQkJc2hpZnQKCQkJb3B0aW1pemU9IiQqIgoJCQk7OwoJCSAgICBlc2FjCgkJOzsK CSAgICBlc2FjCglpZiBbICRtYXhkc2l6IC1sZSA2NCBdOyB0aGVuCgkgICAgY2FzZSAiJG9wdGlt aXplIiBpbgoJCSpPMiopCgkJICAgIG9wdD1gZWNobyAiJG9wdGltaXplIiB8IHNlZCAtZSAncy9P Mi9PMS8nYAoJCSAgICB0b2tlX2NmbGFncz0iJHRva2VfY2ZsYWdzO29wdGltaXplPVwiJG9wdFwi IgoJCSAgICByZWdleGVjX2NmbGFncz0ib3B0aW1pemU9XCIkb3B0XCIiCgkJICAgIDs7CgkJZXNh YwoJICAgIGZpCgk7OwoKICAgICopCgljYXNlICIkb3B0aW1pemUiIGluCgkgICAgIiIpICAgICAg ICAgICBvcHRpbWl6ZT0iK08yICtPbm9saW1pdCIgOzsKCSAgICAqT1szNDU2Nzg5XSopIG9wdGlt aXplPWBlY2hvICIkb3B0aW1pemUiIHwgc2VkIC1lICdzL09bMy05XS9PMi8nYCA7OwoJICAgIGVz YWMKCWNhc2UgIiRvcHRpbWl6ZSIgaW4KCSAgICAqLU8qfFwKCSAgICAqTzIqKSAgIG9wdD1gZWNo byAiJG9wdGltaXplIiB8IHNlZCAtZSAncy8tTy8rTzIvJyAtZSAncy9PMi9PMS8nIC1lICdzLyAq K09ub2xpbWl0Ly8nYAoJCSAgICA7OwoJICAgICopICAgICAgb3B0PSIkb3B0aW1pemUiCgkJICAg IDs7CgkgICAgZXNhYwoJY2FzZSAiJGFyY2huYW1lIiBpbgoJICAgIFBBLVJJU0MyLjApCgkJY2Fz ZSAiJGNjdmVyc2lvbiIgaW4KCQkgICAgQi4xMS4xMS4qKQoJCQkjIG9wbWluaS5jIGFuZCBvcC5j IHdpdGggK08yIG1ha2VzIHRoZSBjb21waWxlciBkaWUKCQkJIyBvZiBpbnRlcm5hbCBlcnJvciwg Zm9yIHBlcmxtYWluLmMgb25seSArTzAgKG5vIG9wdCkKICAgICAgICAgICAgICAgICAgICAgICAg IyB3b3Jrcy4gRGlzYWJsZSArT3ggZm9yIHBwX3BhY2ssIGFzIHRoZSBvcHRpbWl6ZXIKICAgICAg ICAgICAgICAgICAgICAgICAgIyBjYXVzZXMgdGhpcyB1bml0IHRvIGZhaWwgKG5vdCBhIGxpbWl0 IGlzc3VlKQoJCQljYXNlICIkb3B0aW1pemUiIGluCgkJCSpPWzEyXSopCgkJCSAgICBvcHQ9YGVj aG8gIiRvcHRpbWl6ZSIgfCBzZWQgLWUgJ3MvTzIvTzEvJyAtZSAncy8gKitPbm9saW1pdC8vJ2AK CQkJICAgIG9wbWluaV9jZmxhZ3M9Im9wdGltaXplPVwiJG9wdFwiIgoJCQkgICAgb3BfY2ZsYWdz PSJvcHRpbWl6ZT1cIiRvcHRcIiIKCQkJICAgIHBlcmxtYWluX2NmbGFncz0ib3B0aW1pemU9XCJc IiIKCQkJICAgIHBwX3BhY2tfY2ZsYWdzPSJvcHRpbWl6ZT1cIlwiIgoJCQkgICAgOzsKCQkJZXNh YwoJCSAgICBlc2FjCgkJOzsKCSAgICBJQTY0KikKCQljYXNlICIkY2N2ZXJzaW9uIiBpbgoJCSAg ICBCMzkxMEIqQS4wNi4wWzEyMzQ1XSkKCQkJIyA+IGNjIC0tdmVyc2lvbgoJCQkjIGNjOiBIUCBh QysrL0FOU0kgQyBCMzkxMEIgQS4wNi4wNSBbSnVsIDI1IDIwMDVdCgkJCSMgSGFzIG9wdGltaXpp bmcgcHJvYmxlbXMgd2l0aCAtTzIgYW5kIHVwIGZvciBib3RoCgkJCSMgbWFpbnQgKDUuOC44Kykg YW5kIGJsZWFkICg1LjkuMyspCgkJCSMgLU8xLytPMSBwYXNzZWQgYWxsIHRlc3RzIChtKScwNSBb IDEwIEphbiAyMDA1IF0KCQkJb3B0aW1pemU9IiRvcHQiCQkJOzsKCQkJQjM5MTBCKkEuMDYuMTUp CgkJCSMgPiBjYyAtLXZlcnNpb24KCQkJIyBjYzogSFAgQy9hQysrIEIzOTEwQiBBLjA2LjE1IFtN YXkgMTYgMjAwN10KCQkJIyBIYXMgb3B0aW1pemluZyBwcm9ibGVtcyB3aXRoICtPMiBmb3IgYmxl YWQgKDUuMTcuNCksCgkJCSMgc2VlIGh0dHBzOi8vZ2l0aHViLmNvbS9QZXJsL3Blcmw1L2lzc3Vl cy8xMTc0OC4KCQkJIwoJCQkjICtPMiArT25vbGltaXQgK09ub3Byb2NlbGltICArT3N0b3JlX29y ZGVyaW5nIFwKCQkJIyArT25vbGliY2FsbHM9c3RyY21wCgkJCSMgcGFzc2VzIGFsbCB0ZXN0cyAo d2l0aC93aXRob3V0IC1EREVCVUdHSU5HKSBbTm92IDE3IDIwMTFdCgkJCWNhc2UgIiRvcHRpbWl6 ZSIgaW4KCQkJICAgICpPMiopIG9wdGltaXplPSIkb3B0aW1pemUgK09ub3Byb2NlbGltICtPc3Rv cmVfb3JkZXJpbmcgK09ub2xpYmNhbGxzPXN0cmNtcCIgOzsKCQkJICAgIGVzYWMKCQkJOzsKCQkg ICAgKikgIGRvb3BfY2ZsYWdzPSJvcHRpbWl6ZT1cIiRvcHRcIiIKCQkJb3BfY2ZsYWdzPSJvcHRp bWl6ZT1cIiRvcHRcIiIKCQkJI29wdD1gZWNobyAiJG9wdGltaXplIiB8IHNlZCAtZSAncy9PMS9P MC8nYAoJCQlnbG9iYWxzX2NmbGFncz0ib3B0aW1pemU9XCIkb3B0XCIiCTs7CgkJICAgIGVzYWMK CQk7OwoJICAgIGVzYWMKCWlmIFsgJG1heGRzaXogLWxlIDY0IF07IHRoZW4KCSAgICB0b2tlX2Nm bGFncz0iJHRva2VfY2ZsYWdzO29wdGltaXplPVwiJG9wdFwiIgoJICAgIHJlZ2V4ZWNfY2ZsYWdz PSJvcHRpbWl6ZT1cIiRvcHRcIiIKCSAgICBmaQoJbGQ9L3Vzci9iaW4vbGQKCWNjY2RsZmxhZ3M9 JytaJwoJbGRkbGZsYWdzPSctYiArdm5vY29tcGF0d2FybmluZ3MnCgk7OwogICAgZXNhYwoKIyMg TEFSR0VGSUxFUwppZiBbICR4eE9zUmV2IC1sdCAxMDIwIF07IHRoZW4KICAgIHVzZWxhcmdlZmls ZXM9IiR1bmRlZiIKICAgIGZpCgojY2FzZSAiJHVzZWxhcmdlZmlsZXMtJGNjaXNnY2MiIGluCiMg ICAgIiRkZWZpbmUtJGRlZmluZSJ8Jy1kZWZpbmUnKQojCWNhdCA8PEVPTSA+JjQKIwojKioqIEkn bSBpZ25vcmluZyBsYXJnZSBmaWxlcyBmb3IgdGhpcyBidWlsZCBiZWNhdXNlCiMqKiogSSBkb24n dCBrbm93IGhvdyB0byBkbyB1c2UgbGFyZ2UgZmlsZXMgaW4gSFAtVVggdXNpbmcgZ2NjLgojCiNF T00KIwl1c2VsYXJnZWZpbGVzPSIkdW5kZWYiCiMJOzsKIyAgICBlc2FjCgojIE9uY2Ugd2UgaGF2 ZSB0aGUgY29tcGlsZXIgZmxhZ3MgZGVmaW5lZCwgQ29uZmlndXJlIHdpbGwKIyBleGVjdXRlIHRo ZSBmb2xsb3dpbmcgY2FsbC1iYWNrIHNjcmlwdC4gU2VlIGhpbnRzL1JFQURNRS5oaW50cwojIGZv ciBkZXRhaWxzLgpjYXQgPiBVVS9jYy5jYnUgPDwnRU9DQlUnCiMgVGhpcyBzY3JpcHQgVVUvY2Mu Y2J1IHdpbGwgZ2V0ICdjYWxsZWQtYmFjaycgYnkgQ29uZmlndXJlIGFmdGVyIGl0CiMgaGFzIHBy b21wdGVkIHRoZSB1c2VyIGZvciB0aGUgQyBjb21waWxlciB0byB1c2UuCgojIENvbXBpbGUgYW5k IHJ1biB0aGUgYSB0ZXN0IGNhc2UgdG8gc2VlIGlmIGEgY2VydGFpbiBnY2MgYnVnIGlzCiMgcHJl c2VudC4gSWYgc28sIGxvd2VyIHRoZSBvcHRpbWl6YXRpb24gbGV2ZWwgd2hlbiBjb21waWxpbmcK IyBwcF9wYWNrLmMuICBUaGlzIHdvcmtzIGFyb3VuZCBhIGJ1ZyBpbiB1bnBhY2suCgppZiB0ZXN0 IC16ICIkY2Npc2djYyIgLWEgLXogIiRnY2N2ZXJzaW9uIjsgdGhlbgogICAgOiBubyB0ZXN0cyBu ZWVkZWQgZm9yIEhQYwplbHNlCiAgICBlY2hvICIgIgogICAgZWNobyAiVGVzdGluZyBmb3IgYSBj ZXJ0YWluIGdjYyBidWcgaXMgZml4ZWQgaW4geW91ciBjb21waWxlci4uLiIKCiAgICAjIFRyeSBj b21waWxpbmcgdGhlIHRlc3QgY2FzZS4KICAgIGlmICRjYyAtbyB0MDAxIC1PICRjY2ZsYWdzICRs ZGZsYWdzIC1sbSAuLi9oaW50cy90MDAxLmM7IHRoZW4KICAgICAgIGdjY2J1Zz1gJHJ1biAuL3Qw MDFgCiAgICAgICBjYXNlICIkZ2NjYnVnIiBpbgogICAgICAgICAgICpmYWlscyopCiAgICAgICAg ICAgICAgIGNhdCA+JjQgPDxFT0YKVGhpcyBDIGNvbXBpbGVyICgkZ2NjdmVyc2lvbikgaXMga25v d24gdG8gaGF2ZSBvcHRpbWl6ZXIKcHJvYmxlbXMgd2hlbiBjb21waWxpbmcgcHBfcGFjay5jLgoK RGlzYWJsaW5nIG9wdGltaXphdGlvbiBmb3IgcHBfcGFjay5jLgpFT0YKICAgICAgICAgICAgICAg Y2FzZSAiJHBwX3BhY2tfY2ZsYWdzIiBpbgogICAgICAgICAgICAgICAgICAgJycpIHBwX3BhY2tf Y2ZsYWdzPSdvcHRpbWl6ZT0nCiAgICAgICAgICAgICAgICAgICAgICAgZWNobyAicHBfcGFja19j ZmxhZ3M9J29wdGltaXplPVwiXCInIiA+PiBjb25maWcuc2ggOzsKICAgICAgICAgICAgICAgICAg ICopICBlY2hvICJZb3Ugc3BlY2lmaWVkIHBwX3BhY2tfY2ZsYWdzIHlvdXJzZWxmLCBzbyB3ZSds bCBnbyB3aXRoIHlvdXIgdmFsdWUuIiA+JjQgOzsKICAgICAgICAgICAgICAgICAgIGVzYWMKICAg ICAgICAgICAgICAgOzsKICAgICAgICAgICAqKSAgZWNobyAiWW91ciBjb21waWxlciBpcyBvay4i ID4mNAogICAgICAgICAgICAgICA7OwogICAgICAgICAgIGVzYWMKICAgIGVsc2UKICAgICAgIGVj aG8gIiAiCiAgICAgICBlY2hvICIqKiogV0hPQSBUSEVSRSEhISAqKioiID4mNAogICAgICAgZWNo byAiICAgIFlvdXIgQyBjb21waWxlciBcIiRjY1wiIGRvZXNuJ3Qgc2VlbSB0byBiZSB3b3JraW5n ISIgPiY0CiAgICAgICBjYXNlICIka25vd2l0YWxsIiBpbgogICAgICAgICAgICcnKSBlY2hvICIg ICAgWW91J2QgYmV0dGVyIHN0YXJ0IGh1bnRpbmcgZm9yIG9uZSBhbmQgbGV0IG1lIGtub3cgYWJv dXQgaXQuIiA+JjQKICAgICAgICAgICAgICAgZXhpdCAxCiAgICAgICAgICAgICAgIDs7CiAgICAg ICAgICAgZXNhYwogICAgICAgZmkKCiAgICBybSAtZiB0MDAxJF9vIHQwMDEkX2V4ZQogICAgZmkK RU9DQlUKCmNhdCA+Y29uZmlnLmFyY2ggPDwnRU9DQlUnCiMgVGhpcyBzY3JpcHQgVVUvY29uZmln LmFyY2ggd2lsbCBnZXQgJ2NhbGxlZC1iYWNrJyBieSBDb25maWd1cmUgYWZ0ZXIKIyBhbGwgb3Ro ZXIgY29uZmlndXJhdGlvbnMgYXJlIGRvbmUganVzdCBiZWZvcmUgY29uZmlnLmggaXMgZ2VuZXJh dGVkCmNhc2UgIiRhcmNobmFtZTokb3B0aW1pemUiIGluCiAgUEEqOiotZypbLStdTyp8UEEqOipb LStdTyotZyopCiAgICBjYXNlICIkY2NmbGFncyIgaW4KICAgICAgKkRENjQqKSA7OwogICAgICAq KSBjYXNlICIkY2N2ZXJzaW9uIiBpbgoJICAjIE9ubHkgb24gUEEtUklTQy4gQjM5MTBCIChhQ0Mp IGlzIG5vdCBmYXVsdHkKCSAgIyBCLjExLiogYW5kIEEuMTAuKiBhcmUKCSAgW0FCXS4xKikKCSAg ICAgICMgY2M6IGVycm9yIDE0MTQ6IENhbid0IGhhbmRsZSBwcmVwcm9jZXNzZWQgZmlsZSBmb28u aSBpZiAtZyBhbmQgLU8gc3BlY2lmaWVkLgoJICAgICAgZWNobyAiSFAtVVggQy1BTlNJLUMgb24g UEEtUklTQyBkb2VzIG5vdCBhY2NlcHQgYm90aCAtZyBhbmQgLU8gb24gcHJlcHJvY2Vzc2VkIGZp bGVzIiA+JjQKCSAgICAgIGVjaG8gIndoZW4gY29tcGlsaW5nIGluIDMyYml0IG1vZGUuIFRoZSBv cHRpbWl6ZXIgd2lsbCBiZSBkaXNhYmxlZC4iID4mNAoJICAgICAgb3B0aW1pemU9YGVjaG8gIiRv cHRpbWl6ZSIgfCBzZWQgLWUgJ3MvWy0rXU9bMC05XSovLycgLWUgJ3MvK09ub2xpbWl0Ly8nIC1l ICdzL14gKi8vJ2AKCSAgICAgIDs7CgkgIGVzYWMKICAgICAgZXNhYwogIGVzYWMKRU9DQlUKCmNh dCA+VVUvdXNlbGFyZ2VmaWxlcy5jYnUgPDwnRU9DQlUnCiMgVGhpcyBzY3JpcHQgVVUvdXNlbGFy Z2VmaWxlcy5jYnUgd2lsbCBnZXQgJ2NhbGxlZC1iYWNrJyBieSBDb25maWd1cmUKIyBhZnRlciBp dCBoYXMgcHJvbXB0ZWQgdGhlIHVzZXIgZm9yIHdoZXRoZXIgdG8gdXNlIGxhcmdlIGZpbGVzLgoK Y2FzZSAiJGFyY2huYW1lOiR1c2U2NGJpdGFsbDokdXNlNjRiaXRpbnQiIGluCiAgICAqLUxQNjQq OnVuZGVmOmRlZmluZSkKCWFyY2huYW1lPWBlY2hvICIkYXJjaG5hbWUiIHwgc2VkICdzLy1MUDY0 Ly02NGludC8nYAoJZWNobyAiQXJjaG5hbWUgY2hhbmdlZCB0byAkYXJjaG5hbWUiCgk7OwogICAg ZXNhYwoKY2FzZSAiJHVzZWxhcmdlZmlsZXMiIGluCiAgICAiInwkZGVmaW5lfHRydWV8W3lZXSop CgkjIHRoZXJlIGFyZSBsYXJnZWZpbGUgZmxhZ3MgYXZhaWxhYmxlIHZpYSBnZXRjb25mKDEpCgkj IGJ1dCB3ZSBjaGVhdCBmb3Igbm93LiAgKEtlZXAgdGhhdCBpbiB0aGUgbGVmdCBtYXJnaW4uKQpj Y2ZsYWdzX3VzZWxhcmdlZmlsZXM9Ii1EX0xBUkdFRklMRV9TT1VSQ0UgLURfRklMRV9PRkZTRVRf QklUUz02NCIKCgljYXNlICIgJGNjZmxhZ3MgIiBpbgoJKiIgJGNjZmxhZ3NfdXNlbGFyZ2VmaWxl cyAiKikgOzsKCSopIGNjZmxhZ3M9IiRjY2ZsYWdzICRjY2ZsYWdzX3VzZWxhcmdlZmlsZXMiIDs7 Cgllc2FjCgoJaWYgdGVzdCAteiAiJGNjaXNnY2MiIC1hIC16ICIkZ2NjdmVyc2lvbiI7IHRoZW4K CSAgICAjIFRoZSBzdHJpY3QgQU5TSSBtb2RlICgtQWEpIGRvZXNuJ3QgbGlrZSBsYXJnZSBmaWxl cy4KCSAgICBjY2ZsYWdzPWBlY2hvICIgJGNjZmxhZ3MgInxzZWQgJ3NAIC1BYSBAIEBnJ2AKCSAg ICBjYXNlICIkY2NmbGFncyIgaW4KCQkqLUFlKikgOzsKCQkqKSAgICAgY2NmbGFncz0iJGNjZmxh Z3MgLUFlIiA7OwoJCWVzYWMKCSAgICBmaQoJOzsKICAgIGVzYWMKRU9DQlUKCiMgVEhSRUFESU5H CgojIFRoaXMgc2NyaXB0IFVVL3VzZXRocmVhZHMuY2J1IHdpbGwgZ2V0ICdjYWxsZWQtYmFjaycg YnkgQ29uZmlndXJlCiMgYWZ0ZXIgaXQgaGFzIHByb21wdGVkIHRoZSB1c2VyIGZvciB3aGV0aGVy IHRvIHVzZSB0aHJlYWRzLgpjYXQgPlVVL3VzZXRocmVhZHMuY2J1IDw8J0VPQ0JVJwpjYXNlICIk dXNldGhyZWFkcyIgaW4KICAgICRkZWZpbmV8dHJ1ZXxbeVldKikKCWlmIFsgIiR4eE9zUmV2TWFq b3IiIC1sdCAxMCBdOyB0aGVuCgkgICAgY2F0IDw8RU9NID4mNAoKSFAtVVggJHh4T3NSZXZNYWpv ciBjYW5ub3Qgc3VwcG9ydCBQT1NJWCB0aHJlYWRzLgpDb25zaWRlciB1cGdyYWRpbmcgdG8gYXQg bGVhc3QgSFAtVVggMTEuCkNhbm5vdCBjb250aW51ZSwgYWJvcnRpbmcuCkVPTQoJICAgIGV4aXQg MQoJICAgIGZpCgoJaWYgWyAiJHh4T3NSZXZNYWpvciIgLWVxIDEwIF07IHRoZW4KCSAgICAjIFVu ZGVyIDEwLlgsIGEgdGhyZWFkZWQgcGVybCBjYW4gYmUgYnVpbHQKCSAgICBpZiBbIC1mIC91c3Iv aW5jbHVkZS9wdGhyZWFkLmggXTsgdGhlbgoJCWlmIFsgLWYgL3Vzci9saWIvbGliY21hLnNsIF07 IHRoZW4KCQkgICAgIyBEQ0UgKGZyb20gQ29yZSBPUyBDRCkgaXMgaW5zdGFsbGVkCgoJCSAgICMg Q2hlY2sgaWYgaXQgaXMgcHJpc3RpbmUsIG9yIHBhdGNoZWQKCQkgICBjbWF2c249YHdoYXQgL3Vz ci9saWIvbGliY21hLnNsIDI+JjEgfCBncmVwIDE5OTZgCgkJICAgaWYgWyAhIC16ICIkY21hdnNu IiBdOyB0aGVuCgkJICAgICAgIGNhdCA8PEVPTSA+JjQKBwoqKioqKioqKioqKioqKioqKioqKioq KioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioKClBl cmwgd2lsbCBzdXBwb3J0IHRocmVhZGluZyB0aHJvdWdoIC91c3IvbGliL2xpYmNtYS5zbCBmcm9t CnRoZSBIUCBEQ0UgcGFja2FnZSwgYnV0IHRoZSB2ZXJzaW9uIGZvdW5kIGlzIHRvbyBvbGQgdG8g YmUKcmVsaWFibGUuCgpJZiB5b3UgYXJlIG5vdCBkZXBlbmRpbmcgb24gdGhpcyBzcGVjaWZpYyB2 ZXJzaW9uIG9mIHRoZSBsaWJyYXJ5LApjb25zaWRlciB0byB1cGdyYWRlIHVzaW5nIHBhdGNoIFBI U1NfMjM2NzIgKHJlYWQgUkVBRE1FLmhwdXgpCgoqKioqKioqKioqKioqKioqKioqKioqKioqKioq KioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioKCihzbGVlcGlu ZyBmb3IgMTAgc2Vjb25kcy4uLikKRU9NCgkJICAgICAgIHNsZWVwIDEwCgkJICAgICAgIGZpCgoJ CSAgICAjIEl0IG5lZWRzICMgbGliY21hIGFuZCBPTERfUFRIUkVBRFNfQVBJLiBBbHNvCgkJICAg ICMgPHB0aHJlYWQuaD4gbmVlZHMgdG8gYmUgI2luY2x1ZGVkIGJlZm9yZSBhbnkKCQkgICAgIyBv dGhlciBpbmNsdWRlcyAoaW4gcGVybC5oKQoKCQkgICAgIyBIUC1VWCAxMC5YIHVzZXMgdGhlIG9s ZCBwdGhyZWFkcyBBUEkKCQkgICAgZF9vbGRwdGhyZWFkcz0iJGRlZmluZSIKCgkJICAgICMgaW5j bHVkZSBsaWJjbWEgYmVmb3JlIGFsbCB0aGUgb3RoZXJzCgkJICAgIGxpYnN3YW50ZWQ9ImNtYSAk bGlic3dhbnRlZCIKCgkJICAgICMgdGVsbCBwZXJsLmggdG8gaW5jbHVkZSA8cHRocmVhZC5oPiBi ZWZvcmUgb3RoZXIKCQkgICAgIyBpbmNsdWRlIGZpbGVzCgkJICAgIGNjZmxhZ3M9IiRjY2ZsYWdz IC1EUFRIUkVBRF9IX0ZJUlNUIgojIEZpcnN0IGNvbHVtbiBvbiBwdXJwb3NlOgojIHRoaXMgaXMg bm90IGEgc3RhbmRhcmQgQ29uZmlndXJlIHZhcmlhYmxlCiMgYnV0IHdlIG5lZWQgdG8gZ2V0IHRo aXMgbm90aWNlZC4KcHRocmVhZF9oX2ZpcnN0PSIkZGVmaW5lIgoKCQkgICAgIyBIUC1VWCAxMC5Y IHNlZW1zIHRvIGhhdmUgbm8gZWFzeQoJCSAgICAjIHdheSBvZiBkZXRlY3RpbmcgdGhlc2UgKnRp bWVfciBwcm90b3MuCgkJICAgIGRfZ210aW1lX3JfcHJvdG89J2RlZmluZScKCQkgICAgZ210aW1l X3JfcHJvdG89J1JFRU5UUkFOVF9QUk9UT19JX1RTJwoJCSAgICBkX2xvY2FsdGltZV9yX3Byb3Rv PSdkZWZpbmUnCgkJICAgIGxvY2FsdGltZV9yX3Byb3RvPSdSRUVOVFJBTlRfUFJPVE9fSV9UUycK CgkJICAgICMgQXZvaWQgdGhlIHBvaXNvbm91cyBjb25mbGljdGluZyAoYW5kIGlycmVsZXZhbnQp CgkJICAgICMgcHJvdG90eXBlcyBvZiBzZXRrZXkgKCkuCgkJICAgIGlfY3J5cHQ9IiR1bmRlZiIK CgkJICAgICMgQ01BIHJlZGVmaW5lcyBzZWxlY3QgdG8gY21hX3NlbGVjdCwgYW5kIGNtYV9zZWxl Y3QKCQkgICAgIyBleHBlY3RzIGludCAqIGluc3RlYWQgb2YgZmRfc2V0ICogKGp1c3QgbGlrZSA5 LlgpCgkJICAgIHNlbGVjdHR5cGU9J2ludCAqJwoKCQllbGlmIFsgLWYgL3Vzci9saWIvbGlicHRo cmVhZC5zbCBdOyB0aGVuCgkJICAgICMgUFRIIHBhY2thZ2UgaXMgaW5zdGFsbGVkCgkJICAgIGxp YnN3YW50ZWQ9InB0aHJlYWQgJGxpYnN3YW50ZWQiCgkJZWxzZQoJCSAgICBsaWJzd2FudGVkPSJu b190aHJlYWRzX2F2YWlsYWJsZSIKCQkgICAgZmkKCSAgICBlbHNlCgkJbGlic3dhbnRlZD0ibm9f dGhyZWFkc19hdmFpbGFibGUiCgkJZmkKCgkgICAgaWYgWyAkbGlic3dhbnRlZCA9ICJub190aHJl YWRzX2F2YWlsYWJsZSIgXTsgdGhlbgoJCWNhdCA8PEVPTSA+JjQKCkluIEhQLVVYIDEwLlggZm9y IFBPU0lYIHRocmVhZHMgeW91IG5lZWQgYm90aCBvZiB0aGUgZmlsZXMKL3Vzci9pbmNsdWRlL3B0 aHJlYWQuaCBhbmQgZWl0aGVyIC91c3IvbGliL2xpYmNtYS5zbCBvciAvdXNyL2xpYi9saWJwdGhy ZWFkLnNsLgpFaXRoZXIgeW91IG11c3QgdXBncmFkZSB0byBIUC1VWCAxMSBvciBpbnN0YWxsIGEg cG9zaXggdGhyZWFkIGxpYnJhcnk6CgogICAgRENFLUNvcmVUb29scyBmcm9tIEhQLVVYIDEwLjIw IEhhcmR3YXJlIEV4dGVuc2lvbnMgMy4wIENEIChCMzkyMC0xMzk0MSkKCm9yCgogICAgUFRIIHBh Y2thZ2UgZnJvbSBlLmcuIGh0dHA6Ly9ocHV4LmNvbm5lY3Qub3JnLnVrL2hwcGQvaHB1eC9HbnUv cHRoLTIuMC43LwoKQ2Fubm90IGNvbnRpbnVlLCBhYm9ydGluZy4KRU9NCgkJZXhpdCAxCgkJZmkK CWVsc2UKCSAgICAjIDEyIG1heSB3YW50IHVwcGluZyB0aGUgX1BPU0lYX0NfU09VUkNFIGRhdGVz dGFtcC4uLgoJICAgIGNjZmxhZ3M9IiAtRF9QT1NJWF9DX1NPVVJDRT0xOTk1MDZMIC1EX1JFRU5U UkFOVCAkY2NmbGFncyIKCSAgICBzZXQgYGVjaG8gWCAiJGxpYnN3YW50ZWQgInwgc2VkIC1lICdz LyBjIC8gcHRocmVhZCBjIC8nYAoJICAgIHNoaWZ0CgkgICAgbGlic3dhbnRlZD0iJCoiCgoJICAg ICMgSFAtVVggMTEuWCBzZWVtcyB0byBoYXZlIG5vIGVhc3kKCSAgICAjIHdheSBvZiBkZXRlY3Rp bmcgdGhlc2UgKnRpbWVfciBwcm90b3MuCgkgICAgZF9nbXRpbWVfcl9wcm90bz0nZGVmaW5lJwoJ ICAgIGdtdGltZV9yX3Byb3RvPSdSRUVOVFJBTlRfUFJPVE9fU19UUycKCSAgICBkX2xvY2FsdGlt ZV9yX3Byb3RvPSdkZWZpbmUnCgkgICAgbG9jYWx0aW1lX3JfcHJvdG89J1JFRU5UUkFOVF9QUk9U T19TX1RTJwoJICAgIGZpCgk7OwogICAgZXNhYwpFT0NCVQoKIyBUaGVyZSB1c2VkIHRvIGJlOgoj ICBUaGUgbXlzdGVyaW91cyBpb194cyBtZW1vcnkgY29ycnVwdGlvbiBpbiAxMS4wMCAzMmJpdCBz ZWVtcyB0byBnZXQKIyAgZml4ZWQgYnkgbm90IHVzaW5nIFBlcmwncyBtYWxsb2MuICBGbGlwIHNp ZGUgaXMgcGVyZm9ybWFuY2UgbG9zcy4KIyAgU28gd2Ugd2FudCBteW1hbGxvYyBmb3IgYWxsIHNp dHVhdGlvbnMgcG9zc2libGUKIyBUaGF0IHNldCB1c2VteW1hbGxvYyB0byAnbicgZm9yIHRocmVh ZGVkIGJ1aWxkcyBhbmQgbm9uLWdjYyAzMmJpdAojICBub24tZGVidWdnaW5nIGJ1aWxkcyBhbmQg J3knIGZvciBhbGwgb3RoZXJzCgp1c2VteW1hbGxvYz0nbicKY2FzZSAiJHVzZXBlcmxpbyIgaW4K ICAgICR1bmRlZnxmYWxzZXxbbk5dKikgdXNlbXltYWxsb2M9J3knIDs7CiAgICBlc2FjCgojIG1h bGxvYyB3cmFwIHdvcmtzCmNhc2UgIiR1c2VtYWxsb2N3cmFwIiBpbgogICAgJycpIHVzZW1hbGxv Y3dyYXA9J2RlZmluZScgOzsKICAgIGVzYWMKCiMgY3RpbWVfciAoKSBhbmQgYXNjdGltZV9yICgp IHNlZW0gdG8gaGF2ZSBpc3N1ZXMgZm9yIHZlcnNpb25zIGJlZm9yZQojIEhQLVVYIDExCmlmIFsg JHh4T3NSZXZNYWpvciAtbHQgMTEgXTsgdGhlbgogICAgZF9jdGltZV9yPSIkdW5kZWYiCiAgICBk X2FzY3RpbWVfcj0iJHVuZGVmIgogICAgZmkKCiMgZnBjbGFzc2lmeSAoKSBpcyBhIG1hY3JvLCB0 aGUgbGlicmFyeSBjYWxsIGlzIEZwY2xhc3NpZnkKIyBTaW1pbGFybHkgd2l0aCB0aGUgb3RoZXJz IGJlbG93LgpkX2ZwY2xhc3NpZnk9J2RlZmluZScKZF9pc25hbj0nZGVmaW5lJwpkX2lzaW5mPSdk ZWZpbmUnCmRfaXNmaW5pdGU9J2RlZmluZScKZF91bm9yZGVyZWQ9J2RlZmluZScKIyBOZXh0IG9u ZShzKSBuZWVkIHRoZSBsZWFkaW5nIHRhYi4gIFRoZXNlIGFyZSBzcGVjaWFsICdoaW50JyBzeW1i b2xzIHRoYXQKIyBhcmUgbm90IHRvIGJlIHByb3BhZ2F0ZWQgdG8gY29uZmlnLnNoLCBhbGwgcmVs YXRlZCB0byBwdGhyZWFkcyBkcmFmdCA0CiMgaW50ZXJmYWNlcy4KY2FzZSAiJGRfb2xkcHRocmVh ZHMiIGluCiAgICAnJ3wkdW5kZWYpCglkX2NyeXB0X3JfcHJvdG89J3VuZGVmJwoJZF9nZXRncmVu dF9yX3Byb3RvPSd1bmRlZicKCWRfZ2V0cHdlbnRfcl9wcm90bz0ndW5kZWYnCglkX3N0cmVycm9y X3JfcHJvdG89J3VuZGVmJwoJOzsKICAgIGVzYWMKCiMgSC5NZXJpam4gc2F5cyBpdCdzIG5vdCAx OTk4IGFueW1vcmU6IE9EQk0gaXMgbm90IG5lZWRlZCwKIyBhbmQgaXQgc2VlbXMgdG8gYmUgYnVn Z3kgaW4gSFAtVVggYW55d2F5LgppX2RibT11bmRlZgoKIyBJbiBIUC1VWGVzIHByaW9yIHRvIDEx LjIzIHN0cnRvbGQoKSByZXR1cm5lZCBhIEhQLVVYCiMgc3BlY2lmaWMgdW5pb24gY2FsbGVkIGxv bmdfZG91YmxlLCBub3QgYSBDOTkgbG9uZyBkb3VibGUuCmNhc2UgImBncmVwICdkb3VibGUgc3Ry dG9sZC5jb25zdCcgL3Vzci9pbmNsdWRlL3N0ZGxpYi5oYCIgaW4KKiJsb25nIGRvdWJsZSBzdHJ0 b2xkIiopIDs7ICMgc3RydG9sZCBzaG91bGQgYmUgc2FmZS4KKikgZWNobyAiTG9va3MgbGlrZSB5 b3VyIHN0cnRvbGQoKSBpcyBub24tc3RhbmRhcmQuLi4iID4mNAogICBkX3N0cnRvbGQ9dW5kZWYg OzsKZXNhYwoKIyBJbiBwcmUtMTEgSFAtVVhlcyB0aGVyZSByZWFsbHkgaXNuJ3QgaXNmaW5pdGUo KSwgZGVzcGl0ZSB3aGF0CiMgQ29uZmlndXJlIG1pZ2h0IHRoaW5rLiAoVGhlcmUgaXMgZmluaXRl KCksIHRob3VnaC4pCmNhc2UgImBncmVwICdpc2Zpbml0ZScgL3Vzci9pbmNsdWRlL21hdGguaGAi IGluCioiaXNmaW5pdGUiKikgOzsKKikgZF9pc2Zpbml0ZT11bmRlZiA7Owplc2FjCgojIDExLjIz IHNheXMgaXQgaGFzIG1icmxlbiBhbmQgbWJydG93YywgYnV0IGNvbXBpbGluZyB0aGVtIGZhaWxz IGFzIGl0IGNhbid0CiMgZmluZCB0aGUgdHlwZSBkZWZpbml0aW9uIGZvciBtYnN0YXRlX3Qgd2hp Y2ggb25lIG9mIHRoZSBwYXJhbWV0ZXJzIGlzLiAgSXQncwojIG5vdCBpbiB0aGUgaGRyIHRoZSBt YW4gcGFnZSBzYXlzIGl0IGlzLiAgUGVyaGFwcyBhIGJldHRlciBDb25maWd1cmUgcHJvYmUgaXMK IyBuZWVkZWQsIGJ1dCBmb3Igbm93IHNpbXBseSB1bmRlZmluZSB0aGVtCmRfbWJybGVuPSd1bmRl ZicKZF9tYnJ0b3djPSd1bmRlZicKIyBBbmQgdGhpcyBvbmUgaXMgbm90IGtub3cgb24gMTEuMTEg KHdpdGggSFAgQy1BTlNJLUMpCmlmIFsgIiR4eE9zUmV2TWFqb3IiIC1sdCAxMSBdIHx8IFsgIiR4 eE9zUmV2TWlub3IiIC1sdCAxMiBdOyB0aGVuCmRfd2NydG9tYj0ndW5kZWYnCmZpCg==', 'linux' => 'IyBoaW50cy9saW51eC5zaAojIE9yaWdpbmFsIHZlcnNpb24gYnkgcnNhbmRlcnMKIyBBZGRpdGlv bmFsIHN1cHBvcnQgYnkgS2VubmV0aCBBbGJhbm93c2tpIDxramFoZHNAa2phaGRzLmNvbT4KIwoj IEVMRiBzdXBwb3J0IGJ5IEguSi4gTHUgPGhqbEBueW5leHN0LmNvbT4KIyBBZGRpdGlvbmFsIGlu Zm8gZnJvbSBOaWdlbCBIZWFkIDxuaGVhZEBFU09DLmJpdG5ldD4KIyBhbmQgS2VubmV0aCBBbGJh bm93c2tpIDxramFoZHNAa2phaGRzLmNvbT4KIwojIENvbnNvbGlkYXRlZCBieSBBbmR5IERvdWdo ZXJ0eSA8ZG91Z2hlcmFAbGFmYXlldHRlLmVkdT4KIwojIFVwZGF0ZWQgVGh1IEZlYiAgOCAxMTo1 NjoxMCBFU1QgMTk5NgoKIyBVcGRhdGVkIFRodSBNYXkgMzAgMTA6NTA6MjIgRURUIDE5OTYgYnkg PGRvdWdoZXJhQGxhZmF5ZXR0ZS5lZHU+CgojIFVwZGF0ZWQgRnJpIEp1biAyMSAxMTowNzo1NCBF RFQgMTk5NgojIE5EQk0gc3VwcG9ydCBmb3IgRUxGIHJlLWVuYWJsZWQgYnkgPGtqYWhkc0BramFo ZHMuY29tPgoKIyBObyB2ZXJzaW9uIG9mIExpbnV4IHN1cHBvcnRzIHNldHVpZCBzY3JpcHRzLgpk X3N1aWRzYWZlPSd1bmRlZicKCiMgTm8gdmVyc2lvbiBvZiBMaW51eCBuZWVkcyBsaWJ1dGlsIGZv ciBwZXJsLgppX2xpYnV0aWw9J3VuZGVmJwoKIyBEZWJpYW4gYW5kIFJlZCBIYXQsIGFuZCBwZXJo YXBzIG90aGVyIHZlbmRvcnMsIHByb3ZpZGUgYm90aCBydW50aW1lIGFuZAojIGRldmVsb3BtZW50 IHBhY2thZ2VzIGZvciBzb21lIGxpYnJhcmllcy4gIFRoZSBydW50aW1lIHBhY2thZ2VzIGNvbnRh aW4gc2hhcmVkCiMgbGlicmFyaWVzIHdpdGggdmVyc2lvbiBpbmZvcm1hdGlvbiBpbiB0aGVpciBu YW1lcyAoZS5nLiwgbGliZ2RibS5zby4xLjcuMyk7CiMgdGhlIGRldmVsb3BtZW50IHBhY2thZ2Vz IHN1cHBsZW1lbnQgdGhpcyB3aXRoIHZlcnNpb25sZXNzIHNoYXJlZCBsaWJyYXJpZXMKIyAoZS5n LiwgbGliZ2RibS5zbykuCiMKIyBJZiB5b3Ugd2FudCB0byBsaW5rIGFnYWluc3Qgc3VjaCBhIGxp YnJhcnksIHlvdSBtdXN0IGluc3RhbGwgdGhlIGRldmVsb3BtZW50CiMgdmVyc2lvbiBvZiB0aGUg cGFja2FnZS4KIwojIFRoZXNlIHBhY2thZ2VzIHVzZSBhIC1kZXYgbmFtaW5nIGNvbnZlbnRpb24g aW4gYm90aCBEZWJpYW4gYW5kIFJlZCBIYXQ6CiMgICBsaWJnZGJtZzEgIChub24tZGV2ZWxvcG1l bnQgdmVyc2lvbiBvZiBHTlUgbGliYyAyLWxpbmtlZCBHREJNIGxpYnJhcnkpCiMgICBsaWJnZGJt ZzEtZGV2IChkZXZlbG9wbWVudCB2ZXJzaW9uIG9mIEdOVSBsaWJjIDItbGlua2VkIEdEQk0gbGli cmFyeSkKIyBTbyBtYWtlIHN1cmUgdGhhdCBmb3IgYW55IGxpYnJhcmllcyB5b3Ugd2lzaCB0byBs aW5rIFBlcmwgd2l0aCB1bmRlcgojIERlYmlhbiBvciBSZWQgSGF0IHlvdSBoYXZlIHRoZSAtZGV2 IHBhY2thZ2VzIGluc3RhbGxlZC4KCiMgU3VTRSBMaW51eCBjYW4gYmUgdXNlZCBhcyBjcm9zcy1j b21waWxhdGlvbiBob3N0IGZvciBDcmF5IFhUNCBDYXRhbW91bnQvUWsuCmlmIHRlc3QgLWQgL29w dC94dC1wZQp0aGVuCiAgY2FzZSAiYCR7Y2M6LWNjfSAtViAyPiYxYCIgaW4KICAqY2F0YW1vdW50 KikgLiBoaW50cy9jYXRhbW91bnQuc2g7IHJldHVybiA7OwogIGVzYWMKZmkKCiMgU29tZSBvcGVy YXRpbmcgc3lzdGVtcyAoZS5nLiwgU29sYXJpcyAyLjYpIHdpbGwgbGluayB0byBhIHZlcnNpb25l ZCBzaGFyZWQKIyBsaWJyYXJ5IGltcGxpY2l0bHkuICBGb3IgZXhhbXBsZSwgb24gU29sYXJpcywg YGxkIGZvby5vIC1sZ2RibScgd2lsbCBmaW5kIGFuCiMgYXBwcm9wcmlhdGUgdmVyc2lvbiBvZiBs aWJnZGJtLCBpZiBvbmUgaXMgYXZhaWxhYmxlOyBMaW51eCwgaG93ZXZlciwgZG9lc24ndAojIGRv IHRoZSBpbXBsaWNpdCBtYXBwaW5nLgppZ25vcmVfdmVyc2lvbmVkX3NvbGlicz0neScKCiMgQlNE IGNvbXBhdGliaWxpdHkgbGlicmFyeSBubyBsb25nZXIgbmVlZGVkCiMgJ2thZmZlJyBoYXMgYSAv dXNyL2xpYi9saWJuZXQuc28gd2hpY2ggaXMgbm90IGF0IGFsbCByZWxldmFudCBmb3IgcGVybC4K IyBiaW5kIGNhdXNlcyBpc3N1ZXMgd2l0aCBzZXZlcmFsIHJlZW50cmFudCBmdW5jdGlvbnMKc2V0 IGBlY2hvIFggIiRsaWJzd2FudGVkICJ8IHNlZCAtZSAncy8gYnNkIC8gLycgLWUgJ3MvIG5ldCAv IC8nIC1lICdzLyBiaW5kIC8gLydgCnNoaWZ0CmxpYnN3YW50ZWQ9IiQqIgoKIyBEZWJpYW4gNC4w IHB1dHMgbmRibSBpbiB0aGUgLWxnZGJtX2NvbXBhdCBsaWJyYXJ5LgplY2hvICRsaWJzCmlmIGVj aG8gIiAkbGlic3dhbnRlZCAiIHwgZ3JlcCAtcSAnIGdkYm0gJzsgdGhlbgogICAgIyBPbmx5IGFk ZCBpZiBnZGJtIGlzIGluIGxpYnN3YW50ZWQuCiAgICBsaWJzd2FudGVkPSIkbGlic3dhbnRlZCBn ZGJtX2NvbXBhdCIKZmkKCiMgQ29uZmlndXJlIG1heSBmYWlsIHRvIGZpbmQgbHN0YXQoKSBzaW5j ZSBpdCdzIGEgc3RhdGljL2lubGluZQojIGZ1bmN0aW9uIGluIDxzeXMvc3RhdC5oPi4KZF9sc3Rh dD1kZWZpbmUKCiMgbWFsbG9jIHdyYXAgd29ya3MKY2FzZSAiJHVzZW1hbGxvY3dyYXAiIGluCicn KSB1c2VtYWxsb2N3cmFwPSdkZWZpbmUnIDs7CmVzYWMKCiMgVGhlIHN5c3RlbSBtYWxsb2MoKSBp cyBhYm91dCBhcyBmYXN0IGFuZCBhcyBmcnVnYWwgYXMgcGVybCdzLgojIFNpbmNlIHRoZSBzeXN0 ZW0gbWFsbG9jKCkgaGFzIGJlZW4gdGhlIGRlZmF1bHQgc2luY2UgYXQgbGVhc3QKIyA1LjAwMSwg d2UgbWlnaHQgYXMgd2VsbCBsZWF2ZSBpdCB0aGF0IHdheS4gIC0tQUQgIDEwIEphbiAyMDAyCmNh c2UgIiR1c2VteW1hbGxvYyIgaW4KJycpIHVzZW15bWFsbG9jPSduJyA7Owplc2FjCgp1bmFtZV9t aW51c19tPSJgJHJ1biB1bmFtZSAtbSAyPi9kZXYvbnVsbGAiCnVuYW1lX21pbnVzX209IiR7dW5h bWVfbWludXNfbTotIiR0YXJnZXRhcmNoIn0iCgojIENoZWNrIGlmIHdlJ3JlIGFib3V0IHRvIHVz ZSBJbnRlbCdzIElDQyBjb21waWxlcgpjYXNlICJgJHtjYzotY2N9IC1WIDI+JjFgIiBpbgoqIklu dGVsKFIpIEMiKiIgQ29tcGlsZXIiKikKICAgICMgcmVjb3JkIHRoZSB2ZXJzaW9uLCBmb3JtYXRz OgogICAgIyBpY2MgKElDQykgMTAuMSAyMDA4MDgwMQogICAgIyBpY3BjIChJQ0MpIDEwLjEgMjAw ODA4MDEKICAgICMgZm9sbG93ZWQgYnkgYSBjb3B5cmlnaHQgb24gdGhlIHNlY29uZCBsaW5lCiAg ICBjY3ZlcnNpb249YCR7Y2M6LWNjfSAtLXZlcnNpb24gfCBzZWQgLW4gLWUgJ3MvXmljcFw/YyBc KChJQ0MpIFwpXD8vL3AnYAogICAgIyBUaGlzIGlzIG5lZWRlZCBmb3IgQ29uZmlndXJlJ3MgcHJv dG90eXBlIGNoZWNrcyB0byB3b3JrIGNvcnJlY3RseQogICAgIyBUaGUgLW1wIGZsYWcgaXMgbmVl ZGVkIHRvIHBhc3MgdmFyaW91cyBmbG9hdGluZyBwb2ludCByZWxhdGVkIHRlc3RzCiAgICAjIFRo ZSAtbm8tZ2NjIGZsYWcgaXMgbmVlZGVkIG90aGVyd2lzZSwgaWNjIHByZXRlbmRzIChwb29ybHkp IHRvIGJlIGdjYwogICAgY2NmbGFncz0iLXdlMTQ3IC1tcCAtbm8tZ2NjICRjY2ZsYWdzIgogICAg IyBQcmV2ZW50IHJlbG9jYXRpb24gZXJyb3JzIG9uIDY0Yml0cyBhcmNoCiAgICBjYXNlICIkdW5h bWVfbWludXNfbSIgaW4KCSppYTY0KnwqeDg2XzY0KikKCSAgICBjY2NkbGZsYWdzPSctZlBJQycK CTs7CiAgICBlc2FjCiAgICAjIElmIHdlJ3JlIHVzaW5nIElDQywgd2UgdXN1YWxseSB3YW50IHRo ZSBiZXN0IHBlcmZvcm1hbmNlCiAgICBjYXNlICIkb3B0aW1pemUiIGluCiAgICAnJykgb3B0aW1p emU9Jy1PMycgOzsKICAgIGVzYWMKICAgIDs7CioiIFN1biAiKiJDIiopCiAgICAjIFN1bidzIEMg Y29tcGlsZXIsIHdoaWNoIG1pZ2h0IGhhdmUgYSAndGFnJyBuYW1lIGJldHdlZW4KICAgICMgJ1N1 bicgYW5kIHRoZSAnQyc6ICBFeGFtcGxlczoKICAgICMgY2M6IFN1biBDIDUuOSBMaW51eF9pMzg2 IFBhdGNoIDEyNDg3MS0wMSAyMDA3LzA3LzMxCiAgICAjIGNjOiBTdW4gQ2VyZXMgQyA1LjEwIExp bnV4X2kzODYgMjAwOC8wNy8xMAogICAgdGVzdCAiJG9wdGltaXplIiB8fCBvcHRpbWl6ZT0nLXhP MicKICAgIGNjY2RsZmxhZ3M9Jy1LUElDJwogICAgbGRkbGZsYWdzPSctRyAtQmR5bmFtaWMnCiAg ICAjIFN1biBDIGRvZXNuJ3Qgc3VwcG9ydCBnY2MgYXR0cmlidXRlcywgYnV0LCBpbiBtYW55IGNh c2VzLCBkb2Vzbid0CiAgICAjIGNvbXBsYWluIGVpdGhlci4gIE5vdCBhbGwgY2FzZXMsIHRob3Vn aC4KICAgIGRfYXR0cmlidXRlX2Zvcm1hdD0ndW5kZWYnCiAgICBkX2F0dHJpYnV0ZV9tYWxsb2M9 J3VuZGVmJwogICAgZF9hdHRyaWJ1dGVfbm9ubnVsbD0ndW5kZWYnCiAgICBkX2F0dHJpYnV0ZV9u b3JldHVybj0ndW5kZWYnCiAgICBkX2F0dHJpYnV0ZV9wdXJlPSd1bmRlZicKICAgIGRfYXR0cmli dXRlX3VudXNlZD0ndW5kZWYnCiAgICBkX2F0dHJpYnV0ZV93YXJuX3VudXNlZF9yZXN1bHQ9J3Vu ZGVmJwogICAgOzsKZXNhYwoKY2FzZSAiJG9wdGltaXplIiBpbgojIHVzZSAtTzIgYnkgZGVmYXVs dCA7IC1PMyBkb2Vzbid0IHNlZW0gdG8gYnJpbmcgc2lnbmlmaWNhbnQgYmVuZWZpdHMgd2l0aCBn Y2MKJycpCiAgICBvcHRpbWl6ZT0nLU8yJwogICAgY2FzZSAiJHVuYW1lX21pbnVzX20iIGluCiAg ICAgICAgcHBjKikKICAgICAgICAgICAgIyBvbiBwcGMsIGl0IHNlZW1zIHRoYXQgZ2NjIChhdCBs ZWFzdCBnY2MgMy4zLjIpIGlzbid0IGhhcHB5CiAgICAgICAgICAgICMgd2l0aCAtTzIgOyBzbyBk b3duZ3JhZGUgdG8gLU8xLgogICAgICAgICAgICBvcHRpbWl6ZT0nLU8xJwogICAgICAgIDs7CiAg ICAgICAgaWE2NCopCiAgICAgICAgICAgICMgVGhpcyBhcmNoaXRlY3R1cmUgaGFzIGhhZCB2YXJp b3VzIHByb2JsZW1zIHdpdGggZ2NjJ3MKICAgICAgICAgICAgIyBpbiB0aGUgMy4yLCAzLjMsIGFu ZCAzLjQgcmVsZWFzZXMgd2hlbiBvcHRpbWl6ZWQgdG8gLU8yLiAgU2VlCiAgICAgICAgICAgICMg UlQgIzM3MTU2IGZvciBhIGRpc2N1c3Npb24gb2YgdGhlIHByb2JsZW0uCiAgICAgICAgICAgIGNh c2UgImAke2NjOi1nY2N9IC12IDI+JjFgIiBpbgogICAgICAgICAgICAqInZlcnNpb24gMy4yIip8 KiJ2ZXJzaW9uIDMuMyIqfCoidmVyc2lvbiAzLjQiKikKICAgICAgICAgICAgICAgIGNjZmxhZ3M9 Ii1mbm8tZGVsZXRlLW51bGwtcG9pbnRlci1jaGVja3MgJGNjZmxhZ3MiCiAgICAgICAgICAgIDs7 CiAgICAgICAgICAgIGVzYWMKICAgICAgICA7OwogICAgZXNhYwogICAgOzsKZXNhYwoKIyBVYnVu dHUgMTEuMDQgKGFuZCBsYXRlciwgcHJlc3VtYWJseSkgZG9lc24ndCBrZWVwIG1vc3QgbGlicmFy aWVzCiMgKHN1Y2ggYXMgLWxtKSBpbiAvbGliIG9yIC91c3IvbGliLiAgU28gd2UgaGF2ZSB0byBh c2sgZ2NjIHRvIHRlbGwgdXMKIyB3aGVyZSB0byBsb29rLiAgV2UgZG9uJ3Qgd2FudCBnY2MncyBv d24gbGlicmFyaWVzLCBob3dldmVyLCBzbyB3ZQojIGZpbHRlciB0aG9zZSBvdXQuCiMgVGhpcyBj b3VsZCBiZSBjb25kaXRpb25hbCBvbiBVbmJ1bnR1LCBidXQgb3RoZXIgZGlzdHJpYnV0aW9ucyBt YXkKIyBmb2xsb3cgc3VpdCwgYW5kIHRoaXMgc2NoZW1lIHNlZW1zIHRvIHdvcmsgZXZlbiBvbiBy YXRoZXIgb2xkIGdjYydzLgojIFRoaXMgdW5jb25kaXRpb25hbGx5IHVzZXMgZ2NjIGJlY2F1c2Ug ZXZlbiBpZiB0aGUgdXNlciBpcyB1c2luZyBhbm90aGVyCiMgY29tcGlsZXIsIHdlIHN0aWxsIG5l ZWQgdG8gZmluZCB0aGUgbWF0aCBsaWJyYXJ5IGFuZCBmcmllbmRzLCBhbmQgSSBkb24ndAojIGtu b3cgaG93IG90aGVyIGNvbXBpbGVycyB3aWxsIGNvcGUgd2l0aCB0aGF0IHNpdHVhdGlvbi4KIyBN b3JldmVyLCBpZiB0aGUgdXNlciBoYXMgdGhlaXIgb3duIGdjYyBlYXJsaWVyIGluICRQQVRIIHRo YW4gdGhlIHN5c3RlbSBnY2MsCiMgd2UgZG9uJ3Qgd2FudCBpdHMgbGlicmFyaWVzLiBTbyB3ZSB0 cnkgdG8gcHJlZmVyIHRoZSBzeXN0ZW0gZ2NjCiMgU3RpbGwsIGFzIGFuIGVzY2FwZSBoYXRjaCwg YWxsb3cgQ29uZmlndXJlIGNvbW1hbmQgbGluZSBvdmVycmlkZXMgdG8KIyBwbGlicHRoIHRvIGJ5 cGFzcyB0aGlzIGNoZWNrLgppZiBbIC14IC91c3IvYmluL2djYyBdIDsgdGhlbgogICAgZ2NjPS91 c3IvYmluL2djYwojIGNsYW5nIGFsc28gcHJvdmlkZXMgLXByaW50LXNlYXJjaC1kaXJzCmVsaWYg JHtjYzotY2N9IC0tdmVyc2lvbiAyPi9kZXYvbnVsbCB8IGdyZXAgLXEgJ15jbGFuZyAnIDsgdGhl bgogICAgZ2NjPSR7Y2M6LWNjfQplbHNlCiAgICBnY2M9Z2NjCmZpCgpjYXNlICIkcGxpYnB0aCIg aW4KJycpIHBsaWJwdGg9YExBTkc9QyBMQ19BTEw9QyAkZ2NjICRjY2ZsYWdzICRsZGZsYWdzIC1w cmludC1zZWFyY2gtZGlycyB8IGdyZXAgbGlicmFyaWVzIHwKCWN1dCAtZjItIC1kPSB8IHRyICc6 JyAkdHJubCB8IGdyZXAgLXYgJ2djYycgfCBzZWQgLWUgJ3M6LyQ6OidgCiAgICBzZXQgWCAkcGxp YnB0aCAjIENvbGxhcHNlIGFsbCBlbnRyaWVzIG9uIG9uZSBsaW5lCiAgICBzaGlmdAogICAgcGxp YnB0aD0iJCoiCiAgICA7Owplc2FjCgojIEZvciB0aGUgbXVzbCBsaWJjLCBwZXJsIHNob3VsZCAj ZGVmaW5lIF9HTlVfU09VUkNFLiAgT3RoZXJ3aXNlLCBzb21lCiMgYXZhaWxhYmxlIGZ1bmN0aW9u cywgbGlrZSBtZW1lbSwgd29uJ3QgYmUgdXNlZC4gIFNlZSB0aGUgZGlzY3Vzc2lvbiBpbgojIFtw ZXJsICMxMzM3NjBdLiAgbXVzbCBkb2Vzbid0IG9mZmVyIGFuIGVhc3kgd2F5IHRvIGlkZW50aWZ5 IGl0LCBidXQsCiMgYXQgbGVhc3Qgb24gYWxwaW5lIGxpbnV4LCB0aGUgbGRkIC0tdmVyc2lvbiBv dXRwdXQgY29udGFpbnMgdGhlCiMgc3RyaW5nICdtdXNsLicKY2FzZSBgbGRkIC0tdmVyc2lvbiAy PiYxYCBpbgogICAgbXVzbCopICBjY2ZsYWdzPSIkY2NmbGFncyAtRF9HTlVfU09VUkNFIiA7Owog ICAgICAgICopIDs7CmVzYWMKCiMgbGlicXVhZG1hdGggaXMgc29tZXRpbWVzIGluc3RhbGxlZCBh cyBnY2MgaW50ZXJuYWwgbGlicmFyeSwKIyBzbyBjb250cmFyeSB0byBvdXIgdXN1YWwgcG9saWN5 IG9mICpub3QqIGxvb2tpbmcgYXQgZ2NjIGludGVybmFsCiMgZGlyZWN0b3JpZXMgd2Ugbm93ICpk byogbG9vayBhdCB0aGVtLCBpbiBjYXNlIHRoZXkgY29udGFpbgojIHRoZSBxdWFkbWF0aCBsaWJy YXJ5LgojIFhYWCBUaGlzIG1heSBhcHBseSB0byBvdGhlciBnY2MgaW50ZXJuYWwgbGlicmFyaWVz LCBpZiBzdWNoIGV4aXN0LgojIFhYWCBUaGlzIGNvdWxkIGJlIGF0IENvbmZpZ3VyZSBsZXZlbCwg YnV0IHRoZW4gdGhlICRnY2MgaXMgbWVzc3kuCmNhc2UgIiR1c2VxdWFkbWF0aCIgaW4KIiRkZWZp bmUiKQogIGZvciBkIGluIGBMQU5HPUMgTENfQUxMPUMgJGdjYyAkY2NmbGFncyAkbGRmbGFncyAt cHJpbnQtc2VhcmNoLWRpcnMgfCBncmVwIGxpYnJhcmllcyB8IGN1dCAtZjItIC1kPSB8IHRyICc6 JyAkdHJubCB8IGdyZXAgJ2djYycgfCBzZWQgLWUgJ3M6LyQ6OidgCiAgZG8KICAgIGNhc2UgYGxz ICRkLypsaWJxdWFkbWF0aCokc28qIDI+L2Rldi9udWxsYCBpbgogICAgJGQvKmxpYnF1YWRtYXRo KiRzbyopIHhsaWJwdGg9IiR4bGlicHRoICRkIiA7OwogICAgZXNhYwogIGRvbmUKICA7Owplc2Fj CgpjYXNlICIkbGliYyIgaW4KJycpCiMgSWYgeW91IGhhdmUgZ2xpYmMsIHRoZW4gcmVwb3J0IHRo ZSB2ZXJzaW9uIGZvciAuL215Y29uZmlnIGJ1ZyByZXBvcnRpbmcuCiMgKENvbmZpZ3VyZSBkb2Vz bid0IG5lZWQgdG8ga25vdyB0aGUgc3BlY2lmaWMgdmVyc2lvbiBzaW5jZSBpdCBqdXN0IHVzZXMK IyBnY2MgdG8gbG9hZCB0aGUgbGlicmFyeSBmb3IgYWxsIHRlc3RzLikKIyBXZSBkb24ndCB1c2Ug X19HTElCQ19fIGFuZCAgX19HTElCQ19NSU5PUl9fIGJlY2F1c2UgdGhleQojIGFyZSBpbnN1ZmZp Y2llbnRseSBwcmVjaXNlIHRvIGRpc3Rpbmd1aXNoIHRoaW5ncyBsaWtlCiMgbGliYy0yLjAuNiBh bmQgbGliYy0yLjAuNy4KICAgIGZvciBwIGluICRwbGlicHRoCiAgICBkbwogICAgICAgIGZvciB0 cnlsaWIgaW4gbGliYy5zby42IGxpYmMuc28KICAgICAgICBkbwogICAgICAgICAgICBpZiAkdGVz dCAtZSAkcC8kdHJ5bGliOyB0aGVuCiAgICAgICAgICAgICAgICBsaWJjPWBscyAtbCAkcC8kdHJ5 bGliIHwgYXdrICd7cHJpbnQgJE5GfSdgCiAgICAgICAgICAgICAgICBpZiAkdGVzdCAiWCRsaWJj IiAhPSBYOyB0aGVuCiAgICAgICAgICAgICAgICAgICAgYnJlYWsKICAgICAgICAgICAgICAgIGZp CiAgICAgICAgICAgIGZpCiAgICAgICAgZG9uZQogICAgICAgIGlmICR0ZXN0ICJYJGxpYmMiICE9 IFg7IHRoZW4KICAgICAgICAgICAgYnJlYWsKICAgICAgICBmaQogICAgZG9uZQogICAgOzsKZXNh YwoKaWYgJHtzaDotL2Jpbi9zaH0gLWMgZXhpdDsgdGhlbgogIGVjaG8gJycKICBlY2hvICdZb3Ug YXBwZWFyIHRvIGhhdmUgYSB3b3JraW5nIGJhc2guICBHb29kLicKZWxzZQogIGNhdCA8PCAnRU9N JyA+JjQKCioqKioqKioqKioqKioqKioqKioqKioqIFdhcm5pbmchICoqKioqKioqKioqKioqKioq KioqKgpJdCB3b3VsZCBhcHBlYXIgeW91IGhhdmUgYSBkZWZlY3RpdmUgYmFzaCBzaGVsbCBpbnN0 YWxsZWQuIFRoaXMgaXMgbGlrZWx5IHRvCmdpdmUgeW91IGEgZmFpbHVyZSBvZiBvcC9leGVjIHRl c3QgIzUgZHVyaW5nIHRoZSB0ZXN0IHBoYXNlIG9mIHRoZSBidWlsZCwKVXBncmFkaW5nIHRvIGEg cmVjZW50IHZlcnNpb24gKDEuMTQuNCBvciBsYXRlcikgc2hvdWxkIGZpeCB0aGUgcHJvYmxlbS4K KioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqCkVP TQoKZmkKCiMgT24gU1BBUkNsaW51eCwKIyBUaGUgZm9sbG93aW5nIGNzaCBjb25zaXN0ZW50bHkg Y29yZWR1bXBlZCBpbiB0aGUgdGVzdCBkaXJlY3RvcnkKIyAiL2hvbWUvbWlrZWRsci9wZXJsNS4w MDNfOTQvdCIsIHRob3VnaCBub3QgbW9zdCBvdGhlciBkaXJlY3Rvcmllcy4KCiNOYW1lICAgICAg ICA6IGNzaCAgICAgICAgICAgICAgICAgICAgRGlzdHJpYnV0aW9uOiBSZWQgSGF0IExpbnV4IChS ZW1icmFuZHQpCiNWZXJzaW9uICAgICA6IDUuMi42ICAgICAgICAgICAgICAgICAgICAgICAgVmVu ZG9yOiBSZWQgSGF0IFNvZnR3YXJlCiNSZWxlYXNlICAgICA6IDMgICAgICAgICAgICAgICAgICAg ICAgICBCdWlsZCBEYXRlOiBGcmkgTWF5IDI0IDE5OjQyOjE0IDE5OTYKI0luc3RhbGwgZGF0ZTog VGh1IEp1bCAxMSAxNjoyMDoxNCAxOTk2IEJ1aWxkIEhvc3Q6IGl0Y2h5LnJlZGhhdC5jb20KI0dy b3VwICAgICAgIDogU2hlbGxzICAgICAgICAgICAgICAgICAgIFNvdXJjZSBSUE06IGNzaC01LjIu Ni0zLnNyYy5ycG0KI1NpemUgICAgICAgIDogMTg0NDE3CiNEZXNjcmlwdGlvbiA6IEJTRCBjLXNo ZWxsCgojIEZvciB0aGlzIHJlYXNvbiBJIHN1Z2dlc3QgdXNpbmcgdGhlIG11Y2ggYnVnLWZpeGVk IHRjc2ggZm9yIGdsb2JiaW5nCiMgd2hlcmUgYXZhaWxhYmxlLgoKIyBOb3ZlbWJlciAyMDAxOiAg VGhhdCB3YXJuaW5nJ3MgcHJldHR5IG9sZCBub3cgYW5kIHByb2JhYmx5IG5vdCBzbwojIHJlbGV2 YW50LCBlc3BlY2lhbGx5IHNpbmNlIHBlcmwgbm93IHVzZXMgRmlsZTo6R2xvYiBmb3IgZ2xvYmJp bmcuCiMgV2UnbGwgc3RpbGwgbG9vayBmb3IgdGNzaCwgYnV0IHRvbmUgZG93biB0aGUgd2Fybmlu Z3MuCiMgQW5keSBEb3VnaGVydHksIE5vdi4gNiwgMjAwMQppZiAkY3NoIC1jICdlY2hvICR2ZXJz aW9uJyA+L2Rldi9udWxsIDI+JjE7IHRoZW4KICAgIGVjaG8gJ1lvdXIgY3NoIGlzIHJlYWxseSB0 Y3NoLiAgR29vZC4nCmVsc2UKICAgIGlmIHh4eD1gLi9VVS9sb2MgdGNzaCBibHVyZmwgJHB0aGA7 ICR0ZXN0IC1mICIkeHh4IjsgdGhlbgoJZWNobyAiRm91bmQgdGNzaC4gIEknbGwgdXNlIGl0IGZv ciBnbG9iYmluZy4iCgkjIFdlIGNhbid0IGNoYW5nZSBDb25maWd1cmUncyBzZXR0aW5nIG9mICRj c2gsIGR1ZSB0byB0aGUgd2F5CgkjIENvbmZpZ3VyZSBoYW5kbGVzICRkX3BvcnRhYmxlIGFuZCBj b21tYW5kcyBmb3VuZCBpbiAkbG9jbGlzdC4KCSMgV2UgY2FuIHNldCB0aGUgdmFsdWUgZm9yIENT SCBpbiBjb25maWcuaCBieSBzZXR0aW5nIGZ1bGxfY3NoLgoJZnVsbF9jc2g9JHh4eAogICAgZWxp ZiBbIC1mICIkY3NoIiBdOyB0aGVuCgllY2hvICJDb3VsZG4ndCBmaW5kIHRjc2guICBDc2gtYmFz ZWQgZ2xvYmJpbmcgbWlnaHQgYmUgYnJva2VuLiIKICAgIGZpCmZpCgojIFNoaW1wZWkgWWFtYXNo aXRhIDxzaGltcGVpQHNvY3JhdGVzLnBhdG5ldC5jYWx0ZWNoLmVkdT4KIyBNZXNzYWdlLUlkOiA8 MzNFRjE2MzQuQjM2QjY1MDBAcG9ib3guY29tPgojCiMgVGhlIERSMiBvZiBNa0xpbnV4IChvc25h bWU9bGludXgsYXJjaG5hbWU9cHBjLWxpbnV4KSBtYXkgbmVlZAojIHNwZWNpYWwgZmxhZ3MgcGFz c2VkIGluIG9yZGVyIGZvciBkeW5hbWljIGxvYWRpbmcgdG8gd29yay4KIyBpbnN0ZWFkIG9mIHRo ZSByZWNvbW1lbmRlZDoKIwojIGNjZGxmbGFncz0nLXJkeW5hbWljJwojCiMgaXQgc2hvdWxkIGJl OgojIGNjZGxmbGFncz0nLVdsLC1FJwojCiMgU28gaWYgeW91ciBEUjIgKERSMyBjYW1lIG91dCBz dW1tZXIgMTk5OCwgY29uc2lkZXIgdXBncmFkaW5nKQojIGhhcyBwcm9ibGVtcyB3aXRoIGR5bmFt aWMgbG9hZGluZywgdW5jb21tZW50IHRoZQojIGZvbGxvd2luZyB0aHJlZSBsaW5lcywgbWFrZSBk aXN0Y2xlYW4sIGFuZCByZS1Db25maWd1cmU6CiNjYXNlICJgdW5hbWUgLXIgfCBzZWQgJ3MvXlsw LTkuLV0qLy8nYGBhcmNoYCIgaW4KIydvc2ZtYWNoM3BwYycpIGNjZGxmbGFncz0nLVdsLC1FJyA7 OwojZXNhYwoKY2FzZSAiJHVuYW1lX21pbnVzX20iIGluCnNwYXJjKikKCWNhc2UgIiRjY2NkbGZs YWdzIiBpbgoJKi1mcGljKikgY2NjZGxmbGFncz0iYGVjaG8gJGNjY2RsZmxhZ3N8c2VkICdzLy1m cGljLy1mUElDLydgIiA7OwoJKi1mUElDKikgOzsKCSopCSBjY2NkbGZsYWdzPSIkY2NjZGxmbGFn cyAtZlBJQyIgOzsKCWVzYWMKCTs7CmVzYWMKCiMgU3VTRTguMiBoYXMgL3Vzci9saWIvbGlibmRi bSogd2hpY2ggYXJlIGxkIHNjcmlwdHMgcmF0aGVyIHRoYW4KIyB0cnVlIGxpYnJhcmllcy4gVGhl IHNjcmlwdHMgY2F1c2UgYmluZGluZyBhZ2FpbnN0IHN0YXRpYwojIHZlcnNpb24gb2YgLWxnZGJt IHdoaWNoIGlzIGEgYmFkIGlkZWEuIFNvIGlmIHdlIGhhdmUgJ25tJwojIG1ha2Ugc3VyZSBpdCBj YW4gcmVhZCB0aGUgZmlsZQojIE5JLVMgMjAwMy8wOC8wNwpjYXNlICIkbm0iIGluCiAgICAnJykg OzsKICAgICopCiAgICBmb3IgcCBpbiAkcGxpYnB0aAogICAgZG8KICAgICAgICBpZiAkdGVzdCAt ciAkcC9saWJuZGJtLnNvOyB0aGVuCiAgICAgICAgICAgIGlmICRubSAkcC9saWJuZGJtLnNvID4v ZGV2L251bGwgMj4mMSA7IHRoZW4KICAgICAgICAgICAgICAgIGVjaG8gJ1lvdXIgc2hhcmVkIC1s bmRibSBzZWVtcyB0byBiZSBhIHJlYWwgbGlicmFyeS4nCiAgICAgICAgICAgICAgICBfbGlibmRi bV9yZWFsPTEKICAgICAgICAgICAgICAgIGJyZWFrCiAgICAgICAgICAgIGZpCiAgICAgICAgZmkK ICAgIGRvbmUKICAgIGlmICR0ZXN0ICJYJF9saWJuZGJtX3JlYWwiID0gWDsgdGhlbgogICAgICAg IGVjaG8gJ1lvdXIgc2hhcmVkIC1sbmRibSBpcyBub3QgYSByZWFsIGxpYnJhcnkuJwogICAgICAg IHNldCBgZWNobyBYICIkbGlic3dhbnRlZCAifCBzZWQgLWUgJ3MvIG5kYm0gLyAvJ2AKICAgICAg ICBzaGlmdAogICAgICAgIGxpYnN3YW50ZWQ9IiQqIgogICAgZmkKICAgIDs7CmVzYWMKCiMgTGlu dXggb24gU3lub2xvZ3kuCmlmIFsgLWYgL2V0Yy9zeW5vaW5mby5jb25mIC1hIC1kIC91c3Ivc3lu byBdOyB0aGVuCiAgICAjIFRlc3RlZCBvbiBTeW5vbG9neSBEUzIxMyBhbmQgRFM0MTMKICAgICMg IE9TIHZlcnNpb24gaW5mbyBpbiAvZXRjLmRlZmF1bHRzL1ZFUlNJT04KICAgICMgIGh0dHA6Ly9m b3J1bS5zeW5vbG9neS5jb20vd2lraS9pbmRleC5waHAvV2hhdF9raW5kX29mX0NQVV9kb2VzX215 X05BU19oYXZlCiAgICAjIFN5bm9sb2d5IERTMjEzIHJ1bm5pbmcgRFNNIDQuMy0zODEwLTAgKDIw MTMtMTEtMDYpCiAgICAjICBDUFUgbW9kZWwgTWFydmVsbCBLaXJrd29vZCBtdjYyODIgQVJNdjV0 ZQogICAgIyAgTGludXggMi42LjMyLjEyICMzODEwIFdlZCBOb3YgNiAwNToxMzo0MSBDU1QgMjAx MyBhcm12NXRlbCBHTlUvTGludXgKICAgICMgU3lub2xvZ3kgRFM0MTMgcnVubmluZyBEU00gNC4z LTM4MTAtMCAoMjAxMy0xMS0wNikKICAgICMgIENQVSBtb2RlbCBGcmVlc2NhbGUgUW9ySVEgUDEw MjIgcHBjIChlNTAwdjIpCiAgICAjICBsaW51eCAyLjYuMzIuMTIgIzM4MTAgcHBjIEdOVS9MaW51 eAogICAgIyBBbGwgZGV2ZWxvcG1lbnQgc3R1ZmYgaW5zdGFsbGVkIHdpdGggaXBrZyBpcyBpbiAv b3B0CiAgICBpZiBbICIkTEFORyIgPSAiIiAtbyAiJExBTkciID0gIkMiIF07IHRoZW4KCWVjaG8g J1lvdXIgTEFORyBpcyBzYWZlJwogICAgZWxzZQoJZWNobyAnUGxlYXNlIHNldCAkTEFORyB0byAi QyIuIEFsbCBvdGhlciAkTEFORyBzZXR0aW5ncyB3aWxsIGNhdXNlIGhhdm9jJyA+JjQKCUxBTkc9 QwogICAgZmkKICAgIGVjaG8gJ1NldHRpbmcgdXAgdG8gdXNlIC9vcHQvKicgPiY0CiAgICBsb2Np bmNwdGg9Ii9vcHQvaW5jbHVkZSAkbG9jaW5jcHRoIgogICAgbGlicHRoPSIvb3B0L2xpYiAkbGli cHRoIgogICAgbGlic3B0aD0iL29wdC9saWIgJGxpYnNwdGgiCiAgICBsb2NsaWJwdGg9Ii9vcHQv bGliICRsb2NsaWJwdGgiCiAgICAjIFBPU0lYIHdpbGwgbm90IGxpbmsgd2l0aG91dCB0aGUgcHRo cmVhZCBsaWIKICAgIGxpYnN3YW50ZWQ9IiRsaWJzd2FudGVkIHB0aHJlYWQiCiAgICBlY2hvICIk bGlic3dhbnRlZCIgPiY0CmZpCgojIFRoaXMgc2NyaXB0IFVVL3VzZXRocmVhZHMuY2J1IHdpbGwg Z2V0ICdjYWxsZWQtYmFjaycgYnkgQ29uZmlndXJlCiMgYWZ0ZXIgaXQgaGFzIHByb21wdGVkIHRo ZSB1c2VyIGZvciB3aGV0aGVyIHRvIHVzZSB0aHJlYWRzLgpjYXQgPiBVVS91c2V0aHJlYWRzLmNi dSA8PCdFT0NCVScKY2FzZSAiJHVzZXRocmVhZHMiIGluCiRkZWZpbmV8dHJ1ZXxbeVldKikKICAg ICAgICBjY2ZsYWdzPSItRF9SRUVOVFJBTlQgLURfR05VX1NPVVJDRSAkY2NmbGFncyIKICAgICAg ICBpZiBlY2hvICRsaWJzd2FudGVkIHwgZ3JlcCAtdiBwdGhyZWFkID4vZGV2L251bGwKICAgICAg ICB0aGVuCiAgICAgICAgICAgIHNldCBgZWNobyBYICIkbGlic3dhbnRlZCAifCBzZWQgLWUgJ3Mv IGMgLyBwdGhyZWFkIGMgLydgCiAgICAgICAgICAgIHNoaWZ0CiAgICAgICAgICAgIGxpYnN3YW50 ZWQ9IiQqIgogICAgICAgIGZpCgoJIyBTb21laG93IGF0IGxlYXN0IGluIERlYmlhbiAyLjIgdGhl c2UgbWFuYWdlIHRvIGVzY2FwZQoJIyB0aGUgI2RlZmluZSBmb3Jlc3Qgb2YgPGZlYXR1cmVzLmg+ IGFuZCA8dGltZS5oPiBzbyB0aGF0CgkjIHRoZSBoYXNwcm90byBtYWNybyBvZiBDb25maWd1cmUg ZG9lc24ndCBzZWUgdGhlc2UgcHJvdG9zLAoJIyBldmVuIHdpdGggdGhlIC1EX0dOVV9TT1VSQ0Uu CgoJZF9hc2N0aW1lX3JfcHJvdG89IiRkZWZpbmUiCglkX2NyeXB0X3JfcHJvdG89IiRkZWZpbmUi CglkX2N0aW1lX3JfcHJvdG89IiRkZWZpbmUiCglkX2dtdGltZV9yX3Byb3RvPSIkZGVmaW5lIgoJ ZF9sb2NhbHRpbWVfcl9wcm90bz0iJGRlZmluZSIKCWRfcmFuZG9tX3JfcHJvdG89IiRkZWZpbmUi CgoJOzsKZXNhYwpFT0NCVQoKY2F0ID4gVVUvdXNlbGFyZ2VmaWxlcy5jYnUgPDwnRU9DQlUnCiMg VGhpcyBzY3JpcHQgVVUvdXNlbGFyZ2VmaWxlcy5jYnUgd2lsbCBnZXQgJ2NhbGxlZC1iYWNrJyBi eSBDb25maWd1cmUKIyBhZnRlciBpdCBoYXMgcHJvbXB0ZWQgdGhlIHVzZXIgZm9yIHdoZXRoZXIg dG8gdXNlIGxhcmdlIGZpbGVzLgpjYXNlICIkdXNlbGFyZ2VmaWxlcyIgaW4KJyd8JGRlZmluZXx0 cnVlfFt5WV0qKQojIEtlZXAgdGhpcyBpbiB0aGUgbGVmdCBtYXJnaW4uCmNjZmxhZ3NfdXNlbGFy Z2VmaWxlcz0iLURfTEFSR0VGSUxFX1NPVVJDRSAtRF9GSUxFX09GRlNFVF9CSVRTPTY0IgoKCWNj ZmxhZ3M9IiRjY2ZsYWdzICRjY2ZsYWdzX3VzZWxhcmdlZmlsZXMiCgk7Owplc2FjCkVPQ0JVCgoj IFB1cmlmeSBmYWlscyB0byBsaW5rIFBlcmwgaWYgYSAiLWxjIiBpcyBwYXNzZWQgaW50byBpdHMg bGlua2VyCiMgZHVlIHRvIGR1cGxpY2F0ZSBzeW1ib2xzLgpjYXNlICIkUFVSSUZZIiBpbgokZGVm aW5lfHRydWV8W3lZXSopCiAgICBzZXQgYGVjaG8gWCAiJGxpYnN3YW50ZWQgInwgc2VkIC1lICdz LyBjIC8gLydgCiAgICBzaGlmdAogICAgbGlic3dhbnRlZD0iJCoiCiAgICA7Owplc2FjCgojIElm IHVzaW5nIGcrKywgdGhlIENvbmZpZ3VyZSBzY2FuIGZvciBkbG9wZW4oKSBhbmQgKGVzcGVjaWFs bHkpCiMgZGxlcnJvcigpIG1pZ2h0IGZhaWwsIGVhc2llciBqdXN0IHRvIGZvcmNpYmx5IGhpbnQg dGhlbSBpbi4KY2FzZSAiJGNjIiBpbgoqZysrKikKICBkX2Rsb3Blbj0nZGVmaW5lJwogIGRfZGxl cnJvcj0nZGVmaW5lJwogIDs7CmVzYWMKCiMgVW5kZXIgc29tZSBjaXJjdW1zdGFuY2VzIGxpYmRi IGNhbiBnZXQgYnVpbHQgaW4gc3VjaCBhIHdheSBhcyB0bwojIG5lZWQgcHRocmVhZCBleHBsaWNp dGx5IGxpbmtlZC4KCmxpYmRiX25lZWRzX3B0aHJlYWQ9Ik4iCgppZiBlY2hvICIgJGxpYnN3YW50 ZWQgIiB8IGdyZXAgLXYgIiBwdGhyZWFkICIgPi9kZXYvbnVsbAp0aGVuCiAgIGlmIGVjaG8gIiAk bGlic3dhbnRlZCAiIHwgZ3JlcCAiIGRiICIgPi9kZXYvbnVsbAogICB0aGVuCiAgICAgZm9yIERC RElSIGluICRnbGlicHRoCiAgICAgZG8KICAgICAgIERCTElCPSIkREJESVIvbGliZGIuc28iCiAg ICAgICBpZiBbIC1mICREQkxJQiBdCiAgICAgICB0aGVuCiAgICAgICAgIGlmICR7bm06LW5tfSAt dSAkREJMSUIgMj4vZGV2L251bGwgfCBncmVwIHB0aHJlYWQgPi9kZXYvbnVsbAogICAgICAgICB0 aGVuCiAgICAgICAgICAgaWYgbGRkICREQkxJQiB8IGdyZXAgcHRocmVhZCA+L2Rldi9udWxsCiAg ICAgICAgICAgdGhlbgogICAgICAgICAgICAgbGliZGJfbmVlZHNfcHRocmVhZD0iTiIKICAgICAg ICAgICBlbHNlCiAgICAgICAgICAgICBsaWJkYl9uZWVkc19wdGhyZWFkPSJZIgogICAgICAgICAg IGZpCiAgICAgICAgIGZpCiAgICAgICBmaQogICAgIGRvbmUKICAgZmkKZmkKCmNhc2UgIiRsaWJk Yl9uZWVkc19wdGhyZWFkIiBpbgogICJZIikKICAgIGxpYnN3YW50ZWQ9IiRsaWJzd2FudGVkIHB0 aHJlYWQiCiAgICA7Owplc2FjCg==', 'midnightbsd' => 'dXNldmZvcms9J3RydWUnCmNhc2UgIiR1c2VteW1hbGxvYyIgaW4KICAgICIiKSB1c2VteW1hbGxv Yz0nbicKICAgICAgICA7Owplc2FjCmxpYnN3YW50ZWQ9YGVjaG8gJGxpYnN3YW50ZWQgfCBzZWQg J3MvIG1hbGxvYyAvIC8nYAoKb2JqZm9ybWF0PWAvdXNyL2Jpbi9vYmpmb3JtYXRgCmlmIFsgeCRv Ympmb3JtYXQgPSB4YW91dCBdOyB0aGVuCiAgICBpZiBbIC1lIC91c3IvbGliL2FvdXQgXTsgdGhl bgogICAgICAgIGxpYnB0aD0iL3Vzci9saWIvYW91dCAvdXNyL2xvY2FsL2xpYiAvdXNyL2xpYiIK ICAgICAgICBnbGlicHRoPSIvdXNyL2xpYi9hb3V0IC91c3IvbG9jYWwvbGliIC91c3IvbGliIgog ICAgZmkKICAgIGxkZGxmbGFncz0nLUJzaGFyZWFibGUnCmVsc2UKICAgIGxpYnB0aD0iL3Vzci9s aWIgL3Vzci9sb2NhbC9saWIiCiAgICBnbGlicHRoPSIvdXNyL2xpYiAvdXNyL2xvY2FsL2xpYiIK ICAgIGxkZmxhZ3M9Ii1XbCwtRSAiCiAgICBsZGRsZmxhZ3M9Ii1zaGFyZWQgIgpmaQpjY2NkbGZs YWdzPSctRFBJQyAtZlBJQycKCmNjZmxhZ3M9IiR7Y2NmbGFnc30gLURIQVNfRlBTRVRNQVNLIC1E SEFTX0ZMT0FUSU5HUE9JTlRfSCIKaWYgL3Vzci9iaW4vZmlsZSAtTCAvdXNyL2xpYi9saWJjLnNv IHwgL3Vzci9iaW4vZ3JlcCAtdnEgIm5vdCBzdHJpcHBlZCIgOyB0aGVuCiAgICB1c2VubT1mYWxz ZQpmaQoKc2lnbmFsX3Q9J3ZvaWQnCmRfdm9pZHNpZz0nZGVmaW5lJwoKIyBUaGlzIHNjcmlwdCBV VS91c2V0aHJlYWRzLmNidSB3aWxsIGdldCAnY2FsbGVkLWJhY2snIGJ5IENvbmZpZ3VyZSAKIyBh ZnRlciBpdCBoYXMgcHJvbXB0ZWQgdGhlIHVzZXIgZm9yIHdoZXRoZXIgdG8gdXNlIHRocmVhZHMu CmNhdCA+IFVVL3VzZXRocmVhZHMuY2J1IDw8J0VPQ0JVJwpjYXNlICIkdXNldGhyZWFkcyIgaW4K JGRlZmluZXx0cnVlfFt5WV0qKQoJbGRmbGFncz0iLXB0aHJlYWQgJGxkZmxhZ3MiCglzZXQgYGVj aG8gWCAiJGxpYnN3YW50ZWQgInwgc2VkIC1lICdzLyBjIC8vJ2AKCXNoaWZ0CglsaWJzd2FudGVk PSIkKiIKCSMgQ29uZmlndXJlIHdpbGwgcHJvYmFibHkgcGljayB0aGUgd3JvbmcgbGliYyB0byB1 c2UgZm9yIG5tIHNjYW4uCgkjIFRoZSBzYWZlc3QgcXVpY2stZml4IGlzIGp1c3QgdG8gbm90IHVz ZSBubSBhdCBhbGwuLi4KCXVzZW5tPWZhbHNlCgogICAgICAgIHVuc2V0IGxjX3IKCgkjIEV2ZW4g d2l0aCB0aGUgbWFsbG9jIG11dGV4ZXMgdGhlIFBlcmwgbWFsbG9jIGRvZXMgbm90CgkjIHNlZW0g dG8gYmUgdGhyZWFkc2FmZSBpbiBNaWRuaWdodEJTRD8KCWNhc2UgIiR1c2VteW1hbGxvYyIgaW4K CScnKSB1c2VteW1hbGxvYz1uIDs7Cgllc2FjCmVzYWMKRU9DQlUKCiMgbWFsbG9jIHdyYXAgd29y a3MKY2FzZSAiJHVzZW1hbGxvY3dyYXAiIGluCicnKSB1c2VtYWxsb2N3cmFwPSdkZWZpbmUnIDs7 CmVzYWMK', 'netbsd' => 'IyBoaW50cy9uZXRic2Quc2gKIwojIFBsZWFzZSBjaGVjayB3aXRoIHBhY2thZ2VzQG5ldGJzZC5v cmcgYmVmb3JlIG1ha2luZyBtb2RpZmljYXRpb25zCiMgdG8gdGhpcyBmaWxlLgoKY2FzZSAiJGFy Y2huYW1lIiBpbgonJykKICAgIGFyY2huYW1lPWB1bmFtZSAtbWAtJHtvc25hbWV9CiAgICA7Owpl c2FjCgojIE5ldEJTRCBrZWVwcyBkeW5hbWljIGxvYWRpbmcgZGwqKCkgZnVuY3Rpb25zIGluIC91 c3IvbGliL2NydDAubywKIyBzbyBDb25maWd1cmUgZG9lc24ndCBmaW5kIHRoZW0gKHVubGVzcyB5 b3UgYWJhbmRvbiB0aGUgbm0gc2NhbikuCiMgQWxzbywgTmV0QlNEIDAuOWEgd2FzIHRoZSBmaXJz dCByZWxlYXNlIHRvIGludHJvZHVjZSBzaGFyZWQKIyBsaWJyYXJpZXMuCiMKY2FzZSAiJG9zdmVy cyIgaW4KMC45fDAuOCopCgl1c2VkbD0iJHVuZGVmIgoJOzsKKikKCWNhc2UgYHVuYW1lIC1tYCBp bgoJcG1heCkKCQkjIE5ldEJTRCAxLjMgYW5kIDEuMy4xIG9uIHBtYXggc2hpcHBlZCBhbiBgb2xk JyBsZC5zbywKCQkjIHdoaWNoIHdpbGwgbm90IHdvcmsuCgkJY2FzZSAiJG9zdmVycyIgaW4KCQkx LjN8MS4zLjEpCgkJCWRfZGxvcGVuPSR1bmRlZgoJCQk7OwoJCWVzYWMKCQk7OwoJZXNhYwoJaWYg dGVzdCAtZiAvdXNyL2xpYmV4ZWMvbGQuZWxmX3NvOyB0aGVuCgkJIyBFTEYKCQlkX2Rsb3Blbj0k ZGVmaW5lCgkJZF9kbGVycm9yPSRkZWZpbmUKCQljY2NkbGZsYWdzPSItRFBJQyAtZlBJQyAkY2Nj ZGxmbGFncyIKCQlsZGRsZmxhZ3M9Ii1zaGFyZWQgJGxkZGxmbGFncyIKCQljYXQgPlVVL2NjLmNi dSA8PCdFT0NCVScKIyBnY2MgNC42IGRvZXNuJ3Qgc3VwcG9ydCAtLXdob2xlLWFyY2hpdmUsIGJ1 dCBpdCdzIHJlcXVpcmVkIGZvciB0aGUKIyBzeXN0ZW0gZ2NjIHRvIGJ1aWxkIGNvcnJlY3RseSwg c28gY2hlY2sgZm9yIGl0CmVjaG8gJ2ludCBmKHZvaWQpIHsgcmV0dXJuIDA7IH0nID50cnkuYwpp ZiAke2NjOi1jY30gJGNjY2RsZmxhZ3MgLWMgdHJ5LmMgLW90cnkubyAyPiYxICYmCiAgICR7Y2M6 LWNjfSAtLXdob2xlLWFyY2hpdmUgJGxkZGxmbGFncyB0cnkubyAtb3RyeS5zbyAyPiYxIDsgdGhl bgogICAgbGRkbGZsYWdzPSItLXdob2xlLWFyY2hpdmUgJGxkZGxmbGFncyIKZmkKcm0gdHJ5LmMg dHJ5Lm8gdHJ5LnNvIDI+L2Rldi9udWxsCkVPQ0JVCgkJcnBhdGhmbGFnPSItV2wsLXJwYXRoLCIK CQljYXNlICIkb3N2ZXJzIiBpbgoJCTEuWzAtNV0qKQoJCQkjCgkJCSMgSW5jbHVkZSB0aGUgd2hv bGUgbGliZ2NjLmEgaW50byB0aGUgcGVybCBleGVjdXRhYmxlCgkJCSMgc28gdGhhdCBjZXJ0YWlu IHN5bWJvbHMgbmVlZGVkIGJ5IGxvYWRhYmxlIG1vZHVsZXMKCQkJIyBidWlsdCBhcyBDKysgb2Jq ZWN0cyAoX19laF9hbGxvYywgX19wdXJlX3ZpcnR1YWwsCgkJCSMgZXRjLikgd2lsbCBhbHdheXMg YmUgZGVmaW5lZC4KCQkJIwoJCQljY2RsZmxhZ3M9Ii1XbCwtd2hvbGUtYXJjaGl2ZSAtbGdjYyBc CgkJCQktV2wsLW5vLXdob2xlLWFyY2hpdmUgLVdsLC1FICRjY2RsZmxhZ3MiCgkJCTs7CgkJKikK CQkJY2NkbGZsYWdzPSItV2wsLUUgJGNjZGxmbGFncyIKCQkJOzsKCQllc2FjCgllbGlmIHRlc3Qg LWYgL3Vzci9saWJleGVjL2xkLnNvOyB0aGVuCgkJIyBhLm91dAoJCWRfZGxvcGVuPSRkZWZpbmUK CQlkX2RsZXJyb3I9JGRlZmluZQoJCWNjY2RsZmxhZ3M9Ii1EUElDIC1mUElDICRjY2NkbGZsYWdz IgoJCWxkZGxmbGFncz0iLUJzaGFyZWFibGUgJGxkZGxmbGFncyIKCQlycGF0aGZsYWc9Ii1SIgoJ ZWxzZQoJCWRfZGxvcGVuPSR1bmRlZgoJCXJwYXRoZmxhZz0KCWZpCgk7Owplc2FjCgojIG5ldGJz ZCBoYWQgdGhlc2UgYnV0IHRoZXkgZG9uJ3QgcmVhbGx5IHdvcmsgYXMgYWR2ZXJ0aXNlZCwgaW4g dGhlCiMgdmVyc2lvbnMgbGlzdGVkIGJlbG93LiAgaWYgdGhleSBhcmUgZGVmaW5lZCwgdGhlbiB0 aGVyZSBpc24ndCBhCiMgd2F5IHRvIG1ha2UgcGVybCBjYWxsIHNldHVpZCgpIG9yIHNldGdpZCgp LiAgaWYgdGhleSBhcmVuJ3QsIHRoZW4KIyAoJDwsICQ+KSA9ICgkdSwgJHUpOyB3aWxsIHdvcmsg KHNhbWUgZm9yICQoLyQpKS4gIHRoaXMgaXMgYmVjYXVzZQojIHlvdSBjYW4gbm90IGNoYW5nZSB0 aGUgcmVhbCB1c2VyaWQgb2YgYSBwcm9jZXNzIHVuZGVyIDQuNEJTRC4KIyBuZXRic2QgZml4ZWQg dGhpcyBpbiAxLjMuMi4KY2FzZSAiJG9zdmVycyIgaW4KMC45KnwxLlswMTJdKnwxLjN8MS4zLjEp CglkX3NldHJlZ2lkPSIkdW5kZWYiCglkX3NldHJldWlkPSIkdW5kZWYiCgk7Owplc2FjCmNhc2Ug IiRvc3ZlcnMiIGluCjAuOCopCgk7OwoqKQoJZF9nZXRwcm90b2VudF9yPSIkdW5kZWYiCglkX2dl dHByb3RvYnluYW1lX3I9IiR1bmRlZiIKCWRfZ2V0cHJvdG9ieW51bWJlcl9yPSIkdW5kZWYiCglk X3NldHByb3RvZW50X3I9IiR1bmRlZiIKCWRfZW5kcHJvdG9lbnRfcj0iJHVuZGVmIgoJZF9nZXRz ZXJ2ZW50X3I9IiR1bmRlZiIKCWRfZ2V0c2VydmJ5bmFtZV9yPSIkdW5kZWYiCglkX2dldHNlcnZi eXBvcnRfcj0iJHVuZGVmIgoJZF9zZXRzZXJ2ZW50X3I9IiR1bmRlZiIKCWRfZW5kc2VydmVudF9y PSIkdW5kZWYiCglkX2dldGhvc3RieW5hbWVfcj0iJHVuZGVmIgoJZF9nZXRob3N0YnlhZGRyMl9y PSIkdW5kZWYiCglkX2dldGhvc3RieWFkZHJfcj0iJHVuZGVmIgoJZF9zZXRob3N0ZW50X3I9IiR1 bmRlZiIKCWRfZ2V0aG9zdGVudF9yPSIkdW5kZWYiCglkX2VuZGhvc3RlbnRfcj0iJHVuZGVmIgoJ ZF9nZXRwcm90b2VudF9yX3Byb3RvPSIwIgoJZF9nZXRwcm90b2J5bmFtZV9yX3Byb3RvPSIwIgoJ ZF9nZXRwcm90b2J5bnVtYmVyX3JfcHJvdG89IjAiCglkX3NldHByb3RvZW50X3JfcHJvdG89IjAi CglkX2VuZHByb3RvZW50X3JfcHJvdG89IjAiCglkX2dldHNlcnZlbnRfcl9wcm90bz0iMCIKCWRf Z2V0c2VydmJ5bmFtZV9yX3Byb3RvPSIwIgoJZF9nZXRzZXJ2Ynlwb3J0X3JfcHJvdG89IjAiCglk X3NldHNlcnZlbnRfcl9wcm90bz0iMCIKCWRfZW5kc2VydmVudF9yX3Byb3RvPSIwIgoJZF9nZXRo b3N0YnluYW1lX3JfcHJvdG89IjAiCglkX2dldGhvc3RieWFkZHIyX3JfcHJvdG89IjAiCglkX2dl dGhvc3RieWFkZHJfcl9wcm90bz0iMCIKCWRfc2V0aG9zdGVudF9yX3Byb3RvPSIwIgoJZF9lbmRo b3N0ZW50X3JfcHJvdG89IjAiCglkX2dldGhvc3RlbnRfcl9wcm90bz0iMCIKCTs7CmVzYWMKCiMg VGhlc2UgYXJlIG9ic29sZXRlIGluIGFueSBuZXRic2QuCmRfc2V0cmdpZD0iJHVuZGVmIgpkX3Nl dHJ1aWQ9IiR1bmRlZiIKCiMgdGhlcmUncyBubyBwcm9ibGVtIHdpdGggdmZvcmsuCnVzZXZmb3Jr PXRydWUKCiMgVGhpcyBpcyB0aGVyZSBidXQgaW4gbWFjaGluZS9pZWVlZnBfaC4KaWVlZWZwX2g9 ImRlZmluZSIKCiMgVGhpcyBzY3JpcHQgVVUvdXNldGhyZWFkcy5jYnUgd2lsbCBnZXQgJ2NhbGxl ZC1iYWNrJyBieSBDb25maWd1cmUKIyBhZnRlciBpdCBoYXMgcHJvbXB0ZWQgdGhlIHVzZXIgZm9y IHdoZXRoZXIgdG8gdXNlIHRocmVhZHMuCmNhdCA+IFVVL3VzZXRocmVhZHMuY2J1IDw8J0VPQ0JV JwpjYXNlICIkdXNldGhyZWFkcyIgaW4KJGRlZmluZXx0cnVlfFt5WV0qKQoJbHB0aHJlYWQ9Cglm b3IgeHh4IGluIHB0aHJlYWQ7IGRvCgkJZm9yIHl5eSBpbiAkbG9jbGlicHRoICRwbGlicHRoICRn bGlicHRoIGR1bW15OyBkbwoJCQl6eno9JHl5eS9saWIkeHh4LmEKCQkJaWYgdGVzdCAtZiAiJHp6 eiI7IHRoZW4KCQkJCWxwdGhyZWFkPSR4eHgKCQkJCWJyZWFrOwoJCQlmaQoJCQl6eno9JHl5eS9s aWIkeHh4LnNvCgkJCWlmIHRlc3QgLWYgIiR6enoiOyB0aGVuCgkJCQlscHRocmVhZD0keHh4CgkJ CQlicmVhazsKCQkJZmkKCQkJenp6PWBscyAkeXl5L2xpYiR4eHguc28uKiAyPi9kZXYvbnVsbGAK CQkJaWYgdGVzdCAiWCR6enoiICE9IFg7IHRoZW4KCQkJCWxwdGhyZWFkPSR4eHgKCQkJCWJyZWFr OwoJCQlmaQoJCWRvbmUKCQlpZiB0ZXN0ICJYJGxwdGhyZWFkIiAhPSBYOyB0aGVuCgkJCWJyZWFr OwoJCWZpCglkb25lCglpZiB0ZXN0ICJYJGxwdGhyZWFkIiAhPSBYOyB0aGVuCgkJIyBBZGQgLWxw dGhyZWFkLgoJCWxpYnN3YW50ZWQ9IiRsaWJzd2FudGVkICRscHRocmVhZCIKCQkjIFRoZXJlIGlz IG5vIGxpYmNfciBhcyBvZiBOZXRCU0QgMS41LjIsIHNvIG5vIGMgLT4gY19yLgoJCSMgVGhpcyB3 aWxsIGJlIHJldmlzaXRlZCB3aGVuIE5ldEJTRCBnYWlucyBhIG5hdGl2ZSBwdGhyZWFkcwoJCSMg aW1wbGVtZW50YXRpb24uCgllbHNlCgkJZWNobyAiJDA6IE5vIFBPU0lYIHRocmVhZHMgbGlicmFy eSAoLWxwdGhyZWFkKSBmb3VuZC4gICIgXAoJCSAgICAgIllvdSBtYXkgd2FudCB0byBpbnN0YWxs IEdOVSBwdGguICBBYm9ydGluZy4iID4mNAoJCWV4aXQgMQoJZmkKCXVuc2V0IGxwdGhyZWFkCgoJ IyBzZXZlcmFsIHJlZW50cmFudCBmdW5jdGlvbnMgYXJlIGVtYmVkZGVkIGluIGxpYmMsIGJ1dCBo YXZlbid0CgkjIGJlZW4gYWRkZWQgdG8gdGhlIGhlYWRlciBmaWxlcyB5ZXQuICBMZXQncyBob2xk IG9mZiBvbiB1c2luZwoJIyB0aGVtIHVudGlsIHRoZXkgYXJlIGEgdmFsaWQgcGFydCBvZiB0aGUg QVBJCgljYXNlICIkb3N2ZXJzIiBpbgoJWzAxMl0uKnwzLlswLTFdKQoJCWRfZ2V0cHJvdG9ieW5h bWVfcj0kdW5kZWYKCQlkX2dldHByb3RvYnludW1iZXJfcj0kdW5kZWYKCQlkX2dldHByb3RvZW50 X3I9JHVuZGVmCgkJZF9nZXRzZXJ2YnluYW1lX3I9JHVuZGVmCgkJZF9nZXRzZXJ2Ynlwb3J0X3I9 JHVuZGVmCgkJZF9nZXRzZXJ2ZW50X3I9JHVuZGVmCgkJZF9zZXRwcm90b2VudF9yPSR1bmRlZgoJ CWRfc2V0c2VydmVudF9yPSR1bmRlZgoJCWRfZW5kcHJvdG9lbnRfcj0kdW5kZWYKCQlkX2VuZHNl cnZlbnRfcj0kdW5kZWYgOzsKCWVzYWMKCTs7Cgplc2FjCkVPQ0JVCgojIFNldCBzZW5zaWJsZSBk ZWZhdWx0cyBmb3IgTmV0QlNEOiBsb29rIGZvciBsb2NhbCBzb2Z0d2FyZSBpbgojIC91c3IvcGtn IChOZXRCU0QgUGFja2FnZXMgQ29sbGVjdGlvbikgYW5kIGluIC91c3IvbG9jYWwuCiMKbG9jbGli cHRoPSIvdXNyL3BrZy9saWIgL3Vzci9sb2NhbC9saWIiCmxvY2luY3B0aD0iL3Vzci9wa2cvaW5j bHVkZSAvdXNyL2xvY2FsL2luY2x1ZGUiCmNhc2UgIiRycGF0aGZsYWciIGluCicnKQoJbGRmbGFn cz0KCTs7CiopCglsZGZsYWdzPQoJZm9yIHl5eSBpbiAkbG9jbGlicHRoOyBkbwoJCWxkZmxhZ3M9 IiRsZGZsYWdzICRycGF0aGZsYWckeXl5IgoJZG9uZQoJOzsKZXNhYwoKY2FzZSBgdW5hbWUgLW1g IGluCmFscGhhKQogICAgZWNobyAnaW50IG1haW4oKSB7fScgPiB0cnkuYwogICAgZ2NjPWAke2Nj Oi1jY30gLXYgLWMgdHJ5LmMgMj4mMXxncmVwICdnY2MgdmVyc2lvbiBlZ2NzLTInYAogICAgY2Fz ZSAiJGdjYyIgaW4KICAgICcnIHwgImdjYyB2ZXJzaW9uIGVnY3MtMi45NS4iWzMtOV0qKSA7OyAj IDIuOTUuMyBvciBiZXR0ZXIgb2theQogICAgKikJY2F0ID4mNCA8PEVPRgoqKioKKioqIFlvdXIg Z2NjICgkZ2NjKSBpcyBrbm93biB0byBiZQoqKiogdG9vIGJ1Z2d5IG9uIG5ldGJzZC9hbHBoYSB0 byBjb21waWxlIFBlcmwgd2l0aCBvcHRpbWl6YXRpb24uCioqKiBJdCBpcyBzdWdnZXN0ZWQgeW91 IGluc3RhbGwgdGhlIGxhbmcvZ2NjIHBhY2thZ2Ugd2hpY2ggc2hvdWxkCioqKiBoYXZlIGF0IGxl YXN0IGdjYyAyLjk1LjMgd2hpY2ggc2hvdWxkIHdvcmsgb2theTogdXNlIGZvciBleGFtcGxlCioq KiBDb25maWd1cmUgLURjYz0vdXNyL3BrZy9nY2MtMi45NS4zL2Jpbi9jYy4gIFlvdSBjb3VsZCBh bHNvCioqKiBDb25maWd1cmUgLURvcHRpbWl6ZT0tTzAgdG8gY29tcGlsZSBQZXJsIHdpdGhvdXQg YW55IG9wdGltaXphdGlvbgoqKiogYnV0IHRoYXQgaXMgbm90IHJlY29tbWVuZGVkLgoqKioKRU9G CglleGl0IDEKCTs7CiAgICBlc2FjCiAgICBybSAtZiB0cnkuKgogICAgOzsKZXNhYwoKIyBOZXRC U0Qvc3BhcmMgMS41LjMvMS42LjEgZHVtcHMgY29yZSBpbiB0aGUgc2VtaWRfZHMgdGVzdCBvZiBD b25maWd1cmUuCmNhc2UgYHVuYW1lIC1tYCBpbgpzcGFyYykgZF9zZW1jdGxfc2VtaWRfZHM9dW5k ZWYgOzsKZXNhYwoKIyBtYWxsb2Mgd3JhcCB3b3JrcwpjYXNlICIkdXNlbWFsbG9jd3JhcCIgaW4K JycpIHVzZW1hbGxvY3dyYXA9J2RlZmluZScgOzsKZXNhYwoKIyBkb24ndCB1c2UgcGVybCBtYWxs b2MgYnkgZGVmYXVsdApjYXNlICIkdXNlbXltYWxsb2MiIGluCicnKSB1c2VteW1hbGxvYz1uIDs7 CmVzYWMKCiMgTmV0QlNEIDYgZGVmaW5lcyB0aGUgKmF0KCkgZnVuY3Rpb25zIGluIGxpYmMsIGJ1 dCBlaXRoZXIgZG9lc24ndAojIGltcGxlbWVudCB0aGVtLCBvciBpbXBsZW1lbnRzIHRoZW0gb25s eSBmb3IgQVRfRkRDV0QKY2FzZSAiJG9zdmVyIiBpbgpbMS02XS4qKQogICAgICAgIGRfdW5saW5r YXQ9IiR1bmRlZiIKICAgICAgICBkX3JlbmFtZWF0PSIkdW5kZWYiCiAgICAgICAgZF9saW5rYXQ9 IiR1bmRlZiIKICAgICAgICBkX2ZjaG1vZGF0PSIkdW5kZWYiCiAgICAgICAgOzsKZXNhYwoKY2F0 ID5VVS91c2Vsb25nZG91YmxlLmNidSA8PCdFT0NCVScKIyBUaGlzIHNjcmlwdCBVVS91c2Vsb25n ZG91YmxlLmNidSB3aWxsIGdldCAnY2FsbGVkLWJhY2snIGJ5IENvbmZpZ3VyZQojIGFmdGVyIGl0 IGhhcyBwcm9tcHRlZCB0aGUgdXNlciBmb3Igd2hldGhlciB0byB1c2UgbG9uZyBkb3VibGVzLgoj CiMgU2VlIGh0dHBzOi8vZ2l0aHViLmNvbS9QZXJsL3Blcmw1L2lzc3Vlcy8xNzg1MyBhbmQgaHR0 cHM6Ly9naXRodWIuY29tL1BlcmwvcGVybDUvaXNzdWVzLzE3ODU0CmNhc2UgIiR1c2Vsb25nZG91 YmxlIiBpbgokZGVmaW5lfHRydWV8W3lZXSopCiAgICBjYXQgPnRyeS5jIDw8XFRSWQojaW5jbHVk ZSA8c3RkaW8uaD4KI2luY2x1ZGUgPG1hdGguaD4KCmxvbmcgZG91YmxlIHggPSAxLjA7CgppbnQg bWFpbihpbnQgYXJnYywgY2hhciAqKmFyZ3YpIHsKICAgIGRvdWJsZSBlMSA9IGV4cCgxLjApOwog ICAgLyogYXMgb2YgTmV0QlNEIDkuMCBleHBsKCkganVzdCBjYWxscyBleHAoKSwKICAgICAgIEZh aWwgaGVyZSBpZiB0aGV5J3JlIGVxdWFsLiAqLwogICAgcmV0dXJuIGV4cGwoeCkgPT0gKGxvbmcg ZG91YmxlKWUxOwp9ClRSWQogICAgaWYgJGNjIC1vIHRyeSAkY2NmbGFncyAkbGRmbGFncyB0cnku YyAtbG0gJiYgJHJ1biAuL3RyeTsgdGhlbgogICAgICAgIGVjaG8gIk5ldEJTRCBzZWVtIHRvIGhh dmUgZml4ZWQgZXhwbCAoYW5kIGhvcGVmdWxseSBtb3JlKSIgPiY0CiAgICBlbHNlCiAgICAgICAg Y2F0IDw8RU9NID4mNAoKV2FybmluZyEgTmV0QlNEJ3MgbG9uZyBkb3VibGUgc3VwcG9ydCBpcyBs aW1pdGVkIGVub3VnaCB0aGF0IGl0IHdpbGwgY2F1c2UKdGVzdCBmYWlsdXJlcywgYW5kIHBvc3Np Ymx5IGJ1aWxkIGZhaWx1cmVzLCBhbmQgdGhpcyBkb2Vzbid0IGFwcGVhciB0byBoYXZlCmJlZW4g Zml4ZWQgaW4gdGhlIHJlbGVhc2UgeW91J3JlIHJ1bm5pbmcuCgpFT00KICAgIGZpCjs7CmVzYWMK RU9DQlUK', 'openbsd' => 'IyBoaW50cy9vcGVuYnNkLnNoCiMKIyBoaW50cyBmaWxlIGZvciBPcGVuQlNEOyBUb2RkIE1pbGxl ciA8bWlsbGVydEBvcGVuYnNkLm9yZz4KIyBFZGl0ZWQgdG8gYWxsb3cgQ29uZmlndXJlIGNvbW1h bmQtbGluZSBvdmVycmlkZXMgYnkKIyAgQW5keSBEb3VnaGVydHkgPGRvdWdoZXJhQGxhZmF5ZXR0 ZS5lZHU+CiMKIyBUbyBidWlsZCB3aXRoIGRpc3RyaWJ1dGlvbiBwYXRocywgdXNlOgojCS4vQ29u ZmlndXJlIC1kZXMgLURvcGVuYnNkX2Rpc3RyaWJ1dGlvbj1kZWZpbmVkCiMKCiMgT3BlbkJTRCBo YXMgYSBiZXR0ZXIgbWFsbG9jIHRoYW4gcGVybC4uLgp0ZXN0ICIkdXNlbXltYWxsb2MiIHx8IHVz ZW15bWFsbG9jPSduJwoKIyBtYWxsb2Mgd3JhcCB3b3JrcwpjYXNlICIkdXNlbWFsbG9jd3JhcCIg aW4KJycpIHVzZW1hbGxvY3dyYXA9J2RlZmluZScgOzsKZXNhYwoKIyBDdXJyZW50bHksIHZmb3Jr KDIpIGlzIG5vdCBhIHJlYWwgd2luIG92ZXIgZm9yaygyKS4KdXNldmZvcms9IiR1bmRlZiIKCiMg SW4gT3BlbkJTRCA8IDMuMywgdGhlIHNldHJlP1t1Z11pZCgpIGFyZSBlbXVsYXRlZCB1c2luZyB0 aGUKIyBfUE9TSVhfU0FWRURfSURTIGZ1bmN0aW9uYWxpdHkgd2hpY2ggZG9lcyBub3QgaGF2ZSB0 aGUgc2FtZQojIHNlbWFudGljcyBhcyA0LjNCU0QuICBTdGFydGluZyB3aXRoIE9wZW5CU0QgMy4z LCB0aGUgb3JpZ2luYWwKIyBzZW1hbnRpY3MgaGF2ZSBiZWVuIHJlc3RvcmVkLgpjYXNlICIkb3N2 ZXJzIiBpbgpbMC0yXS4qfDMuWzAtMl0pCglkX3NldHJlZ2lkPSR1bmRlZgoJZF9zZXRyZXVpZD0k dW5kZWYKCWRfc2V0cmdpZD0kdW5kZWYKCWRfc2V0cnVpZD0kdW5kZWYKZXNhYwoKIwojIE5vdCBh bGwgcGxhdGZvcm1zIHN1cHBvcnQgZHluYW1pYyBsb2FkaW5nLi4uCiMgRm9yIHRoZSBjYXNlIG9m ICIkb3BlbmJzZF9kaXN0cmlidXRpb24iLCB0aGUgaGludHMgZmlsZQojIG5lZWRzIHRvIGtub3cg d2hldGhlciB3ZSBhcmUgdXNpbmcgZHluYW1pYyBsb2FkaW5nIHNvIHRoYXQKIyBpdCBjYW4gc2V0 IHRoZSBsaWJwZXJsIG5hbWUgYXBwcm9wcmlhdGVseS4KIyBBbGxvdyBjb21tYW5kIGxpbmUgb3Zl cnJpZGVzLgojCkFSQ0g9YGFyY2ggfCBzZWQgJ3MvXk9wZW5CU0QuLy8nYApjYXNlICIke0FSQ0h9 LSR7b3N2ZXJzfSIgaW4KYWxwaGEtMi5bMC04XXxtaXBzLTIuWzAtOF18cG93ZXJwYy0yLlswLTdd fG04OGstWzItNF0uKnxtODhrLTUuWzAtMl18aHBwYS0zLlswLTVdfHZheC0qKQoJdGVzdCAteiAi JHVzZWRsIiAmJiB1c2VkbD0kdW5kZWYKCTs7CiopCgl0ZXN0IC16ICIkdXNlZGwiICYmIHVzZWRs PSRkZWZpbmUKCSMgV2UgdXNlIC1mUElDIGhlcmUgYmVjYXVzZSAtZnBpYyBpcyAqTk9UKiBlbm91 Z2ggZm9yIHNvbWUgb2YgdGhlCgkjIGV4dGVuc2lvbnMgbGlrZSBUayBvbiBzb21lIE9wZW5CU0Qg cGxhdGZvcm1zIChpZTogc3BhcmMpCgljY2NkbGZsYWdzPSItRFBJQyAtZlBJQyAkY2NjZGxmbGFn cyIKCWNhc2UgIiRvc3ZlcnMiIGluCglbMDFdLip8Mi5bMC03XXwyLlswLTddLiopCgkJbGRkbGZs YWdzPSItQnNoYXJlYWJsZSAkbGRkbGZsYWdzIgoJCTs7CgkyLls4LTldfDMuMCkKCQlsZD0ke2Nj Oi1jY30KCQlsZGRsZmxhZ3M9Ii1zaGFyZWQgLWZQSUMgJGxkZGxmbGFncyIKCQk7OwoJKikgIyBm cm9tIDMuMSBvbndhcmRzCgkJbGQ9JHtjYzotY2N9CgkJbGRkbGZsYWdzPSItc2hhcmVkIC1mUElD ICRsZGRsZmxhZ3MiCgkJbGlic3dhbnRlZD1gZWNobyAkbGlic3dhbnRlZCB8IHNlZCAncy8gZGwg LyAvJ2AKCQk7OwoJZXNhYwoKCSMgV2UgbmVlZCB0byBmb3JjZSBsZCB0byBleHBvcnQgc3ltYm9s cyBvbiBFTEYgcGxhdGZvcm1zLgoJIyBXaXRob3V0IHRoaXMsIGRsb3BlbigpIGlzIGNyaXBwbGVk LgoJRUxGPWAke2NjOi1jY30gLWRNIC1FIC0gPC9kZXYvbnVsbCB8IGdyZXAgX19FTEZfX2AKCXRl c3QgLW4gIiRFTEYiICYmIGxkZmxhZ3M9Ii1XbCwtRSAkbGRmbGFncyIKCTs7CmVzYWMKCiMKIyBU d2Vha3MgZm9yIHZhcmlvdXMgdmVyc2lvbnMgb2YgT3BlbkJTRAojCmNhc2UgIiRvc3ZlcnMiIGlu CjIuNSkKCSMgT3BlbkJTRCAyLjUgaGFzIGJyb2tlbiBvZGJtIHN1cHBvcnQKCWlfZGJtPSR1bmRl ZgoJOzsKZXNhYwoKIyBPcGVuQlNEIGRvZXNuJ3QgbmVlZCBsaWJjcnlwdCBidXQgbWFueSBmb2xr cyBrZWVwIGEgc3R1YiBsaWIKIyBhcm91bmQgZm9yIG9sZCBOZXRCU0QgYmluYXJpZXMuCmxpYnN3 YW50ZWQ9YGVjaG8gJGxpYnN3YW50ZWQgfCBzZWQgJ3MvIGNyeXB0IC8gLydgCgojIENvbmZpZ3Vy ZSBjYW4ndCBmaWd1cmUgdGhpcyBvdXQgbm9uLWludGVyYWN0aXZlbHkKZF9zdWlkc2FmZT0kZGVm aW5lCgojIGNjIGlzIGdjYyBzbyB3ZSBjYW4gZG8gYmV0dGVyIHRoYW4gLU8KIyBBbGxvdyBhIGNv bW1hbmQtbGluZSBvdmVycmlkZSwgc3VjaCBhcyAtRG9wdGltaXplPS1nCmNhc2UgIiR7QVJDSH0t JHtvc3ZlcnN9IiBpbgpocHBhLTMuM3xtODhrLTIuKnxtODhrLTMuWzAtM10pCiAgIHRlc3QgIiRv cHRpbWl6ZSIgfHwgb3B0aW1pemU9Jy1PMCcKICAgOzsKbTg4ay0zLjQpCiAgIHRlc3QgIiRvcHRp bWl6ZSIgfHwgb3B0aW1pemU9Jy1PMScKICAgOzsKKikKICAgdGVzdCAiJG9wdGltaXplIiB8fCBv cHRpbWl6ZT0nLU8yJwogICA7Owplc2FjCgojIFRoaXMgc2NyaXB0IFVVL3VzZXRocmVhZHMuY2J1 IHdpbGwgZ2V0ICdjYWxsZWQtYmFjaycgYnkgQ29uZmlndXJlIAojIGFmdGVyIGl0IGhhcyBwcm9t cHRlZCB0aGUgdXNlciBmb3Igd2hldGhlciB0byB1c2UgdGhyZWFkcy4KY2F0ID4gVVUvdXNldGhy ZWFkcy5jYnUgPDwnRU9DQlUnCmNhc2UgIiR1c2V0aHJlYWRzIiBpbgokZGVmaW5lfHRydWV8W3lZ XSopCgkjIGFueSBvcGVuYnNkIHZlcnNpb24gZGVwZW5kZW5jaWVzIHdpdGggcHRocmVhZHM/Cglj Y2ZsYWdzPSItcHRocmVhZCAkY2NmbGFncyIKCWxkZmxhZ3M9Ii1wdGhyZWFkICRsZGZsYWdzIgoJ Y2FzZSAiJG9zdmVycyIgaW4KCVswLTJdLip8My5bMC0yXSkKCQkjIENoYW5nZSBmcm9tIC1sYyB0 byAtbGNfcgoJCXNldCBgZWNobyAiWCAkbGlic3dhbnRlZCAiIHwgc2VkICdzLyBjIC8gY19yIC8n YAoJCXNoaWZ0CgkJbGlic3dhbnRlZD0iJCoiCgk7OwoJZXNhYwoJY2FzZSAiJG9zdmVycyIgaW4K CVswMTJdLip8My5bMC02XSkKICAgICAgICAJIyBCcm9rZW4gdXAgdG8gT3BlbkJTRCAzLjYsIGZp eGVkIGluIE9wZW5CU0QgMy43CgkJZF9nZXRzZXJ2YnluYW1lX3I9JHVuZGVmIDs7Cgllc2FjCmVz YWMKRU9DQlUKCiMgV2hlbiBidWlsZGluZyBpbiB0aGUgT3BlbkJTRCB0cmVlIHdlIHVzZSBkaWZm ZXJlbnQgcGF0aHMKIyBUaGlzIGlzIG9ubHkgcGFydCBvZiB0aGUgc3RvcnksIHRoZSByZXN0IGNv bWVzIGZyb20gY29uZmlnLm92ZXIKY2FzZSAiJG9wZW5ic2RfZGlzdHJpYnV0aW9uIiBpbgonJ3wk dW5kZWZ8ZmFsc2UpIDs7CiopCgkjIFdlIHB1dCB0aGluZ3MgaW4gL3Vzciwgbm90IC91c3IvbG9j YWwKCXByZWZpeD0nL3VzcicKCXByZWZpeGV4cD0nL3VzcicKCXN5c21hbj0nL3Vzci9zaGFyZS9t YW4vbWFuMScKCWxpYnB0aD0nL3Vzci9saWInCglnbGlicHRoPScvdXNyL2xpYicKCSMgTG9jYWwg dGhpbmdzLCBob3dldmVyLCBkbyBnbyBpbiAvdXNyL2xvY2FsCglzaXRlcHJlZml4PScvdXNyL2xv Y2FsJwoJc2l0ZXByZWZpeGV4cD0nL3Vzci9sb2NhbCcKCSMgUG9ydHMgaW5zdGFsbHMgbm9uLXN0 ZCBsaWJzIGluIC91c3IvbG9jYWwvbGliIHNvIGxvb2sgdGhlcmUgdG9vCglsb2NpbmNwdGg9Jy91 c3IvbG9jYWwvaW5jbHVkZScKCWxvY2xpYnB0aD0nL3Vzci9sb2NhbC9saWInCgkjIExpbmsgcGVy bCB3aXRoIHNoYXJlZCBsaWJwZXJsCglpZiBbICIkdXNlZGwiID0gIiRkZWZpbmUiIC1hIC1yIHNo bGliX3ZlcnNpb24gXTsgdGhlbgoJCXVzZXNocnBsaWI9dHJ1ZQoJCWxpYnBlcmw9YC4gLi9zaGxp Yl92ZXJzaW9uOyBlY2hvIGxpYnBlcmwuc28uJHttYWpvcn0uJHttaW5vcn1gCglmaQoJOzsKZXNh YwoKIyBvcGVuYnNkIGhhcyBhIHByb2JsZW0gcmVnYXJkaW5nIG5ld2xvY2FsZSgpCiMgaHR0cHM6 Ly9tYXJjLmluZm8vP2w9b3BlbmJzZC1idWdzJm09MTU1MzY0NTY4NjA4NzU5Jnc9MgojIHdoaWNo IGlzIGJlaW5nIGZpeGVkLiAgSW4gdGhlIG1lYW50aW1lLCBmb3JiaWQgUE9TSVggMjAwOCBsb2Nh bGVzCmRfbmV3bG9jYWxlPSIkdW5kZWYiCgojIGVuZAo=', 'solaris' => 'IyBoaW50cy9zb2xhcmlzXzIuc2gKIyBDb250cmlidXRpb25zIGJ5IChpbiBhbHBoYWJldGljYWwg b3JkZXIpIEFsYW4gQnVybGlzb24sIEFuZHkgRG91Z2hlcnR5LAojIERlYW4gUm9laHJpY2gsIEph cmtrbyBIaWV0YW5pZW1pLCBMdXBlIENocmlzdG9waCwgUmljaGFyZCBTb2RlcmJlcmcgYW5kCiMg bWFueSBvdGhlcnMuCiMKIyBTZWUgUkVBRE1FLnNvbGFyaXMgZm9yIGFkZGl0aW9uYWwgaW5mb3Jt YXRpb24uCiMKIyBGb3IgY29uc2lzdGVuY3kgd2l0aCBnY2MsIHdlIGRvIG5vdCBhZG9wdCBTdW4g TWFya2V0aW5nJ3MKIyByZW1vdmFsIG9mIHRoZSAnMi4nIHByZWZpeCBmcm9tIHRoZSBTb2xhcmlz IHZlcnNpb24gbnVtYmVyLgojIChDb25maWd1cmUgdHJpZXMgdG8gZGV0ZWN0IGFuIG9sZCBmaXhp bmNsdWRlcyBhbmQgbmVlZHMKIyB0aGlzIGluZm9ybWF0aW9uLikKCiMgSWYgcGVybCBmYWlscyB0 ZXN0cyB0aGF0IGludm9sdmUgZHluYW1pYyBsb2FkaW5nIG9mIGV4dGVuc2lvbnMsIGFuZAojIHlv dSBhcmUgdXNpbmcgZ2NjLCBiZSBzdXJlIHRoYXQgeW91IGFyZSBOT1QgdXNpbmcgR05VIGFzIGFu ZCBsZC4gIE9uZQojIHdheSB0byBkbyB0aGF0IGlzIHRvIGludm9rZSBDb25maWd1cmUgd2l0aAoj CiMgICAgIHNoIENvbmZpZ3VyZSAtRGNjPSdnY2MgLUIvdXNyL2Njcy9iaW4vJwojCiMgIChOb3Rl IHRoYXQgdGhlIHRyYWlsaW5nIHNsYXNoIGlzICpyZXF1aXJlZCouKQojICBnY2Mgd2lsbCBvY2Nh c2lvbmFsbHkgZW1pdCB3YXJuaW5ncyBhYm91dCAidW51c2VkIHByZWZpeCIsIGJ1dAojICB0aGVz ZSBvdWdodCB0byBiZSBoYXJtbGVzcy4gIFNlZSBiZWxvdyBmb3IgbW9yZSBkZXRhaWxzLgoKIyBT b2xhcmlzIGhhcyBzZWN1cmUgU1VJRCBzY3JpcHRzCmRfc3VpZHNhZmU9JHtkX3N1aWRzYWZlOi1k ZWZpbmV9CgojIEJlIHBhcmFub2lkIGFib3V0IG5tIGZhaWxpbmcgdG8gZmluZCBzeW1ib2xzCm1p c3RydXN0bm09JHttaXN0cnVzdG5tOi1ydW59CgojIFNldmVyYWwgcGVvcGxlIHJlcG9ydGVkIHBy b2JsZW1zIHdpdGggcGVybCdzIG1hbGxvYywgZXNwZWNpYWxseQojIHdoZW4gdXNlNjRiaXRhbGwg aXMgZGVmaW5lZCBvciB3aGVuIHVzaW5nIGdjYy4KIyAgICAgaHR0cDovL3d3dy54cmF5Lm1wZS5t cGcuZGUvbWFpbGluZy1saXN0cy9wZXJsNS1wb3J0ZXJzLzIwMDEtMDEvbXNnMDEzMTguaHRtbAoj ICAgICBodHRwOi8vd3d3LnhyYXkubXBlLm1wZy5kZS9tYWlsaW5nLWxpc3RzL3Blcmw1LXBvcnRl cnMvMjAwMS0wMS9tc2cwMDQ2NS5odG1sCnVzZW15bWFsbG9jPSR7dXNlbXltYWxsb2M6LWZhbHNl fQoKIyBtYWxsb2Mgd3JhcCB3b3JrcwpjYXNlICIkdXNlbWFsbG9jd3JhcCIgaW4KJycpIHVzZW1h bGxvY3dyYXA9J2RlZmluZScgOzsKZXNhYwoKIyBBdm9pZCBhbGwgbGlicmFyaWVzIGluIC91c3Iv dWNibGliLgojIC9saWIgaXMganVzdCBhIHN5bWxpbmsgdG8gL3Vzci9saWIKc2V0IGBlY2hvICRn bGlicHRoIHwgc2VkIC1lICdzQC91c3IvdWNibGliQEAnIC1lICdzQCAvbGliIEAgQCdgCmdsaWJw dGg9IiQqIgoKIyBTdGFydGluZyB3aXRoIFNvbGFyaXMgMTAsIHdlIGRvbid0IHdhbnQgdmVyc2lv bmVkIHNoYXJlZCBsaWJyYXJpZXMgYmVjYXVzZQojIHRob3NlIG9mdGVuIGluZGljYXRlIGEgcHJp dmF0ZSB1c2Ugb25seSBsaWJyYXJ5LiAgRXNwZWNpYWxseSBiYWRseSB0aGF0IHdvdWxkCiMgYnJl YWsgdGhpbmdzIHdpdGggU1VOV2JkYiAoQmVya2VsZXkgREIpIGJlaW5nIGluc3RhbGxlZCwgd2hp Y2ggYnJpbmdzIGluCiMgL3Vzci9saWIvbGliZGIuc28uMSwgYnV0IHRoYXQgaXMgbm90IHJlYWxs eSBtZWFudCBmb3IgcHVibGljIGNvbnN1bXB0aW9uLgojICBYWFggUmV2aXNpdCBhZnRlciBwZXJs IDUuMTAgLS0gc2hvdWxkIHdlIGFwcGx5IHRoaXMgdG8gb2xkZXIgU29sYXJpcwojIHZlcnNpb25z IHRvbz8gIChBLkQuIDExLzIwMDcpLgpjYXNlICJgJHJ1biB1bmFtZSAtcmAiIGluCjUuWzAtOV0p IDs7CiopIGlnbm9yZV92ZXJzaW9uZWRfc29saWJzPXkgOzsKZXNhYwoKIyBSZW1vdmUgdW53YW50 ZWQgbGlicmFyaWVzLiAgLWx1Y2IgY29udGFpbnMgaW5jb21wYXRpYmxlIHJvdXRpbmVzLgojIC1s bGQgYW5kIC1sc2VjIGRvbid0IGRvIGFueXRoaW5nIHVzZWZ1bC4gLWxjcnlwdCBkb2VzIG5vdAoj IHJlYWxseSBwcm92aWRlIGFueXRoaW5nIHdlIG5lZWQgb3ZlciAtbGMsIHNvIHdlIGRyb3AgaXQs IHRvby4KIyAtbG1hbGxvYyBjYW4gY2F1c2UgYSBwcm9ibGVtIHdpdGggR05VIENDICYgU29sYXJp cy4gIFNwZWNpZmljYWxseSwKIyBsaWJtYWxsb2MuYSBtYXkgYWxsb2NhdGUgbWVtb3J5IHRoYXQg aXMgb25seSA0IGJ5dGUgYWxpZ25lZCwgYnV0CiMgR05VIENDIG9uIHRoZSBTcGFyYyBhc3N1bWVz IHRoYXQgZG91YmxlcyBhcmUgOCBieXRlIGFsaWduZWQuCiMgVGhhbmtzIHRvICBIYWxsdmFyZCBC LiBGdXJ1c2V0aCA8aC5iLmZ1cnVzZXRoQHVzaXQudWlvLm5vPgpzZXQgYGVjaG8gIiAkbGlic3dh bnRlZCAiIHwgc2VkIC1lICdzQCBsZCBAIEAnIC1lICdzQCBtYWxsb2MgQCBAJyAtZSAnc0AgdWNi IEAgQCcgLWUgJ3NAIHNlYyBAIEAnIC1lICdzQCBjcnlwdCBAIEAnYApsaWJzd2FudGVkPSIkKiIK CiMgTG9vayBmb3IgYXJjaGl0ZWN0dXJlIG5hbWUuICBXZSB3YW50IHRvIHN1Z2dlc3QgYSB1c2Vm dWwgZGVmYXVsdC4KY2FzZSAiJGFyY2huYW1lIiBpbgonJykKICAgIGlmIHRlc3QgLWYgL3Vzci9i aW4vYXJjaDsgdGhlbgoJYXJjaG5hbWU9YC91c3IvYmluL2FyY2hgCglhcmNobmFtZT0iJHthcmNo bmFtZX0tJHtvc25hbWV9IgogICAgZWxpZiB0ZXN0IC1mIC91c3IvdWNiL2FyY2g7IHRoZW4KCWFy Y2huYW1lPWAvdXNyL3VjYi9hcmNoYAoJYXJjaG5hbWU9IiR7YXJjaG5hbWV9LSR7b3NuYW1lfSIK ICAgIGZpCiAgICA7Owplc2FjCgojCiMgVGhpcyBleHRyYWN0cyB0aGUgbGlicmFyeSBkaXJlY3Rv cmllcyB0aGF0IHdpbGwgYmUgc2VhcmNoZWQgYnkgdGhlIFN1bgojIFdvcmtzaG9wIGNvbXBpbGVy LCBnaXZlbiB0aGUgY29tbWFuZC1saW5lIHN1cHBsaWVkIGluICR0cnl3b3Jrc2hvcGNjLgojIFVz ZSB0aHVzbHk6IGxvY2xpYnB0aD0iYCRnZXR3b3Jrc2hvcGxpYnNgICRsb2NsaWJwdGgiCiMKCWdl dHdvcmtzaG9wbGlicz1gY2F0IDw8J0VORCcKZXZhbCAkdHJ5d29ya3Nob3BjYyAtIyMjIDI+JjEg fCBcCnNlZCAtbiAnLyAtWSAvcyEuKiAtWSAiUCxcKFteIl0qXCkiLiohXDEhcCcgfCB0ciAnOicg JyAnIHwgXApzZWQgLWUgJ3MhL3Vzci9saWIvc3BhcmN2OSEhJyAtZSAncyEvdXNyL2Njcy9saWIv c3BhcmN2OSEhJyBcCiAgICAtZSAncyEvdXNyL2xpYiEhZycgLWUgJ3MhL3Vzci9jY3MvbGliISFn JwpFTkQKYAoKY2FzZSAiJGNjIiBpbgonJykgICAgZm9yIGkgaW4gYGxzIC1yIC9vcHQvKnN0dWRp byovYmluL2NjYCAvb3B0L1NVTldzcHJvL2Jpbi9jYwogICAgICAgZG8KCSAgICAgICBpZiB0ZXN0 IC1mICIkaSI7IHRoZW4KCQkgICAgICAgY2M9JGkKCQkgICAgICAgY2F0IDw8RU9GID4mNAoKWW91 IHNwZWNpZmllZCBubyBjYyBidXQgeW91IHNlZW0gdG8gaGF2ZSB0aGUgV29ya3Nob3AgY29tcGls ZXIKKCRjYykgaW5zdGFsbGVkLCB1c2luZyB0aGF0LgpJZiB5b3Ugd2FudCBzb21ldGhpbmcgZWxz ZSwgc3BlY2lmeSB0aGF0IGluIHRoZSBjb21tYW5kIGxpbmUsCmUuZy4gQ29uZmlndXJlIC1EY2M9 Z2NjCgpFT0YKCQkJYnJlYWsKCQlmaQoJZG9uZQoJOzsKZXNhYwoKIyMjIyMjIyMjIyMjIyMjIyMj IyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjCiMgR2VuZXJhbCBzYW5pdHkgdGVz dGluZy4gIFNlZSBiZWxvdyBmb3IgZXhjZXJwdHMgZnJvbSB0aGUgU29sYXJpcyBGQVEuCiMKIyBG cm9tIHJvZWhyaWNoQGlyb253b29kLWZkZGkuY3JheS5jb20gV2VkIFNlcCAyNyAxMjo1MTo0NiAx OTk1CiMgRGF0ZTogVGh1LCA3IFNlcCAxOTk1IDE2OjMxOjQwIC0wNTAwCiMgRnJvbTogRGVhbiBS b2VocmljaCA8cm9laHJpY2hAaXJvbndvb2QtZmRkaS5jcmF5LmNvbT4KIyBUbzogcGVybDUtcG9y dGVyc0BhZnJpY2Eubmljb2guY29tCiMgU3ViamVjdDogUmU6IE9uIHBlcmw1L3NvbGFyaXMvZ2Nj CiMKIyBIZXJlJ3MgYW5vdGhlciBkcmFmdCBvZiB0aGUgcGVybDUvc29sYXJpcy9nY2Mgc2FuaXR5 LWNoZWNrZXIuCgpjYXNlIGB0eXBlICR7Y2M6LWNjfWAgaW4KKi91c3IvdWNiL2NjKikgY2F0IDw8 RU5EID4mNAoKTk9URTogIFNvbWUgcGVvcGxlIGhhdmUgcmVwb3J0ZWQgcHJvYmxlbXMgd2l0aCAv dXNyL3VjYi9jYy4KSWYgeW91IGhhdmUgZGlmZmljdWx0aWVzLCBwbGVhc2UgbWFrZSBzdXJlIHRo ZSBkaXJlY3RvcnkKY29udGFpbmluZyB5b3VyIEMgY29tcGlsZXIgaXMgYmVmb3JlIC91c3IvdWNi IGluIHlvdXIgUEFUSC4KCkVORAo7Owplc2FjCgoKIyBDaGVjayB0aGF0IC9kZXYvZmQgaXMgbW91 bnRlZC4gIElmIGl0IGlzIG5vdCBtb3VudGVkLCBsZXQgdGhlCiMgdXNlciBrbm93IHRoYXQgc3Vp ZCBzY3JpcHRzIG1heSBub3Qgd29yay4KJHJ1biBtb3VudCB8IGdyZXAgJ14vZGV2L2ZkICcgMj4m MSA+IC9kZXYvbnVsbApjYXNlICQ/IGluCjApIDs7CiopCgljYXQgPDxFTkQgPiY0CgpOT1RFOiBZ b3VyIHN5c3RlbSBkb2VzIG5vdCBoYXZlIC9kZXYvZmQgbW91bnRlZC4gIElmIHlvdSB3YW50IHRv CmJlIGFibGUgdG8gdXNlIHNldC11aWQgc2NyaXB0cyB5b3UgbXVzdCBhc2sgeW91ciBzeXN0ZW0g YWRtaW5pc3RyYXRvcgp0byBtb3VudCAvZGV2L2ZkLgoKRU5ECgk7Owplc2FjCgoKIyBTZWUgaWYg bGlidWNiIGNhbiBiZSBmb3VuZCBpbiAvdXNyL2xpYi4gIElmIGl0IGlzLCB3YXJuIHRoZSB1c2Vy CiMgdGhhdCB0aGlzIG1heSBjYXVzZSBwcm9ibGVtcyB3aGlsZSBidWlsZGluZyBQZXJsIGV4dGVu c2lvbnMuCmZvdW5kX2xpYnVjYj0nJwpjYXNlICIkcnVuIiBpbgonJykgL3Vzci9iaW4vbHMgL3Vz ci9saWIvbGlidWNiKiA+L2Rldi9udWxsIDI+JjEKICAgIGZvdW5kX2xpYnVjYj0kPwogICAgOzsK KikgICRydW4gL3Vzci9iaW4vbHMgJy91c3IvbGliL2xpYnVjYionID4vZGV2L251bGwgMj4mMQog ICAgZm91bmRfbGlidWNiPSQ/CiAgICA7Owplc2FjCgpjYXNlICRmb3VuZF9saWJ1Y2IgaW4KMCkK CWNhdCA8PEVORCA+JjQKCk5PVEU6IGxpYnVjYiBoYXMgYmVlbiBmb3VuZCBpbiAvdXNyL2xpYi4g IGxpYnVjYiBzaG91bGQgcmVzaWRlIGluCi91c3IvdWNibGliLiAgWW91IG1heSBoYXZlIHRyb3Vi bGUgd2hpbGUgYnVpbGRpbmcgUGVybCBleHRlbnNpb25zLgoKRU5ECjs7CmVzYWMKCiMgVXNlIHNo ZWxsIGJ1aWx0LWluICd0eXBlJyBjb21tYW5kIGluc3RlYWQgb2YgL3Vzci9iaW4vd2hpY2ggdG8K IyBhdm9pZCBwb3NzaWJsZSBjc2ggc3RhcnQtdXAgcHJvYmxlbXMgYW5kIGFsc28gdG8gdXNlIHRo ZSBzYW1lIHNoZWxsCiMgd2UnbGwgYmUgdXNpbmcgdG8gQ29uZmlndXJlIGFuZCBtYWtlIHBlcmwu CiMgVGhlIHBhdGggbmFtZSBpcyB0aGUgbGFzdCBmaWVsZCBpbiB0aGUgb3V0cHV0LCBidXQgdGhl IHR5cGUgY29tbWFuZAojIGhhcyBhbiBhbm5veWluZyBhcnJheSBvZiBwb3NzaWJsZSBvdXRwdXRz LCBlLmcuOgojCW1ha2UgaXMgaGFzaGVkICgvb3B0L2dudS9iaW4vbWFrZSkKIwljYyBpcyAvdXNy L3VjYi9jYwojCWZvbyBub3QgZm91bmQKIyB1c2UgYSBjb21tYW5kIGxpa2UgdHlwZSBtYWtlIHwg YXdrICd7cHJpbnQgJE5GfScgfCBzZWQgJ3MvWygpXS8vZycKCiMgU2VlIGlmIG1ha2UoMSkgaXMg R05VIG1ha2UoMSkuCiMgSWYgaXQgaXMsIG1ha2Ugc3VyZSB0aGUgc2V0Z2lkIGJpdCBpcyBub3Qg c2V0LgptYWtlIC12ID4gbWFrZS52ZXJzIDI+JjEKaWYgZ3JlcCBHTlUgbWFrZS52ZXJzID4gL2Rl di9udWxsIDI+JjE7IHRoZW4KICAgIHRtcD1gdHlwZSBtYWtlIHwgYXdrICd7cHJpbnQgJE5GfScg fCBzZWQgJ3MvWygpXS8vZydgCiAgICBjYXNlICJgJHtsczotJy91c3IvYmluL2xzJ30gLWxMICR0 bXBgIiBpbgogICAgPz8/Pz8/cyopCgkgICAgY2F0IDw8RU5EID4mMgoKTk9URTogWW91ciBQQVRI IHBvaW50cyB0byBHTlUgbWFrZSwgYW5kIHlvdXIgR05VIG1ha2UgaGFzIHRoZSBzZXQtZ3JvdXAt aWQKYml0IHNldC4gIFlvdSBtdXN0IGVpdGhlciByZWFycmFuZ2UgeW91ciBQQVRIIHRvIHB1dCAv dXNyL2Njcy9iaW4gYmVmb3JlIHRoZQpHTlUgdXRpbGl0aWVzIG9yIHlvdSBtdXN0IGFzayB5b3Vy IHN5c3RlbSBhZG1pbmlzdHJhdG9yIHRvIGRpc2FibGUgdGhlCnNldC1ncm91cC1pZCBiaXQgb24g R05VIG1ha2UuCgpFTkQKCSAgICA7OwogICAgZXNhYwpmaQpybSAtZiBtYWtlLnZlcnMKCmNhdCA+ IFVVL2NjLmNidSA8PCdFT0NCVScKIyBUaGlzIHNjcmlwdCBVVS9jYy5jYnUgd2lsbCBnZXQgJ2Nh bGxlZC1iYWNrJyBieSBDb25maWd1cmUgYWZ0ZXIgaXQKIyBoYXMgcHJvbXB0ZWQgdGhlIHVzZXIg Zm9yIHRoZSBDIGNvbXBpbGVyIHRvIHVzZS4KCiMgSWYgdGhlIEMgY29tcGlsZXIgaXMgZ2NjOgoj ICAgLSBjaGVjayB0aGUgZml4ZWQtaW5jbHVkZXMKIyAgIC0gY2hlY2sgYXMoMSkgYW5kIGxkKDEp LCB0aGV5IHNob3VsZCBub3QgYmUgR05VCiMJKEdOVSBhcyBhbmQgbGQgMi44LjEgYW5kIGxhdGVy IGFyZSByZXBvcnRlZGx5IG9rLCBob3dldmVyLikKIyBJZiB0aGUgQyBjb21waWxlciBpcyBub3Qg Z2NjOgojICAgLSBDaGVjayBpZiBpdCBpcyB0aGUgV29ya3Nob3AvRm9ydGUgY29tcGlsZXIuCiMg ICAgIElmIGl0IGlzLCBwcmVwYXJlIGZvciA2NCBiaXQgYW5kIGxvbmcgZG91Ymxlcy4KIyAgIC0g Y2hlY2sgYXMoMSkgYW5kIGxkKDEpLCB0aGV5IHNob3VsZCBub3QgYmUgR05VCiMJKEdOVSBhcyBh bmQgbGQgMi44LjEgYW5kIGxhdGVyIGFyZSByZXBvcnRlZGx5IG9rLCBob3dldmVyLikKIwojIFdh dGNoIG91dCBpbiBjYXNlIHRoZXkgaGF2ZSBub3Qgc2V0ICRjYy4KCiMgUGVybCBjb21waWxlZCB3 aXRoIHNvbWUgY29tYmluYXRpb25zIG9mIEdOVSBhcyBhbmQgbGQgbWF5IG5vdAojIGJlIGFibGUg dG8gcGVyZm9ybSBkeW5hbWljIGxvYWRpbmcgb2YgZXh0ZW5zaW9ucy4gIElmIHlvdSBoYXZlIGEK IyBwcm9ibGVtIHdpdGggZHluYW1pYyBsb2FkaW5nLCBiZSBzdXJlIHRoYXQgeW91IGFyZSB1c2lu ZyB0aGUgU29sYXJpcwojIC91c3IvY2NzL2Jpbi9hcyBhbmQgL3Vzci9jY3MvYmluL2xkLiAgWW91 IGNhbiBkbyB0aGF0IHdpdGgKIwlzaCBDb25maWd1cmUgLURjYz0nZ2NjIC1CL3Vzci9jY3MvYmlu LycKIyAobm90ZSB0aGUgdHJhaWxpbmcgc2xhc2ggaXMgcmVxdWlyZWQpLgojIENvbWJpbmF0aW9u cyB0aGF0IGFyZSBrbm93biB0byB3b3JrIHdpdGggdGhlIGZvbGxvd2luZyBoaW50czoKIwojICBn Y2MtMi43LjIsIEdOVSBhcyAyLjcsIEdOVSBsZCAyLjcKIyAgZWdjcy0xLjAuMywgR05VIGFzIDIu OS4xIGFuZCBHTlUgbGQgMi45LjEKIwktLUFuZHkgRG91Z2hlcnR5ICA8ZG91Z2hlcmFAbGFmYXll dHRlLmVkdT4KIwlUdWUgQXByIDEzIDE3OjE5OjQzIEVEVCAxOTk5CgojIEdldCBnY2MgdG8gc2hh cmUgaXRzIHNlY3JldHMuCmVjaG8gJ2ludCBtYWluKCkgeyByZXR1cm4gMDsgfScgPiB0cnkuYwoJ IyBJbmRlbnQgdG8gYXZvaWQgcHJvcGFnYXRpb24gdG8gY29uZmlnLnNoCgl2ZXJib3NlPWAke2Nj Oi1jY30gJGNjZmxhZ3MgLXYgLW8gdHJ5IHRyeS5jIDI+JjFgCgojIFhYWCBUT0RPOiAgJ3NwZWNz JyBvdXRwdXQgY2hhbmdlZCBmcm9tICdSZWFkaW5nIHNwZWNzIGZyb20nIGluIGdjYy1bMjNdIHRv ICdVc2luZwojIGJ1aWx0LWluIHNwZWNzJyBpbiBnY2MtNC4gIFBlcmhhcHMgd2Ugc2hvdWxkIGp1 c3QgdXNlIHRoZSBzYW1lIGdjYyB0ZXN0IGFzCiMgaW4gQ29uZmlndXJlIHRvIHNlZSBpZiB3ZSdy ZSB1c2luZyBnY2MuCmlmIGVjaG8gIiR2ZXJib3NlIiB8IGVncmVwICcoUmVhZGluZyBzcGVjcyBm cm9tKXwoVXNpbmcgYnVpbHQtaW4gc3BlY3MpJyA+L2Rldi9udWxsIDI+JjE7IHRoZW4KCSMKCSMg VXNpbmcgZ2NjLgoJIwoJY2NfbmFtZT0nZ2NjJwoKCSMgU2VlIGlmIGFzKDEpIGlzIEdOVSBhcygx KS4gIEdOVSBhcygxKSBtaWdodCBub3Qgd29yayBmb3IgdGhpcyBqb2IuCglpZiBlY2hvICIkdmVy Ym9zZSIgfCBncmVwICcgL3Vzci9jY3MvYmluL2FzICcgPi9kZXYvbnVsbCAyPiYxOyB0aGVuCgkg ICAgOgoJZWxzZQoJICAgIGNhdCA8PEVORCA+JjIKCk5PVEU6IFlvdSBhcmUgdXNpbmcgR05VIGFz KDEpLiAgR05VIGFzKDEpIG1pZ2h0IG5vdCBidWlsZCBQZXJsLiAgSWYgeW91CmhhdmUgdHJvdWJs ZSwgeW91IGNhbiB1c2UgL3Vzci9jY3MvYmluL2FzIGJ5IGluY2x1ZGluZyAtQi91c3IvY2NzL2Jp bi8KaW4geW91ciAke2NjOi1jY30gY29tbWFuZC4gIChOb3RlIHRoYXQgdGhlIHRyYWlsaW5nICIv IiBpcyByZXF1aXJlZC4pCgpFTkQKCSAgICAjIEFwcGFyZW50bHkgbm90IG5lZWRlZCwgYXQgbGVh c3QgZm9yIGFzIDIuNyBhbmQgbGF0ZXIuCgkgICAgIyBjYz0iJHtjYzotY2N9ICRjY2ZsYWdzIC1C L3Vzci9jY3MvYmluLyIKCWZpCgoJIyBTZWUgaWYgbGQoMSkgaXMgR05VIGxkKDEpLiAgR05VIGxk KDEpIG1pZ2h0IG5vdCB3b3JrIGZvciB0aGlzIGpvYi4KCSMgUmVjb21wdXRlICR2ZXJib3NlIHNp bmNlIHdlIG1heSBoYXZlIGp1c3QgY2hhbmdlZCAkY2MuCgl2ZXJib3NlPWAke2NjOi1jY30gJGNj ZmxhZ3MgLXYgLW8gdHJ5IHRyeS5jIDI+JjEgfCBncmVwIGxkIDI+JjFgCgoJaWYgZWNobyAiJHZl cmJvc2UiIHwgZ3JlcCAnIC91c3IvY2NzL2Jpbi9sZCAnID4vZGV2L251bGwgMj4mMTsgdGhlbgoJ ICAgICMgT2ssIGdjYyBkaXJlY3RseSBjYWxscyB0aGUgU29sYXJpcyAvdXNyL2Njcy9iaW4vbGQu CgkgICAgOgoJZWxpZiBlY2hvICIkdmVyYm9zZSIgfCBncmVwICJsZDogU29mdHdhcmUgR2VuZXJh dGlvbiBVdGlsaXRpZXMiID4vZGV2L251bGwgMj4mMTsgdGhlbgoJICAgICMgSG1tLiAgZ2NjIGRv ZXNuJ3QgY2FsbCAvdXNyL2Njcy9iaW4vbGQgZGlyZWN0bHksIGJ1dCBpdAoJICAgICMgZG9lcyBh cHBlYXIgdG8gYmUgdXNpbmcgaXQgZXZlbnR1YWxseS4gIGVnY3MtMS4wLjMncyBsZAoJICAgICMg d3JhcHBlciBkb2VzIHRoaXMuCgkgICAgIyBNb3N0IFNvbGFyaXMgdmVyc2lvbnMgb2YgbGQgSSd2 ZSBzZWVuIGNvbnRhaW4gdGhlIG1hZ2ljCgkgICAgIyBzdHJpbmcgdXNlZCBpbiB0aGUgZ3JlcC4K CSAgICA6CgllbGlmIGVjaG8gIiR2ZXJib3NlIiB8IGdyZXAgIlNvbGFyaXMgTGluayBFZGl0b3Jz IiA+L2Rldi9udWxsIDI+JjE7IHRoZW4KCSAgICAjIEhvd2V2ZXIgc29tZSBTb2xhcmlzIDggdmVy c2lvbnMgcHJpb3IgdG8gbGQgNS44LTEuMjg2IGNvbnRhaW4KCSAgICAjIHRoaXMgc3RyaW5nIGlu c3RlYWQuCgkgICAgOgoJZWxzZQoJICAgICMgTm8gZXZpZGVuY2UgeWV0IG9mIC91c3IvY2NzL2Jp bi9sZC4gIFNvbWUgdmVyc2lvbnMKCSAgICAjIG9mIGVnY3MncyBsZCB3cmFwcGVyIGNhbGwgL3Vz ci9jY3MvYmluL2xkIGluIHR1cm4gYnV0CgkgICAgIyBhcHBhcmVudGx5IGRvbid0IHJldmVhbCB0 aGF0IHVubGVzcyB5b3UgcGFzcyBpbiAtVi4KCSAgICAjIChUaGlzIG1heSBhbGwgZGVwZW5kIG9u IGxvY2FsIGNvbmZpZ3VyYXRpb25zIHRvby4pCgoJICAgICMgUmVjb21wdXRlIHZlcmJvc2Ugd2l0 aCAtV2wsLXYgdG8gZmluZCBHTlUgbGQgaWYgcHJlc2VudAoJICAgIHZlcmJvc2U9YCR7Y2M6LWNj fSAkY2NmbGFncyAtV2wsLXYgLW8gdHJ5IHRyeS5jIDI+JjEgfCBncmVwIC9sZCAyPiYxYAoKCSAg ICBteWxkPWBlY2hvICR2ZXJib3NlIHwgYXdrICcvXC9sZC8ge3ByaW50ICQxfSdgCgkgICAgIyBU aGlzIGFzc3VtZXMgdGhhdCBnY2MncyBvdXRwdXQgd2lsbCBub3QgY2hhbmdlLCBhbmQgdGhhdAoJ ICAgICMgL2Z1bGwvcGF0aC90by9sZCB3aWxsIGJlIHRoZSBmaXJzdCB3b3JkIG9mIHRoZSBvdXRw dXQuCgkgICAgIyBUaHVzIG15bGQgaXMgc29tZXRoaW5nIGxpa2UgL29wdC9nbnUvc3BhcmMtc3Vu LXNvbGFyaXMyLjUvYmluL2xkCgoJICAgICMgQWxsb3cgdGhhdCAkbXlsZCBtYXkgYmUgJycsIGR1 ZSB0byBjaGFuZ2VzIGluIGdjYydzIG91dHB1dAoJICAgIGlmICR7bXlsZDotbGR9IC1WIDI+JjEg fAoJCWdyZXAgImxkOiBTb2Z0d2FyZSBHZW5lcmF0aW9uIFV0aWxpdGllcyIgPi9kZXYvbnVsbCAy PiYxOyB0aGVuCgkJIyBPaywgL3Vzci9jY3MvYmluL2xkIGV2ZW50dWFsbHkgZG9lcyBnZXQgY2Fs bGVkLgoJCToKCSAgICBlbGlmICR7bXlsZDotbGR9IC1WIDI+JjEgfAoJCWdyZXAgIlNvbGFyaXMg TGluayBFZGl0b3JzIiA+L2Rldi9udWxsIDI+JjE7IHRoZW4KCQkjIE9rLCAvdXNyL2Njcy9iaW4v bGQgZXZlbnR1YWxseSBkb2VzIGdldCBjYWxsZWQuCgkJOgoJICAgIGVsc2UKCQllY2hvICJGb3Vu ZCBHTlUgbGQ9JyRteWxkJyIgPiY0CgkJY2F0IDw8RU5EID4mMgoKTk9URTogWW91IGFyZSB1c2lu ZyBHTlUgbGQoMSkuICBHTlUgbGQoMSkgbWlnaHQgbm90IGJ1aWxkIFBlcmwuICBJZiB5b3UKaGF2 ZSB0cm91YmxlLCB5b3UgY2FuIHVzZSAvdXNyL2Njcy9iaW4vbGQgYnkgaW5jbHVkaW5nIC1CL3Vz ci9jY3MvYmluLwppbiB5b3VyICR7Y2M6LWNjfSBjb21tYW5kLiAgKE5vdGUgdGhhdCB0aGUgdHJh aWxpbmcgIi8iIGlzIHJlcXVpcmVkLikKCkkgd2lsbCB0cnkgdG8gdXNlIEdOVSBsZCBieSBwYXNz aW5nIGluIHRoZSAtV2wsLUUgZmxhZywgYnV0IGlmIHRoYXQKZG9lc24ndCB3b3JrLCB5b3Ugc2hv dWxkIHVzZSAtQi91c3IvY2NzL2Jpbi8gaW5zdGVhZC4KCkVORAoJCWNjZGxmbGFncz0iJGNjZGxm bGFncyAtV2wsLUUiCgkJbGRkbGZsYWdzPSIkbGRkbGZsYWdzIC1XbCwtRSAtc2hhcmVkIgoJICAg IGZpCglmaQoKZWxzZQoJIwoJIyBOb3QgdXNpbmcgZ2NjLgoJIwoJY2F0ID4gdHJ5LmMgPDwgJ0VP TScKI2luY2x1ZGUgPHN0ZGlvLmg+CmludCBtYWluKCkgewojaWYgZGVmaW5lZChfX1NVTlBST19D KQoJcHJpbnRmKCJ3b3Jrc2hvcFxuIik7CiNlbHNlCiNpZiBkZWZpbmVkKF9fU1VOUFJPX0NDKQoJ cHJpbnRmKCJ3b3Jrc2hvcCBDQ1xuIik7CiNlbHNlCglwcmludGYoIlxuIik7CiNlbmRpZgojZW5k aWYKcmV0dXJuKDApOwp9CkVPTQoJdHJ5d29ya3Nob3BjYz0iJHtjYzotY2N9ICRjY2ZsYWdzIHRy eS5jIC1vIHRyeSIKCWlmICR0cnl3b3Jrc2hvcGNjID4vZGV2L251bGwgMj4mMTsgdGhlbgoJCWNj X25hbWU9YCRydW4gLi90cnlgCgkJaWYgdGVzdCAiJGNjX25hbWUiID0gIndvcmtzaG9wIjsgdGhl bgoJCQljY3ZlcnNpb249ImAke2NjOi1jY30gLVYgMj4mMXxzZWQgLW4gLWUgJzFzL15bQ2NdW0Nj OV05KjogLy9wJ2AiCgkJZmkKCQlpZiB0ZXN0ICIkY2NfbmFtZSIgPSAid29ya3Nob3AgQ0MiOyB0 aGVuCgkJCWNjdmVyc2lvbj0iYCR7Y2M6LUNDfSAtViAyPiYxfHNlZCAtbiAtZSAnMXMvXltDY11b Q106IC8vcCdgIgoJCWZpCgkJY2FzZSAiJGNjX25hbWUiIGluCgkJd29ya3Nob3AqKQoJCQkjIFNl dHRpbmdzIGZvciBlaXRoZXIgY2Mgb3IgQ0MKCQkJaWYgdGVzdCAhICIkdXNlNjRiaXRhbGxfZG9u ZSI7IHRoZW4KCQkJCWxvY2xpYnB0aD0iL3Vzci9saWIgL3Vzci9jY3MvbGliIGAkZ2V0d29ya3No b3BsaWJzYCAkbG9jbGlicHRoIgoJCQlmaQoJCQkjIFN1biBDQy9jYyBkb24ndCBzdXBwb3J0IGdj YyBhdHRyaWJ1dGVzCgkJCWRfYXR0cmlidXRlX2Zvcm1hdD0ndW5kZWYnCgkJCWRfYXR0cmlidXRl X21hbGxvYz0ndW5kZWYnCgkJCWRfYXR0cmlidXRlX25vbm51bGw9J3VuZGVmJwoJCQlkX2F0dHJp YnV0ZV9ub3JldHVybj0ndW5kZWYnCgkJCWRfYXR0cmlidXRlX3B1cmU9J3VuZGVmJwoJCQlkX2F0 dHJpYnV0ZV91bnVzZWQ9J3VuZGVmJwoJCQlkX2F0dHJpYnV0ZV93YXJuX3VudXNlZF9yZXN1bHQ9 J3VuZGVmJwoJCQljYXNlICIkY2MiIGluCgkJCSpjOTkpCSMgYzk5IHJlamVjdHMgYmFyZSAnLU8n LgoJCQkJY2FzZSAiJG9wdGltaXplIiBpbgoJCQkJJyd8LU8pIG9wdGltaXplPS1PMyA7OwoJCQkJ ZXNhYwoJCQkJIyBXaXRob3V0IC1YYSBjOTkgZG9lc24ndCBzZWUKCQkJCSMgbWFueSBPUyBpbnRl cmZhY2VzLgoJCQkJY2FzZSAiJGNjZmxhZ3MiIGluCgkJCQkqLVhhKikJOzsKCQkJCSopIGNjZmxh Z3M9IiRjY2ZsYWdzIC1YYSIgOzsKCQkJCWVzYWMKCQkJCTs7CgkJCWVzYWMKCQkJOzsKCQllc2Fj CglmaQoKCSMgU2VlIGlmIGFzKDEpIGlzIEdOVSBhcygxKS4gIEdOVSBtaWdodCBub3Qgd29yayBm b3IgdGhpcyBqb2IuCgljYXNlIGBhcyAtLXZlcnNpb24gPCAvZGV2L251bGwgMj4mMWAgaW4KCSpH TlUqKQoJCWNhdCA8PEVORCA+JjIKCk5PVEU6IFlvdSBhcmUgdXNpbmcgR05VIGFzKDEpLiAgR05V IGFzKDEpIG1pZ2h0IG5vdCBidWlsZCBQZXJsLgpZb3UgbXVzdCBhcnJhbmdlIHRvIHVzZSAvdXNy L2Njcy9iaW4vYXMsIHBlcmhhcHMgYnkgYWRkaW5nIC91c3IvY2NzL2Jpbgp0byB0aGUgYmVnaW5u aW5nIG9mIHlvdXIgUEFUSC4KCkVORAoJCTs7Cgllc2FjCgoJIyBTZWUgaWYgbGQoMSkgaXMgR05V IGxkKDEpLiAgR05VIGxkKDEpIG1pZ2h0IG5vdCB3b3JrIGZvciB0aGlzIGpvYi4KCSMgbGQgLS12 ZXJzaW9uIGRvZXNuJ3QgcHJvcGVybHkgcmVwb3J0IGl0c2VsZiBhcyBhIEdOVSB0b29sLAoJIyBh cyBvZiBsZCB2ZXJzaW9uIDIuNiwgc28gd2UgbmVlZCB0byBiZSBtb3JlIHN0cmljdC4gVFdQIDkv NS85NgoJIyBTdW4ncyBsZCBhbHdheXMgZW1pdHMgdGhlICJTb2Z0d2FyZSBHZW5lcmF0aW9uIFV0 aWxpdGllcyIgc3RyaW5nLgoJaWYgbGQgLVYgMj4mMSB8IGdyZXAgImxkOiBTb2Z0d2FyZSBHZW5l cmF0aW9uIFV0aWxpdGllcyIgPi9kZXYvbnVsbCAyPiYxOyB0aGVuCgkgICAgIyBPaywgbGQgaXMg L3Vzci9jY3MvYmluL2xkLgoJICAgIDoKCWVsc2UKCSAgICBjYXQgPDxFTkQgPiYyCgpOT1RFOiBZ b3UgYXJlIGFwcGFyZW50bHkgdXNpbmcgR05VIGxkKDEpLiAgR05VIGxkKDEpIG1pZ2h0IG5vdCBi dWlsZCBQZXJsLgpZb3Ugc2hvdWxkIGFycmFuZ2UgdG8gdXNlIC91c3IvY2NzL2Jpbi9sZCwgcGVy aGFwcyBieSBhZGRpbmcgL3Vzci9jY3MvYmluCnRvIHRoZSBiZWdpbm5pbmcgb2YgeW91ciBQQVRI LgoKRU5ECglmaQpmaQoKIyBhcyAtLXZlcnNpb24gb3IgbGQgLS12ZXJzaW9uIG1pZ2h0IGR1bXAg Y29yZS4Kcm0gLWYgdHJ5IHRyeS5jIGNvcmUKRU9DQlUKCmNhdCA+IFVVL3VzZXRocmVhZHMuY2J1 IDw8J0VPQ0JVJwojIFRoaXMgc2NyaXB0IFVVL3VzZXRocmVhZHMuY2J1IHdpbGwgZ2V0ICdjYWxs ZWQtYmFjaycgYnkgQ29uZmlndXJlCiMgYWZ0ZXIgaXQgaGFzIHByb21wdGVkIHRoZSB1c2VyIGZv ciB3aGV0aGVyIHRvIHVzZSB0aHJlYWRzLgpjYXNlICIkdXNldGhyZWFkcyIgaW4KJGRlZmluZXx0 cnVlfFt5WV0qKQoJY2NmbGFncz0iLURfUkVFTlRSQU5UICRjY2ZsYWdzIgoKCSMgLWxwdGhyZWFk IG92ZXJyaWRlcyBzb21lIGxpYiBDIGZ1bmN0aW9ucywgc28gcHV0IGl0IGJlZm9yZSBjLgoJc2V0 IGBlY2hvIFggIiRsaWJzd2FudGVkICJ8IHNlZCAtZSAicy8gYyAvIHB0aHJlYWQgYyAvImAKCXNo aWZ0CglsaWJzd2FudGVkPSIkKiIKCgkjIHNjaGVkX3lpZWxkIGlzIGF2YWlsYWJsZSBpbiB0aGUg LWxydCBsaWJyYXJ5LiAgSG93ZXZlciwKCSMgd2UgY2FuIGFsc28gcGljayB1cCB0aGUgZXF1aXZh bGVudCB5aWVsZCgpIGZ1bmN0aW9uIGluIHRoZQoJIyBub3JtYWwgQyBsaWJyYXJ5LiAgVG8gYXZv aWQgcHVsbGluZyBpbiB1bm5lY2Vzc2FyeQoJIyBsaWJyYXJpZXMsIHdlJ2xsIG5vcm1hbGx5IGF2 b2lkIHNjaGVkX3lpZWxkKCkvLWxydCBhbmQKCSMganVzdCB1c2UgeWllbGQoKS4gIEhvd2V2ZXIs IHdlJ2xsIGhvbm9yIGEgY29tbWFuZC1saW5lCgkjIG92ZXJyaWRlIDogIi1Ec2NoZWRfeWllbGQ9 c2NoZWRfeWllbGQiLgoJIyBJZiB3ZSBlbmQgdXAgdXNpbmcgc2NoZWRfeWllbGQsIHdlJ3JlIGdv aW5nIHRvIG5lZWQgLWxydC4KCXNjaGVkX3lpZWxkPSR7c2NoZWRfeWllbGQ6LXlpZWxkfQoJaWYg dGVzdCAiJHNjaGVkX3lpZWxkIiA9ICJzY2hlZF95aWVsZCI7IHRoZW4KCSAgICBzZXQgYGVjaG8g WCAiJGxpYnN3YW50ZWQgInwgc2VkIC1lICJzLyBwdGhyZWFkIC8gcnQgcHRocmVhZCAvImAKCSAg ICBzaGlmdAoJICAgIGxpYnN3YW50ZWQ9IiQqIgoJZmkKCgkjIE9uIFNvbGFyaXMgMi42IHg4NiB0 aGVyZSBpcyBhIGJ1ZyB3aXRoIHNpZ3NldGptcCgpIGFuZCBzaWdsb25nam1wKCkKCSMgd2hlbiBs aW5rZWQgd2l0aCB0aGUgdGhyZWFkcyBsaWJyYXJ5LCBzdWNoIHRoYXQgd2hhdGV2ZXIgcG9zaXRp dmUKCSMgdmFsdWUgeW91IHBhc3MgdG8gc2lnbG9uZ2ptcCgpLCBzaWdzZXRqbXAoKSByZXR1cm5z IDEuCgkjIFRoYW5rcyB0byBTaW1vbiBQYXJzb25zIDxTLlBhcnNvbnNAZnRlbC5jby51az4gZm9y IHRoaXMgcmVwb3J0LgoJIyBTdW4gQnVnSUQgaXMgNDExNzk0NiwgInNpZ3NldGptcCBhbHdheXMg cmV0dXJucyAxIHdoZW4gY2FsbGVkIGJ5CgkjIHNpZ2xvbmdqbXAgaW4gYSBNVCBwcm9ncmFtIi4g QXMgb2YgMTk5ODA2MjIsIHRoZXJlIGlzIG5vIHBhdGNoCgkjIGF2YWlsYWJsZS4KCWNhdCA+dHJ5 LmMgPDwnRU9NJwoJLyogVGVzdCBmb3Igc2lnKHNldHxsb25nKWptcCBidWcuICovCgkjaW5jbHVk ZSA8c2V0am1wLmg+CgoJaW50IG1haW4oKQoJewoJICAgIHNpZ2ptcF9idWYgZW52OwoJICAgIGlu dCByZXQ7CgoJICAgIHJldCA9IHNpZ3NldGptcChlbnYsIDEpOwoJICAgIGlmIChyZXQpIHsgcmV0 dXJuIHJldCA9PSAyOyB9CgkgICAgc2lnbG9uZ2ptcChlbnYsIDIpOwoJfQpFT00KCWlmIHRlc3Qg ImBhcmNoYCIgPSBpODZwYyAtYSBgdW5hbWUgLXJgID0gNS42ICYmIFwKCSAgICR7Y2M6LWNjfSB0 cnkuYyAtbHB0aHJlYWQgPi9kZXYvbnVsbCAyPiYxICYmIC4vYS5vdXQ7IHRoZW4KCSAgICBkX3Np Z3NldGptcD0kdW5kZWYKCWZpCgoJIyBUaGVzZSBwcm90b3R5cGVzIHNob3VsZCBiZSB2aXNpYmxl IHNpbmNlIHdlIHVzaW5nCgkjIC1EX1JFRU5UUkFOVCwgYnV0IHRoYXQgZG9lcyBub3Qgc2VlbSB0 byB3b3JrLgoJIyBJdCBkb2VzIHNlZW0gdG8gd29yayBmb3IgZ2V0bmV0YnlhZGRyX3IsIHdlaXJk bHkgZW5vdWdoLAoJIyBhbmQgb3RoZXIgX3IgZnVuY3Rpb25zLiAoU29sYXJpcyA4KQoKCWRfY3Rl cm1pZF9yX3Byb3RvPSIkZGVmaW5lIgoJZF9nZXRob3N0YnlhZGRyX3JfcHJvdG89IiRkZWZpbmUi CglkX2dldGhvc3RieW5hbWVfcl9wcm90bz0iJGRlZmluZSIKCWRfZ2V0bmV0YnluYW1lX3JfcHJv dG89IiRkZWZpbmUiCglkX2dldHByb3RvYnluYW1lX3JfcHJvdG89IiRkZWZpbmUiCglkX2dldHBy b3RvYnludW1iZXJfcl9wcm90bz0iJGRlZmluZSIKCWRfZ2V0c2VydmJ5bmFtZV9yX3Byb3RvPSIk ZGVmaW5lIgoJZF9nZXRzZXJ2Ynlwb3J0X3JfcHJvdG89IiRkZWZpbmUiCgoJIyBEaXR0by4gKFNv bGFyaXMgNykKCWRfcmVhZGRpcl9yX3Byb3RvPSIkZGVmaW5lIgoJZF9yZWFkZGlyNjRfcl9wcm90 bz0iJGRlZmluZSIKCWRfdG1wbmFtX3JfcHJvdG89IiRkZWZpbmUiCglkX3R0eW5hbWVfcl9wcm90 bz0iJGRlZmluZSIKCgk7Owplc2FjCkVPQ0JVCgpjYXQgPiBVVS91c2VsYXJnZWZpbGVzLmNidSA8 PCdFT0NCVScKIyBUaGlzIHNjcmlwdCBVVS91c2VsYXJnZWZpbGVzLmNidSB3aWxsIGdldCAnY2Fs bGVkLWJhY2snIGJ5IENvbmZpZ3VyZQojIGFmdGVyIGl0IGhhcyBwcm9tcHRlZCB0aGUgdXNlciBm b3Igd2hldGhlciB0byB1c2UgbGFyZ2UgZmlsZXMuCmNhc2UgIiR1c2VsYXJnZWZpbGVzIiBpbgon J3wkZGVmaW5lfHRydWV8W3lZXSopCgojIEtlZXAgdGhlc2UgaW4gdGhlIGxlZnQgbWFyZ2luLgpj Y2ZsYWdzX3VzZWxhcmdlZmlsZXM9ImAkcnVuIGdldGNvbmYgTEZTX0NGTEFHUyAyPi9kZXYvbnVs bGAiCmxkZmxhZ3NfdXNlbGFyZ2VmaWxlcz0iYCRydW4gZ2V0Y29uZiBMRlNfTERGTEFHUyAyPi9k ZXYvbnVsbGAiCmxpYnN3YW50ZWRfdXNlbGFyZ2VmaWxlcz0iYCRydW4gZ2V0Y29uZiBMRlNfTElC UyAyPi9kZXYvbnVsbHxzZWQgLWUgJ3NAXi1sQEAnIC1lICdzQCAtbEAgQGcnYCIKCiAgICBjY2Zs YWdzPSIkY2NmbGFncyAkY2NmbGFnc191c2VsYXJnZWZpbGVzIgogICAgbGRmbGFncz0iJGxkZmxh Z3MgJGxkZmxhZ3NfdXNlbGFyZ2VmaWxlcyIKICAgIGxpYnN3YW50ZWQ9IiRsaWJzd2FudGVkICRs aWJzd2FudGVkX3VzZWxhcmdlZmlsZXMiCiAgICA7Owplc2FjCkVPQ0JVCgojIFRoaXMgaXMgdHJ1 bHkgYSBtZXNzLgpjYXNlICIkdXNlbW9yZWJpdHMiIGluCiIkZGVmaW5lInx0cnVlfFt5WV0qKQoJ dXNlNjRiaXRpbnQ9IiRkZWZpbmUiCgl1c2Vsb25nZG91YmxlPSIkZGVmaW5lIgoJOzsKZXNhYwoK aWYgdGVzdCBgJHJ1biB1bmFtZSAtcGAgPSBpMzg2OyB0aGVuCiAgICBjYXNlICIkdXNlNjRiaXRp bnQiIGluCiAgICAiJGRlZmluZSJ8dHJ1ZXxbeVldKikKICAgICAgICAgICAgY2NmbGFncz0iJGNj ZmxhZ3MgLURQVFJfSVNfTE9ORyIKICAgICAgICAgICAgOzsKICAgIGVzYWMKZmkKCmlmIHRlc3Qg YCRydW4gdW5hbWUgLXBgID0gc3BhcmMgLW8gYCRydW4gdW5hbWUgLXBgID0gaTM4NjsgdGhlbgog ICAgY2F0ID4gVVUvdXNlNjRiaXRpbnQuY2J1IDw8J0VPQ0JVJwojIFRoaXMgc2NyaXB0IFVVL3Vz ZTY0Yml0aW50LmNidSB3aWxsIGdldCAnY2FsbGVkLWJhY2snIGJ5IENvbmZpZ3VyZQojIGFmdGVy IGl0IGhhcyBwcm9tcHRlZCB0aGUgdXNlciBmb3Igd2hldGhlciB0byB1c2UgNjQgYml0IGludGVn ZXJzLgpjYXNlICIkdXNlNjRiaXRpbnQiIGluCiIkZGVmaW5lInx0cnVlfFt5WV0qKQoJICAgIGNh c2UgImAkcnVuIHVuYW1lIC1yYCIgaW4KCSAgICA1LlswLTRdKQoJCWNhdCA+JjQgPDxFT00KU29s YXJpcyBgdW5hbWUgLXJ8c2VkIC1lICdzL141XC4vMi4vJ2AgZG9lcyBub3Qgc3VwcG9ydCA2NC1i aXQgaW50ZWdlcnMuCllvdSBzaG91bGQgdXBncmFkZSB0byBhdCBsZWFzdCBTb2xhcmlzIDIuNS4K RU9NCgkJZXhpdCAxCgkJOzsKCSAgICBlc2FjCgojIGdjYy0yLjguMSBvbiBTb2xhcmlzIDggd2l0 aCAtRHVzZTY0Yml0aW50IGZhaWxzIG9wL3BhdC50IHRlc3QgODIyCiMgaWYgd2UgY29tcGlsZSBy ZWdleGVjLmMgd2l0aCAtTy4gIFR1cm4gb2ZmIG9wdGltaXphdGlvbiBmb3IgdGhhdCBvbmUKIyBm aWxlLiAgU2VlIGhpbnRzL1JFQURNRS5oaW50cyAsIGVzcGVjaWFsbHkKIyA9aGVhZDIgUHJvcGFn YXRpbmcgdmFyaWFibGVzIHRvIGNvbmZpZy5zaCwgbWV0aG9kIDMuCiMgIEEuIERvdWdoZXJ0eSAg TWF5IDI0LCAyMDAyCiAgICBjYXNlICIke2djY3ZlcnNpb259LSR7b3B0aW1pemV9IiBpbgogICAg Mi44Ki1PKikKCSMgSG9ub3IgYSBjb21tYW5kLWxpbmUgb3ZlcnJpZGUgKHJhdGhlciB1bmxpa2Vs eSkKCWNhc2UgIiRyZWdleGVjX2NmbGFncyIgaW4KCScnKSBlY2hvICJEaXNhYmxpbmcgb3B0aW1p emF0aW9uIG9uIHJlZ2V4ZWMuYyBmb3IgZ2NjICRnY2N2ZXJzaW9uIiA+JjQKCSAgICByZWdleGVj X2NmbGFncz0nb3B0aW1pemU9JwoJICAgIGVjaG8gInJlZ2V4ZWNfY2ZsYWdzPSdvcHRpbWl6ZT1c IlwiJyIgPj4gY29uZmlnLnNoCgkgICAgOzsKCWVzYWMKCTs7CiAgICBlc2FjCiAgICA7Owplc2Fj CkVPQ0JVCgogICAgY2F0ID4gVVUvdXNlNjRiaXRhbGwuY2J1IDw8J0VPQ0JVJwojIFRoaXMgc2Ny aXB0IFVVL3VzZTY0Yml0YWxsLmNidSB3aWxsIGdldCAnY2FsbGVkLWJhY2snIGJ5IENvbmZpZ3Vy ZQojIGFmdGVyIGl0IGhhcyBwcm9tcHRlZCB0aGUgdXNlciBmb3Igd2hldGhlciB0byBiZSBtYXhp bWFsbHkgNjQgYml0dHkuCmNhc2UgIiR1c2U2NGJpdGFsbC0kdXNlNjRiaXRhbGxfZG9uZSIgaW4K IiRkZWZpbmUtInx0cnVlLXxbeVldKi0pCgkgICAgY2FzZSAiYCRydW4gdW5hbWUgLXJgIiBpbgoJ ICAgIDUuWzAtNl0pCgkJY2F0ID4mNCA8PEVPTQpTb2xhcmlzIGB1bmFtZSAtcnxzZWQgLWUgJ3Mv XjVcLi8yLi8nYCBkb2VzIG5vdCBzdXBwb3J0IDY0LWJpdCBwb2ludGVycy4KWW91IHNob3VsZCB1 cGdyYWRlIHRvIGF0IGxlYXN0IFNvbGFyaXMgMi43LgpFT00KCQlleGl0IDEKCQk7OwoJICAgIGVz YWMKCSAgICBwcm9jZXNzb3I9YCRydW4gdW5hbWUgLXBgOwoJICAgIGlmIHRlc3QgIiRwcm9jZXNz b3IiID0gc3BhcmM7IHRoZW4KCQlsaWJjPScvdXNyL2xpYi9zcGFyY3Y5L2xpYmMuc28nCgkJaWYg dGVzdCAhIC1mICRsaWJjOyB0aGVuCgkJICAgIGNhdCA+JjQgPDxFT00KCkkgZG8gbm90IHNlZSB0 aGUgNjQtYml0IGxpYmMsICRsaWJjLgpDYW5ub3QgY29udGludWUsIGFib3J0aW5nLgoKRU9NCgkJ ICAgIGV4aXQgMQoJCWZpCgkgICAgZmkKCSAgICBjYXNlICIke2NjOi1jY30gLXYgMj4vZGV2L251 bGwiIGluCgkgICAgKmdjYyp8KmcrKyopCgkJZWNobyAnaW50IG1haW4oKSB7IHJldHVybiAwOyB9 JyA+IHRyeS5jCgkJY2FzZSAiYCR7Y2M6LWNjfSAkY2NmbGFncyAtbWNwdT12OSAtbTY0IC1TIHRy eS5jIDI+JjEgfCBncmVwICdtNjQgaXMgbm90IHN1cHBvcnRlZCBieSB0aGlzIGNvbmZpZ3VyYXRp b24nYCIgaW4KCQkqIm02NCBpcyBub3Qgc3VwcG9ydGVkIiopCgkJICAgIGNhdCA+JjQgPDxFT00K CkZ1bGwgNjQtYml0IGJ1aWxkIGlzIG5vdCBzdXBwb3J0ZWQgYnkgdGhpcyBnY2MgY29uZmlndXJh dGlvbi4KQ2hlY2sgaHR0cDovL2djYy5nbnUub3JnLyBmb3IgdGhlIGxhdGVzdCBuZXdzIG9mIGF2 YWlsYWJpbGl0eQpvZiBnY2MgZm9yIDY0LWJpdCBTcGFyYy4KCkNhbm5vdCBjb250aW51ZSwgYWJv cnRpbmcuCgpFT00KCQkgICAgZXhpdCAxCgkJICAgIDs7CgkJZXNhYwoJCWlmIHRlc3QgIiRwcm9j ZXNzb3IiID0gc3BhcmM7IHRoZW4KCQkgICAgbG9jbGlicHRoPSIvdXNyL2xpYi9zcGFyY3Y5ICRs b2NsaWJwdGgiCgkJICAgIGNjZmxhZ3M9IiRjY2ZsYWdzIC1tY3B1PXY5IgoJCWZpCgkJY2NmbGFn cz0iJGNjZmxhZ3MgLW02NCIKCgkJIyBUaGlzIGFkZHMgaW4gLVdhLC14YXJjaD12OS4gIEkgc3Vz cGVjdCB0aGF0J3Mgc3VwZXJmbHVvdXMsCgkJIyBzaW5jZSB0aGUgLW02NCBhYm92ZSBzaG91bGQg ZG8gdGhhdCBhbHJlYWR5LiAgU29tZW9uZQoJCSMgd2l0aCBnY2MtMy54LngsIHBsZWFzZSB0ZXN0 IHdpdGggZ2NjIC12LiAgIEEuRC4gMjAtTm92LTIwMDMKIwkJaWYgdGVzdCAkcHJvY2Vzc29yID0g c3BhcmMgLWEgWGAkcnVuIGdldGNvbmYgWEJTNV9MUDY0X09GRjY0X0NGTEFHUyAyPi9kZXYvbnVs bGAgIT0gWDsgdGhlbgojCQkgICAgY2NmbGFncz0iJGNjZmxhZ3MgLVdhLGAkcnVuIGdldGNvbmYg WEJTNV9MUDY0X09GRjY0X0NGTEFHUyAyPi9kZXYvbnVsbGAiCiMJCWZpCgkJbGRmbGFncz0iJGxk ZmxhZ3MgLW02NCIKCgkJIyBTZWUgW3BlcmwgIzY2NjA0XTogIE9uIFNvbGFyaXMgMTEsIGdjYyAt bTY0IG9uIGFtZDY0CgkJIyBhcHBlYXJzIG5vdCB0byB1bmRlcnN0YW5kIC1HLiAgKGdjYyAtRyBo YXMgbm90IGNhdXNlZAoJCSMgcHJvYmxlbXMgb24gb3RoZXIgcGxhdGZvcm1zIGluIHRoZSBwYXN0 LikgIGdjYyB2ZXJzaW9ucwoJCSMgYXQgbGVhc3QgYXMgb2xkIGFzIDMuNC4zIHN1cHBvcnQgLXNo YXJlZCwgc28ganVzdAoJCSMgdXNlIHRoYXQgd2l0aCBTb2xhcmlzIDExIGFuZCBsYXRlciwgYnV0 IGtlZXAKCQkjIHRoZSBvbGQgYmVoYXZpb3IgZm9yIG9sZGVyIFNvbGFyaXMgdmVyc2lvbnMuCgkJ Y2FzZSAiJG9zdmVycyIgaW4KCQkJMi4/fDIuMTApIGxkZGxmbGFncz0iJGxkZGxmbGFncyAtRyAt bTY0IiA7OwoJCQkqKSBsZGRsZmxhZ3M9IiRsZGRsZmxhZ3MgLXNoYXJlZCAtbTY0IiA7OwoJCWVz YWMKCQk7OwoJICAgICopCgkJZ2V0Y29uZmNjZmxhZ3M9ImAkcnVuIGdldGNvbmYgWEJTNV9MUDY0 X09GRjY0X0NGTEFHUyAyPi9kZXYvbnVsbGAiCgkJZ2V0Y29uZmxkZmxhZ3M9ImAkcnVuIGdldGNv bmYgWEJTNV9MUDY0X09GRjY0X0xERkxBR1MgMj4vZGV2L251bGxgIgoJCWdldGNvbmZsZGRsZmxh Z3M9ImAkcnVuIGdldGNvbmYgWEJTNV9MUDY0X09GRjY0X0xERkxBR1MgMj4vZGV2L251bGxgIgoJ CWVjaG8gImludCBtYWluKCkgeyByZXR1cm4oMCk7IH0gIiA+IHRyeS5jCgkJY2FzZSAiYCR7Y2M6 LWNjfSAkZ2V0Y29uZmNjZmxhZ3MgdHJ5LmMgMj4mMSB8IGdyZXAgJ2RlcHJlY2F0ZWQnYCIgaW4K CQkqIiAteGFyY2g9Z2VuZXJpYzY0IGlzIGRlcHJlY2F0ZWQsIHVzZSAtbTY0ICIqKQoJCSAgICBn ZXRjb25mY2NmbGFncz1gZWNobyAkZ2V0Y29uZmNjZmxhZ3MgfCBzZWQgLWUgJ3MveGFyY2g9Z2Vu ZXJpYzY0L202NC8nYAoJCSAgICBnZXRjb25mbGRmbGFncz1gZWNobyAkZ2V0Y29uZmxkZmxhZ3Mg fCBzZWQgLWUgJ3MveGFyY2g9Z2VuZXJpYzY0L202NC8nYAoJCSAgICBnZXRjb25mbGRkbGZsYWdz PWBlY2hvICRnZXRjb25mbGRkbGZsYWdzIHwgc2VkIC1lICdzL3hhcmNoPWdlbmVyaWM2NC9tNjQv J2AKCQkgICAgOzsKCQllc2FjCgkJY2NmbGFncz0iJGNjZmxhZ3MgJGdldGNvbmZjY2ZsYWdzIgoJ CWxkZmxhZ3M9IiRsZGZsYWdzICRnZXRjb25mbGRmbGFncyIKCQlsZGRsZmxhZ3M9IiRsZGRsZmxh Z3MgLUcgJGdldGNvbmZsZGRsZmxhZ3MiCgoJCWVjaG8gImludCBtYWluKCkgeyByZXR1cm4oMCk7 IH0gIiA+IHRyeS5jCgkJdHJ5d29ya3Nob3BjYz0iJHtjYzotY2N9IHRyeS5jIC1vIHRyeSAkY2Nm bGFncyIKCQlpZiB0ZXN0ICIkcHJvY2Vzc29yIiA9IHNwYXJjOyB0aGVuCgkJICAgIGxvY2xpYnB0 aD0iL3Vzci9saWIvc3BhcmN2OSAvdXNyL2Njcy9saWIvc3BhcmN2OSAkbG9jbGlicHRoIgoJCWZp CgkJbG9jbGlicHRoPSJgJGdldHdvcmtzaG9wbGlic2AgJGxvY2xpYnB0aCIKCQk7OwoJICAgIGVz YWMKCSAgICB1bnNldCBwcm9jZXNzb3IKCSAgICB1c2U2NGJpdGFsbF9kb25lPXllcwoJICAgIGFy Y2huYW1lNjQ9NjQKCSAgICA7Owplc2FjCkVPQ0JVCgogICAgIyBBY3R1YWxseSwgd2Ugd2FudCB0 byBydW4gdGhpcyBhbHJlYWR5IG5vdywgaWYgc28gcmVxdWVzdGVkLAogICAgIyBiZWNhdXNlIHdl IG5lZWQgdG8gZml4IHVwIHRoaW5ncyByaWdodCBub3cuCiAgICBjYXNlICIkdXNlNjRiaXRhbGwi IGluCiAgICAiJGRlZmluZSJ8dHJ1ZXxbeVldKikKCSMgQ0JVcyBleHBlY3QgdG8gYmUgcnVuIGlu IFVVCgljZCBVVTsgLiAuL3VzZTY0Yml0YWxsLmNidTsgY2QgLi4KCTs7CiAgICBlc2FjCmZpCgpj YXQgPiBVVS91c2Vsb25nZG91YmxlLmNidSA8PCdFT0NCVScKIyBUaGlzIHNjcmlwdCBVVS91c2Vs b25nZG91YmxlLmNidSB3aWxsIGdldCAnY2FsbGVkLWJhY2snIGJ5IENvbmZpZ3VyZQojIGFmdGVy IGl0IGhhcyBwcm9tcHRlZCB0aGUgdXNlciBmb3Igd2hldGhlciB0byB1c2UgbG9uZyBkb3VibGVz LgpjYXNlICIkdXNlbG9uZ2RvdWJsZSIgaW4KIiRkZWZpbmUifHRydWV8W3lZXSopCglpZiB0ZXN0 ICIkY2NfbmFtZSIgPSAid29ya3Nob3AiOyB0aGVuCgkJY2F0ID4gdHJ5LmMgPDwgJ0VPTScKI2lu Y2x1ZGUgPHN1bm1hdGguaD4KaW50IG1haW4oKSB7ICh2b2lkKSBwb3dsKDIsIDI1Nik7IHJldHVy bigwKTsgfQpFT00KCQlpZiAke2NjOi1jY30gdHJ5LmMgLWxzdW5tYXRoIC1vIHRyeSA+IC9kZXYv bnVsbCAyPiYxICYmIC4vdHJ5OyB0aGVuCgkJCWxpYnN3YW50ZWQ9IiRsaWJzd2FudGVkIHN1bm1h dGgiCgkJZmkKCWVsc2UKCQljYXQgPiY0IDw8RU9NCgpUaGUgU3VuIFdvcmtzaG9wIG1hdGggbGli cmFyeSBpcyBlaXRoZXIgbm90IGF2YWlsYWJsZSBvciBub3Qgd29ya2luZywKc28gSSBkbyBub3Qg a25vdyBob3cgdG8gZG8gbG9uZyBkb3VibGVzLCBzb3JyeS4KSSdtIHRoZXJlZm9yZSBkaXNhYmxp bmcgdGhlIHVzZSBvZiBsb25nIGRvdWJsZXMuCkVPTQoJCXVzZWxvbmdkb3VibGU9IiR1bmRlZiIK CWZpCgk7Owplc2FjCkVPQ0JVCgojCiMgSWYgdW5zZXRlbnYgaXMgYXZhaWxhYmxlLCB1c2UgaXQg aW4gY29uanVuY3Rpb24gd2l0aCBQRVJMX1VTRV9TQUZFX1BVVEVOViB0bwojIHdvcmsgYXJvdW5k IFN1biBidWdpZCA2MzMzODMwLiAgQm90aCB1bnNldGVudiBhbmQgNjMzMzgzMCBvbmx5IGFwcGVh ciBpbgojIFNvbGFyaXMgMTAsIHNvIHdlIGRvbid0IG5lZWQgdG8gcHJvYmUgZXhwbGljaXRseSBm b3IgYW4gT1MgdmVyc2lvbi4gIFdlIGhhdmUKIyB0byBhcHBlbmQgdGhpcyB0ZXN0IHRvIHRoZSBl bmQgb2YgY29uZmlnLm92ZXIgYXMgaXQgbmVlZHMgdG8gcnVuIGFmdGVyCiMgQ29uZmlndXJlIGhh cyBwcm9iZWQgZm9yIHVuc2V0ZW52LCBhbmQgdGhpcyBoaW50cyBmaWxlIGlzIHByb2Nlc3NlZCBi ZWZvcmUKIyB0aGF0IGhhcyBoYXBwZW5lZC4KIwpjYXQgPj4gY29uZmlnLm92ZXIgPDwnRU9PVkVS JwppZiB0ZXN0ICIkZF91bnNldGVudiIgPSAiJGRlZmluZSIgLWEgXAogICAgYGV4cHIgIiRjY2Zs YWdzIiA6ICcuKi1EUEVSTF9VU0VfU0FGRV9QVVRFTlYnYCAtZXEgMDsgdGhlbgogICAgICAgIGNj ZmxhZ3M9IiRjY2ZsYWdzIC1EUEVSTF9VU0VfU0FGRV9QVVRFTlYiCmZpCkVPT1ZFUgoKcm0gLWYg dHJ5LmMgdHJ5Lm8gdHJ5IGEub3V0CgojIElmIHVzaW5nIEMrKywgdGhlIENvbmZpZ3VyZSBzY2Fu IGZvciBkbG9wZW4oKSB3aWxsIGZhaWwgaW4gU29sYXJpcwojIGJlY2F1c2Ugb25lIG9mIHRoZSB0 d28gKDEpIGFuIGV4dGVybiAiQyIgbGlua2FnZSBkZWZpbml0aW9uIGlzIG5lZWRlZAojICgyKSAj aW5jbHVkZSA8ZGxmY24uaD4gaXMgbmVlZGVkLCAqYW5kKiBhIGNhc3QgdG8gKHZvaWQqKCopKCkp CiMgaXMgbmVlZGVkIGZvciB0aGUgJmRsb3Blbi4gIEFkZGluZyBhbnkgb2YgdGhlc2Ugd291bGQg cmVxdWlyZSBjaGFuZ2luZwojIGEgZGVsaWNhdGUgc3BvdCBpbiBDb25maWd1cmUsIHNvIGVhc2ll ciBqdXN0IHRvIGZvcmNlIG91ciBndWVzcyBoZXJlCiMgZm9yIFNvbGFyaXMuICBNdWNoIHRoZSBz YW1lIGdvZXMgZm9yIGRsZXJyb3IoKS4KY2FzZSAiJGNjIiBpbgoqZysrKnwqQ0MqKQogIGRfZGxv cGVuPSdkZWZpbmUnCiAgZF9kbGVycm9yPSdkZWZpbmUnCiAgOzsKZXNhYwoKIyBPcmFjbGUvU3Vu IGJ1aWxkcyB0aGVpciBQZXJsIHNoYXJlZCBzaW5jZSA1LjYuMSwgYW5kIHRoZXkgYWxzbwojIHN0 cm9uZ2x5IHJlY29tbWVuZCB1c2luZyBzaGFyZWQgbGlicmFyaWVzIGluIGdlbmVyYWwuCiMKIyBG dXJ0aGVybW9yZSwgT3BlbkluZGlhbmEgc2VlbXMgdG8gZWZmZWN0aXZlbHkgcmVxdWlyZSBidWls ZGluZyBwZXJsCiMgc2hhcmVkLCBvciBvdGhlcndpc2UgcGVybCBzY3JpcHRzIHdvbid0IGV2ZW4g ZmluZCB0aGUgUGVybCBsaWJyYXJ5Lgp1c2VzaHJwbGliPSd0cnVlJwo=', ); my %files = ( 'freebsd' => 'freebsd.sh', 'netbsd' => 'netbsd.sh', 'openbsd' => 'openbsd.sh', 'linux' => 'linux.sh', 'dragonfly' => 'dragonfly.sh', 'darwin' => 'darwin.sh', 'hpux' => 'hpux.sh', 'cygwin' => 'cygwin.sh', 'midnightbsd' => 'midnightbsd.sh', 'gnukfreebsd' => 'gnukfreebsd.sh', 'solaris' => 'solaris_2.sh', 'bitrig' => 'bitrig.sh', 'gnu' => 'gnu.sh', ); sub hint_file { my $os = shift; $os = shift if eval { $os->isa(__PACKAGE__) }; $os = $^O unless $os; return unless defined $hints{ $os }; my $content = decode_base64( $hints{ $os } ); return $content unless wantarray; return ( $files{ $os }, $content ); } sub hints { return sort keys %hints; } qq'nudge nudge wink wink'; __END__ =pod =encoding UTF-8 =head1 NAME Devel::PatchPerl::Hints - replacement 'hints' files =head1 VERSION version 2.08 =head1 SYNOPSIS use Devel::PatchPerl::Hints; if ( my $content = Devel::PatchPerl::Hints->hint_file() ) { chmod 0644, 'hints/netbsd.sh' or die "$!"; open my $hints, '>', 'hints/netbsd.sh' or die "$!"; print $hints $content; close $hints; } # Get a list of OS for which we have hints my @os = Devel::PatchPerl::Hints->hints(); =head1 DESCRIPTION Sometimes there is a problem with Perls C file for a particular perl port. This module provides fixed C files encoded using C. =head1 FUNCTION The function is exported, but has to implicitly imported into the requesting package. use Devel::PatchPerl::Hints qw[hint_file]; It may also be called as a class method: use Devel::PatchPerl::Hints; my $content = Devel::PatchPerl::Hints->hint_file(); =over =item C Takes an optional argument which is the OS name ( as would be returned by C<$^O> ). By default it will use C<$^O>. In a scalar context, Will return the decoded content of the C file suitable for writing straight to a file handle or undef list if there isn't an applicable C file for the given or derived OS. If called in a list context, will return a list, the first item will be the name of the C file that will need to be amended, the second item will be a string with the decoded content of the C file suitable for writing straight to a file handle. Otherwise an empty list will be returned. =item C Takes no arguments, returns a list of OS names for which there are C files. =back =head1 AUTHOR Chris Williams =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2021 by Chris Williams and Marcus Holland-Moritz. 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 DEVEL_PATCHPERL_HINTS $fatpacked{"Devel/PatchPerl/Plugin.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DEVEL_PATCHPERL_PLUGIN'; package Devel::PatchPerl::Plugin; $Devel::PatchPerl::Plugin::VERSION = '2.08'; #ABSTRACT: Devel::PatchPerl plugins explained use strict; use warnings; qq[Plug it in]; __END__ =pod =encoding UTF-8 =head1 NAME Devel::PatchPerl::Plugin - Devel::PatchPerl plugins explained =head1 VERSION version 2.08 =head1 DESCRIPTION This document explains the L plugin system. Plugins are a mechanism for providing additional functionality to L. Plugins are searched for in the L namespace. =head1 INITIALISATION The plugin constructor is C. A plugin is specified using the C environment variable. It may either be specified in full (ie. C) or as the short part (ie. C). $ export PERL5_PATCHPERL_PLUGIN=Devel::PatchPerl::Plugin::Feegle $ export PERL5_PATCHPERL_PLUGIN=Feegle When L has identified the perl source patch and done its patching it will attempt to load the plugin identified. It will then call the class method C for the plugin package, with the following parameters: 'version', the Perl version of the source tree; 'source', the absolute path to the Perl source tree; 'patchexe', the 'patch' utility that can be used; Plugins are called with the current working directory being the root of the Perl source tree, ie. C. Summarised: $ENV{PERL5_PATCHPERL_PLUGIN} = 'Devel::PatchPerl::Plugin::Feegle'; my $plugin = $ENV{PERL5_PATCHPERL_PLUGIN}; eval "require $plugin"; eval { $plugin->patchperl( version => $vers, source => $srcdir, patchexe => $patch ); }; =head1 WHAT CAN PLUGINS DO? Anything you desire to a Perl source tree. =head1 WHY USE AN ENVIRONMENT VARIABLE TO SPECIFY PLUGINS? So that indicating a plugin to use can be specified independently of whatever mechanism is calling L to do its bidding. Think L. =head1 AUTHOR Chris Williams =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2021 by Chris Williams and Marcus Holland-Moritz. 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 DEVEL_PATCHPERL_PLUGIN $fatpacked{"ExtUtils/Command.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_COMMAND'; package ExtUtils::Command; use 5.00503; use strict; require Exporter; use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION); @ISA = qw(Exporter); @EXPORT = qw(cp rm_f rm_rf mv cat eqtime mkpath touch test_f test_d chmod dos2unix); $VERSION = '7.38'; $VERSION =~ tr/_//d; my $Is_VMS = $^O eq 'VMS'; my $Is_VMS_mode = $Is_VMS; my $Is_VMS_noefs = $Is_VMS; my $Is_Win32 = $^O eq 'MSWin32'; if( $Is_VMS ) { my $vms_unix_rpt; my $vms_efs; my $vms_case; if (eval { local $SIG{__DIE__}; local @INC = @INC; pop @INC if $INC[-1] eq '.'; require VMS::Feature; }) { $vms_unix_rpt = VMS::Feature::current("filename_unix_report"); $vms_efs = VMS::Feature::current("efs_charset"); $vms_case = VMS::Feature::current("efs_case_preserve"); } else { my $unix_rpt = $ENV{'DECC$FILENAME_UNIX_REPORT'} || ''; my $efs_charset = $ENV{'DECC$EFS_CHARSET'} || ''; my $efs_case = $ENV{'DECC$EFS_CASE_PRESERVE'} || ''; $vms_unix_rpt = $unix_rpt =~ /^[ET1]/i; $vms_efs = $efs_charset =~ /^[ET1]/i; $vms_case = $efs_case =~ /^[ET1]/i; } $Is_VMS_mode = 0 if $vms_unix_rpt; $Is_VMS_noefs = 0 if ($vms_efs); } =head1 NAME ExtUtils::Command - utilities to replace common UNIX commands in Makefiles etc. =head1 SYNOPSIS perl -MExtUtils::Command -e cat files... > destination perl -MExtUtils::Command -e mv source... destination perl -MExtUtils::Command -e cp source... destination perl -MExtUtils::Command -e touch files... perl -MExtUtils::Command -e rm_f files... perl -MExtUtils::Command -e rm_rf directories... perl -MExtUtils::Command -e mkpath directories... perl -MExtUtils::Command -e eqtime source destination perl -MExtUtils::Command -e test_f file perl -MExtUtils::Command -e test_d directory perl -MExtUtils::Command -e chmod mode files... ... =head1 DESCRIPTION The module is used to replace common UNIX commands. In all cases the functions work from @ARGV rather than taking arguments. This makes them easier to deal with in Makefiles. Call them like this: perl -MExtUtils::Command -e some_command some files to work on and I like this: perl -MExtUtils::Command -e 'some_command qw(some files to work on)' For that use L. Filenames with * and ? will be glob expanded. =head2 FUNCTIONS =over 4 =cut # VMS uses % instead of ? to mean "one character" my $wild_regex = $Is_VMS ? '*%' : '*?'; sub expand_wildcards { @ARGV = map(/[$wild_regex]/o ? glob($_) : $_,@ARGV); } =item cat cat file ... Concatenates all files mentioned on command line to STDOUT. =cut sub cat () { expand_wildcards(); print while (<>); } =item eqtime eqtime source destination Sets modified time of destination to that of source. =cut sub eqtime { my ($src,$dst) = @ARGV; local @ARGV = ($dst); touch(); # in case $dst doesn't exist utime((stat($src))[8,9],$dst); } =item rm_rf rm_rf files or directories ... Removes files and directories - recursively (even if readonly) =cut sub rm_rf { expand_wildcards(); require File::Path; File::Path::rmtree([grep -e $_,@ARGV],0,0); } =item rm_f rm_f file ... Removes files (even if readonly) =cut sub rm_f { expand_wildcards(); foreach my $file (@ARGV) { next unless -f $file; next if _unlink($file); chmod(0777, $file); next if _unlink($file); require Carp; Carp::carp("Cannot delete $file: $!"); } } sub _unlink { my $files_unlinked = 0; foreach my $file (@_) { my $delete_count = 0; $delete_count++ while unlink $file; $files_unlinked++ if $delete_count; } return $files_unlinked; } =item touch touch file ... Makes files exist, with current timestamp =cut sub touch { my $t = time; expand_wildcards(); foreach my $file (@ARGV) { open(FILE,">>$file") || die "Cannot write $file:$!"; close(FILE); utime($t,$t,$file); } } =item mv mv source_file destination_file mv source_file source_file destination_dir Moves source to destination. Multiple sources are allowed if destination is an existing directory. Returns true if all moves succeeded, false otherwise. =cut sub mv { expand_wildcards(); my @src = @ARGV; my $dst = pop @src; if (@src > 1 && ! -d $dst) { require Carp; Carp::croak("Too many arguments"); } require File::Copy; my $nok = 0; foreach my $src (@src) { $nok ||= !File::Copy::move($src,$dst); } return !$nok; } =item cp cp source_file destination_file cp source_file source_file destination_dir Copies sources to the destination. Multiple sources are allowed if destination is an existing directory. Returns true if all copies succeeded, false otherwise. =cut sub cp { expand_wildcards(); my @src = @ARGV; my $dst = pop @src; if (@src > 1 && ! -d $dst) { require Carp; Carp::croak("Too many arguments"); } require File::Copy; my $nok = 0; foreach my $src (@src) { $nok ||= !File::Copy::copy($src,$dst); # Win32 does not update the mod time of a copied file, just the # created time which make does not look at. utime(time, time, $dst) if $Is_Win32; } return $nok; } =item chmod chmod mode files ... Sets UNIX like permissions 'mode' on all the files. e.g. 0666 =cut sub chmod { local @ARGV = @ARGV; my $mode = shift(@ARGV); expand_wildcards(); if( $Is_VMS_mode && $Is_VMS_noefs) { require File::Spec; foreach my $idx (0..$#ARGV) { my $path = $ARGV[$idx]; next unless -d $path; # chmod 0777, [.foo.bar] doesn't work on VMS, you have to do # chmod 0777, [.foo]bar.dir my @dirs = File::Spec->splitdir( $path ); $dirs[-1] .= '.dir'; $path = File::Spec->catfile(@dirs); $ARGV[$idx] = $path; } } chmod(oct $mode,@ARGV) || die "Cannot chmod ".join(' ',$mode,@ARGV).":$!"; } =item mkpath mkpath directory ... Creates directories, including any parent directories. =cut sub mkpath { expand_wildcards(); require File::Path; File::Path::mkpath([@ARGV],0,0777); } =item test_f test_f file Tests if a file exists. I with 0 if it does, 1 if it does not (ie. shell's idea of true and false). =cut sub test_f { exit(-f $ARGV[0] ? 0 : 1); } =item test_d test_d directory Tests if a directory exists. I with 0 if it does, 1 if it does not (ie. shell's idea of true and false). =cut sub test_d { exit(-d $ARGV[0] ? 0 : 1); } =item dos2unix dos2unix files or dirs ... Converts DOS and OS/2 linefeeds to Unix style recursively. =cut sub dos2unix { require File::Find; File::Find::find(sub { return if -d; return unless -w _; return unless -r _; return if -B _; local $\; my $orig = $_; my $temp = '.dos2unix_tmp'; open ORIG, $_ or do { warn "dos2unix can't open $_: $!"; return }; open TEMP, ">$temp" or do { warn "dos2unix can't create .dos2unix_tmp: $!"; return }; binmode ORIG; binmode TEMP; while (my $line = ) { $line =~ s/\015\012/\012/g; print TEMP $line; } close ORIG; close TEMP; rename $temp, $orig; }, @ARGV); } =back =head1 SEE ALSO Shell::Command which is these same functions but take arguments normally. =head1 AUTHOR Nick Ing-Simmons C Maintained by Michael G Schwern C within the ExtUtils-MakeMaker package and, as a separate CPAN package, by Randy Kobes C. =cut EXTUTILS_COMMAND $fatpacked{"ExtUtils/Command/MM.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_COMMAND_MM'; package ExtUtils::Command::MM; require 5.006; use strict; use warnings; require Exporter; our @ISA = qw(Exporter); our @EXPORT = qw(test_harness pod2man perllocal_install uninstall warn_if_old_packlist test_s cp_nonempty); our $VERSION = '7.38'; $VERSION =~ tr/_//d; my $Is_VMS = $^O eq 'VMS'; sub mtime { no warnings 'redefine'; local $@; *mtime = (eval { require Time::HiRes } && defined &Time::HiRes::stat) ? sub { (Time::HiRes::stat($_[0]))[9] } : sub { ( stat($_[0]))[9] } ; goto &mtime; } =head1 NAME ExtUtils::Command::MM - Commands for the MM's to use in Makefiles =head1 SYNOPSIS perl "-MExtUtils::Command::MM" -e "function" "--" arguments... =head1 DESCRIPTION B The interface is not stable. ExtUtils::Command::MM encapsulates code which would otherwise have to be done with large "one" liners. Any $(FOO) used in the examples are make variables, not Perl. =over 4 =item B test_harness($verbose, @test_libs); Runs the tests on @ARGV via Test::Harness passing through the $verbose flag. Any @test_libs will be unshifted onto the test's @INC. @test_libs are run in alphabetical order. =cut sub test_harness { require Test::Harness; require File::Spec; $Test::Harness::verbose = shift; # Because Windows doesn't do this for us and listing all the *.t files # out on the command line can blow over its exec limit. require ExtUtils::Command; my @argv = ExtUtils::Command::expand_wildcards(@ARGV); local @INC = @INC; unshift @INC, map { File::Spec->rel2abs($_) } @_; Test::Harness::runtests(sort { lc $a cmp lc $b } @argv); } =item B pod2man( '--option=value', $podfile1 => $manpage1, $podfile2 => $manpage2, ... ); # or args on @ARGV pod2man() is a function performing most of the duties of the pod2man program. Its arguments are exactly the same as pod2man as of 5.8.0 with the addition of: --perm_rw octal permission to set the resulting manpage to And the removal of: --verbose/-v --help/-h If no arguments are given to pod2man it will read from @ARGV. If Pod::Man is unavailable, this function will warn and return undef. =cut sub pod2man { local @ARGV = @_ ? @_ : @ARGV; { local $@; if( !eval { require Pod::Man } ) { warn "Pod::Man is not available: $@". "Man pages will not be generated during this install.\n"; return 0; } } require Getopt::Long; # We will cheat and just use Getopt::Long. We fool it by putting # our arguments into @ARGV. Should be safe. my %options = (); Getopt::Long::config ('bundling_override'); Getopt::Long::GetOptions (\%options, 'section|s=s', 'release|r=s', 'center|c=s', 'date|d=s', 'fixed=s', 'fixedbold=s', 'fixeditalic=s', 'fixedbolditalic=s', 'official|o', 'quotes|q=s', 'lax|l', 'name|n=s', 'perm_rw=i', 'utf8|u' ); delete $options{utf8} unless $Pod::Man::VERSION >= 2.17; # If there's no files, don't bother going further. return 0 unless @ARGV; # Official sets --center, but don't override things explicitly set. if ($options{official} && !defined $options{center}) { $options{center} = q[Perl Programmer's Reference Guide]; } # This isn't a valid Pod::Man option and is only accepted for backwards # compatibility. delete $options{lax}; my $count = scalar @ARGV / 2; my $plural = $count == 1 ? 'document' : 'documents'; print "Manifying $count pod $plural\n"; do {{ # so 'next' works my ($pod, $man) = splice(@ARGV, 0, 2); next if ((-e $man) && (mtime($man) > mtime($pod)) && (mtime($man) > mtime("Makefile"))); my $parser = Pod::Man->new(%options); $parser->parse_from_file($pod, $man) or do { warn("Could not install $man\n"); next }; if (exists $options{perm_rw}) { chmod(oct($options{perm_rw}), $man) or do { warn("chmod $options{perm_rw} $man: $!\n"); next }; } }} while @ARGV; return 1; } =item B perl "-MExtUtils::Command::MM" -e warn_if_old_packlist Displays a warning that an old packlist file was found. Reads the filename from @ARGV. =cut sub warn_if_old_packlist { my $packlist = $ARGV[0]; return unless -f $packlist; print <<"PACKLIST_WARNING"; WARNING: I have found an old package in $packlist. Please make sure the two installations are not conflicting PACKLIST_WARNING } =item B perl "-MExtUtils::Command::MM" -e perllocal_install ... # VMS only, key|value pairs come on STDIN perl "-MExtUtils::Command::MM" -e perllocal_install < | ... Prints a fragment of POD suitable for appending to perllocal.pod. Arguments are read from @ARGV. 'type' is the type of what you're installing. Usually 'Module'. 'module name' is simply the name of your module. (Foo::Bar) Key/value pairs are extra information about the module. Fields include: installed into which directory your module was out into LINKTYPE dynamic or static linking VERSION module version number EXE_FILES any executables installed in a space separated list =cut sub perllocal_install { my($type, $name) = splice(@ARGV, 0, 2); # VMS feeds args as a piped file on STDIN since it usually can't # fit all the args on a single command line. my @mod_info = $Is_VMS ? split /\|/, : @ARGV; my $pod; my $time = gmtime($ENV{SOURCE_DATE_EPOCH} || time); $pod = sprintf <<'POD', scalar($time), $type, $name, $name; =head2 %s: C<%s> L<%s|%s> =over 4 POD do { my($key, $val) = splice(@mod_info, 0, 2); $pod .= < POD } while(@mod_info); $pod .= "=back\n\n"; $pod =~ s/^ //mg; print $pod; return 1; } =item B perl "-MExtUtils::Command::MM" -e uninstall A wrapper around ExtUtils::Install::uninstall(). Warns that uninstallation is deprecated and doesn't actually perform the uninstallation. =cut sub uninstall { my($packlist) = shift @ARGV; require ExtUtils::Install; print <<'WARNING'; Uninstall is unsafe and deprecated, the uninstallation was not performed. We will show what would have been done. WARNING ExtUtils::Install::uninstall($packlist, 1, 1); print <<'WARNING'; Uninstall is unsafe and deprecated, the uninstallation was not performed. Please check the list above carefully, there may be errors. Remove the appropriate files manually. Sorry for the inconvenience. WARNING } =item B perl "-MExtUtils::Command::MM" -e test_s Tests if a file exists and is not empty (size > 0). I with 0 if it does, 1 if it does not. =cut sub test_s { exit(-s $ARGV[0] ? 0 : 1); } =item B perl "-MExtUtils::Command::MM" -e cp_nonempty Tests if the source file exists and is not empty (size > 0). If it is not empty it copies it to the given destination with the given permissions. =back =cut sub cp_nonempty { my @args = @ARGV; return 0 unless -s $args[0]; require ExtUtils::Command; { local @ARGV = @args[0,1]; ExtUtils::Command::cp(@ARGV); } { local @ARGV = @args[2,1]; ExtUtils::Command::chmod(@ARGV); } } 1; EXTUTILS_COMMAND_MM $fatpacked{"ExtUtils/Install.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_INSTALL'; package ExtUtils::Install; use strict; use vars qw(@ISA @EXPORT $VERSION $MUST_REBOOT %Config); use AutoSplit; use Carp (); use Config qw(%Config); use Cwd qw(cwd); use Exporter; use ExtUtils::Packlist; use File::Basename qw(dirname); use File::Compare qw(compare); use File::Copy; use File::Find qw(find); use File::Path; use File::Spec; @ISA = ('Exporter'); @EXPORT = ('install','uninstall','pm_to_blib', 'install_default'); =pod =head1 NAME ExtUtils::Install - install files from here to there =head1 SYNOPSIS use ExtUtils::Install; install({ 'blib/lib' => 'some/install/dir' } ); uninstall($packlist); pm_to_blib({ 'lib/Foo/Bar.pm' => 'blib/lib/Foo/Bar.pm' }); =head1 VERSION 2.06 =cut $VERSION = '2.06'; # <-- do not forget to update the POD section just above this line! $VERSION = eval $VERSION; =pod =head1 DESCRIPTION Handles the installing and uninstalling of perl modules, scripts, man pages, etc... Both install() and uninstall() are specific to the way ExtUtils::MakeMaker handles the installation and deinstallation of perl modules. They are not designed as general purpose tools. On some operating systems such as Win32 installation may not be possible until after a reboot has occurred. This can have varying consequences: removing an old DLL does not impact programs using the new one, but if a new DLL cannot be installed properly until reboot then anything depending on it must wait. The package variable $ExtUtils::Install::MUST_REBOOT is used to store this status. If this variable is true then such an operation has occurred and anything depending on this module cannot proceed until a reboot has occurred. If this value is defined but false then such an operation has ocurred, but should not impact later operations. =over =begin _private =item _chmod($$;$) Wrapper to chmod() for debugging and error trapping. =item _warnonce(@) Warns about something only once. =item _choke(@) Dies with a special message. =back =end _private =cut my $Is_VMS = $^O eq 'VMS'; my $Is_MacPerl = $^O eq 'MacOS'; my $Is_Win32 = $^O eq 'MSWin32'; my $Is_cygwin = $^O eq 'cygwin'; my $CanMoveAtBoot = ($Is_Win32 || $Is_cygwin); my $Inc_uninstall_warn_handler; # install relative to here my $INSTALL_ROOT = $ENV{PERL_INSTALL_ROOT}; my $INSTALL_QUIET = $ENV{PERL_INSTALL_QUIET}; my $Curdir = File::Spec->curdir; my $Updir = File::Spec->updir; sub _estr(@) { return join "\n",'!' x 72,@_,'!' x 72,''; } {my %warned; sub _warnonce(@) { my $first=shift; my $msg=_estr "WARNING: $first",@_; warn $msg unless $warned{$msg}++; }} sub _choke(@) { my $first=shift; my $msg=_estr "ERROR: $first",@_; Carp::croak($msg); } sub _chmod($$;$) { my ( $mode, $item, $verbose )=@_; $verbose ||= 0; if (chmod $mode, $item) { printf "chmod(0%o, %s)\n",$mode, $item if $verbose > 1; } else { my $err="$!"; _warnonce sprintf "WARNING: Failed chmod(0%o, %s): %s\n", $mode, $item, $err if -e $item; } } =begin _private =over =item _move_file_at_boot( $file, $target, $moan ) OS-Specific, Win32/Cygwin Schedules a file to be moved/renamed/deleted at next boot. $file should be a filespec of an existing file $target should be a ref to an array if the file is to be deleted otherwise it should be a filespec for a rename. If the file is existing it will be replaced. Sets $MUST_REBOOT to 0 to indicate a deletion operation has occurred and sets it to 1 to indicate that a move operation has been requested. returns 1 on success, on failure if $moan is false errors are fatal. If $moan is true then returns 0 on error and warns instead of dies. =end _private =cut { my $Has_Win32API_File; sub _move_file_at_boot { #XXX OS-SPECIFIC my ( $file, $target, $moan )= @_; Carp::confess("Panic: Can't _move_file_at_boot on this platform!") unless $CanMoveAtBoot; my $descr= ref $target ? "'$file' for deletion" : "'$file' for installation as '$target'"; # *note* CanMoveAtBoot is only incidentally the same condition as below # this needs not hold true in the future. $Has_Win32API_File = ($Is_Win32 || $Is_cygwin) ? (eval {require Win32API::File; 1} || 0) : 0 unless defined $Has_Win32API_File; if ( ! $Has_Win32API_File ) { my @msg=( "Cannot schedule $descr at reboot.", "Try installing Win32API::File to allow operations on locked files", "to be scheduled during reboot. Or try to perform the operation by", "hand yourself. (You may need to close other perl processes first)" ); if ( $moan ) { _warnonce(@msg) } else { _choke(@msg) } return 0; } my $opts= Win32API::File::MOVEFILE_DELAY_UNTIL_REBOOT(); $opts= $opts | Win32API::File::MOVEFILE_REPLACE_EXISTING() unless ref $target; _chmod( 0666, $file ); _chmod( 0666, $target ) unless ref $target; if (Win32API::File::MoveFileEx( $file, $target, $opts )) { $MUST_REBOOT ||= ref $target ? 0 : 1; return 1; } else { my @msg=( "MoveFileEx $descr at reboot failed: $^E", "You may try to perform the operation by hand yourself. ", "(You may need to close other perl processes first).", ); if ( $moan ) { _warnonce(@msg) } else { _choke(@msg) } } return 0; } } =begin _private =item _unlink_or_rename( $file, $tryhard, $installing ) OS-Specific, Win32/Cygwin Tries to get a file out of the way by unlinking it or renaming it. On some OS'es (Win32 based) DLL files can end up locked such that they can be renamed but not deleted. Likewise sometimes a file can be locked such that it cant even be renamed or changed except at reboot. To handle these cases this routine finds a tempfile name that it can either rename the file out of the way or use as a proxy for the install so that the rename can happen later (at reboot). $file : the file to remove. $tryhard : should advanced tricks be used for deletion $installing : we are not merely deleting but we want to overwrite When $tryhard is not true if the unlink fails its fatal. When $tryhard is true then the file is attempted to be renamed. The renamed file is then scheduled for deletion. If the rename fails then $installing governs what happens. If it is false the failure is fatal. If it is true then an attempt is made to schedule installation at boot using a temporary file to hold the new file. If this fails then a fatal error is thrown, if it succeeds it returns the temporary file name (which will be a derivative of the original in the same directory) so that the caller can use it to install under. In all other cases of success returns $file. On failure throws a fatal error. =end _private =cut sub _unlink_or_rename { #XXX OS-SPECIFIC my ( $file, $tryhard, $installing )= @_; # this chmod was originally unconditional. However, its not needed on # POSIXy systems since permission to unlink a file is specified by the # directory rather than the file; and in fact it screwed up hard- and # symlinked files. Keep it for other platforms in case its still # needed there. if ($^O =~ /^(dos|os2|MSWin32|VMS)$/) { _chmod( 0666, $file ); } my $unlink_count = 0; while (unlink $file) { $unlink_count++; } return $file if $unlink_count > 0; my $error="$!"; _choke("Cannot unlink '$file': $!") unless $CanMoveAtBoot && $tryhard; my $tmp= "AAA"; ++$tmp while -e "$file.$tmp"; $tmp= "$file.$tmp"; warn "WARNING: Unable to unlink '$file': $error\n", "Going to try to rename it to '$tmp'.\n"; if ( rename $file, $tmp ) { warn "Rename successful. Scheduling '$tmp'\nfor deletion at reboot.\n"; # when $installing we can set $moan to true. # IOW, if we cant delete the renamed file at reboot its # not the end of the world. The other cases are more serious # and need to be fatal. _move_file_at_boot( $tmp, [], $installing ); return $file; } elsif ( $installing ) { _warnonce("Rename failed: $!. Scheduling '$tmp'\nfor". " installation as '$file' at reboot.\n"); _move_file_at_boot( $tmp, $file ); return $tmp; } else { _choke("Rename failed:$!", "Cannot proceed."); } } =pod =back =head2 Functions =begin _private =over =item _get_install_skip Handles loading the INSTALL.SKIP file. Returns an array of patterns to use. =cut sub _get_install_skip { my ( $skip, $verbose )= @_; if ($ENV{EU_INSTALL_IGNORE_SKIP}) { print "EU_INSTALL_IGNORE_SKIP is set, ignore skipfile settings\n" if $verbose>2; return []; } if ( ! defined $skip ) { print "Looking for install skip list\n" if $verbose>2; for my $file ( 'INSTALL.SKIP', $ENV{EU_INSTALL_SITE_SKIPFILE} ) { next unless $file; print "\tChecking for $file\n" if $verbose>2; if (-e $file) { $skip= $file; last; } } } if ($skip && !ref $skip) { print "Reading skip patterns from '$skip'.\n" if $verbose; if (open my $fh,$skip ) { my @patterns; while (<$fh>) { chomp; next if /^\s*(?:#|$)/; print "\tSkip pattern: $_\n" if $verbose>3; push @patterns, $_; } $skip= \@patterns; } else { warn "Can't read skip file:'$skip':$!\n"; $skip=[]; } } elsif ( UNIVERSAL::isa($skip,'ARRAY') ) { print "Using array for skip list\n" if $verbose>2; } elsif ($verbose) { print "No skip list found.\n" if $verbose>1; $skip= []; } warn "Got @{[0+@$skip]} skip patterns.\n" if $verbose>3; return $skip } =pod =item _have_write_access Abstract a -w check that tries to use POSIX::access() if possible. =cut { my $has_posix; sub _have_write_access { my $dir=shift; unless (defined $has_posix) { $has_posix= (!$Is_cygwin && !$Is_Win32 && eval 'local $^W; require POSIX; 1') || 0; } if ($has_posix) { return POSIX::access($dir, POSIX::W_OK()); } else { return -w $dir; } } } =pod =item _can_write_dir(C<$dir>) Checks whether a given directory is writable, taking account the possibility that the directory might not exist and would have to be created first. Returns a list, containing: C<($writable, $determined_by, @create)> C<$writable> says whether the directory is (hypothetically) writable C<$determined_by> is the directory the status was determined from. It will be either the C<$dir>, or one of its parents. C<@create> is a list of directories that would probably have to be created to make the requested directory. It may not actually be correct on relative paths with C<..> in them. But for our purposes it should work ok =cut sub _can_write_dir { my $dir=shift; return unless defined $dir and length $dir; my ($vol, $dirs, $file) = File::Spec->splitpath($dir,1); my @dirs = File::Spec->splitdir($dirs); unshift @dirs, File::Spec->curdir unless File::Spec->file_name_is_absolute($dir); my $path=''; my @make; while (@dirs) { if ($Is_VMS) { $dir = File::Spec->catdir($vol,@dirs); } else { $dir = File::Spec->catdir(@dirs); $dir = File::Spec->catpath($vol,$dir,'') if defined $vol and length $vol; } next if ( $dir eq $path ); if ( ! -e $dir ) { unshift @make,$dir; next; } if ( _have_write_access($dir) ) { return 1,$dir,@make } else { return 0,$dir,@make } } continue { pop @dirs; } return 0; } =pod =item _mkpath($dir,$show,$mode,$verbose,$dry_run) Wrapper around File::Path::mkpath() to handle errors. If $verbose is true and >1 then additional diagnostics will be produced, also this will force $show to true. If $dry_run is true then the directory will not be created but a check will be made to see whether it would be possible to write to the directory, or that it would be possible to create the directory. If $dry_run is not true dies if the directory can not be created or is not writable. =cut sub _mkpath { my ($dir,$show,$mode,$verbose,$dry_run)=@_; if ( $verbose && $verbose > 1 && ! -d $dir) { $show= 1; printf "mkpath(%s,%d,%#o)\n", $dir, $show, $mode; } if (!$dry_run) { if ( ! eval { File::Path::mkpath($dir,$show,$mode); 1 } ) { _choke("Can't create '$dir'","$@"); } } my ($can,$root,@make)=_can_write_dir($dir); if (!$can) { my @msg=( "Can't create '$dir'", $root ? "Do not have write permissions on '$root'" : "Unknown Error" ); if ($dry_run) { _warnonce @msg; } else { _choke @msg; } } elsif ($show and $dry_run) { print "$_\n" for @make; } } =pod =item _copy($from,$to,$verbose,$dry_run) Wrapper around File::Copy::copy to handle errors. If $verbose is true and >1 then additional diagnostics will be emitted. If $dry_run is true then the copy will not actually occur. Dies if the copy fails. =cut sub _copy { my ( $from, $to, $verbose, $dry_run)=@_; if ($verbose && $verbose>1) { printf "copy(%s,%s)\n", $from, $to; } if (!$dry_run) { File::Copy::copy($from,$to) or Carp::croak( _estr "ERROR: Cannot copy '$from' to '$to': $!" ); } } =pod =item _chdir($from) Wrapper around chdir to catch errors. If not called in void context returns the cwd from before the chdir. dies on error. =cut sub _chdir { my ($dir)= @_; my $ret; if (defined wantarray) { $ret= cwd; } chdir $dir or _choke("Couldn't chdir to '$dir': $!"); return $ret; } =pod =back =end _private =over =item B # deprecated forms install(\%from_to); install(\%from_to, $verbose, $dry_run, $uninstall_shadows, $skip, $always_copy, \%result); # recommended form as of 1.47 install([ from_to => \%from_to, verbose => 1, dry_run => 0, uninstall_shadows => 1, skip => undef, always_copy => 1, result => \%install_results, ]); Copies each directory tree of %from_to to its corresponding value preserving timestamps and permissions. There are two keys with a special meaning in the hash: "read" and "write". These contain packlist files. After the copying is done, install() will write the list of target files to $from_to{write}. If $from_to{read} is given the contents of this file will be merged into the written file. The read and the written file may be identical, but on AFS it is quite likely that people are installing to a different directory than the one where the files later appear. If $verbose is true, will print out each file removed. Default is false. This is "make install VERBINST=1". $verbose values going up to 5 show increasingly more diagnostics output. If $dry_run is true it will only print what it was going to do without actually doing it. Default is false. If $uninstall_shadows is true any differing versions throughout @INC will be uninstalled. This is "make install UNINST=1" As of 1.37_02 install() supports the use of a list of patterns to filter out files that shouldn't be installed. If $skip is omitted or undefined then install will try to read the list from INSTALL.SKIP in the CWD. This file is a list of regular expressions and is just like the MANIFEST.SKIP file used by L. A default site INSTALL.SKIP may be provided by setting then environment variable EU_INSTALL_SITE_SKIPFILE, this will only be used when there isn't a distribution specific INSTALL.SKIP. If the environment variable EU_INSTALL_IGNORE_SKIP is true then no install file filtering will be performed. If $skip is undefined then the skip file will be autodetected and used if it is found. If $skip is a reference to an array then it is assumed the array contains the list of patterns, if $skip is a true non reference it is assumed to be the filename holding the list of patterns, any other value of $skip is taken to mean that no install filtering should occur. B As of version 1.47 the following additions were made to the install interface. Note that the new argument style and use of the %result hash is recommended. The $always_copy parameter which when true causes files to be updated regardless as to whether they have changed, if it is defined but false then copies are made only if the files have changed, if it is undefined then the value of the environment variable EU_INSTALL_ALWAYS_COPY is used as default. The %result hash will be populated with the various keys/subhashes reflecting the install. Currently these keys and their structure are: install => { $target => $source }, install_fail => { $target => $source }, install_unchanged => { $target => $source }, install_filtered => { $source => $pattern }, uninstall => { $uninstalled => $source }, uninstall_fail => { $uninstalled => $source }, where C<$source> is the filespec of the file being installed. C<$target> is where it is being installed to, and C<$uninstalled> is any shadow file that is in C<@INC> or C<$ENV{PERL5LIB}> or other standard locations, and C<$pattern> is the pattern that caused a source file to be skipped. In future more keys will be added, such as to show created directories, however this requires changes in other modules and must therefore wait. These keys will be populated before any exceptions are thrown should there be an error. Note that all updates of the %result are additive, the hash will not be cleared before use, thus allowing status results of many installs to be easily aggregated. B If there is only one argument and it is a reference to an array then the array is assumed to contain a list of key-value pairs specifying the options. In this case the option "from_to" is mandatory. This style means that you do not have to supply a cryptic list of arguments and can use a self documenting argument list that is easier to understand. This is now the recommended interface to install(). B If all actions were successful install will return a hashref of the results as described above for the $result parameter. If any action is a failure then install will die, therefore it is recommended to pass in the $result parameter instead of using the return value. If the result parameter is provided then the returned hashref will be the passed in hashref. =cut sub install { #XXX OS-SPECIFIC my($from_to,$verbose,$dry_run,$uninstall_shadows,$skip,$always_copy,$result) = @_; if (@_==1 and eval { 1+@$from_to }) { my %opts = @$from_to; $from_to = $opts{from_to} or Carp::confess("from_to is a mandatory parameter"); $verbose = $opts{verbose}; $dry_run = $opts{dry_run}; $uninstall_shadows = $opts{uninstall_shadows}; $skip = $opts{skip}; $always_copy = $opts{always_copy}; $result = $opts{result}; } $result ||= {}; $verbose ||= 0; $dry_run ||= 0; $skip= _get_install_skip($skip,$verbose); $always_copy = $ENV{EU_INSTALL_ALWAYS_COPY} || $ENV{EU_ALWAYS_COPY} || 0 unless defined $always_copy; my(%from_to) = %$from_to; my(%pack, $dir, %warned); my($packlist) = ExtUtils::Packlist->new(); local(*DIR); for (qw/read write/) { $pack{$_}=$from_to{$_}; delete $from_to{$_}; } my $tmpfile = install_rooted_file($pack{"read"}); $packlist->read($tmpfile) if (-f $tmpfile); my $cwd = cwd(); my @found_files; my %check_dirs; MOD_INSTALL: foreach my $source (sort keys %from_to) { #copy the tree to the target directory without altering #timestamp and permission and remember for the .packlist #file. The packlist file contains the absolute paths of the #install locations. AFS users may call this a bug. We'll have #to reconsider how to add the means to satisfy AFS users also. #October 1997: we want to install .pm files into archlib if #there are any files in arch. So we depend on having ./blib/arch #hardcoded here. my $targetroot = install_rooted_dir($from_to{$source}); my $blib_lib = File::Spec->catdir('blib', 'lib'); my $blib_arch = File::Spec->catdir('blib', 'arch'); if ($source eq $blib_lib and exists $from_to{$blib_arch} and directory_not_empty($blib_arch) ){ $targetroot = install_rooted_dir($from_to{$blib_arch}); print "Files found in $blib_arch: installing files in $blib_lib into architecture dependent library tree\n"; } next unless -d $source; _chdir($source); # 5.5.3's File::Find missing no_chdir option # XXX OS-SPECIFIC # File::Find seems to always be Unixy except on MacPerl :( my $current_directory= $Is_MacPerl ? $Curdir : '.'; find(sub { my ($mode,$size,$atime,$mtime) = (stat)[2,7,8,9]; return if !-f _; my $origfile = $_; return if $origfile eq ".exists"; my $targetdir = File::Spec->catdir($targetroot, $File::Find::dir); my $targetfile = File::Spec->catfile($targetdir, $origfile); my $sourcedir = File::Spec->catdir($source, $File::Find::dir); my $sourcefile = File::Spec->catfile($sourcedir, $origfile); for my $pat (@$skip) { if ( $sourcefile=~/$pat/ ) { print "Skipping $targetfile (filtered)\n" if $verbose>1; $result->{install_filtered}{$sourcefile} = $pat; return; } } # we have to do this for back compat with old File::Finds # and because the target is relative my $save_cwd = _chdir($cwd); my $diff = 0; # XXX: I wonder how useful this logic is actually -- demerphq if ( $always_copy or !-f $targetfile or -s $targetfile != $size) { $diff++; } else { # we might not need to copy this file $diff = compare($sourcefile, $targetfile); } $check_dirs{$targetdir}++ unless -w $targetfile; push @found_files, [ $diff, $File::Find::dir, $origfile, $mode, $size, $atime, $mtime, $targetdir, $targetfile, $sourcedir, $sourcefile, ]; #restore the original directory we were in when File::Find #called us so that it doesn't get horribly confused. _chdir($save_cwd); }, $current_directory ); _chdir($cwd); } foreach my $targetdir (sort keys %check_dirs) { _mkpath( $targetdir, 0, 0755, $verbose, $dry_run ); } foreach my $found (@found_files) { my ($diff, $ffd, $origfile, $mode, $size, $atime, $mtime, $targetdir, $targetfile, $sourcedir, $sourcefile)= @$found; my $realtarget= $targetfile; if ($diff) { eval { if (-f $targetfile) { print "_unlink_or_rename($targetfile)\n" if $verbose>1; $targetfile= _unlink_or_rename( $targetfile, 'tryhard', 'install' ) unless $dry_run; } elsif ( ! -d $targetdir ) { _mkpath( $targetdir, 0, 0755, $verbose, $dry_run ); } print "Installing $targetfile\n"; _copy( $sourcefile, $targetfile, $verbose, $dry_run, ); #XXX OS-SPECIFIC print "utime($atime,$mtime,$targetfile)\n" if $verbose>1; utime($atime,$mtime + $Is_VMS,$targetfile) unless $dry_run>1; $mode = 0444 | ( $mode & 0111 ? 0111 : 0 ); $mode = $mode | 0222 if $realtarget ne $targetfile; _chmod( $mode, $targetfile, $verbose ); $result->{install}{$targetfile} = $sourcefile; 1 } or do { $result->{install_fail}{$targetfile} = $sourcefile; die $@; }; } else { $result->{install_unchanged}{$targetfile} = $sourcefile; print "Skipping $targetfile (unchanged)\n" if $verbose; } if ( $uninstall_shadows ) { inc_uninstall($sourcefile,$ffd, $verbose, $dry_run, $realtarget ne $targetfile ? $realtarget : "", $result); } # Record the full pathname. $packlist->{$targetfile}++; } if ($pack{'write'}) { $dir = install_rooted_dir(dirname($pack{'write'})); _mkpath( $dir, 0, 0755, $verbose, $dry_run ); print "Writing $pack{'write'}\n" if $verbose; $packlist->write(install_rooted_file($pack{'write'})) unless $dry_run; } _do_cleanup($verbose); return $result; } =begin _private =item _do_cleanup Standardize finish event for after another instruction has occurred. Handles converting $MUST_REBOOT to a die for instance. =end _private =cut sub _do_cleanup { my ($verbose) = @_; if ($MUST_REBOOT) { die _estr "Operation not completed! ", "You must reboot to complete the installation.", "Sorry."; } elsif (defined $MUST_REBOOT & $verbose) { warn _estr "Installation will be completed at the next reboot.\n", "However it is not necessary to reboot immediately.\n"; } } =begin _undocumented =item install_rooted_file( $file ) Returns $file, or catfile($INSTALL_ROOT,$file) if $INSTALL_ROOT is defined. =item install_rooted_dir( $dir ) Returns $dir, or catdir($INSTALL_ROOT,$dir) if $INSTALL_ROOT is defined. =end _undocumented =cut sub install_rooted_file { if (defined $INSTALL_ROOT) { File::Spec->catfile($INSTALL_ROOT, $_[0]); } else { $_[0]; } } sub install_rooted_dir { if (defined $INSTALL_ROOT) { File::Spec->catdir($INSTALL_ROOT, $_[0]); } else { $_[0]; } } =begin _undocumented =item forceunlink( $file, $tryhard ) Tries to delete a file. If $tryhard is true then we will use whatever devious tricks we can to delete the file. Currently this only applies to Win32 in that it will try to use Win32API::File to schedule a delete at reboot. A wrapper for _unlink_or_rename(). =end _undocumented =cut sub forceunlink { my ( $file, $tryhard )= @_; #XXX OS-SPECIFIC _unlink_or_rename( $file, $tryhard, not("installing") ); } =begin _undocumented =item directory_not_empty( $dir ) Returns 1 if there is an .exists file somewhere in a directory tree. Returns 0 if there is not. =end _undocumented =cut sub directory_not_empty ($) { my($dir) = @_; my $files = 0; find(sub { return if $_ eq ".exists"; if (-f) { $File::Find::prune++; $files = 1; } }, $dir); return $files; } =pod =item B I install_default(); install_default($fullext); Calls install() with arguments to copy a module from blib/ to the default site installation location. $fullext is the name of the module converted to a directory (ie. Foo::Bar would be Foo/Bar). If $fullext is not specified, it will attempt to read it from @ARGV. This is primarily useful for install scripts. B This function is not really useful because of the hard-coded install location with no way to control site vs core vs vendor directories and the strange way in which the module name is given. Consider its use discouraged. =cut sub install_default { @_ < 2 or Carp::croak("install_default should be called with 0 or 1 argument"); my $FULLEXT = @_ ? shift : $ARGV[0]; defined $FULLEXT or die "Do not know to where to write install log"; my $INST_LIB = File::Spec->catdir($Curdir,"blib","lib"); my $INST_ARCHLIB = File::Spec->catdir($Curdir,"blib","arch"); my $INST_BIN = File::Spec->catdir($Curdir,'blib','bin'); my $INST_SCRIPT = File::Spec->catdir($Curdir,'blib','script'); my $INST_MAN1DIR = File::Spec->catdir($Curdir,'blib','man1'); my $INST_MAN3DIR = File::Spec->catdir($Curdir,'blib','man3'); my @INST_HTML; if($Config{installhtmldir}) { my $INST_HTMLDIR = File::Spec->catdir($Curdir,'blib','html'); @INST_HTML = ($INST_HTMLDIR => $Config{installhtmldir}); } install({ read => "$Config{sitearchexp}/auto/$FULLEXT/.packlist", write => "$Config{installsitearch}/auto/$FULLEXT/.packlist", $INST_LIB => (directory_not_empty($INST_ARCHLIB)) ? $Config{installsitearch} : $Config{installsitelib}, $INST_ARCHLIB => $Config{installsitearch}, $INST_BIN => $Config{installbin} , $INST_SCRIPT => $Config{installscript}, $INST_MAN1DIR => $Config{installman1dir}, $INST_MAN3DIR => $Config{installman3dir}, @INST_HTML, },1,0,0); } =item B uninstall($packlist_file); uninstall($packlist_file, $verbose, $dont_execute); Removes the files listed in a $packlist_file. If $verbose is true, will print out each file removed. Default is false. If $dont_execute is true it will only print what it was going to do without actually doing it. Default is false. =cut sub uninstall { my($fil,$verbose,$dry_run) = @_; $verbose ||= 0; $dry_run ||= 0; die _estr "ERROR: no packlist file found: '$fil'" unless -f $fil; # my $my_req = $self->catfile(qw(auto ExtUtils Install forceunlink.al)); # require $my_req; # Hairy, but for the first my ($packlist) = ExtUtils::Packlist->new($fil); foreach (sort(keys(%$packlist))) { chomp; print "unlink $_\n" if $verbose; forceunlink($_,'tryhard') unless $dry_run; } print "unlink $fil\n" if $verbose; forceunlink($fil, 'tryhard') unless $dry_run; _do_cleanup($verbose); } =begin _undocumented =item inc_uninstall($filepath,$libdir,$verbose,$dry_run,$ignore,$results) Remove shadowed files. If $ignore is true then it is assumed to hold a filename to ignore. This is used to prevent spurious warnings from occurring when doing an install at reboot. We now only die when failing to remove a file that has precedence over our own, when our install has precedence we only warn. $results is assumed to contain a hashref which will have the keys 'uninstall' and 'uninstall_fail' populated with keys for the files removed and values of the source files they would shadow. =end _undocumented =cut sub inc_uninstall { my($filepath,$libdir,$verbose,$dry_run,$ignore,$results) = @_; my($dir); $ignore||=""; my $file = (File::Spec->splitpath($filepath))[2]; my %seen_dir = (); my @PERL_ENV_LIB = split $Config{path_sep}, defined $ENV{'PERL5LIB'} ? $ENV{'PERL5LIB'} : $ENV{'PERLLIB'} || ''; my @dirs=( @PERL_ENV_LIB, @INC, @Config{qw(archlibexp privlibexp sitearchexp sitelibexp)}); #warn join "\n","---",@dirs,"---"; my $seen_ours; foreach $dir ( @dirs ) { my $canonpath = $Is_VMS ? $dir : File::Spec->canonpath($dir); next if $canonpath eq $Curdir; next if $seen_dir{$canonpath}++; my $targetfile = File::Spec->catfile($canonpath,$libdir,$file); next unless -f $targetfile; # The reason why we compare file's contents is, that we cannot # know, which is the file we just installed (AFS). So we leave # an identical file in place my $diff = 0; if ( -f $targetfile && -s _ == -s $filepath) { # We have a good chance, we can skip this one $diff = compare($filepath,$targetfile); } else { $diff++; } print "#$file and $targetfile differ\n" if $diff && $verbose > 1; if (!$diff or $targetfile eq $ignore) { $seen_ours = 1; next; } if ($dry_run) { $results->{uninstall}{$targetfile} = $filepath; if ($verbose) { $Inc_uninstall_warn_handler ||= ExtUtils::Install::Warn->new(); $libdir =~ s|^\./||s ; # That's just cosmetics, no need to port. It looks prettier. $Inc_uninstall_warn_handler->add( File::Spec->catfile($libdir, $file), $targetfile ); } # if not verbose, we just say nothing } else { print "Unlinking $targetfile (shadowing?)\n" if $verbose; eval { die "Fake die for testing" if $ExtUtils::Install::Testing and ucase(File::Spec->canonpath($ExtUtils::Install::Testing)) eq ucase($targetfile); forceunlink($targetfile,'tryhard'); $results->{uninstall}{$targetfile} = $filepath; 1; } or do { $results->{fail_uninstall}{$targetfile} = $filepath; if ($seen_ours) { warn "Failed to remove probably harmless shadow file '$targetfile'\n"; } else { die "$@\n"; } }; } } } =begin _undocumented =item run_filter($cmd,$src,$dest) Filter $src using $cmd into $dest. =end _undocumented =cut sub run_filter { my ($cmd, $src, $dest) = @_; local(*CMD, *SRC); open(CMD, "|$cmd >$dest") || die "Cannot fork: $!"; open(SRC, $src) || die "Cannot open $src: $!"; my $buf; my $sz = 1024; while (my $len = sysread(SRC, $buf, $sz)) { syswrite(CMD, $buf, $len); } close SRC; close CMD or die "Filter command '$cmd' failed for $src"; } =pod =item B pm_to_blib(\%from_to); pm_to_blib(\%from_to, $autosplit_dir); pm_to_blib(\%from_to, $autosplit_dir, $filter_cmd); Copies each key of %from_to to its corresponding value efficiently. If an $autosplit_dir is provided, all .pm files will be autosplit into it. Any destination directories are created. $filter_cmd is an optional shell command to run each .pm file through prior to splitting and copying. Input is the contents of the module, output the new module contents. You can have an environment variable PERL_INSTALL_ROOT set which will be prepended as a directory to each installed file (and directory). By default verbose output is generated, setting the PERL_INSTALL_QUIET environment variable will silence this output. =cut sub pm_to_blib { my($fromto,$autodir,$pm_filter) = @_; _mkpath($autodir,0,0755) if defined $autodir; while(my($from, $to) = each %$fromto) { if( -f $to && -s $from == -s $to && -M $to < -M $from ) { print "Skip $to (unchanged)\n" unless $INSTALL_QUIET; next; } # When a pm_filter is defined, we need to pre-process the source first # to determine whether it has changed or not. Therefore, only perform # the comparison check when there's no filter to be ran. # -- RAM, 03/01/2001 my $need_filtering = defined $pm_filter && length $pm_filter && $from =~ /\.pm$/; if (!$need_filtering && 0 == compare($from,$to)) { print "Skip $to (unchanged)\n" unless $INSTALL_QUIET; next; } if (-f $to){ # we wont try hard here. its too likely to mess things up. forceunlink($to); } else { _mkpath(dirname($to),0,0755); } if ($need_filtering) { run_filter($pm_filter, $from, $to); print "$pm_filter <$from >$to\n"; } else { _copy( $from, $to ); print "cp $from $to\n" unless $INSTALL_QUIET; } my($mode,$atime,$mtime) = (stat $from)[2,8,9]; utime($atime,$mtime+$Is_VMS,$to); _chmod(0444 | ( $mode & 0111 ? 0111 : 0 ),$to); next unless $from =~ /\.pm$/; _autosplit($to,$autodir) if defined $autodir; } } =begin _private =item _autosplit From 1.0307 back, AutoSplit will sometimes leave an open filehandle to the file being split. This causes problems on systems with mandatory locking (ie. Windows). So we wrap it and close the filehandle. =end _private =cut sub _autosplit { #XXX OS-SPECIFIC my $retval = autosplit(@_); close *AutoSplit::IN if defined *AutoSplit::IN{IO}; return $retval; } package ExtUtils::Install::Warn; sub new { bless {}, shift } sub add { my($self,$file,$targetfile) = @_; push @{$self->{$file}}, $targetfile; } sub DESTROY { unless(defined $INSTALL_ROOT) { my $self = shift; my($file,$i,$plural); foreach $file (sort keys %$self) { $plural = @{$self->{$file}} > 1 ? "s" : ""; print "## Differing version$plural of $file found. You might like to\n"; for (0..$#{$self->{$file}}) { print "rm ", $self->{$file}[$_], "\n"; $i++; } } $plural = $i>1 ? "all those files" : "this file"; my $inst = (_invokant() eq 'ExtUtils::MakeMaker') ? ( $Config::Config{make} || 'make' ).' install' . ( $Is_VMS ? '/MACRO="UNINST"=1' : ' UNINST=1' ) : './Build install uninst=1'; print "## Running '$inst' will unlink $plural for you.\n"; } } =begin _private =item _invokant Does a heuristic on the stack to see who called us for more intelligent error messages. Currently assumes we will be called only by Module::Build or by ExtUtils::MakeMaker. =end _private =cut sub _invokant { my @stack; my $frame = 0; while (my $file = (caller($frame++))[1]) { push @stack, (File::Spec->splitpath($file))[2]; } my $builder; my $top = pop @stack; if ($top =~ /^Build/i || exists($INC{'Module/Build.pm'})) { $builder = 'Module::Build'; } else { $builder = 'ExtUtils::MakeMaker'; } return $builder; } =pod =back =head1 ENVIRONMENT =over 4 =item B Will be prepended to each install path. =item B Will prevent the automatic use of INSTALL.SKIP as the install skip file. =item B If there is no INSTALL.SKIP file in the make directory then this value can be used to provide a default. =item B If this environment variable is true then normal install processes will always overwrite older identical files during the install process. Note that the alias EU_ALWAYS_COPY will be supported if EU_INSTALL_ALWAYS_COPY is not defined until at least the 1.50 release. Please ensure you use the correct EU_INSTALL_ALWAYS_COPY. =back =head1 AUTHOR Original author lost in the mists of time. Probably the same as Makemaker. Production release currently maintained by demerphq C, extensive changes by Michael G. Schwern. Send bug reports via http://rt.cpan.org/. Please send your generated Makefile along with your report. =head1 LICENSE This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See L =cut 1; EXTUTILS_INSTALL $fatpacked{"ExtUtils/Installed.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_INSTALLED'; package ExtUtils::Installed; use 5.00503; use strict; #use warnings; # XXX requires 5.6 use Carp qw(); use ExtUtils::Packlist; use ExtUtils::MakeMaker; use Config; use File::Find; use File::Basename; use File::Spec; my $Is_VMS = $^O eq 'VMS'; my $DOSISH = ($^O =~ /^(MSWin\d\d|os2|dos|mint)$/); require VMS::Filespec if $Is_VMS; use vars qw($VERSION); $VERSION = '2.06'; $VERSION = eval $VERSION; sub _is_prefix { my ($self, $path, $prefix) = @_; return unless defined $prefix && defined $path; if( $Is_VMS ) { $prefix = VMS::Filespec::unixify($prefix); $path = VMS::Filespec::unixify($path); } # Unix path normalization. $prefix = File::Spec->canonpath($prefix); return 1 if substr($path, 0, length($prefix)) eq $prefix; if ($DOSISH) { $path =~ s|\\|/|g; $prefix =~ s|\\|/|g; return 1 if $path =~ m{^\Q$prefix\E}i; } return(0); } sub _is_doc { my ($self, $path) = @_; my $man1dir = $self->{':private:'}{Config}{man1direxp}; my $man3dir = $self->{':private:'}{Config}{man3direxp}; return(($man1dir && $self->_is_prefix($path, $man1dir)) || ($man3dir && $self->_is_prefix($path, $man3dir)) ? 1 : 0) } sub _is_type { my ($self, $path, $type) = @_; return 1 if $type eq "all"; return($self->_is_doc($path)) if $type eq "doc"; my $conf= $self->{':private:'}{Config}; if ($type eq "prog") { return($self->_is_prefix($path, $conf->{prefix} || $conf->{prefixexp}) && !($self->_is_doc($path)) ? 1 : 0); } return(0); } sub _is_under { my ($self, $path, @under) = @_; $under[0] = "" if (! @under); foreach my $dir (@under) { return(1) if ($self->_is_prefix($path, $dir)); } return(0); } sub _fix_dirs { my ($self, @dirs)= @_; # File::Find does not know how to deal with VMS filepaths. if( $Is_VMS ) { $_ = VMS::Filespec::unixify($_) for @dirs; } if ($DOSISH) { s|\\|/|g for @dirs; } return wantarray ? @dirs : $dirs[0]; } sub _make_entry { my ($self, $module, $packlist_file, $modfile)= @_; my $data= { module => $module, packlist => scalar(ExtUtils::Packlist->new($packlist_file)), packlist_file => $packlist_file, }; if (!$modfile) { $data->{version} = $self->{':private:'}{Config}{version}; } else { $data->{modfile} = $modfile; # Find the top-level module file in @INC $data->{version} = ''; foreach my $dir (@{$self->{':private:'}{INC}}) { my $p = File::Spec->catfile($dir, $modfile); if (-r $p) { $module = _module_name($p, $module) if $Is_VMS; $data->{version} = MM->parse_version($p); $data->{version_from} = $p; $data->{packlist_valid} = exists $data->{packlist}{$p}; last; } } } $self->{$module}= $data; } our $INSTALLED; sub new { my ($class) = shift(@_); $class = ref($class) || $class; my %args = @_; return $INSTALLED if $INSTALLED and ($args{default_get} || $args{default}); my $self = bless {}, $class; $INSTALLED= $self if $args{default_set} || $args{default}; if ($args{config_override}) { eval { $self->{':private:'}{Config} = { %{$args{config_override}} }; } or Carp::croak( "The 'config_override' parameter must be a hash reference." ); } else { $self->{':private:'}{Config} = \%Config; } for my $tuple ([inc_override => INC => [ @INC ] ], [ extra_libs => EXTRA => [] ]) { my ($arg,$key,$val)=@$tuple; if ( $args{$arg} ) { eval { $self->{':private:'}{$key} = [ @{$args{$arg}} ]; } or Carp::croak( "The '$arg' parameter must be an array reference." ); } elsif ($val) { $self->{':private:'}{$key} = $val; } } { my %dupe; @{$self->{':private:'}{LIBDIRS}} = grep { $_ ne '.' || ! $args{skip_cwd} } grep { -e $_ && !$dupe{$_}++ } @{$self->{':private:'}{EXTRA}}, @{$self->{':private:'}{INC}}; } my @dirs= $self->_fix_dirs(@{$self->{':private:'}{LIBDIRS}}); # Read the core packlist my $archlib = $self->_fix_dirs($self->{':private:'}{Config}{archlibexp}); $self->_make_entry("Perl",File::Spec->catfile($archlib, '.packlist')); my $root; # Read the module packlists my $sub = sub { # Only process module .packlists return if $_ ne ".packlist" || $File::Find::dir eq $archlib; # Hack of the leading bits of the paths & convert to a module name my $module = $File::Find::name; my $found = $module =~ s!^.*?/auto/(.*)/.packlist!$1!s or do { # warn "Woah! \$_=$_\n\$module=$module\n\$File::Find::dir=$File::Find::dir\n", # join ("\n",@dirs); return; }; my $modfile = "$module.pm"; $module =~ s!/!::!g; return if $self->{$module}; #shadowing? $self->_make_entry($module,$File::Find::name,$modfile); }; while (@dirs) { $root= shift @dirs; next if !-d $root; find($sub,$root); } return $self; } # VMS's non-case preserving file-system means the package name can't # be reconstructed from the filename. sub _module_name { my($file, $orig_module) = @_; my $module = ''; if (open PACKFH, $file) { while () { if (/package\s+(\S+)\s*;/) { my $pack = $1; # Make a sanity check, that lower case $module # is identical to lowercase $pack before # accepting it if (lc($pack) eq lc($orig_module)) { $module = $pack; last; } } } close PACKFH; } print STDERR "Couldn't figure out the package name for $file\n" unless $module; return $module; } sub modules { my ($self) = @_; $self= $self->new(default=>1) if !ref $self; # Bug/feature of sort in scalar context requires this. return wantarray ? sort grep { not /^:private:$/ } keys %$self : grep { not /^:private:$/ } keys %$self; } sub files { my ($self, $module, $type, @under) = @_; $self= $self->new(default=>1) if !ref $self; # Validate arguments Carp::croak("$module is not installed") if (! exists($self->{$module})); $type = "all" if (! defined($type)); Carp::croak('type must be "all", "prog" or "doc"') if ($type ne "all" && $type ne "prog" && $type ne "doc"); my (@files); foreach my $file (keys(%{$self->{$module}{packlist}})) { push(@files, $file) if ($self->_is_type($file, $type) && $self->_is_under($file, @under)); } return(@files); } sub directories { my ($self, $module, $type, @under) = @_; $self= $self->new(default=>1) if !ref $self; my (%dirs); foreach my $file ($self->files($module, $type, @under)) { $dirs{dirname($file)}++; } return sort keys %dirs; } sub directory_tree { my ($self, $module, $type, @under) = @_; $self= $self->new(default=>1) if !ref $self; my (%dirs); foreach my $dir ($self->directories($module, $type, @under)) { $dirs{$dir}++; my ($last) = (""); while ($last ne $dir) { $last = $dir; $dir = dirname($dir); last if !$self->_is_under($dir, @under); $dirs{$dir}++; } } return(sort(keys(%dirs))); } sub validate { my ($self, $module, $remove) = @_; $self= $self->new(default=>1) if !ref $self; Carp::croak("$module is not installed") if (! exists($self->{$module})); return($self->{$module}{packlist}->validate($remove)); } sub packlist { my ($self, $module) = @_; $self= $self->new(default=>1) if !ref $self; Carp::croak("$module is not installed") if (! exists($self->{$module})); return($self->{$module}{packlist}); } sub version { my ($self, $module) = @_; $self= $self->new(default=>1) if !ref $self; Carp::croak("$module is not installed") if (! exists($self->{$module})); return($self->{$module}{version}); } sub debug_dump { my ($self, $module) = @_; $self= $self->new(default=>1) if !ref $self; local $self->{":private:"}{Config}; require Data::Dumper; print Data::Dumper->new([$self])->Sortkeys(1)->Indent(1)->Dump(); } 1; __END__ =head1 NAME ExtUtils::Installed - Inventory management of installed modules =head1 SYNOPSIS use ExtUtils::Installed; my ($inst) = ExtUtils::Installed->new( skip_cwd => 1 ); my (@modules) = $inst->modules(); my (@missing) = $inst->validate("DBI"); my $all_files = $inst->files("DBI"); my $files_below_usr_local = $inst->files("DBI", "all", "/usr/local"); my $all_dirs = $inst->directories("DBI"); my $dirs_below_usr_local = $inst->directory_tree("DBI", "prog"); my $packlist = $inst->packlist("DBI"); =head1 DESCRIPTION ExtUtils::Installed provides a standard way to find out what core and module files have been installed. It uses the information stored in .packlist files created during installation to provide this information. In addition it provides facilities to classify the installed files and to extract directory information from the .packlist files. =head1 USAGE The new() function searches for all the installed .packlists on the system, and stores their contents. The .packlists can be queried with the functions described below. Where it searches by default is determined by the settings found in C<%Config::Config>, and what the value is of the PERL5LIB environment variable. =head1 METHODS Unless specified otherwise all method can be called as class methods, or as object methods. If called as class methods then the "default" object will be used, and if necessary created using the current processes %Config and @INC. See the 'default' option to new() for details. =over 4 =item new() This takes optional named parameters. Without parameters, this searches for all the installed .packlists on the system using information from C<%Config::Config> and the default module search paths C<@INC>. The packlists are read using the L module. If the named parameter C is true, the current directory C<.> will be stripped from C<@INC> before searching for .packlists. This keeps ExtUtils::Installed from finding modules installed in other perls that happen to be located below the current directory. If the named parameter C is specified, it should be a reference to a hash which contains all information usually found in C<%Config::Config>. For example, you can obtain the configuration information for a separate perl installation and pass that in. my $yoda_cfg = get_fake_config('yoda'); my $yoda_inst = ExtUtils::Installed->new(config_override=>$yoda_cfg); Similarly, the parameter C may be a reference to an array which is used in place of the default module search paths from C<@INC>. use Config; my @dirs = split(/\Q$Config{path_sep}\E/, $ENV{PERL5LIB}); my $p5libs = ExtUtils::Installed->new(inc_override=>\@dirs); B: You probably do not want to use these options alone, almost always you will want to set both together. The parameter C can be used to specify B paths to search for installed modules. For instance my $installed = ExtUtils::Installed->new(extra_libs=>["/my/lib/path"]); This should only be necessary if F is not in PERL5LIB. Finally there is the 'default', and the related 'default_get' and 'default_set' options. These options control the "default" object which is provided by the class interface to the methods. Setting C to true tells the constructor to return the default object if it is defined. Setting C to true tells the constructor to make the default object the constructed object. Setting the C option is like setting both to true. This is used primarily internally and probably isn't interesting to any real user. =item modules() This returns a list of the names of all the installed modules. The perl 'core' is given the special name 'Perl'. =item files() This takes one mandatory parameter, the name of a module. It returns a list of all the filenames from the package. To obtain a list of core perl files, use the module name 'Perl'. Additional parameters are allowed. The first is one of the strings "prog", "doc" or "all", to select either just program files, just manual files or all files. The remaining parameters are a list of directories. The filenames returned will be restricted to those under the specified directories. =item directories() This takes one mandatory parameter, the name of a module. It returns a list of all the directories from the package. Additional parameters are allowed. The first is one of the strings "prog", "doc" or "all", to select either just program directories, just manual directories or all directories. The remaining parameters are a list of directories. The directories returned will be restricted to those under the specified directories. This method returns only the leaf directories that contain files from the specified module. =item directory_tree() This is identical in operation to directories(), except that it includes all the intermediate directories back up to the specified directories. =item validate() This takes one mandatory parameter, the name of a module. It checks that all the files listed in the modules .packlist actually exist, and returns a list of any missing files. If an optional second argument which evaluates to true is given any missing files will be removed from the .packlist =item packlist() This returns the ExtUtils::Packlist object for the specified module. =item version() This returns the version number for the specified module. =back =head1 EXAMPLE See the example in L. =head1 AUTHOR Alan Burlison =cut EXTUTILS_INSTALLED $fatpacked{"ExtUtils/Liblist.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_LIBLIST'; package ExtUtils::Liblist; use strict; our $VERSION = '7.38'; $VERSION =~ tr/_//d; use File::Spec; require ExtUtils::Liblist::Kid; our @ISA = qw(ExtUtils::Liblist::Kid File::Spec); # Backwards compatibility with old interface. sub ext { goto &ExtUtils::Liblist::Kid::ext; } sub lsdir { shift; my $rex = qr/$_[1]/; opendir my $dir_fh, $_[0]; my @out = grep /$rex/, readdir $dir_fh; closedir $dir_fh; return @out; } __END__ =head1 NAME ExtUtils::Liblist - determine libraries to use and how to use them =head1 SYNOPSIS require ExtUtils::Liblist; $MM->ext($potential_libs, $verbose, $need_names); # Usually you can get away with: ExtUtils::Liblist->ext($potential_libs, $verbose, $need_names) =head1 DESCRIPTION This utility takes a list of libraries in the form C<-llib1 -llib2 -llib3> and returns lines suitable for inclusion in an extension Makefile. Extra library paths may be included with the form C<-L/another/path> this will affect the searches for all subsequent libraries. It returns an array of four or five scalar values: EXTRALIBS, BSLOADLIBS, LDLOADLIBS, LD_RUN_PATH, and, optionally, a reference to the array of the filenames of actual libraries. Some of these don't mean anything unless on Unix. See the details about those platform specifics below. The list of the filenames is returned only if $need_names argument is true. Dependent libraries can be linked in one of three ways: =over 2 =item * For static extensions by the ld command when the perl binary is linked with the extension library. See EXTRALIBS below. =item * For dynamic extensions at build/link time by the ld command when the shared object is built/linked. See LDLOADLIBS below. =item * For dynamic extensions at load time by the DynaLoader when the shared object is loaded. See BSLOADLIBS below. =back =head2 EXTRALIBS List of libraries that need to be linked with when linking a perl binary which includes this extension. Only those libraries that actually exist are included. These are written to a file and used when linking perl. =head2 LDLOADLIBS and LD_RUN_PATH List of those libraries which can or must be linked into the shared library when created using ld. These may be static or dynamic libraries. LD_RUN_PATH is a colon separated list of the directories in LDLOADLIBS. It is passed as an environment variable to the process that links the shared library. =head2 BSLOADLIBS List of those libraries that are needed but can be linked in dynamically at run time on this platform. SunOS/Solaris does not need this because ld records the information (from LDLOADLIBS) into the object file. This list is used to create a .bs (bootstrap) file. =head1 PORTABILITY This module deals with a lot of system dependencies and has quite a few architecture specific Cs in the code. =head2 VMS implementation The version of ext() which is executed under VMS differs from the Unix-OS/2 version in several respects: =over 2 =item * Input library and path specifications are accepted with or without the C<-l> and C<-L> prefixes used by Unix linkers. If neither prefix is present, a token is considered a directory to search if it is in fact a directory, and a library to search for otherwise. Authors who wish their extensions to be portable to Unix or OS/2 should use the Unix prefixes, since the Unix-OS/2 version of ext() requires them. =item * Wherever possible, shareable images are preferred to object libraries, and object libraries to plain object files. In accordance with VMS naming conventions, ext() looks for files named Ishr and Irtl; it also looks for Ilib and libI to accommodate Unix conventions used in some ported software. =item * For each library that is found, an appropriate directive for a linker options file is generated. The return values are space-separated strings of these directives, rather than elements used on the linker command line. =item * LDLOADLIBS contains both the libraries found based on C<$potential_libs> and the CRTLs, if any, specified in Config.pm. EXTRALIBS contains just those libraries found based on C<$potential_libs>. BSLOADLIBS and LD_RUN_PATH are always empty. =back In addition, an attempt is made to recognize several common Unix library names, and filter them out or convert them to their VMS equivalents, as appropriate. In general, the VMS version of ext() should properly handle input from extensions originally designed for a Unix or VMS environment. If you encounter problems, or discover cases where the search could be improved, please let us know. =head2 Win32 implementation The version of ext() which is executed under Win32 differs from the Unix-OS/2 version in several respects: =over 2 =item * If C<$potential_libs> is empty, the return value will be empty. Otherwise, the libraries specified by C<$Config{perllibs}> (see Config.pm) will be appended to the list of C<$potential_libs>. The libraries will be searched for in the directories specified in C<$potential_libs>, C<$Config{libpth}>, and in C<$Config{installarchlib}/CORE>. For each library that is found, a space-separated list of fully qualified library pathnames is generated. =item * Input library and path specifications are accepted with or without the C<-l> and C<-L> prefixes used by Unix linkers. An entry of the form C<-La:\foo> specifies the C directory to look for the libraries that follow. An entry of the form C<-lfoo> specifies the library C, which may be spelled differently depending on what kind of compiler you are using. If you are using GCC, it gets translated to C, but for other win32 compilers, it becomes C. If no files are found by those translated names, one more attempt is made to find them using either C or C, depending on whether GCC or some other win32 compiler is being used, respectively. If neither the C<-L> or C<-l> prefix is present in an entry, the entry is considered a directory to search if it is in fact a directory, and a library to search for otherwise. The C<$Config{lib_ext}> suffix will be appended to any entries that are not directories and don't already have the suffix. Note that the C<-L> and C<-l> prefixes are B, but authors who wish their extensions to be portable to Unix or OS/2 should use the prefixes, since the Unix-OS/2 version of ext() requires them. =item * Entries cannot be plain object files, as many Win32 compilers will not handle object files in the place of libraries. =item * Entries in C<$potential_libs> beginning with a colon and followed by alphanumeric characters are treated as flags. Unknown flags will be ignored. An entry that matches C disables the appending of default libraries found in C<$Config{perllibs}> (this should be only needed very rarely). An entry that matches C disables all searching for the libraries specified after it. Translation of C<-Lfoo> and C<-lfoo> still happens as appropriate (depending on compiler being used, as reflected by C<$Config{cc}>), but the entries are not verified to be valid files or directories. An entry that matches C reenables searching for the libraries specified after it. You can put it at the end to enable searching for default libraries specified by C<$Config{perllibs}>. =item * The libraries specified may be a mixture of static libraries and import libraries (to link with DLLs). Since both kinds are used pretty transparently on the Win32 platform, we do not attempt to distinguish between them. =item * LDLOADLIBS and EXTRALIBS are always identical under Win32, and BSLOADLIBS and LD_RUN_PATH are always empty (this may change in future). =item * You must make sure that any paths and path components are properly surrounded with double-quotes if they contain spaces. For example, C<$potential_libs> could be (literally): "-Lc:\Program Files\vc\lib" msvcrt.lib "la test\foo bar.lib" Note how the first and last entries are protected by quotes in order to protect the spaces. =item * Since this module is most often used only indirectly from extension C files, here is an example C entry to add a library to the build process for an extension: LIBS => ['-lgl'] When using GCC, that entry specifies that MakeMaker should first look for C (followed by C) in all the locations specified by C<$Config{libpth}>. When using a compiler other than GCC, the above entry will search for C (followed by C). If the library happens to be in a location not in C<$Config{libpth}>, you need: LIBS => ['-Lc:\gllibs -lgl'] Here is a less often used example: LIBS => ['-lgl', ':nosearch -Ld:\mesalibs -lmesa -luser32'] This specifies a search for library C as before. If that search fails to find the library, it looks at the next item in the list. The C<:nosearch> flag will prevent searching for the libraries that follow, so it simply returns the value as C<-Ld:\mesalibs -lmesa -luser32>, since GCC can use that value as is with its linker. When using the Visual C compiler, the second item is returned as C<-libpath:d:\mesalibs mesa.lib user32.lib>. When using the Borland compiler, the second item is returned as C<-Ld:\mesalibs mesa.lib user32.lib>, and MakeMaker takes care of moving the C<-Ld:\mesalibs> to the correct place in the linker command line. =back =head1 SEE ALSO L =cut EXTUTILS_LIBLIST $fatpacked{"ExtUtils/Liblist/Kid.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_LIBLIST_KID'; package ExtUtils::Liblist::Kid; # XXX Splitting this out into its own .pm is a temporary solution. # This kid package is to be used by MakeMaker. It will not work if # $self is not a Makemaker. use 5.006; # Broken out of MakeMaker from version 4.11 use strict; use warnings; our $VERSION = '7.38'; $VERSION =~ tr/_//d; use ExtUtils::MakeMaker::Config; use Cwd 'cwd'; use File::Basename; use File::Spec; sub ext { if ( $^O eq 'VMS' ) { return &_vms_ext; } elsif ( $^O eq 'MSWin32' ) { return &_win32_ext; } else { return &_unix_os2_ext; } } sub _unix_os2_ext { my ( $self, $potential_libs, $verbose, $give_libs ) = @_; $verbose ||= 0; if ( $^O =~ /os2|android/ and $Config{perllibs} ) { # Dynamic libraries are not transitive, so we may need including # the libraries linked against perl.dll/libperl.so again. $potential_libs .= " " if $potential_libs; $potential_libs .= $Config{perllibs}; } return ( "", "", "", "", ( $give_libs ? [] : () ) ) unless $potential_libs; warn "Potential libraries are '$potential_libs':\n" if $verbose; my ( $so ) = $Config{so}; my ( $libs ) = defined $Config{perllibs} ? $Config{perllibs} : $Config{libs}; my $Config_libext = $Config{lib_ext} || ".a"; my $Config_dlext = $Config{dlext}; # compute $extralibs, $bsloadlibs and $ldloadlibs from # $potential_libs # this is a rewrite of Andy Dougherty's extliblist in perl require Text::ParseWords; my ( @searchpath ); # from "-L/path" entries in $potential_libs my ( @libpath ) = Text::ParseWords::quotewords( '\s+', 0, $Config{'libpth'} || '' ); my ( @ldloadlibs, @bsloadlibs, @extralibs, @ld_run_path, %ld_run_path_seen ); my ( @libs, %libs_seen ); my ( $fullname, @fullname ); my ( $pwd ) = cwd(); # from Cwd.pm my ( $found ) = 0; if ( $^O eq 'darwin' or $^O eq 'next' ) { # 'escape' Mach-O ld -framework and -F flags, so they aren't dropped later on $potential_libs =~ s/(^|\s)(-(?:weak_|reexport_|lazy_)?framework)\s+(\S+)/$1-Wl,$2 -Wl,$3/g; $potential_libs =~ s/(^|\s)(-F)\s*(\S+)/$1-Wl,$2 -Wl,$3/g; } foreach my $thislib ( Text::ParseWords::quotewords( '\s+', 0, $potential_libs) ) { my ( $custom_name ) = ''; # Handle possible linker path arguments. if ( $thislib =~ s/^(-[LR]|-Wl,-R|-Wl,-rpath,)// ) { # save path flag type my ( $ptype ) = $1; unless ( -d $thislib ) { warn "$ptype$thislib ignored, directory does not exist\n" if $verbose; next; } my ( $rtype ) = $ptype; if ( ( $ptype eq '-R' ) or ( $ptype =~ m!^-Wl,-[Rr]! ) ) { if ( $Config{'lddlflags'} =~ /-Wl,-[Rr]/ ) { $rtype = '-Wl,-R'; } elsif ( $Config{'lddlflags'} =~ /-R/ ) { $rtype = '-R'; } } unless ( File::Spec->file_name_is_absolute( $thislib ) ) { warn "Warning: $ptype$thislib changed to $ptype$pwd/$thislib\n"; $thislib = $self->catdir( $pwd, $thislib ); } push( @searchpath, $thislib ); $thislib = qq{"$thislib"} if $thislib =~ / /; # protect spaces if there push( @extralibs, "$ptype$thislib" ); push( @ldloadlibs, "$rtype$thislib" ); next; } if ( $thislib =~ m!^-Wl,! ) { push( @extralibs, $thislib ); push( @ldloadlibs, $thislib ); next; } # Handle possible library arguments. if ( $thislib =~ s/^-l(:)?// ) { # Handle -l:foo.so, which means that the library will # actually be called foo.so, not libfoo.so. This # is used in Android by ExtUtils::Depends to allow one XS # module to link to another. $custom_name = $1 || ''; } else { warn "Unrecognized argument in LIBS ignored: '$thislib'\n"; next; } my ( $found_lib ) = 0; foreach my $thispth ( @searchpath, @libpath ) { # Try to find the full name of the library. We need this to # determine whether it's a dynamically-loadable library or not. # This tends to be subject to various os-specific quirks. # For gcc-2.6.2 on linux (March 1995), DLD can not load # .sa libraries, with the exception of libm.sa, so we # deliberately skip them. if ((@fullname = $self->lsdir($thispth, "^\Qlib$thislib.$so.\E[0-9]+")) || (@fullname = $self->lsdir($thispth, "^\Qlib$thislib.\E[0-9]+\Q\.$so"))) { # Take care that libfoo.so.10 wins against libfoo.so.9. # Compare two libraries to find the most recent version # number. E.g. if you have libfoo.so.9.0.7 and # libfoo.so.10.1, first convert all digits into two # decimal places. Then we'll add ".00" to the shorter # strings so that we're comparing strings of equal length # Thus we'll compare libfoo.so.09.07.00 with # libfoo.so.10.01.00. Some libraries might have letters # in the version. We don't know what they mean, but will # try to skip them gracefully -- we'll set any letter to # '0'. Finally, sort in reverse so we can take the # first element. #TODO: iterate through the directory instead of sorting $fullname = "$thispth/" . ( sort { my ( $ma ) = $a; my ( $mb ) = $b; $ma =~ tr/A-Za-z/0/s; $ma =~ s/\b(\d)\b/0$1/g; $mb =~ tr/A-Za-z/0/s; $mb =~ s/\b(\d)\b/0$1/g; while ( length( $ma ) < length( $mb ) ) { $ma .= ".00"; } while ( length( $mb ) < length( $ma ) ) { $mb .= ".00"; } # Comparison deliberately backwards $mb cmp $ma; } @fullname )[0]; } elsif ( -f ( $fullname = "$thispth/lib$thislib.$so" ) && ( ( $Config{'dlsrc'} ne "dl_dld.xs" ) || ( $thislib eq "m" ) ) ) { } elsif (-f ( $fullname = "$thispth/lib${thislib}_s$Config_libext" ) && ( $Config{'archname'} !~ /RM\d\d\d-svr4/ ) && ( $thislib .= "_s" ) ) { # we must explicitly use _s version } elsif ( -f ( $fullname = "$thispth/lib$thislib$Config_libext" ) ) { } elsif ( defined( $Config_dlext ) && -f ( $fullname = "$thispth/lib$thislib.$Config_dlext" ) ) { } elsif ( -f ( $fullname = "$thispth/$thislib$Config_libext" ) ) { } elsif ( -f ( $fullname = "$thispth/lib$thislib.dll$Config_libext" ) ) { } elsif ( $^O eq 'cygwin' && -f ( $fullname = "$thispth/$thislib.dll" ) ) { } elsif ( -f ( $fullname = "$thispth/Slib$thislib$Config_libext" ) ) { } elsif ($^O eq 'dgux' && -l ( $fullname = "$thispth/lib$thislib$Config_libext" ) && readlink( $fullname ) =~ /^elink:/s ) { # Some of DG's libraries look like misconnected symbolic # links, but development tools can follow them. (They # look like this: # # libm.a -> elink:${SDE_PATH:-/usr}/sde/\ # ${TARGET_BINARY_INTERFACE:-m88kdgux}/usr/lib/libm.a # # , the compilation tools expand the environment variables.) } elsif ( $custom_name && -f ( $fullname = "$thispth/$thislib" ) ) { } else { warn "$thislib not found in $thispth\n" if $verbose; next; } warn "'-l$thislib' found at $fullname\n" if $verbose; push @libs, $fullname unless $libs_seen{$fullname}++; $found++; $found_lib++; # Now update library lists # what do we know about this library... my $is_dyna = ( $fullname !~ /\Q$Config_libext\E\z/ ); my $in_perl = ( $libs =~ /\B-l:?\Q${thislib}\E\b/s ); # include the path to the lib once in the dynamic linker path # but only if it is a dynamic lib and not in Perl itself my ( $fullnamedir ) = dirname( $fullname ); push @ld_run_path, $fullnamedir if $is_dyna && !$in_perl && !$ld_run_path_seen{$fullnamedir}++; # Do not add it into the list if it is already linked in # with the main perl executable. # We have to special-case the NeXT, because math and ndbm # are both in libsys_s unless ( $in_perl || ( $Config{'osname'} eq 'next' && ( $thislib eq 'm' || $thislib eq 'ndbm' ) ) ) { push( @extralibs, "-l$custom_name$thislib" ); } # We might be able to load this archive file dynamically if ( ( $Config{'dlsrc'} =~ /dl_next/ && $Config{'osvers'} lt '4_0' ) || ( $Config{'dlsrc'} =~ /dl_dld/ ) ) { # We push -l$thislib instead of $fullname because # it avoids hardwiring a fixed path into the .bs file. # Mkbootstrap will automatically add dl_findfile() to # the .bs file if it sees a name in the -l format. # USE THIS, when dl_findfile() is fixed: # push(@bsloadlibs, "-l$thislib"); # OLD USE WAS while checking results against old_extliblist push( @bsloadlibs, "$fullname" ); } else { if ( $is_dyna ) { # For SunOS4, do not add in this shared library if # it is already linked in the main perl executable push( @ldloadlibs, "-l$custom_name$thislib" ) unless ( $in_perl and $^O eq 'sunos' ); } else { push( @ldloadlibs, "-l$custom_name$thislib" ); } } last; # found one here so don't bother looking further } warn "Warning (mostly harmless): " . "No library found for -l$thislib\n" unless $found_lib > 0; } unless ( $found ) { return ( '', '', '', '', ( $give_libs ? \@libs : () ) ); } else { return ( "@extralibs", "@bsloadlibs", "@ldloadlibs", join( ":", @ld_run_path ), ( $give_libs ? \@libs : () ) ); } } sub _win32_ext { require Text::ParseWords; my ( $self, $potential_libs, $verbose, $give_libs ) = @_; $verbose ||= 0; # If user did not supply a list, we punt. # (caller should probably use the list in $Config{libs}) return ( "", "", "", "", ( $give_libs ? [] : () ) ) unless $potential_libs; # TODO: make this use MM_Win32.pm's compiler detection my %libs_seen; my @extralibs; my $cc = $Config{cc} || ''; my $VC = $cc =~ /\bcl\b/i; my $GC = $cc =~ /\bgcc\b/i; my $libext = _win32_lib_extensions(); my @searchpath = ( '' ); # from "-L/path" entries in $potential_libs my @libpath = _win32_default_search_paths( $VC, $GC ); my $pwd = cwd(); # from Cwd.pm my $search = 1; # compute @extralibs from $potential_libs my @lib_search_list = _win32_make_lib_search_list( $potential_libs, $verbose ); for ( @lib_search_list ) { my $thislib = $_; # see if entry is a flag if ( /^:\w+$/ ) { $search = 0 if lc eq ':nosearch'; $search = 1 if lc eq ':search'; _debug( "Ignoring unknown flag '$thislib'\n", $verbose ) if !/^:(no)?(search|default)$/i; next; } # if searching is disabled, do compiler-specific translations unless ( $search ) { s/^-l(.+)$/$1.lib/ unless $GC; s/^-L/-libpath:/ if $VC; push( @extralibs, $_ ); next; } # handle possible linker path arguments if ( s/^-L// and not -d ) { _debug( "$thislib ignored, directory does not exist\n", $verbose ); next; } elsif ( -d ) { unless ( File::Spec->file_name_is_absolute( $_ ) ) { warn "Warning: '$thislib' changed to '-L$pwd/$_'\n"; $_ = $self->catdir( $pwd, $_ ); } push( @searchpath, $_ ); next; } my @paths = ( @searchpath, @libpath ); my ( $fullname, $path ) = _win32_search_file( $thislib, $libext, \@paths, $verbose, $GC ); if ( !$fullname ) { warn "Warning (mostly harmless): No library found for $thislib\n"; next; } _debug( "'$thislib' found as '$fullname'\n", $verbose ); push( @extralibs, $fullname ); $libs_seen{$fullname} = 1 if $path; # why is this a special case? } my @libs = sort keys %libs_seen; return ( '', '', '', '', ( $give_libs ? \@libs : () ) ) unless @extralibs; # make sure paths with spaces are properly quoted @extralibs = map { qq["$_"] } @extralibs; @libs = map { qq["$_"] } @libs; my $lib = join( ' ', @extralibs ); # normalize back to backward slashes (to help braindead tools) # XXX this may break equally braindead GNU tools that don't understand # backslashes, either. Seems like one can't win here. Cursed be CP/M. $lib =~ s,/,\\,g; _debug( "Result: $lib\n", $verbose ); wantarray ? ( $lib, '', $lib, '', ( $give_libs ? \@libs : () ) ) : $lib; } sub _win32_make_lib_search_list { my ( $potential_libs, $verbose ) = @_; # If Config.pm defines a set of default libs, we always # tack them on to the user-supplied list, unless the user # specified :nodefault my $libs = $Config{'perllibs'}; $potential_libs = join( ' ', $potential_libs, $libs ) if $libs and $potential_libs !~ /:nodefault/i; _debug( "Potential libraries are '$potential_libs':\n", $verbose ); $potential_libs =~ s,\\,/,g; # normalize to forward slashes my @list = Text::ParseWords::quotewords( '\s+', 0, $potential_libs ); return @list; } sub _win32_default_search_paths { my ( $VC, $GC ) = @_; my $libpth = $Config{'libpth'} || ''; $libpth =~ s,\\,/,g; # normalize to forward slashes my @libpath = Text::ParseWords::quotewords( '\s+', 0, $libpth ); push @libpath, "$Config{installarchlib}/CORE"; # add "$Config{installarchlib}/CORE" to default search path push @libpath, split /;/, $ENV{LIB} if $VC and $ENV{LIB}; push @libpath, split /;/, $ENV{LIBRARY_PATH} if $GC and $ENV{LIBRARY_PATH}; return @libpath; } sub _win32_search_file { my ( $thislib, $libext, $paths, $verbose, $GC ) = @_; my @file_list = _win32_build_file_list( $thislib, $GC, $libext ); for my $lib_file ( @file_list ) { for my $path ( @{$paths} ) { my $fullname = $lib_file; $fullname = "$path\\$fullname" if $path; return ( $fullname, $path ) if -f $fullname; _debug( "'$thislib' not found as '$fullname'\n", $verbose ); } } return; } sub _win32_build_file_list { my ( $lib, $GC, $extensions ) = @_; my @pre_fixed = _win32_build_prefixed_list( $lib, $GC ); return map _win32_attach_extensions( $_, $extensions ), @pre_fixed; } sub _win32_build_prefixed_list { my ( $lib, $GC ) = @_; return $lib if $lib !~ s/^-l//; return $lib if $lib =~ /^lib/ and !$GC; ( my $no_prefix = $lib ) =~ s/^lib//i; $lib = "lib$lib" if $no_prefix eq $lib; return ( $lib, $no_prefix ) if $GC; return ( $no_prefix, $lib ); } sub _win32_attach_extensions { my ( $lib, $extensions ) = @_; return map _win32_try_attach_extension( $lib, $_ ), @{$extensions}; } sub _win32_try_attach_extension { my ( $lib, $extension ) = @_; return $lib if $lib =~ /\Q$extension\E$/i; return "$lib$extension"; } sub _win32_lib_extensions { my @extensions; push @extensions, $Config{'lib_ext'} if $Config{'lib_ext'}; push @extensions, '.dll.a' if grep { m!^\.a$! } @extensions; push @extensions, '.lib' unless grep { m!^\.lib$! } @extensions; return \@extensions; } sub _debug { my ( $message, $verbose ) = @_; return if !$verbose; warn $message; return; } sub _vms_ext { my ( $self, $potential_libs, $verbose, $give_libs ) = @_; $verbose ||= 0; my ( @crtls, $crtlstr ); @crtls = ( ( $Config{'ldflags'} =~ m-/Debug-i ? $Config{'dbgprefix'} : '' ) . 'PerlShr/Share' ); push( @crtls, grep { not /\(/ } split /\s+/, $Config{'perllibs'} ); push( @crtls, grep { not /\(/ } split /\s+/, $Config{'libc'} ); # In general, we pass through the basic libraries from %Config unchanged. # The one exception is that if we're building in the Perl source tree, and # a library spec could be resolved via a logical name, we go to some trouble # to insure that the copy in the local tree is used, rather than one to # which a system-wide logical may point. if ( $self->{PERL_SRC} ) { my ( $locspec, $type ); foreach my $lib ( @crtls ) { if ( ( $locspec, $type ) = $lib =~ m{^([\w\$-]+)(/\w+)?} and $locspec =~ /perl/i ) { if ( lc $type eq '/share' ) { $locspec .= $Config{'exe_ext'}; } elsif ( lc $type eq '/library' ) { $locspec .= $Config{'lib_ext'}; } else { $locspec .= $Config{'obj_ext'}; } $locspec = $self->catfile( $self->{PERL_SRC}, $locspec ); $lib = "$locspec$type" if -e $locspec; } } } $crtlstr = @crtls ? join( ' ', @crtls ) : ''; unless ( $potential_libs ) { warn "Result:\n\tEXTRALIBS: \n\tLDLOADLIBS: $crtlstr\n" if $verbose; return ( '', '', $crtlstr, '', ( $give_libs ? [] : () ) ); } my ( %found, @fndlibs, $ldlib ); my $cwd = cwd(); my ( $so, $lib_ext, $obj_ext ) = @Config{ 'so', 'lib_ext', 'obj_ext' }; # List of common Unix library names and their VMS equivalents # (VMS equivalent of '' indicates that the library is automatically # searched by the linker, and should be skipped here.) my ( @flibs, %libs_seen ); my %libmap = ( 'm' => '', 'f77' => '', 'F77' => '', 'V77' => '', 'c' => '', 'malloc' => '', 'crypt' => '', 'resolv' => '', 'c_s' => '', 'socket' => '', 'X11' => 'DECW$XLIBSHR', 'Xt' => 'DECW$XTSHR', 'Xm' => 'DECW$XMLIBSHR', 'Xmu' => 'DECW$XMULIBSHR' ); warn "Potential libraries are '$potential_libs'\n" if $verbose; # First, sort out directories and library names in the input my ( @dirs, @libs ); foreach my $lib ( split ' ', $potential_libs ) { push( @dirs, $1 ), next if $lib =~ /^-L(.*)/; push( @dirs, $lib ), next if $lib =~ /[:>\]]$/; push( @dirs, $lib ), next if -d $lib; push( @libs, $1 ), next if $lib =~ /^-l(.*)/; push( @libs, $lib ); } push( @dirs, split( ' ', $Config{'libpth'} ) ); # Now make sure we've got VMS-syntax absolute directory specs # (We don't, however, check whether someone's hidden a relative # path in a logical name.) foreach my $dir ( @dirs ) { unless ( -d $dir ) { warn "Skipping nonexistent Directory $dir\n" if $verbose > 1; $dir = ''; next; } warn "Resolving directory $dir\n" if $verbose; if ( File::Spec->file_name_is_absolute( $dir ) ) { $dir = VMS::Filespec::vmspath( $dir ); } else { $dir = $self->catdir( $cwd, $dir ); } } @dirs = grep { length( $_ ) } @dirs; unshift( @dirs, '' ); # Check each $lib without additions first LIB: foreach my $lib ( @libs ) { if ( exists $libmap{$lib} ) { next unless length $libmap{$lib}; $lib = $libmap{$lib}; } my ( @variants, $cand ); my ( $ctype ) = ''; # If we don't have a file type, consider it a possibly abbreviated name and # check for common variants. We try these first to grab libraries before # a like-named executable image (e.g. -lperl resolves to perlshr.exe # before perl.exe). if ( $lib !~ /\.[^:>\]]*$/ ) { push( @variants, "${lib}shr", "${lib}rtl", "${lib}lib" ); push( @variants, "lib$lib" ) if $lib !~ /[:>\]]/; } push( @variants, $lib ); warn "Looking for $lib\n" if $verbose; foreach my $variant ( @variants ) { my ( $fullname, $name ); foreach my $dir ( @dirs ) { my ( $type ); $name = "$dir$variant"; warn "\tChecking $name\n" if $verbose > 2; $fullname = VMS::Filespec::rmsexpand( $name ); if ( defined $fullname and -f $fullname ) { # It's got its own suffix, so we'll have to figure out the type if ( $fullname =~ /(?:$so|exe)$/i ) { $type = 'SHR'; } elsif ( $fullname =~ /(?:$lib_ext|olb)$/i ) { $type = 'OLB'; } elsif ( $fullname =~ /(?:$obj_ext|obj)$/i ) { warn "Warning (mostly harmless): " . "Plain object file $fullname found in library list\n"; $type = 'OBJ'; } else { warn "Warning (mostly harmless): " . "Unknown library type for $fullname; assuming shared\n"; $type = 'SHR'; } } elsif (-f ( $fullname = VMS::Filespec::rmsexpand( $name, $so ) ) or -f ( $fullname = VMS::Filespec::rmsexpand( $name, '.exe' ) ) ) { $type = 'SHR'; $name = $fullname unless $fullname =~ /exe;?\d*$/i; } elsif ( not length( $ctype ) and # If we've got a lib already, # don't bother ( -f ( $fullname = VMS::Filespec::rmsexpand( $name, $lib_ext ) ) or -f ( $fullname = VMS::Filespec::rmsexpand( $name, '.olb' ) ) ) ) { $type = 'OLB'; $name = $fullname unless $fullname =~ /olb;?\d*$/i; } elsif ( not length( $ctype ) and # If we've got a lib already, # don't bother ( -f ( $fullname = VMS::Filespec::rmsexpand( $name, $obj_ext ) ) or -f ( $fullname = VMS::Filespec::rmsexpand( $name, '.obj' ) ) ) ) { warn "Warning (mostly harmless): " . "Plain object file $fullname found in library list\n"; $type = 'OBJ'; $name = $fullname unless $fullname =~ /obj;?\d*$/i; } if ( defined $type ) { $ctype = $type; $cand = $name; last if $ctype eq 'SHR'; } } if ( $ctype ) { push @{ $found{$ctype} }, $cand; warn "\tFound as $cand (really $fullname), type $ctype\n" if $verbose > 1; push @flibs, $name unless $libs_seen{$fullname}++; next LIB; } } warn "Warning (mostly harmless): " . "No library found for $lib\n"; } push @fndlibs, @{ $found{OBJ} } if exists $found{OBJ}; push @fndlibs, map { "$_/Library" } @{ $found{OLB} } if exists $found{OLB}; push @fndlibs, map { "$_/Share" } @{ $found{SHR} } if exists $found{SHR}; my $lib = join( ' ', @fndlibs ); $ldlib = $crtlstr ? "$lib $crtlstr" : $lib; $ldlib =~ s/^\s+|\s+$//g; warn "Result:\n\tEXTRALIBS: $lib\n\tLDLOADLIBS: $ldlib\n" if $verbose; wantarray ? ( $lib, '', $ldlib, '', ( $give_libs ? \@flibs : () ) ) : $lib; } 1; EXTUTILS_LIBLIST_KID $fatpacked{"ExtUtils/MM.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_MM'; package ExtUtils::MM; use strict; use ExtUtils::MakeMaker::Config; our $VERSION = '7.38'; $VERSION =~ tr/_//d; require ExtUtils::Liblist; require ExtUtils::MakeMaker; our @ISA = qw(ExtUtils::Liblist ExtUtils::MakeMaker); =head1 NAME ExtUtils::MM - OS adjusted ExtUtils::MakeMaker subclass =head1 SYNOPSIS require ExtUtils::MM; my $mm = MM->new(...); =head1 DESCRIPTION B ExtUtils::MM is a subclass of ExtUtils::MakeMaker which automatically chooses the appropriate OS specific subclass for you (ie. ExtUils::MM_Unix, etc...). It also provides a convenient alias via the MM class (I didn't want MakeMaker modules outside of ExtUtils/). This class might turn out to be a temporary solution, but MM won't go away. =cut { # Convenient alias. package MM; our @ISA = qw(ExtUtils::MM); sub DESTROY {} } sub _is_win95 { # miniperl might not have the Win32 functions available and we need # to run in miniperl. my $have_win32 = eval { require Win32 }; return $have_win32 && defined &Win32::IsWin95 ? Win32::IsWin95() : ! defined $ENV{SYSTEMROOT}; } my %Is = (); $Is{VMS} = $^O eq 'VMS'; $Is{OS2} = $^O eq 'os2'; $Is{MacOS} = $^O eq 'MacOS'; if( $^O eq 'MSWin32' ) { _is_win95() ? $Is{Win95} = 1 : $Is{Win32} = 1; } $Is{UWIN} = $^O =~ /^uwin(-nt)?$/; $Is{Cygwin} = $^O eq 'cygwin'; $Is{NW5} = $Config{osname} eq 'NetWare'; # intentional $Is{BeOS} = ($^O =~ /beos/i or $^O eq 'haiku'); $Is{DOS} = $^O eq 'dos'; if( $Is{NW5} ) { $^O = 'NetWare'; delete $Is{Win32}; } $Is{VOS} = $^O eq 'vos'; $Is{QNX} = $^O eq 'qnx'; $Is{AIX} = $^O eq 'aix'; $Is{Darwin} = $^O eq 'darwin'; $Is{Unix} = !grep { $_ } values %Is; map { delete $Is{$_} unless $Is{$_} } keys %Is; _assert( keys %Is == 1 ); my($OS) = keys %Is; my $class = "ExtUtils::MM_$OS"; eval "require $class" unless $INC{"ExtUtils/MM_$OS.pm"}; ## no critic die $@ if $@; unshift @ISA, $class; sub _assert { my $sanity = shift; die sprintf "Assert failed at %s line %d\n", (caller)[1,2] unless $sanity; return; } EXTUTILS_MM $fatpacked{"ExtUtils/MM_AIX.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_MM_AIX'; package ExtUtils::MM_AIX; use strict; our $VERSION = '7.38'; $VERSION =~ tr/_//d; use ExtUtils::MakeMaker::Config; require ExtUtils::MM_Unix; our @ISA = qw(ExtUtils::MM_Unix); =head1 NAME ExtUtils::MM_AIX - AIX specific subclass of ExtUtils::MM_Unix =head1 SYNOPSIS Don't use this module directly. Use ExtUtils::MM and let it choose. =head1 DESCRIPTION This is a subclass of ExtUtils::MM_Unix which contains functionality for AIX. Unless otherwise stated it works just like ExtUtils::MM_Unix =head2 Overridden methods =head3 dlsyms Define DL_FUNCS and DL_VARS and write the *.exp files. =cut sub dlsyms { my($self,%attribs) = @_; return '' unless $self->needs_linking; join "\n", $self->xs_dlsyms_iterator(\%attribs); } =head3 xs_dlsyms_ext On AIX, is C<.exp>. =cut sub xs_dlsyms_ext { '.exp'; } sub xs_dlsyms_arg { my($self, $file) = @_; my $arg = qq{-bE:${file}}; $arg = '-Wl,'.$arg if $Config{lddlflags} =~ /-Wl,-bE:/; return $arg; } sub init_others { my $self = shift; $self->SUPER::init_others; # perl "hints" add -bE:$(BASEEXT).exp to LDDLFLAGS. strip that out # so right value can be added by xs_make_dynamic_lib to work for XSMULTI $self->{LDDLFLAGS} ||= $Config{lddlflags}; $self->{LDDLFLAGS} =~ s#(\s*)\S*\Q$(BASEEXT)\E\S*(\s*)#$1$2#; return; } =head1 AUTHOR Michael G Schwern with code from ExtUtils::MM_Unix =head1 SEE ALSO L =cut 1; EXTUTILS_MM_AIX $fatpacked{"ExtUtils/MM_Any.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_MM_ANY'; package ExtUtils::MM_Any; use strict; our $VERSION = '7.38'; $VERSION =~ tr/_//d; use Carp; use File::Spec; use File::Basename; BEGIN { our @ISA = qw(File::Spec); } # We need $Verbose use ExtUtils::MakeMaker qw($Verbose neatvalue _sprintf562); use ExtUtils::MakeMaker::Config; # So we don't have to keep calling the methods over and over again, # we have these globals to cache the values. Faster and shrtr. my $Curdir = __PACKAGE__->curdir; #my $Updir = __PACKAGE__->updir; my $METASPEC_URL = 'https://metacpan.org/pod/CPAN::Meta::Spec'; my $METASPEC_V = 2; =head1 NAME ExtUtils::MM_Any - Platform-agnostic MM methods =head1 SYNOPSIS FOR INTERNAL USE ONLY! package ExtUtils::MM_SomeOS; # Temporarily, you have to subclass both. Put MM_Any first. require ExtUtils::MM_Any; require ExtUtils::MM_Unix; @ISA = qw(ExtUtils::MM_Any ExtUtils::Unix); =head1 DESCRIPTION B ExtUtils::MM_Any is a superclass for the ExtUtils::MM_* set of modules. It contains methods which are either inherently cross-platform or are written in a cross-platform manner. Subclass off of ExtUtils::MM_Any I ExtUtils::MM_Unix. This is a temporary solution. B =head1 METHODS Any methods marked I must be implemented by subclasses. =head2 Cross-platform helper methods These are methods which help writing cross-platform code. =head3 os_flavor I my @os_flavor = $mm->os_flavor; @os_flavor is the style of operating system this is, usually corresponding to the MM_*.pm file we're using. The first element of @os_flavor is the major family (ie. Unix, Windows, VMS, OS/2, etc...) and the rest are sub families. Some examples: Cygwin98 ('Unix', 'Cygwin', 'Cygwin9x') Windows ('Win32') Win98 ('Win32', 'Win9x') Linux ('Unix', 'Linux') MacOS X ('Unix', 'Darwin', 'MacOS', 'MacOS X') OS/2 ('OS/2') This is used to write code for styles of operating system. See os_flavor_is() for use. =head3 os_flavor_is my $is_this_flavor = $mm->os_flavor_is($this_flavor); my $is_this_flavor = $mm->os_flavor_is(@one_of_these_flavors); Checks to see if the current operating system is one of the given flavors. This is useful for code like: if( $mm->os_flavor_is('Unix') ) { $out = `foo 2>&1`; } else { $out = `foo`; } =cut sub os_flavor_is { my $self = shift; my %flavors = map { ($_ => 1) } $self->os_flavor; return (grep { $flavors{$_} } @_) ? 1 : 0; } =head3 can_load_xs my $can_load_xs = $self->can_load_xs; Returns true if we have the ability to load XS. This is important because miniperl, used to build XS modules in the core, can not load XS. =cut sub can_load_xs { return defined &DynaLoader::boot_DynaLoader ? 1 : 0; } =head3 can_run use ExtUtils::MM; my $runnable = MM->can_run($Config{make}); If called in a scalar context it will return the full path to the binary you asked for if it was found, or C if it was not. If called in a list context, it will return a list of the full paths to instances of the binary where found in C, or an empty list if it was not found. Copied from L, but modified into a method (and removed C<$INSTANCES> capability). =cut sub can_run { my ($self, $command) = @_; # a lot of VMS executables have a symbol defined # check those first if ( $^O eq 'VMS' ) { require VMS::DCLsym; my $syms = VMS::DCLsym->new; return $command if scalar $syms->getsym( uc $command ); } my @possibles; if( File::Spec->file_name_is_absolute($command) ) { return $self->maybe_command($command); } else { for my $dir ( File::Spec->path, File::Spec->curdir ) { next if ! $dir || ! -d $dir; my $abs = File::Spec->catfile($self->os_flavor_is('Win32') ? Win32::GetShortPathName( $dir ) : $dir, $command); push @possibles, $abs if $abs = $self->maybe_command($abs); } } return @possibles if wantarray; return shift @possibles; } =head3 can_redirect_error $useredirect = MM->can_redirect_error; True if on an OS where qx operator (or backticks) can redirect C onto C. =cut sub can_redirect_error { my $self = shift; $self->os_flavor_is('Unix') or ($self->os_flavor_is('Win32') and !$self->os_flavor_is('Win9x')) or $self->os_flavor_is('OS/2') } =head3 is_make_type my $is_dmake = $self->is_make_type('dmake'); Returns true if C<< $self->make >> is the given type; possibilities are: gmake GNU make dmake nmake bsdmake BSD pmake-derived =cut my %maketype2true; # undocumented - so t/cd.t can still do its thing sub _clear_maketype_cache { %maketype2true = () } sub is_make_type { my($self, $type) = @_; return $maketype2true{$type} if defined $maketype2true{$type}; (undef, undef, my $make_basename) = $self->splitpath($self->make); return $maketype2true{$type} = 1 if $make_basename =~ /\b$type\b/i; # executable's filename return $maketype2true{$type} = 0 if $make_basename =~ /\b[gdn]make\b/i; # Never fall through for dmake/nmake/gmake # now have to run with "-v" and guess my $redirect = $self->can_redirect_error ? '2>&1' : ''; my $make = $self->make || $self->{MAKE}; my $minus_v = `"$make" -v $redirect`; return $maketype2true{$type} = 1 if $type eq 'gmake' and $minus_v =~ /GNU make/i; return $maketype2true{$type} = 1 if $type eq 'bsdmake' and $minus_v =~ /^usage: make \[-BeikNnqrstWwX\]/im; $maketype2true{$type} = 0; # it wasn't whatever you asked } =head3 can_dep_space my $can_dep_space = $self->can_dep_space; Returns true if C can handle (probably by quoting) dependencies that contain a space. Currently known true for GNU make, false for BSD pmake derivative. =cut my $cached_dep_space; sub can_dep_space { my $self = shift; return $cached_dep_space if defined $cached_dep_space; return $cached_dep_space = 1 if $self->is_make_type('gmake'); return $cached_dep_space = 0 if $self->is_make_type('dmake'); # only on W32 return $cached_dep_space = 0 if $self->is_make_type('bsdmake'); return $cached_dep_space = 0; # assume no } =head3 quote_dep $text = $mm->quote_dep($text); Method that protects Makefile single-value constants (mainly filenames), so that make will still treat them as single values even if they inconveniently have spaces in. If the make program being used cannot achieve such protection and the given text would need it, throws an exception. =cut sub quote_dep { my ($self, $arg) = @_; die <can_dep_space; Tried to use make dependency with space for make that can't: '$arg' EOF $arg =~ s/( )/\\$1/g; # how GNU make does it return $arg; } =head3 split_command my @cmds = $MM->split_command($cmd, @args); Most OS have a maximum command length they can execute at once. Large modules can easily generate commands well past that limit. Its necessary to split long commands up into a series of shorter commands. C will return a series of @cmds each processing part of the args. Collectively they will process all the arguments. Each individual line in @cmds will not be longer than the $self->max_exec_len being careful to take into account macro expansion. $cmd should include any switches and repeated initial arguments. If no @args are given, no @cmds will be returned. Pairs of arguments will always be preserved in a single command, this is a heuristic for things like pm_to_blib and pod2man which work on pairs of arguments. This makes things like this safe: $self->split_command($cmd, %pod2man); =cut sub split_command { my($self, $cmd, @args) = @_; my @cmds = (); return(@cmds) unless @args; # If the command was given as a here-doc, there's probably a trailing # newline. chomp $cmd; # set aside 30% for macro expansion. my $len_left = int($self->max_exec_len * 0.70); $len_left -= length $self->_expand_macros($cmd); do { my $arg_str = ''; my @next_args; while( @next_args = splice(@args, 0, 2) ) { # Two at a time to preserve pairs. my $next_arg_str = "\t ". join ' ', @next_args, "\n"; if( !length $arg_str ) { $arg_str .= $next_arg_str } elsif( length($arg_str) + length($next_arg_str) > $len_left ) { unshift @args, @next_args; last; } else { $arg_str .= $next_arg_str; } } chop $arg_str; push @cmds, $self->escape_newlines("$cmd \n$arg_str"); } while @args; return @cmds; } sub _expand_macros { my($self, $cmd) = @_; $cmd =~ s{\$\((\w+)\)}{ defined $self->{$1} ? $self->{$1} : "\$($1)" }e; return $cmd; } =head3 make_type Returns a suitable string describing the type of makefile being written. =cut # override if this isn't suitable! sub make_type { return 'Unix-style'; } =head3 stashmeta my @recipelines = $MM->stashmeta($text, $file); Generates a set of C<@recipelines> which will result in the literal C<$text> ending up in literal C<$file> when the recipe is executed. Call it once, with all the text you want in C<$file>. Make macros will not be expanded, so the locations will be fixed at configure-time, not at build-time. =cut sub stashmeta { my($self, $text, $file) = @_; $self->echo($text, $file, { allow_variables => 0, append => 0 }); } =head3 echo my @commands = $MM->echo($text); my @commands = $MM->echo($text, $file); my @commands = $MM->echo($text, $file, \%opts); Generates a set of @commands which print the $text to a $file. If $file is not given, output goes to STDOUT. If $opts{append} is true the $file will be appended to rather than overwritten. Default is to overwrite. If $opts{allow_variables} is true, make variables of the form C<$(...)> will not be escaped. Other C<$> will. Default is to escape all C<$>. Example of use: my $make = join '', map "\t$_\n", $MM->echo($text, $file); =cut sub echo { my($self, $text, $file, $opts) = @_; # Compatibility with old options if( !ref $opts ) { my $append = $opts; $opts = { append => $append || 0 }; } $opts->{allow_variables} = 0 unless defined $opts->{allow_variables}; my $ql_opts = { allow_variables => $opts->{allow_variables} }; my @cmds = map { '$(NOECHO) $(ECHO) '.$self->quote_literal($_, $ql_opts) } split /\n/, $text; if( $file ) { my $redirect = $opts->{append} ? '>>' : '>'; $cmds[0] .= " $redirect $file"; $_ .= " >> $file" foreach @cmds[1..$#cmds]; } return @cmds; } =head3 wraplist my $args = $mm->wraplist(@list); Takes an array of items and turns them into a well-formatted list of arguments. In most cases this is simply something like: FOO \ BAR \ BAZ =cut sub wraplist { my $self = shift; return join " \\\n\t", @_; } =head3 maketext_filter my $filter_make_text = $mm->maketext_filter($make_text); The text of the Makefile is run through this method before writing to disk. It allows systems a chance to make portability fixes to the Makefile. By default it does nothing. This method is protected and not intended to be called outside of MakeMaker. =cut sub maketext_filter { return $_[1] } =head3 cd I my $subdir_cmd = $MM->cd($subdir, @cmds); This will generate a make fragment which runs the @cmds in the given $dir. The rough equivalent to this, except cross platform. cd $subdir && $cmd Currently $dir can only go down one level. "foo" is fine. "foo/bar" is not. "../foo" is right out. The resulting $subdir_cmd has no leading tab nor trailing newline. This makes it easier to embed in a make string. For example. my $make = sprintf <<'CODE', $subdir_cmd; foo : $(ECHO) what %s $(ECHO) mouche CODE =head3 oneliner I my $oneliner = $MM->oneliner($perl_code); my $oneliner = $MM->oneliner($perl_code, \@switches); This will generate a perl one-liner safe for the particular platform you're on based on the given $perl_code and @switches (a -e is assumed) suitable for using in a make target. It will use the proper shell quoting and escapes. $(PERLRUN) will be used as perl. Any newlines in $perl_code will be escaped. Leading and trailing newlines will be stripped. Makes this idiom much easier: my $code = $MM->oneliner(<<'CODE', [...switches...]); some code here another line here CODE Usage might be something like: # an echo emulation $oneliner = $MM->oneliner('print "Foo\n"'); $make = '$oneliner > somefile'; Dollar signs in the $perl_code will be protected from make using the C method, unless they are recognised as being a make variable, C<$(varname)>, in which case they will be left for make to expand. Remember to quote make macros else it might be used as a bareword. For example: # Assign the value of the $(VERSION_FROM) make macro to $vf. $oneliner = $MM->oneliner('$vf = "$(VERSION_FROM)"'); Its currently very simple and may be expanded sometime in the figure to include more flexible code and switches. =head3 quote_literal I my $safe_text = $MM->quote_literal($text); my $safe_text = $MM->quote_literal($text, \%options); This will quote $text so it is interpreted literally in the shell. For example, on Unix this would escape any single-quotes in $text and put single-quotes around the whole thing. If $options{allow_variables} is true it will leave C<'$(FOO)'> make variables untouched. If false they will be escaped like any other C<$>. Defaults to true. =head3 escape_dollarsigns my $escaped_text = $MM->escape_dollarsigns($text); Escapes stray C<$> so they are not interpreted as make variables. It lets by C<$(...)>. =cut sub escape_dollarsigns { my($self, $text) = @_; # Escape dollar signs which are not starting a variable $text =~ s{\$ (?!\() }{\$\$}gx; return $text; } =head3 escape_all_dollarsigns my $escaped_text = $MM->escape_all_dollarsigns($text); Escapes all C<$> so they are not interpreted as make variables. =cut sub escape_all_dollarsigns { my($self, $text) = @_; # Escape dollar signs $text =~ s{\$}{\$\$}gx; return $text; } =head3 escape_newlines I my $escaped_text = $MM->escape_newlines($text); Shell escapes newlines in $text. =head3 max_exec_len I my $max_exec_len = $MM->max_exec_len; Calculates the maximum command size the OS can exec. Effectively, this is the max size of a shell command line. =for _private $self->{_MAX_EXEC_LEN} is set by this method, but only for testing purposes. =head3 make my $make = $MM->make; Returns the make variant we're generating the Makefile for. This attempts to do some normalization on the information from %Config or the user. =cut sub make { my $self = shift; my $make = lc $self->{MAKE}; # Truncate anything like foomake6 to just foomake. $make =~ s/^(\w+make).*/$1/; # Turn gnumake into gmake. $make =~ s/^gnu/g/; return $make; } =head2 Targets These are methods which produce make targets. =head3 all_target Generate the default target 'all'. =cut sub all_target { my $self = shift; return <<'MAKE_EXT'; all :: pure_all $(NOECHO) $(NOOP) MAKE_EXT } =head3 blibdirs_target my $make_frag = $mm->blibdirs_target; Creates the blibdirs target which creates all the directories we use in blib/. The blibdirs.ts target is deprecated. Depend on blibdirs instead. =cut sub _xs_list_basenames { my ($self) = @_; map { (my $b = $_) =~ s/\.xs$//; $b } sort keys %{ $self->{XS} }; } sub blibdirs_target { my $self = shift; my @dirs = map { uc "\$(INST_$_)" } qw(libdir archlib autodir archautodir bin script man1dir man3dir ); if ($self->{XSMULTI}) { for my $ext ($self->_xs_list_basenames) { my ($v, $d, $f) = File::Spec->splitpath($ext); my @d = File::Spec->splitdir($d); shift @d if $d[0] eq 'lib'; push @dirs, $self->catdir('$(INST_ARCHLIB)', 'auto', @d, $f); } } my @exists = map { $_.'$(DFSEP).exists' } @dirs; my $make = sprintf <<'MAKE', join(' ', @exists); blibdirs : %s $(NOECHO) $(NOOP) # Backwards compat with 6.18 through 6.25 blibdirs.ts : blibdirs $(NOECHO) $(NOOP) MAKE $make .= $self->dir_target(@dirs); return $make; } =head3 clean (o) Defines the clean target. =cut sub clean { # --- Cleanup and Distribution Sections --- my($self, %attribs) = @_; my @m; push(@m, ' # Delete temporary files but do not touch installed files. We don\'t delete # the Makefile here so a later make realclean still has a makefile to use. clean :: clean_subdirs '); my @files = sort values %{$self->{XS}}; # .c files from *.xs files push @files, map { my $file = $_; map { $file.$_ } $self->{OBJ_EXT}, qw(.def _def.old .bs .bso .exp .base); } $self->_xs_list_basenames; my @dirs = qw(blib); # Normally these are all under blib but they might have been # redefined. # XXX normally this would be a good idea, but the Perl core sets # INST_LIB = ../../lib rather than actually installing the files. # So a "make clean" in an ext/ directory would blow away lib. # Until the core is adjusted let's leave this out. # push @dirs, qw($(INST_ARCHLIB) $(INST_LIB) # $(INST_BIN) $(INST_SCRIPT) # $(INST_MAN1DIR) $(INST_MAN3DIR) # $(INST_LIBDIR) $(INST_ARCHLIBDIR) $(INST_AUTODIR) # $(INST_STATIC) $(INST_DYNAMIC) # ); if( $attribs{FILES} ) { # Use @dirs because we don't know what's in here. push @dirs, ref $attribs{FILES} ? @{$attribs{FILES}} : split /\s+/, $attribs{FILES} ; } push(@files, qw[$(MAKE_APERL_FILE) MYMETA.json MYMETA.yml perlmain.c tmon.out mon.out so_locations blibdirs.ts pm_to_blib pm_to_blib.ts *$(OBJ_EXT) *$(LIB_EXT) perl.exe perl perl$(EXE_EXT) $(BOOTSTRAP) $(BASEEXT).bso $(BASEEXT).def lib$(BASEEXT).def $(BASEEXT).exp $(BASEEXT).x ]); push(@files, $self->catfile('$(INST_ARCHAUTODIR)','extralibs.all')); push(@files, $self->catfile('$(INST_ARCHAUTODIR)','extralibs.ld')); # core files if ($^O eq 'vos') { push(@files, qw[perl*.kp]); } else { push(@files, qw[core core.*perl.*.? *perl.core]); } push(@files, map { "core." . "[0-9]"x$_ } (1..5)); # OS specific things to clean up. Use @dirs since we don't know # what might be in here. push @dirs, $self->extra_clean_files; # Occasionally files are repeated several times from different sources { my(%f) = map { ($_ => 1) } @files; @files = sort keys %f; } { my(%d) = map { ($_ => 1) } @dirs; @dirs = sort keys %d; } push @m, map "\t$_\n", $self->split_command('- $(RM_F)', @files); push @m, map "\t$_\n", $self->split_command('- $(RM_RF)', @dirs); # Leave Makefile.old around for realclean push @m, <<'MAKE'; $(NOECHO) $(RM_F) $(MAKEFILE_OLD) - $(MV) $(FIRST_MAKEFILE) $(MAKEFILE_OLD) $(DEV_NULL) MAKE push(@m, "\t$attribs{POSTOP}\n") if $attribs{POSTOP}; join("", @m); } =head3 clean_subdirs_target my $make_frag = $MM->clean_subdirs_target; Returns the clean_subdirs target. This is used by the clean target to call clean on any subdirectories which contain Makefiles. =cut sub clean_subdirs_target { my($self) = shift; # No subdirectories, no cleaning. return <<'NOOP_FRAG' unless @{$self->{DIR}}; clean_subdirs : $(NOECHO) $(NOOP) NOOP_FRAG my $clean = "clean_subdirs :\n"; for my $dir (@{$self->{DIR}}) { my $subclean = $self->oneliner(sprintf <<'CODE', $dir); exit 0 unless chdir '%s'; system '$(MAKE) clean' if -f '$(FIRST_MAKEFILE)'; CODE $clean .= "\t$subclean\n"; } return $clean; } =head3 dir_target my $make_frag = $mm->dir_target(@directories); Generates targets to create the specified directories and set its permission to PERM_DIR. Because depending on a directory to just ensure it exists doesn't work too well (the modified time changes too often) dir_target() creates a .exists file in the created directory. It is this you should depend on. For portability purposes you should use the $(DIRFILESEP) macro rather than a '/' to separate the directory from the file. yourdirectory$(DIRFILESEP).exists =cut sub dir_target { my($self, @dirs) = @_; my $make = ''; foreach my $dir (@dirs) { $make .= sprintf <<'MAKE', ($dir) x 4; %s$(DFSEP).exists :: Makefile.PL $(NOECHO) $(MKPATH) %s $(NOECHO) $(CHMOD) $(PERM_DIR) %s $(NOECHO) $(TOUCH) %s$(DFSEP).exists MAKE } return $make; } =head3 distdir Defines the scratch directory target that will hold the distribution before tar-ing (or shar-ing). =cut # For backwards compatibility. *dist_dir = *distdir; sub distdir { my($self) = shift; my $meta_target = $self->{NO_META} ? '' : 'distmeta'; my $sign_target = !$self->{SIGN} ? '' : 'distsignature'; return sprintf <<'MAKE_FRAG', $meta_target, $sign_target; create_distdir : $(RM_RF) $(DISTVNAME) $(PERLRUN) "-MExtUtils::Manifest=manicopy,maniread" \ -e "manicopy(maniread(),'$(DISTVNAME)', '$(DIST_CP)');" distdir : create_distdir %s %s $(NOECHO) $(NOOP) MAKE_FRAG } =head3 dist_test Defines a target that produces the distribution in the scratch directory, and runs 'perl Makefile.PL; make ;make test' in that subdirectory. =cut sub dist_test { my($self) = shift; my $mpl_args = join " ", map qq["$_"], @ARGV; my $test = $self->cd('$(DISTVNAME)', '$(ABSPERLRUN) Makefile.PL '.$mpl_args, '$(MAKE) $(PASTHRU)', '$(MAKE) test $(PASTHRU)' ); return sprintf <<'MAKE_FRAG', $test; disttest : distdir %s MAKE_FRAG } =head3 xs_dlsyms_arg Returns command-line arg(s) to linker for file listing dlsyms to export. Defaults to returning empty string, can be overridden by e.g. AIX. =cut sub xs_dlsyms_arg { return ''; } =head3 xs_dlsyms_ext Returns file-extension for C method's output file, including any "." character. =cut sub xs_dlsyms_ext { die "Pure virtual method"; } =head3 xs_dlsyms_extra Returns any extra text to be prepended to the C<$extra> argument of C. =cut sub xs_dlsyms_extra { ''; } =head3 xs_dlsyms_iterator Iterates over necessary shared objects, calling C method for each with appropriate arguments. =cut sub xs_dlsyms_iterator { my ($self, $attribs) = @_; if ($self->{XSMULTI}) { my @m; for my $ext ($self->_xs_list_basenames) { my @parts = File::Spec->splitdir($ext); shift @parts if $parts[0] eq 'lib'; my $name = join '::', @parts; push @m, $self->xs_make_dlsyms( $attribs, $ext . $self->xs_dlsyms_ext, "$ext.xs", $name, $parts[-1], {}, [], {}, [], $self->xs_dlsyms_extra . q!, 'FILE' => ! . neatvalue($ext), ); } return join "\n", @m; } else { return $self->xs_make_dlsyms( $attribs, $self->{BASEEXT} . $self->xs_dlsyms_ext, 'Makefile.PL', $self->{NAME}, $self->{DLBASE}, $attribs->{DL_FUNCS} || $self->{DL_FUNCS} || {}, $attribs->{FUNCLIST} || $self->{FUNCLIST} || [], $attribs->{IMPORTS} || $self->{IMPORTS} || {}, $attribs->{DL_VARS} || $self->{DL_VARS} || [], $self->xs_dlsyms_extra, ); } } =head3 xs_make_dlsyms $self->xs_make_dlsyms( \%attribs, # hashref from %attribs in caller "$self->{BASEEXT}.def", # output file for Makefile target 'Makefile.PL', # dependency $self->{NAME}, # shared object's "name" $self->{DLBASE}, # last ::-separated part of name $attribs{DL_FUNCS} || $self->{DL_FUNCS} || {}, # various params $attribs{FUNCLIST} || $self->{FUNCLIST} || [], $attribs{IMPORTS} || $self->{IMPORTS} || {}, $attribs{DL_VARS} || $self->{DL_VARS} || [], # optional extra param that will be added as param to Mksymlists ); Utility method that returns Makefile snippet to call C. =cut sub xs_make_dlsyms { my ($self, $attribs, $target, $dep, $name, $dlbase, $funcs, $funclist, $imports, $vars, $extra) = @_; my @m = ( "\n$target: $dep\n", q! $(PERLRUN) -MExtUtils::Mksymlists \\ -e "Mksymlists('NAME'=>\"!, $name, q!\", 'DLBASE' => '!,$dlbase, # The above two lines quoted differently to work around # a bug in the 4DOS/4NT command line interpreter. The visible # result of the bug was files named q('extension_name',) *with the # single quotes and the comma* in the extension build directories. q!', 'DL_FUNCS' => !,neatvalue($funcs), q!, 'FUNCLIST' => !,neatvalue($funclist), q!, 'IMPORTS' => !,neatvalue($imports), q!, 'DL_VARS' => !, neatvalue($vars) ); push @m, $extra if defined $extra; push @m, qq!);"\n!; join '', @m; } =head3 dynamic (o) Defines the dynamic target. =cut sub dynamic { # --- Dynamic Loading Sections --- my($self) = shift; ' dynamic :: $(FIRST_MAKEFILE) config $(INST_BOOT) $(INST_DYNAMIC) $(NOECHO) $(NOOP) '; } =head3 makemakerdflt_target my $make_frag = $mm->makemakerdflt_target Returns a make fragment with the makemakerdeflt_target specified. This target is the first target in the Makefile, is the default target and simply points off to 'all' just in case any make variant gets confused or something gets snuck in before the real 'all' target. =cut sub makemakerdflt_target { return <<'MAKE_FRAG'; makemakerdflt : all $(NOECHO) $(NOOP) MAKE_FRAG } =head3 manifypods_target my $manifypods_target = $self->manifypods_target; Generates the manifypods target. This target generates man pages from all POD files in MAN1PODS and MAN3PODS. =cut sub manifypods_target { my($self) = shift; my $man1pods = ''; my $man3pods = ''; my $dependencies = ''; # populate manXpods & dependencies: foreach my $name (sort keys %{$self->{MAN1PODS}}, sort keys %{$self->{MAN3PODS}}) { $dependencies .= " \\\n\t$name"; } my $manify = <{"MAN${num}PODS"}; my $p2m = sprintf <<'CMD', "\$(MAN${num}SECTION)", "$]" > 5.008 ? " -u" : ""; $(NOECHO) $(POD2MAN) --section=%s --perm_rw=$(PERM_RW)%s CMD push @man_cmds, $self->split_command($p2m, map {($_,$pods->{$_})} sort keys %$pods); } $manify .= "\t\$(NOECHO) \$(NOOP)\n" unless @man_cmds; $manify .= join '', map { "$_\n" } @man_cmds; return $manify; } { my $has_cpan_meta; sub _has_cpan_meta { return $has_cpan_meta if defined $has_cpan_meta; return $has_cpan_meta = !!eval { require CPAN::Meta; CPAN::Meta->VERSION(2.112150); 1; }; } } =head3 metafile_target my $target = $mm->metafile_target; Generate the metafile target. Writes the file META.yml (YAML encoded meta-data) and META.json (JSON encoded meta-data) about the module in the distdir. The format follows Module::Build's as closely as possible. =cut sub metafile_target { my $self = shift; return <<'MAKE_FRAG' if $self->{NO_META} or ! _has_cpan_meta(); metafile : $(NOECHO) $(NOOP) MAKE_FRAG my $metadata = $self->metafile_data( $self->{META_ADD} || {}, $self->{META_MERGE} || {}, ); my $meta = $self->_fix_metadata_before_conversion( $metadata ); my @write_metayml = $self->stashmeta( $meta->as_string({version => "1.4"}), 'META_new.yml' ); my @write_metajson = $self->stashmeta( $meta->as_string({version => "2.0"}), 'META_new.json' ); my $metayml = join("\n\t", @write_metayml); my $metajson = join("\n\t", @write_metajson); return sprintf <<'MAKE_FRAG', $metayml, $metajson; metafile : create_distdir $(NOECHO) $(ECHO) Generating META.yml %s -$(NOECHO) $(MV) META_new.yml $(DISTVNAME)/META.yml $(NOECHO) $(ECHO) Generating META.json %s -$(NOECHO) $(MV) META_new.json $(DISTVNAME)/META.json MAKE_FRAG } =begin private =head3 _fix_metadata_before_conversion $mm->_fix_metadata_before_conversion( \%metadata ); Fixes errors in the metadata before it's handed off to CPAN::Meta for conversion. This hopefully results in something that can be used further on, no guarantee is made though. =end private =cut sub _fix_metadata_before_conversion { my ( $self, $metadata ) = @_; # we should never be called unless this already passed but # prefer to be defensive in case somebody else calls this return unless _has_cpan_meta; my $bad_version = $metadata->{version} && !CPAN::Meta::Validator->new->version( 'version', $metadata->{version} ); # just delete all invalid versions if( $bad_version ) { warn "Can't parse version '$metadata->{version}'\n"; $metadata->{version} = ''; } my $validator2 = CPAN::Meta::Validator->new( $metadata ); my @errors; push @errors, $validator2->errors if !$validator2->is_valid; my $validator14 = CPAN::Meta::Validator->new( { %$metadata, 'meta-spec' => { version => 1.4 }, } ); push @errors, $validator14->errors if !$validator14->is_valid; # fix non-camelcase custom resource keys (only other trick we know) for my $error ( @errors ) { my ( $key ) = ( $error =~ /Custom resource '(.*)' must be in CamelCase./ ); next if !$key; # first try to remove all non-alphabetic chars ( my $new_key = $key ) =~ s/[^_a-zA-Z]//g; # if that doesn't work, uppercase first one $new_key = ucfirst $new_key if !$validator14->custom_1( $new_key ); # copy to new key if that worked $metadata->{resources}{$new_key} = $metadata->{resources}{$key} if $validator14->custom_1( $new_key ); # and delete old one in any case delete $metadata->{resources}{$key}; } # paper over validation issues, but still complain, necessary because # there's no guarantee that the above will fix ALL errors my $meta = eval { CPAN::Meta->create( $metadata, { lazy_validation => 1 } ) }; warn $@ if $@ and $@ !~ /encountered CODE.*, but JSON can only represent references to arrays or hashes/; # use the original metadata straight if the conversion failed # or if it can't be stringified. if( !$meta || !eval { $meta->as_string( { version => $METASPEC_V } ) } || !eval { $meta->as_string } ) { $meta = bless $metadata, 'CPAN::Meta'; } my $now_license = $meta->as_struct({ version => 2 })->{license}; if ($self->{LICENSE} and $self->{LICENSE} ne 'unknown' and @{$now_license} == 1 and $now_license->[0] eq 'unknown' ) { warn "Invalid LICENSE value '$self->{LICENSE}' ignored\n"; } $meta; } =begin private =head3 _sort_pairs my @pairs = _sort_pairs($sort_sub, \%hash); Sorts the pairs of a hash based on keys ordered according to C<$sort_sub>. =end private =cut sub _sort_pairs { my $sort = shift; my $pairs = shift; return map { $_ => $pairs->{$_} } sort $sort keys %$pairs; } # Taken from Module::Build::Base sub _hash_merge { my ($self, $h, $k, $v) = @_; if (ref $h->{$k} eq 'ARRAY') { push @{$h->{$k}}, ref $v ? @$v : $v; } elsif (ref $h->{$k} eq 'HASH') { $self->_hash_merge($h->{$k}, $_, $v->{$_}) foreach keys %$v; } else { $h->{$k} = $v; } } =head3 metafile_data my $metadata_hashref = $mm->metafile_data(\%meta_add, \%meta_merge); Returns the data which MakeMaker turns into the META.yml file and the META.json file. It is always in version 2.0 of the format. Values of %meta_add will overwrite any existing metadata in those keys. %meta_merge will be merged with them. =cut sub metafile_data { my $self = shift; my($meta_add, $meta_merge) = @_; $meta_add ||= {}; $meta_merge ||= {}; my $version = _normalize_version($self->{VERSION}); my $release_status = ($version =~ /_/) ? 'unstable' : 'stable'; my %meta = ( # required abstract => $self->{ABSTRACT} || 'unknown', author => defined($self->{AUTHOR}) ? $self->{AUTHOR} : ['unknown'], dynamic_config => 1, generated_by => "ExtUtils::MakeMaker version $ExtUtils::MakeMaker::VERSION", license => [ $self->{LICENSE} || 'unknown' ], 'meta-spec' => { url => $METASPEC_URL, version => $METASPEC_V, }, name => $self->{DISTNAME}, release_status => $release_status, version => $version, # optional no_index => { directory => [qw(t inc)] }, ); $self->_add_requirements_to_meta(\%meta); if (!eval { require JSON::PP; require CPAN::Meta::Converter; CPAN::Meta::Converter->VERSION(2.141170) }) { return \%meta; } # needs to be based on the original version my $v1_add = _metaspec_version($meta_add) !~ /^2/; my ($add_v, $merge_v) = map _metaspec_version($_), $meta_add, $meta_merge; for my $frag ($meta_add, $meta_merge) { my $def_v = $frag == $meta_add ? $merge_v : $add_v; $frag = CPAN::Meta::Converter->new($frag, default_version => $def_v)->upgrade_fragment; } # if we upgraded a 1.x _ADD fragment, we gave it a prereqs key that # will override all prereqs, which is more than the user asked for; # instead, we'll go inside the prereqs and override all those while( my($key, $val) = each %$meta_add ) { if ($v1_add and $key eq 'prereqs') { $meta{$key}{$_} = $val->{$_} for keys %$val; } elsif ($key ne 'meta-spec') { $meta{$key} = $val; } } while( my($key, $val) = each %$meta_merge ) { next if $key eq 'meta-spec'; $self->_hash_merge(\%meta, $key, $val); } return \%meta; } =begin private =cut sub _add_requirements_to_meta { my ( $self, $meta ) = @_; # Check the original args so we can tell between the user setting it # to an empty hash and it just being initialized. $meta->{prereqs}{configure}{requires} = $self->{ARGS}{CONFIGURE_REQUIRES} ? $self->{CONFIGURE_REQUIRES} : { 'ExtUtils::MakeMaker' => 0, }; $meta->{prereqs}{build}{requires} = $self->{ARGS}{BUILD_REQUIRES} ? $self->{BUILD_REQUIRES} : { 'ExtUtils::MakeMaker' => 0, }; $meta->{prereqs}{test}{requires} = $self->{TEST_REQUIRES} if $self->{ARGS}{TEST_REQUIRES}; $meta->{prereqs}{runtime}{requires} = $self->{PREREQ_PM} if $self->{ARGS}{PREREQ_PM}; $meta->{prereqs}{runtime}{requires}{perl} = _normalize_version($self->{MIN_PERL_VERSION}) if $self->{MIN_PERL_VERSION}; } # spec version of given fragment - if not given, assume 1.4 sub _metaspec_version { my ( $meta ) = @_; return $meta->{'meta-spec'}->{version} if defined $meta->{'meta-spec'} and defined $meta->{'meta-spec'}->{version}; return '1.4'; } sub _add_requirements_to_meta_v1_4 { my ( $self, $meta ) = @_; # Check the original args so we can tell between the user setting it # to an empty hash and it just being initialized. if( $self->{ARGS}{CONFIGURE_REQUIRES} ) { $meta->{configure_requires} = $self->{CONFIGURE_REQUIRES}; } else { $meta->{configure_requires} = { 'ExtUtils::MakeMaker' => 0, }; } if( $self->{ARGS}{BUILD_REQUIRES} ) { $meta->{build_requires} = $self->{BUILD_REQUIRES}; } else { $meta->{build_requires} = { 'ExtUtils::MakeMaker' => 0, }; } if( $self->{ARGS}{TEST_REQUIRES} ) { $meta->{build_requires} = { %{ $meta->{build_requires} }, %{ $self->{TEST_REQUIRES} }, }; } $meta->{requires} = $self->{PREREQ_PM} if defined $self->{PREREQ_PM}; $meta->{requires}{perl} = _normalize_version($self->{MIN_PERL_VERSION}) if $self->{MIN_PERL_VERSION}; } # Adapted from Module::Build::Base sub _normalize_version { my ($version) = @_; $version = 0 unless defined $version; if ( ref $version eq 'version' ) { # version objects $version = $version->stringify; } elsif ( $version =~ /^[^v][^.]*\.[^.]+\./ ) { # no leading v, multiple dots # normalize string tuples without "v": "1.2.3" -> "v1.2.3" $version = "v$version"; } else { # leave alone } return $version; } =head3 _dump_hash $yaml = _dump_hash(\%options, %hash); Implements a fake YAML dumper for a hash given as a list of pairs. No quoting/escaping is done. Keys are supposed to be strings. Values are undef, strings, hash refs or array refs of strings. Supported options are: delta => STR - indentation delta use_header => BOOL - whether to include a YAML header indent => STR - a string of spaces default: '' max_key_length => INT - maximum key length used to align keys and values of the same hash default: 20 key_sort => CODE - a sort sub It may be undef, which means no sorting by keys default: sub { lc $a cmp lc $b } customs => HASH - special options for certain keys (whose values are hashes themselves) may contain: max_key_length, key_sort, customs =end private =cut sub _dump_hash { croak "first argument should be a hash ref" unless ref $_[0] eq 'HASH'; my $options = shift; my %hash = @_; # Use a list to preserve order. my @pairs; my $k_sort = exists $options->{key_sort} ? $options->{key_sort} : sub { lc $a cmp lc $b }; if ($k_sort) { croak "'key_sort' should be a coderef" unless ref $k_sort eq 'CODE'; @pairs = _sort_pairs($k_sort, \%hash); } else { # list of pairs, no sorting @pairs = @_; } my $yaml = $options->{use_header} ? "--- #YAML:1.0\n" : ''; my $indent = $options->{indent} || ''; my $k_length = min( ($options->{max_key_length} || 20), max(map { length($_) + 1 } grep { !ref $hash{$_} } keys %hash) ); my $customs = $options->{customs} || {}; # printf format for key my $k_format = "%-${k_length}s"; while( @pairs ) { my($key, $val) = splice @pairs, 0, 2; $val = '~' unless defined $val; if(ref $val eq 'HASH') { if ( keys %$val ) { my %k_options = ( # options for recursive call delta => $options->{delta}, use_header => 0, indent => $indent . $options->{delta}, ); if (exists $customs->{$key}) { my %k_custom = %{$customs->{$key}}; foreach my $k (qw(key_sort max_key_length customs)) { $k_options{$k} = $k_custom{$k} if exists $k_custom{$k}; } } $yaml .= $indent . "$key:\n" . _dump_hash(\%k_options, %$val); } else { $yaml .= $indent . "$key: {}\n"; } } elsif (ref $val eq 'ARRAY') { if( @$val ) { $yaml .= $indent . "$key:\n"; for (@$val) { croak "only nested arrays of non-refs are supported" if ref $_; $yaml .= $indent . $options->{delta} . "- $_\n"; } } else { $yaml .= $indent . "$key: []\n"; } } elsif( ref $val and !blessed($val) ) { croak "only nested hashes, arrays and objects are supported"; } else { # if it's an object, just stringify it $yaml .= $indent . sprintf "$k_format %s\n", "$key:", $val; } }; return $yaml; } sub blessed { return eval { $_[0]->isa("UNIVERSAL"); }; } sub max { return (sort { $b <=> $a } @_)[0]; } sub min { return (sort { $a <=> $b } @_)[0]; } =head3 metafile_file my $meta_yml = $mm->metafile_file(@metadata_pairs); Turns the @metadata_pairs into YAML. This method does not implement a complete YAML dumper, being limited to dump a hash with values which are strings, undef's or nested hashes and arrays of strings. No quoting/escaping is done. =cut sub metafile_file { my $self = shift; my %dump_options = ( use_header => 1, delta => ' ' x 4, key_sort => undef, ); return _dump_hash(\%dump_options, @_); } =head3 distmeta_target my $make_frag = $mm->distmeta_target; Generates the distmeta target to add META.yml and META.json to the MANIFEST in the distdir. =cut sub distmeta_target { my $self = shift; my @add_meta = ( $self->oneliner(<<'CODE', ['-MExtUtils::Manifest=maniadd']), exit unless -e q{META.yml}; eval { maniadd({q{META.yml} => q{Module YAML meta-data (added by MakeMaker)}}) } or die "Could not add META.yml to MANIFEST: ${'@'}" CODE $self->oneliner(<<'CODE', ['-MExtUtils::Manifest=maniadd']) exit unless -f q{META.json}; eval { maniadd({q{META.json} => q{Module JSON meta-data (added by MakeMaker)}}) } or die "Could not add META.json to MANIFEST: ${'@'}" CODE ); my @add_meta_to_distdir = map { $self->cd('$(DISTVNAME)', $_) } @add_meta; return sprintf <<'MAKE', @add_meta_to_distdir; distmeta : create_distdir metafile $(NOECHO) %s $(NOECHO) %s MAKE } =head3 mymeta my $mymeta = $mm->mymeta; Generate MYMETA information as a hash either from an existing CPAN Meta file (META.json or META.yml) or from internal data. =cut sub mymeta { my $self = shift; my $file = shift || ''; # for testing my $mymeta = $self->_mymeta_from_meta($file); my $v2 = 1; unless ( $mymeta ) { $mymeta = $self->metafile_data( $self->{META_ADD} || {}, $self->{META_MERGE} || {}, ); $v2 = 0; } # Overwrite the non-configure dependency hashes $self->_add_requirements_to_meta($mymeta); $mymeta->{dynamic_config} = 0; return $mymeta; } sub _mymeta_from_meta { my $self = shift; my $metafile = shift || ''; # for testing return unless _has_cpan_meta(); my $meta; for my $file ( $metafile, "META.json", "META.yml" ) { next unless -e $file; eval { $meta = CPAN::Meta->load_file($file)->as_struct( { version => 2 } ); }; last if $meta; } return unless $meta; # META.yml before 6.25_01 cannot be trusted. META.yml lived in the source directory. # There was a good chance the author accidentally uploaded a stale META.yml if they # rolled their own tarball rather than using "make dist". if ($meta->{generated_by} && $meta->{generated_by} =~ /ExtUtils::MakeMaker version ([\d\._]+)/) { my $eummv = do { local $^W = 0; $1+0; }; if ($eummv < 6.2501) { return; } } return $meta; } =head3 write_mymeta $self->write_mymeta( $mymeta ); Write MYMETA information to MYMETA.json and MYMETA.yml. =cut sub write_mymeta { my $self = shift; my $mymeta = shift; return unless _has_cpan_meta(); my $meta_obj = $self->_fix_metadata_before_conversion( $mymeta ); $meta_obj->save( 'MYMETA.json', { version => "2.0" } ); $meta_obj->save( 'MYMETA.yml', { version => "1.4" } ); return 1; } =head3 realclean (o) Defines the realclean target. =cut sub realclean { my($self, %attribs) = @_; my @dirs = qw($(DISTVNAME)); my @files = qw($(FIRST_MAKEFILE) $(MAKEFILE_OLD)); # Special exception for the perl core where INST_* is not in blib. # This cleans up the files built from the ext/ directory (all XS). if( $self->{PERL_CORE} ) { push @dirs, qw($(INST_AUTODIR) $(INST_ARCHAUTODIR)); push @files, values %{$self->{PM}}; } if( $self->has_link_code ){ push @files, qw($(OBJECT)); } if( $attribs{FILES} ) { if( ref $attribs{FILES} ) { push @dirs, @{ $attribs{FILES} }; } else { push @dirs, split /\s+/, $attribs{FILES}; } } # Occasionally files are repeated several times from different sources { my(%f) = map { ($_ => 1) } @files; @files = sort keys %f; } { my(%d) = map { ($_ => 1) } @dirs; @dirs = sort keys %d; } my $rm_cmd = join "\n\t", map { "$_" } $self->split_command('- $(RM_F)', @files); my $rmf_cmd = join "\n\t", map { "$_" } $self->split_command('- $(RM_RF)', @dirs); my $m = sprintf <<'MAKE', $rm_cmd, $rmf_cmd; # Delete temporary files (via clean) and also delete dist files realclean purge :: realclean_subdirs %s %s MAKE $m .= "\t$attribs{POSTOP}\n" if $attribs{POSTOP}; return $m; } =head3 realclean_subdirs_target my $make_frag = $MM->realclean_subdirs_target; Returns the realclean_subdirs target. This is used by the realclean target to call realclean on any subdirectories which contain Makefiles. =cut sub realclean_subdirs_target { my $self = shift; my @m = <<'EOF'; # so clean is forced to complete before realclean_subdirs runs realclean_subdirs : clean EOF return join '', @m, "\t\$(NOECHO) \$(NOOP)\n" unless @{$self->{DIR}}; foreach my $dir (@{$self->{DIR}}) { foreach my $makefile ('$(MAKEFILE_OLD)', '$(FIRST_MAKEFILE)' ) { my $subrclean .= $self->oneliner(_sprintf562 <<'CODE', $dir, $makefile); chdir '%1$s'; system '$(MAKE) $(USEMAKEFILE) %2$s realclean' if -f '%2$s'; CODE push @m, "\t- $subrclean\n"; } } return join '', @m; } =head3 signature_target my $target = $mm->signature_target; Generate the signature target. Writes the file SIGNATURE with "cpansign -s". =cut sub signature_target { my $self = shift; return <<'MAKE_FRAG'; signature : cpansign -s MAKE_FRAG } =head3 distsignature_target my $make_frag = $mm->distsignature_target; Generates the distsignature target to add SIGNATURE to the MANIFEST in the distdir. =cut sub distsignature_target { my $self = shift; my $add_sign = $self->oneliner(<<'CODE', ['-MExtUtils::Manifest=maniadd']); eval { maniadd({q{SIGNATURE} => q{Public-key signature (added by MakeMaker)}}) } or die "Could not add SIGNATURE to MANIFEST: ${'@'}" CODE my $sign_dist = $self->cd('$(DISTVNAME)' => 'cpansign -s'); # cpansign -s complains if SIGNATURE is in the MANIFEST yet does not # exist my $touch_sig = $self->cd('$(DISTVNAME)' => '$(TOUCH) SIGNATURE'); my $add_sign_to_dist = $self->cd('$(DISTVNAME)' => $add_sign ); return sprintf <<'MAKE', $add_sign_to_dist, $touch_sig, $sign_dist distsignature : distmeta $(NOECHO) %s $(NOECHO) %s %s MAKE } =head3 special_targets my $make_frag = $mm->special_targets Returns a make fragment containing any targets which have special meaning to make. For example, .SUFFIXES and .PHONY. =cut sub special_targets { my $make_frag = <<'MAKE_FRAG'; .SUFFIXES : .xs .c .C .cpp .i .s .cxx .cc $(OBJ_EXT) .PHONY: all config static dynamic test linkext manifest blibdirs clean realclean disttest distdir pure_all subdirs clean_subdirs makemakerdflt manifypods realclean_subdirs subdirs_dynamic subdirs_pure_nolink subdirs_static subdirs-test_dynamic subdirs-test_static test_dynamic test_static MAKE_FRAG $make_frag .= <<'MAKE_FRAG' if $ENV{CLEARCASE_ROOT}; .NO_CONFIG_REC: Makefile MAKE_FRAG return $make_frag; } =head2 Init methods Methods which help initialize the MakeMaker object and macros. =head3 init_ABSTRACT $mm->init_ABSTRACT =cut sub init_ABSTRACT { my $self = shift; if( $self->{ABSTRACT_FROM} and $self->{ABSTRACT} ) { warn "Both ABSTRACT_FROM and ABSTRACT are set. ". "Ignoring ABSTRACT_FROM.\n"; return; } if ($self->{ABSTRACT_FROM}){ $self->{ABSTRACT} = $self->parse_abstract($self->{ABSTRACT_FROM}) or carp "WARNING: Setting ABSTRACT via file ". "'$self->{ABSTRACT_FROM}' failed\n"; } if ($self->{ABSTRACT} && $self->{ABSTRACT} =~ m![[:cntrl:]]+!) { warn "WARNING: ABSTRACT contains control character(s),". " they will be removed\n"; $self->{ABSTRACT} =~ s![[:cntrl:]]+!!g; return; } } =head3 init_INST $mm->init_INST; Called by init_main. Sets up all INST_* variables except those related to XS code. Those are handled in init_xs. =cut sub init_INST { my($self) = shift; $self->{INST_ARCHLIB} ||= $self->catdir($Curdir,"blib","arch"); $self->{INST_BIN} ||= $self->catdir($Curdir,'blib','bin'); # INST_LIB typically pre-set if building an extension after # perl has been built and installed. Setting INST_LIB allows # you to build directly into, say $Config{privlibexp}. unless ($self->{INST_LIB}){ if ($self->{PERL_CORE}) { $self->{INST_LIB} = $self->{INST_ARCHLIB} = $self->{PERL_LIB}; } else { $self->{INST_LIB} = $self->catdir($Curdir,"blib","lib"); } } my @parentdir = split(/::/, $self->{PARENT_NAME}); $self->{INST_LIBDIR} = $self->catdir('$(INST_LIB)', @parentdir); $self->{INST_ARCHLIBDIR} = $self->catdir('$(INST_ARCHLIB)', @parentdir); $self->{INST_AUTODIR} = $self->catdir('$(INST_LIB)', 'auto', '$(FULLEXT)'); $self->{INST_ARCHAUTODIR} = $self->catdir('$(INST_ARCHLIB)', 'auto', '$(FULLEXT)'); $self->{INST_SCRIPT} ||= $self->catdir($Curdir,'blib','script'); $self->{INST_MAN1DIR} ||= $self->catdir($Curdir,'blib','man1'); $self->{INST_MAN3DIR} ||= $self->catdir($Curdir,'blib','man3'); return 1; } =head3 init_INSTALL $mm->init_INSTALL; Called by init_main. Sets up all INSTALL_* variables (except INSTALLDIRS) and *PREFIX. =cut sub init_INSTALL { my($self) = shift; if( $self->{ARGS}{INSTALL_BASE} and $self->{ARGS}{PREFIX} ) { die "Only one of PREFIX or INSTALL_BASE can be given. Not both.\n"; } if( $self->{ARGS}{INSTALL_BASE} ) { $self->init_INSTALL_from_INSTALL_BASE; } else { $self->init_INSTALL_from_PREFIX; } } =head3 init_INSTALL_from_PREFIX $mm->init_INSTALL_from_PREFIX; =cut sub init_INSTALL_from_PREFIX { my $self = shift; $self->init_lib2arch; # There are often no Config.pm defaults for these new man variables so # we fall back to the old behavior which is to use installman*dir foreach my $num (1, 3) { my $k = 'installsiteman'.$num.'dir'; $self->{uc $k} ||= uc "\$(installman${num}dir)" unless $Config{$k}; } foreach my $num (1, 3) { my $k = 'installvendorman'.$num.'dir'; unless( $Config{$k} ) { $self->{uc $k} ||= $Config{usevendorprefix} ? uc "\$(installman${num}dir)" : ''; } } $self->{INSTALLSITEBIN} ||= '$(INSTALLBIN)' unless $Config{installsitebin}; $self->{INSTALLSITESCRIPT} ||= '$(INSTALLSCRIPT)' unless $Config{installsitescript}; unless( $Config{installvendorbin} ) { $self->{INSTALLVENDORBIN} ||= $Config{usevendorprefix} ? $Config{installbin} : ''; } unless( $Config{installvendorscript} ) { $self->{INSTALLVENDORSCRIPT} ||= $Config{usevendorprefix} ? $Config{installscript} : ''; } my $iprefix = $Config{installprefixexp} || $Config{installprefix} || $Config{prefixexp} || $Config{prefix} || ''; my $vprefix = $Config{usevendorprefix} ? $Config{vendorprefixexp} : ''; my $sprefix = $Config{siteprefixexp} || ''; # 5.005_03 doesn't have a siteprefix. $sprefix = $iprefix unless $sprefix; $self->{PREFIX} ||= ''; if( $self->{PREFIX} ) { @{$self}{qw(PERLPREFIX SITEPREFIX VENDORPREFIX)} = ('$(PREFIX)') x 3; } else { $self->{PERLPREFIX} ||= $iprefix; $self->{SITEPREFIX} ||= $sprefix; $self->{VENDORPREFIX} ||= $vprefix; # Lots of MM extension authors like to use $(PREFIX) so we # put something sensible in there no matter what. $self->{PREFIX} = '$('.uc $self->{INSTALLDIRS}.'PREFIX)'; } my $arch = $Config{archname}; my $version = $Config{version}; # default style my $libstyle = $Config{installstyle} || 'lib/perl5'; my $manstyle = ''; if( $self->{LIBSTYLE} ) { $libstyle = $self->{LIBSTYLE}; $manstyle = $self->{LIBSTYLE} eq 'lib/perl5' ? 'lib/perl5' : ''; } # Some systems, like VOS, set installman*dir to '' if they can't # read man pages. for my $num (1, 3) { $self->{'INSTALLMAN'.$num.'DIR'} ||= 'none' unless $Config{'installman'.$num.'dir'}; } my %bin_layouts = ( bin => { s => $iprefix, t => 'perl', d => 'bin' }, vendorbin => { s => $vprefix, t => 'vendor', d => 'bin' }, sitebin => { s => $sprefix, t => 'site', d => 'bin' }, script => { s => $iprefix, t => 'perl', d => 'bin' }, vendorscript=> { s => $vprefix, t => 'vendor', d => 'bin' }, sitescript => { s => $sprefix, t => 'site', d => 'bin' }, ); my %man_layouts = ( man1dir => { s => $iprefix, t => 'perl', d => 'man/man1', style => $manstyle, }, siteman1dir => { s => $sprefix, t => 'site', d => 'man/man1', style => $manstyle, }, vendorman1dir => { s => $vprefix, t => 'vendor', d => 'man/man1', style => $manstyle, }, man3dir => { s => $iprefix, t => 'perl', d => 'man/man3', style => $manstyle, }, siteman3dir => { s => $sprefix, t => 'site', d => 'man/man3', style => $manstyle, }, vendorman3dir => { s => $vprefix, t => 'vendor', d => 'man/man3', style => $manstyle, }, ); my %lib_layouts = ( privlib => { s => $iprefix, t => 'perl', d => '', style => $libstyle, }, vendorlib => { s => $vprefix, t => 'vendor', d => '', style => $libstyle, }, sitelib => { s => $sprefix, t => 'site', d => 'site_perl', style => $libstyle, }, archlib => { s => $iprefix, t => 'perl', d => "$version/$arch", style => $libstyle }, vendorarch => { s => $vprefix, t => 'vendor', d => "$version/$arch", style => $libstyle }, sitearch => { s => $sprefix, t => 'site', d => "site_perl/$version/$arch", style => $libstyle }, ); # Special case for LIB. if( $self->{LIB} ) { foreach my $var (keys %lib_layouts) { my $Installvar = uc "install$var"; if( $var =~ /arch/ ) { $self->{$Installvar} ||= $self->catdir($self->{LIB}, $Config{archname}); } else { $self->{$Installvar} ||= $self->{LIB}; } } } my %type2prefix = ( perl => 'PERLPREFIX', site => 'SITEPREFIX', vendor => 'VENDORPREFIX' ); my %layouts = (%bin_layouts, %man_layouts, %lib_layouts); while( my($var, $layout) = each(%layouts) ) { my($s, $t, $d, $style) = @{$layout}{qw(s t d style)}; my $r = '$('.$type2prefix{$t}.')'; warn "Prefixing $var\n" if $Verbose >= 2; my $installvar = "install$var"; my $Installvar = uc $installvar; next if $self->{$Installvar}; $d = "$style/$d" if $style; $self->prefixify($installvar, $s, $r, $d); warn " $Installvar == $self->{$Installvar}\n" if $Verbose >= 2; } # Generate these if they weren't figured out. $self->{VENDORARCHEXP} ||= $self->{INSTALLVENDORARCH}; $self->{VENDORLIBEXP} ||= $self->{INSTALLVENDORLIB}; return 1; } =head3 init_from_INSTALL_BASE $mm->init_from_INSTALL_BASE =cut my %map = ( lib => [qw(lib perl5)], arch => [('lib', 'perl5', $Config{archname})], bin => [qw(bin)], man1dir => [qw(man man1)], man3dir => [qw(man man3)] ); $map{script} = $map{bin}; sub init_INSTALL_from_INSTALL_BASE { my $self = shift; @{$self}{qw(PREFIX VENDORPREFIX SITEPREFIX PERLPREFIX)} = '$(INSTALL_BASE)'; my %install; foreach my $thing (keys %map) { foreach my $dir (('', 'SITE', 'VENDOR')) { my $uc_thing = uc $thing; my $key = "INSTALL".$dir.$uc_thing; $install{$key} ||= ($thing =~ /^man.dir$/ and not $Config{lc $key}) ? 'none' : $self->catdir('$(INSTALL_BASE)', @{$map{$thing}}); } } # Adjust for variable quirks. $install{INSTALLARCHLIB} ||= delete $install{INSTALLARCH}; $install{INSTALLPRIVLIB} ||= delete $install{INSTALLLIB}; foreach my $key (keys %install) { $self->{$key} ||= $install{$key}; } return 1; } =head3 init_VERSION I $mm->init_VERSION Initialize macros representing versions of MakeMaker and other tools MAKEMAKER: path to the MakeMaker module. MM_VERSION: ExtUtils::MakeMaker Version MM_REVISION: ExtUtils::MakeMaker version control revision (for backwards compat) VERSION: version of your module VERSION_MACRO: which macro represents the version (usually 'VERSION') VERSION_SYM: like version but safe for use as an RCS revision number DEFINE_VERSION: -D line to set the module version when compiling XS_VERSION: version in your .xs file. Defaults to $(VERSION) XS_VERSION_MACRO: which macro represents the XS version. XS_DEFINE_VERSION: -D line to set the xs version when compiling. Called by init_main. =cut sub init_VERSION { my($self) = shift; $self->{MAKEMAKER} = $ExtUtils::MakeMaker::Filename; $self->{MM_VERSION} = $ExtUtils::MakeMaker::VERSION; $self->{MM_REVISION}= $ExtUtils::MakeMaker::Revision; $self->{VERSION_FROM} ||= ''; if ($self->{VERSION_FROM}){ $self->{VERSION} = $self->parse_version($self->{VERSION_FROM}); if( $self->{VERSION} eq 'undef' ) { carp("WARNING: Setting VERSION via file ". "'$self->{VERSION_FROM}' failed\n"); } } if (defined $self->{VERSION}) { if ( $self->{VERSION} !~ /^\s*v?[\d_\.]+\s*$/ ) { require version; my $normal = eval { version->new( $self->{VERSION} ) }; $self->{VERSION} = $normal if defined $normal; } $self->{VERSION} =~ s/^\s+//; $self->{VERSION} =~ s/\s+$//; } else { $self->{VERSION} = ''; } $self->{VERSION_MACRO} = 'VERSION'; ($self->{VERSION_SYM} = $self->{VERSION}) =~ s/\W/_/g; $self->{DEFINE_VERSION} = '-D$(VERSION_MACRO)=\"$(VERSION)\"'; # Graham Barr and Paul Marquess had some ideas how to ensure # version compatibility between the *.pm file and the # corresponding *.xs file. The bottom line was, that we need an # XS_VERSION macro that defaults to VERSION: $self->{XS_VERSION} ||= $self->{VERSION}; $self->{XS_VERSION_MACRO} = 'XS_VERSION'; $self->{XS_DEFINE_VERSION} = '-D$(XS_VERSION_MACRO)=\"$(XS_VERSION)\"'; } =head3 init_tools $MM->init_tools(); Initializes the simple macro definitions used by tools_other() and places them in the $MM object. These use conservative cross platform versions and should be overridden with platform specific versions for performance. Defines at least these macros. Macro Description NOOP Do nothing NOECHO Tell make not to display the command itself SHELL Program used to run shell commands ECHO Print text adding a newline on the end RM_F Remove a file RM_RF Remove a directory TOUCH Update a file's timestamp TEST_F Test for a file's existence TEST_S Test the size of a file CP Copy a file CP_NONEMPTY Copy a file if it is not empty MV Move a file CHMOD Change permissions on a file FALSE Exit with non-zero TRUE Exit with zero UMASK_NULL Nullify umask DEV_NULL Suppress all command output =cut sub init_tools { my $self = shift; $self->{ECHO} ||= $self->oneliner('binmode STDOUT, qq{:raw}; print qq{@ARGV}', ['-l']); $self->{ECHO_N} ||= $self->oneliner('print qq{@ARGV}'); $self->{TOUCH} ||= $self->oneliner('touch', ["-MExtUtils::Command"]); $self->{CHMOD} ||= $self->oneliner('chmod', ["-MExtUtils::Command"]); $self->{RM_F} ||= $self->oneliner('rm_f', ["-MExtUtils::Command"]); $self->{RM_RF} ||= $self->oneliner('rm_rf', ["-MExtUtils::Command"]); $self->{TEST_F} ||= $self->oneliner('test_f', ["-MExtUtils::Command"]); $self->{TEST_S} ||= $self->oneliner('test_s', ["-MExtUtils::Command::MM"]); $self->{CP_NONEMPTY} ||= $self->oneliner('cp_nonempty', ["-MExtUtils::Command::MM"]); $self->{FALSE} ||= $self->oneliner('exit 1'); $self->{TRUE} ||= $self->oneliner('exit 0'); $self->{MKPATH} ||= $self->oneliner('mkpath', ["-MExtUtils::Command"]); $self->{CP} ||= $self->oneliner('cp', ["-MExtUtils::Command"]); $self->{MV} ||= $self->oneliner('mv', ["-MExtUtils::Command"]); $self->{MOD_INSTALL} ||= $self->oneliner(<<'CODE', ['-MExtUtils::Install']); install([ from_to => {@ARGV}, verbose => '$(VERBINST)', uninstall_shadows => '$(UNINST)', dir_mode => '$(PERM_DIR)' ]); CODE $self->{DOC_INSTALL} ||= $self->oneliner('perllocal_install', ["-MExtUtils::Command::MM"]); $self->{UNINSTALL} ||= $self->oneliner('uninstall', ["-MExtUtils::Command::MM"]); $self->{WARN_IF_OLD_PACKLIST} ||= $self->oneliner('warn_if_old_packlist', ["-MExtUtils::Command::MM"]); $self->{FIXIN} ||= $self->oneliner('MY->fixin(shift)', ["-MExtUtils::MY"]); $self->{EQUALIZE_TIMESTAMP} ||= $self->oneliner('eqtime', ["-MExtUtils::Command"]); $self->{UNINST} ||= 0; $self->{VERBINST} ||= 0; $self->{SHELL} ||= $Config{sh}; # UMASK_NULL is not used by MakeMaker but some CPAN modules # make use of it. $self->{UMASK_NULL} ||= "umask 0"; # Not the greatest default, but its something. $self->{DEV_NULL} ||= "> /dev/null 2>&1"; $self->{NOOP} ||= '$(TRUE)'; $self->{NOECHO} = '@' unless defined $self->{NOECHO}; $self->{FIRST_MAKEFILE} ||= $self->{MAKEFILE} || 'Makefile'; $self->{MAKEFILE} ||= $self->{FIRST_MAKEFILE}; $self->{MAKEFILE_OLD} ||= $self->{MAKEFILE}.'.old'; $self->{MAKE_APERL_FILE} ||= $self->{MAKEFILE}.'.aperl'; # Not everybody uses -f to indicate "use this Makefile instead" $self->{USEMAKEFILE} ||= '-f'; # Some makes require a wrapper around macros passed in on the command # line. $self->{MACROSTART} ||= ''; $self->{MACROEND} ||= ''; return; } =head3 init_others $MM->init_others(); Initializes the macro definitions having to do with compiling and linking used by tools_other() and places them in the $MM object. If there is no description, its the same as the parameter to WriteMakefile() documented in ExtUtils::MakeMaker. =cut sub init_others { my $self = shift; $self->{LD_RUN_PATH} = ""; $self->{LIBS} = $self->_fix_libs($self->{LIBS}); # Compute EXTRALIBS, BSLOADLIBS and LDLOADLIBS from $self->{LIBS} foreach my $libs ( @{$self->{LIBS}} ){ $libs =~ s/^\s*(.*\S)\s*$/$1/; # remove leading and trailing whitespace my(@libs) = $self->extliblist($libs); if ($libs[0] or $libs[1] or $libs[2]){ # LD_RUN_PATH now computed by ExtUtils::Liblist ($self->{EXTRALIBS}, $self->{BSLOADLIBS}, $self->{LDLOADLIBS}, $self->{LD_RUN_PATH}) = @libs; last; } } if ( $self->{OBJECT} ) { $self->{OBJECT} = join(" ", @{$self->{OBJECT}}) if ref $self->{OBJECT}; $self->{OBJECT} =~ s!\.o(bj)?\b!\$(OBJ_EXT)!g; } elsif ( ($self->{MAGICXS} || $self->{XSMULTI}) && @{$self->{O_FILES}||[]} ) { $self->{OBJECT} = join(" ", @{$self->{O_FILES}}); $self->{OBJECT} =~ s!\.o(bj)?\b!\$(OBJ_EXT)!g; } else { # init_dirscan should have found out, if we have C files $self->{OBJECT} = ""; $self->{OBJECT} = '$(BASEEXT)$(OBJ_EXT)' if @{$self->{C}||[]}; } $self->{OBJECT} =~ s/\n+/ \\\n\t/g; $self->{BOOTDEP} = (-f "$self->{BASEEXT}_BS") ? "$self->{BASEEXT}_BS" : ""; $self->{PERLMAINCC} ||= '$(CC)'; $self->{LDFROM} = '$(OBJECT)' unless $self->{LDFROM}; # Sanity check: don't define LINKTYPE = dynamic if we're skipping # the 'dynamic' section of MM. We don't have this problem with # 'static', since we either must use it (%Config says we can't # use dynamic loading) or the caller asked for it explicitly. if (!$self->{LINKTYPE}) { $self->{LINKTYPE} = $self->{SKIPHASH}{'dynamic'} ? 'static' : ($Config{usedl} ? 'dynamic' : 'static'); } return; } # Lets look at $self->{LIBS} carefully: It may be an anon array, a string or # undefined. In any case we turn it into an anon array sub _fix_libs { my($self, $libs) = @_; return !defined $libs ? [''] : !ref $libs ? [$libs] : !defined $libs->[0] ? [''] : $libs ; } =head3 tools_other my $make_frag = $MM->tools_other; Returns a make fragment containing definitions for the macros init_others() initializes. =cut sub tools_other { my($self) = shift; my @m; # We set PM_FILTER as late as possible so it can see all the earlier # on macro-order sensitive makes such as nmake. for my $tool (qw{ SHELL CHMOD CP MV NOOP NOECHO RM_F RM_RF TEST_F TOUCH UMASK_NULL DEV_NULL MKPATH EQUALIZE_TIMESTAMP FALSE TRUE ECHO ECHO_N UNINST VERBINST MOD_INSTALL DOC_INSTALL UNINSTALL WARN_IF_OLD_PACKLIST MACROSTART MACROEND USEMAKEFILE PM_FILTER FIXIN CP_NONEMPTY } ) { next unless defined $self->{$tool}; push @m, "$tool = $self->{$tool}\n"; } return join "", @m; } =head3 init_DIRFILESEP I $MM->init_DIRFILESEP; my $dirfilesep = $MM->{DIRFILESEP}; Initializes the DIRFILESEP macro which is the separator between the directory and filename in a filepath. ie. / on Unix, \ on Win32 and nothing on VMS. For example: # instead of $(INST_ARCHAUTODIR)/extralibs.ld $(INST_ARCHAUTODIR)$(DIRFILESEP)extralibs.ld Something of a hack but it prevents a lot of code duplication between MM_* variants. Do not use this as a separator between directories. Some operating systems use different separators between subdirectories as between directories and filenames (for example: VOLUME:[dir1.dir2]file on VMS). =head3 init_linker I $mm->init_linker; Initialize macros which have to do with linking. PERL_ARCHIVE: path to libperl.a equivalent to be linked to dynamic extensions. PERL_ARCHIVE_AFTER: path to a library which should be put on the linker command line I the external libraries to be linked to dynamic extensions. This may be needed if the linker is one-pass, and Perl includes some overrides for C RTL functions, such as malloc(). EXPORT_LIST: name of a file that is passed to linker to define symbols to be exported. Some OSes do not need these in which case leave it blank. =head3 init_platform $mm->init_platform Initialize any macros which are for platform specific use only. A typical one is the version number of your OS specific module. (ie. MM_Unix_VERSION or MM_VMS_VERSION). =cut sub init_platform { return ''; } =head3 init_MAKE $mm->init_MAKE Initialize MAKE from either a MAKE environment variable or $Config{make}. =cut sub init_MAKE { my $self = shift; $self->{MAKE} ||= $ENV{MAKE} || $Config{make}; } =head2 Tools A grab bag of methods to generate specific macros and commands. =head3 manifypods Defines targets and routines to translate the pods into manpages and put them into the INST_* directories. =cut sub manifypods { my $self = shift; my $POD2MAN_macro = $self->POD2MAN_macro(); my $manifypods_target = $self->manifypods_target(); return <POD2MAN_macro Returns a definition for the POD2MAN macro. This is a program which emulates the pod2man utility. You can add more switches to the command by simply appending them on the macro. Typical usage: $(POD2MAN) --section=3 --perm_rw=$(PERM_RW) podfile1 man_page1 ... =cut sub POD2MAN_macro { my $self = shift; # Need the trailing '--' so perl stops gobbling arguments and - happens # to be an alternative end of line separator on VMS so we quote it return <<'END_OF_DEF'; POD2MAN_EXE = $(PERLRUN) "-MExtUtils::Command::MM" -e pod2man "--" POD2MAN = $(POD2MAN_EXE) END_OF_DEF } =head3 test_via_harness my $command = $mm->test_via_harness($perl, $tests); Returns a $command line which runs the given set of $tests with Test::Harness and the given $perl. Used on the t/*.t files. =cut sub test_via_harness { my($self, $perl, $tests) = @_; return qq{\t$perl "-MExtUtils::Command::MM" "-MTest::Harness" }. qq{"-e" "undef *Test::Harness::Switches; test_harness(\$(TEST_VERBOSE), '\$(INST_LIB)', '\$(INST_ARCHLIB)')" $tests\n}; } =head3 test_via_script my $command = $mm->test_via_script($perl, $script); Returns a $command line which just runs a single test without Test::Harness. No checks are done on the results, they're just printed. Used for test.pl, since they don't always follow Test::Harness formatting. =cut sub test_via_script { my($self, $perl, $script) = @_; return qq{\t$perl "-I\$(INST_LIB)" "-I\$(INST_ARCHLIB)" $script\n}; } =head3 tool_autosplit Defines a simple perl call that runs autosplit. May be deprecated by pm_to_blib soon. =cut sub tool_autosplit { my($self, %attribs) = @_; my $maxlen = $attribs{MAXLEN} ? '$$AutoSplit::Maxlen=$attribs{MAXLEN};' : ''; my $asplit = $self->oneliner(sprintf <<'PERL_CODE', $maxlen); use AutoSplit; %s autosplit($$ARGV[0], $$ARGV[1], 0, 1, 1) PERL_CODE return sprintf <<'MAKE_FRAG', $asplit; # Usage: $(AUTOSPLITFILE) FileToSplit AutoDirToSplitInto AUTOSPLITFILE = %s MAKE_FRAG } =head3 arch_check my $arch_ok = $mm->arch_check( $INC{"Config.pm"}, File::Spec->catfile($Config{archlibexp}, "Config.pm") ); A sanity check that what Perl thinks the architecture is and what Config thinks the architecture is are the same. If they're not it will return false and show a diagnostic message. When building Perl it will always return true, as nothing is installed yet. The interface is a bit odd because this is the result of a quick refactoring. Don't rely on it. =cut sub arch_check { my $self = shift; my($pconfig, $cconfig) = @_; return 1 if $self->{PERL_SRC}; my($pvol, $pthinks) = $self->splitpath($pconfig); my($cvol, $cthinks) = $self->splitpath($cconfig); $pthinks = $self->canonpath($pthinks); $cthinks = $self->canonpath($cthinks); my $ret = 1; if ($pthinks ne $cthinks) { print "Have $pthinks\n"; print "Want $cthinks\n"; $ret = 0; my $arch = (grep length, $self->splitdir($pthinks))[-1]; print <{UNINSTALLED_PERL}; Your perl and your Config.pm seem to have different ideas about the architecture they are running on. Perl thinks: [$arch] Config says: [$Config{archname}] This may or may not cause problems. Please check your installation of perl if you have problems building this extension. END } return $ret; } =head2 File::Spec wrappers ExtUtils::MM_Any is a subclass of File::Spec. The methods noted here override File::Spec. =head3 catfile File::Spec <= 0.83 has a bug where the file part of catfile is not canonicalized. This override fixes that bug. =cut sub catfile { my $self = shift; return $self->canonpath($self->SUPER::catfile(@_)); } =head2 Misc Methods I can't really figure out where they should go yet. =head3 find_tests my $test = $mm->find_tests; Returns a string suitable for feeding to the shell to return all tests in t/*.t. =cut sub find_tests { my($self) = shift; return -d 't' ? 't/*.t' : ''; } =head3 find_tests_recursive my $tests = $mm->find_tests_recursive; Returns a string suitable for feeding to the shell to return all tests in t/ but recursively. Equivalent to my $tests = $mm->find_tests_recursive_in('t'); =cut sub find_tests_recursive { my $self = shift; return $self->find_tests_recursive_in('t'); } =head3 find_tests_recursive_in my $tests = $mm->find_tests_recursive_in($dir); Returns a string suitable for feeding to the shell to return all tests in $dir recursively. =cut sub find_tests_recursive_in { my($self, $dir) = @_; return '' unless -d $dir; require File::Find; my $base_depth = grep { $_ ne '' } File::Spec->splitdir( (File::Spec->splitpath($dir))[1] ); my %depths; my $wanted = sub { return unless m!\.t$!; my ($volume,$directories,$file) = File::Spec->splitpath( $File::Find::name ); my $depth = grep { $_ ne '' } File::Spec->splitdir( $directories ); $depth -= $base_depth; $depths{ $depth } = 1; }; File::Find::find( $wanted, $dir ); return join ' ', map { $dir . '/*' x $_ . '.t' } sort { $a <=> $b } keys %depths; } =head3 extra_clean_files my @files_to_clean = $MM->extra_clean_files; Returns a list of OS specific files to be removed in the clean target in addition to the usual set. =cut # An empty method here tickled a perl 5.8.1 bug and would return its object. sub extra_clean_files { return; } =head3 installvars my @installvars = $mm->installvars; A list of all the INSTALL* variables without the INSTALL prefix. Useful for iteration or building related variable sets. =cut sub installvars { return qw(PRIVLIB SITELIB VENDORLIB ARCHLIB SITEARCH VENDORARCH BIN SITEBIN VENDORBIN SCRIPT SITESCRIPT VENDORSCRIPT MAN1DIR SITEMAN1DIR VENDORMAN1DIR MAN3DIR SITEMAN3DIR VENDORMAN3DIR ); } =head3 libscan my $wanted = $self->libscan($path); Takes a path to a file or dir and returns an empty string if we don't want to include this file in the library. Otherwise it returns the the $path unchanged. Mainly used to exclude version control administrative directories and base-level F from installation. =cut sub libscan { my($self,$path) = @_; if ($path =~ m<^README\.pod$>i) { warn "WARNING: Older versions of ExtUtils::MakeMaker may errantly install $path as part of this distribution. It is recommended to avoid using this path in CPAN modules.\n" unless $ENV{PERL_CORE}; return ''; } my($dirs,$file) = ($self->splitpath($path))[1,2]; return '' if grep /^(?:RCS|CVS|SCCS|\.svn|_darcs)$/, $self->splitdir($dirs), $file; return $path; } =head3 platform_constants my $make_frag = $mm->platform_constants Returns a make fragment defining all the macros initialized in init_platform() rather than put them in constants(). =cut sub platform_constants { return ''; } =head3 post_constants (o) Returns an empty string per default. Dedicated to overrides from within Makefile.PL after all constants have been defined. =cut sub post_constants { ""; } =head3 post_initialize (o) Returns an empty string per default. Used in Makefile.PLs to add some chunk of text to the Makefile after the object is initialized. =cut sub post_initialize { ""; } =head3 postamble (o) Returns an empty string. Can be used in Makefile.PLs to write some text to the Makefile at the end. =cut sub postamble { ""; } =begin private =head3 _PREREQ_PRINT $self->_PREREQ_PRINT; Implements PREREQ_PRINT. Refactored out of MakeMaker->new(). =end private =cut sub _PREREQ_PRINT { my $self = shift; require Data::Dumper; my @what = ('PREREQ_PM'); push @what, 'MIN_PERL_VERSION' if $self->{MIN_PERL_VERSION}; push @what, 'BUILD_REQUIRES' if $self->{BUILD_REQUIRES}; print Data::Dumper->Dump([@{$self}{@what}], \@what); exit 0; } =begin private =head3 _PRINT_PREREQ $mm->_PRINT_PREREQ; Implements PRINT_PREREQ, a slightly different version of PREREQ_PRINT added by Redhat to, I think, support generating RPMs from Perl modules. Should not include BUILD_REQUIRES as RPMs do not include them. Refactored out of MakeMaker->new(). =end private =cut sub _PRINT_PREREQ { my $self = shift; my $prereqs= $self->{PREREQ_PM}; my @prereq = map { [$_, $prereqs->{$_}] } keys %$prereqs; if ( $self->{MIN_PERL_VERSION} ) { push @prereq, ['perl' => $self->{MIN_PERL_VERSION}]; } print join(" ", map { "perl($_->[0])>=$_->[1] " } sort { $a->[0] cmp $b->[0] } @prereq), "\n"; exit 0; } =begin private =head3 _perl_header_files my $perl_header_files= $self->_perl_header_files; returns a sorted list of header files as found in PERL_SRC or $archlibexp/CORE. Used by perldepend() in MM_Unix and MM_VMS via _perl_header_files_fragment() =end private =cut sub _perl_header_files { my $self = shift; my $header_dir = $self->{PERL_SRC} || $ENV{PERL_SRC} || $self->catdir($Config{archlibexp}, 'CORE'); opendir my $dh, $header_dir or die "Failed to opendir '$header_dir' to find header files: $!"; # we need to use a temporary here as the sort in scalar context would have undefined results. my @perl_headers= sort grep { /\.h\z/ } readdir($dh); closedir $dh; return @perl_headers; } =begin private =head3 _perl_header_files_fragment ($o, $separator) my $perl_header_files_fragment= $self->_perl_header_files_fragment("/"); return a Makefile fragment which holds the list of perl header files which XS code depends on $(PERL_INC), and sets up the dependency for the $(OBJECT) file. The $separator argument defaults to "". MM_VMS will set it to "" and MM_UNIX to "/" in perldepend(). This reason child subclasses need to control this is that in VMS the $(PERL_INC) directory will already have delimiters in it, but in UNIX $(PERL_INC) will need a slash between it an the filename. Hypothetically win32 could use "\\" (but it doesn't need to). =end private =cut sub _perl_header_files_fragment { my ($self, $separator)= @_; $separator ||= ""; return join("\\\n", "PERL_HDRS = ", map { sprintf( " \$(PERL_INCDEP)%s%s ", $separator, $_ ) } $self->_perl_header_files() ) . "\n\n" . "\$(OBJECT) : \$(PERL_HDRS)\n"; } =head1 AUTHOR Michael G Schwern and the denizens of makemaker@perl.org with code from ExtUtils::MM_Unix and ExtUtils::MM_Win32. =cut 1; EXTUTILS_MM_ANY $fatpacked{"ExtUtils/MM_BeOS.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_MM_BEOS'; package ExtUtils::MM_BeOS; use strict; =head1 NAME ExtUtils::MM_BeOS - methods to override UN*X behaviour in ExtUtils::MakeMaker =head1 SYNOPSIS use ExtUtils::MM_BeOS; # Done internally by ExtUtils::MakeMaker if needed =head1 DESCRIPTION See ExtUtils::MM_Unix for a documentation of the methods provided there. This package overrides the implementation of these methods, not the semantics. =over 4 =cut use ExtUtils::MakeMaker::Config; use File::Spec; require ExtUtils::MM_Any; require ExtUtils::MM_Unix; our @ISA = qw( ExtUtils::MM_Any ExtUtils::MM_Unix ); our $VERSION = '7.38'; $VERSION =~ tr/_//d; =item os_flavor BeOS is BeOS. =cut sub os_flavor { return('BeOS'); } =item init_linker libperl.a equivalent to be linked to dynamic extensions. =cut sub init_linker { my($self) = shift; $self->{PERL_ARCHIVE} ||= File::Spec->catdir('$(PERL_INC)',$Config{libperl}); $self->{PERL_ARCHIVEDEP} ||= ''; $self->{PERL_ARCHIVE_AFTER} ||= ''; $self->{EXPORT_LIST} ||= ''; } =back =cut 1; __END__ EXTUTILS_MM_BEOS $fatpacked{"ExtUtils/MM_Cygwin.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_MM_CYGWIN'; package ExtUtils::MM_Cygwin; use strict; use ExtUtils::MakeMaker::Config; use File::Spec; require ExtUtils::MM_Unix; require ExtUtils::MM_Win32; our @ISA = qw( ExtUtils::MM_Unix ); our $VERSION = '7.38'; $VERSION =~ tr/_//d; =head1 NAME ExtUtils::MM_Cygwin - methods to override UN*X behaviour in ExtUtils::MakeMaker =head1 SYNOPSIS use ExtUtils::MM_Cygwin; # Done internally by ExtUtils::MakeMaker if needed =head1 DESCRIPTION See ExtUtils::MM_Unix for a documentation of the methods provided there. =over 4 =item os_flavor We're Unix and Cygwin. =cut sub os_flavor { return('Unix', 'Cygwin'); } =item cflags if configured for dynamic loading, triggers #define EXT in EXTERN.h =cut sub cflags { my($self,$libperl)=@_; return $self->{CFLAGS} if $self->{CFLAGS}; return '' unless $self->needs_linking(); my $base = $self->SUPER::cflags($libperl); foreach (split /\n/, $base) { /^(\S*)\s*=\s*(\S*)$/ and $self->{$1} = $2; }; $self->{CCFLAGS} .= " -DUSEIMPORTLIB" if ($Config{useshrplib} eq 'true'); return $self->{CFLAGS} = qq{ CCFLAGS = $self->{CCFLAGS} OPTIMIZE = $self->{OPTIMIZE} PERLTYPE = $self->{PERLTYPE} }; } =item replace_manpage_separator replaces strings '::' with '.' in MAN*POD man page names =cut sub replace_manpage_separator { my($self, $man) = @_; $man =~ s{/+}{.}g; return $man; } =item init_linker points to libperl.a =cut sub init_linker { my $self = shift; if ($Config{useshrplib} eq 'true') { my $libperl = '$(PERL_INC)' .'/'. "$Config{libperl}"; if( "$]" >= 5.006002 ) { $libperl =~ s/(dll\.)?a$/dll.a/; } $self->{PERL_ARCHIVE} = $libperl; } else { $self->{PERL_ARCHIVE} = '$(PERL_INC)' .'/'. ("$Config{libperl}" or "libperl.a"); } $self->{PERL_ARCHIVEDEP} ||= ''; $self->{PERL_ARCHIVE_AFTER} ||= ''; $self->{EXPORT_LIST} ||= ''; } =item maybe_command Determine whether a file is native to Cygwin by checking whether it resides inside the Cygwin installation (using Windows paths). If so, use C to determine if it may be a command. Otherwise use the tests from C. =cut sub maybe_command { my ($self, $file) = @_; my $cygpath = Cygwin::posix_to_win_path('/', 1); my $filepath = Cygwin::posix_to_win_path($file, 1); return (substr($filepath,0,length($cygpath)) eq $cygpath) ? $self->SUPER::maybe_command($file) # Unix : ExtUtils::MM_Win32->maybe_command($file); # Win32 } =item dynamic_lib Use the default to produce the *.dll's. But for new archdir dll's use the same rebase address if the old exists. =cut sub dynamic_lib { my($self, %attribs) = @_; my $s = ExtUtils::MM_Unix::dynamic_lib($self, %attribs); return '' unless $s; return $s unless %{$self->{XS}}; # do an ephemeral rebase so the new DLL fits to the current rebase map $s .= "\t/bin/find \$\(INST_ARCHLIB\)/auto -xdev -name \\*.$self->{DLEXT} | /bin/rebase -sOT -" if (( $Config{myarchname} eq 'i686-cygwin' ) and not ( exists $ENV{CYGPORT_PACKAGE_VERSION} )); $s; } =item install Rebase dll's with the global rebase database after installation. =cut sub install { my($self, %attribs) = @_; my $s = ExtUtils::MM_Unix::install($self, %attribs); return '' unless $s; return $s unless %{$self->{XS}}; my $INSTALLDIRS = $self->{INSTALLDIRS}; my $INSTALLLIB = $self->{"INSTALL". ($INSTALLDIRS eq 'perl' ? 'ARCHLIB' : uc($INSTALLDIRS)."ARCH")}; my $dop = "\$\(DESTDIR\)$INSTALLLIB/auto/"; my $dll = "$dop/$self->{FULLEXT}/$self->{BASEEXT}.$self->{DLEXT}"; $s =~ s|^(pure_install :: pure_\$\(INSTALLDIRS\)_install\n\t)\$\(NOECHO\) \$\(NOOP\)\n|$1\$(CHMOD) \$(PERM_RWX) $dll\n\t/bin/find $dop -xdev -name \\*.$self->{DLEXT} \| /bin/rebase -sOT -\n|m if (( $Config{myarchname} eq 'i686-cygwin') and not ( exists $ENV{CYGPORT_PACKAGE_VERSION} )); $s; } =item all_target Build man pages, too =cut sub all_target { ExtUtils::MM_Unix::all_target(shift); } =back =cut 1; EXTUTILS_MM_CYGWIN $fatpacked{"ExtUtils/MM_DOS.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_MM_DOS'; package ExtUtils::MM_DOS; use strict; our $VERSION = '7.38'; $VERSION =~ tr/_//d; require ExtUtils::MM_Any; require ExtUtils::MM_Unix; our @ISA = qw( ExtUtils::MM_Any ExtUtils::MM_Unix ); =head1 NAME ExtUtils::MM_DOS - DOS specific subclass of ExtUtils::MM_Unix =head1 SYNOPSIS Don't use this module directly. Use ExtUtils::MM and let it choose. =head1 DESCRIPTION This is a subclass of ExtUtils::MM_Unix which contains functionality for DOS. Unless otherwise stated, it works just like ExtUtils::MM_Unix =head2 Overridden methods =over 4 =item os_flavor =cut sub os_flavor { return('DOS'); } =item B Generates Foo__Bar.3 style man page names =cut sub replace_manpage_separator { my($self, $man) = @_; $man =~ s,/+,__,g; return $man; } =item xs_static_lib_is_xs =cut sub xs_static_lib_is_xs { return 1; } =back =head1 AUTHOR Michael G Schwern with code from ExtUtils::MM_Unix =head1 SEE ALSO L, L =cut 1; EXTUTILS_MM_DOS $fatpacked{"ExtUtils/MM_Darwin.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_MM_DARWIN'; package ExtUtils::MM_Darwin; use strict; BEGIN { require ExtUtils::MM_Unix; our @ISA = qw( ExtUtils::MM_Unix ); } our $VERSION = '7.38'; $VERSION =~ tr/_//d; =head1 NAME ExtUtils::MM_Darwin - special behaviors for OS X =head1 SYNOPSIS For internal MakeMaker use only =head1 DESCRIPTION See L for L for documentation on the methods overridden here. =head2 Overridden Methods =head3 init_dist Turn off Apple tar's tendency to copy resource forks as "._foo" files. =cut sub init_dist { my $self = shift; # Thank you, Apple, for breaking tar and then breaking the work around. # 10.4 wants COPY_EXTENDED_ATTRIBUTES_DISABLE while 10.5 wants # COPYFILE_DISABLE. I'm not going to push my luck and instead just # set both. $self->{TAR} ||= 'COPY_EXTENDED_ATTRIBUTES_DISABLE=1 COPYFILE_DISABLE=1 tar'; $self->SUPER::init_dist(@_); } 1; EXTUTILS_MM_DARWIN $fatpacked{"ExtUtils/MM_MacOS.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_MM_MACOS'; package ExtUtils::MM_MacOS; use strict; our $VERSION = '7.38'; $VERSION =~ tr/_//d; sub new { die 'MacOS Classic (MacPerl) is no longer supported by MakeMaker'; } =head1 NAME ExtUtils::MM_MacOS - once produced Makefiles for MacOS Classic =head1 SYNOPSIS # MM_MacOS no longer contains any code. This is just a stub. =head1 DESCRIPTION Once upon a time, MakeMaker could produce an approximation of a correct Makefile on MacOS Classic (MacPerl). Due to a lack of maintainers, this fell out of sync with the rest of MakeMaker and hadn't worked in years. Since there's little chance of it being repaired, MacOS Classic is fading away, and the code was icky to begin with, the code has been deleted to make maintenance easier. Anyone interested in resurrecting this file should pull the old version from the MakeMaker CVS repository and contact makemaker@perl.org. =cut 1; EXTUTILS_MM_MACOS $fatpacked{"ExtUtils/MM_NW5.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_MM_NW5'; package ExtUtils::MM_NW5; =head1 NAME ExtUtils::MM_NW5 - methods to override UN*X behaviour in ExtUtils::MakeMaker =head1 SYNOPSIS use ExtUtils::MM_NW5; # Done internally by ExtUtils::MakeMaker if needed =head1 DESCRIPTION See ExtUtils::MM_Unix for a documentation of the methods provided there. This package overrides the implementation of these methods, not the semantics. =over =cut use strict; use ExtUtils::MakeMaker::Config; use File::Basename; our $VERSION = '7.38'; $VERSION =~ tr/_//d; require ExtUtils::MM_Win32; our @ISA = qw(ExtUtils::MM_Win32); use ExtUtils::MakeMaker qw(&neatvalue &_sprintf562); $ENV{EMXSHELL} = 'sh'; # to run `commands` my $BORLAND = $Config{'cc'} =~ /\bbcc/i; my $GCC = $Config{'cc'} =~ /\bgcc/i; =item os_flavor We're Netware in addition to being Windows. =cut sub os_flavor { my $self = shift; return ($self->SUPER::os_flavor, 'Netware'); } =item init_platform Add Netware macros. LIBPTH, BASE_IMPORT, NLM_VERSION, MPKTOOL, TOOLPATH, BOOT_SYMBOL, NLM_SHORT_NAME, INCLUDE, PATH, MM_NW5_REVISION =item platform_constants Add Netware macros initialized above to the Makefile. =cut sub init_platform { my($self) = shift; # To get Win32's setup. $self->SUPER::init_platform; # incpath is copied to makefile var INCLUDE in constants sub, here just # make it empty my $libpth = $Config{'libpth'}; $libpth =~ s( )(;); $self->{'LIBPTH'} = $libpth; $self->{'BASE_IMPORT'} = $Config{'base_import'}; # Additional import file specified from Makefile.pl if($self->{'base_import'}) { $self->{'BASE_IMPORT'} .= ', ' . $self->{'base_import'}; } $self->{'NLM_VERSION'} = $Config{'nlm_version'}; $self->{'MPKTOOL'} = $Config{'mpktool'}; $self->{'TOOLPATH'} = $Config{'toolpath'}; (my $boot = $self->{'NAME'}) =~ s/:/_/g; $self->{'BOOT_SYMBOL'}=$boot; # If the final binary name is greater than 8 chars, # truncate it here. if(length($self->{'BASEEXT'}) > 8) { $self->{'NLM_SHORT_NAME'} = substr($self->{'BASEEXT'},0,8); } # Get the include path and replace the spaces with ; # Copy this to makefile as INCLUDE = d:\...;d:\; ($self->{INCLUDE} = $Config{'incpath'}) =~ s/([ ]*)-I/;/g; # Set the path to CodeWarrior binaries which might not have been set in # any other place $self->{PATH} = '$(PATH);$(TOOLPATH)'; $self->{MM_NW5_VERSION} = $VERSION; } sub platform_constants { my($self) = shift; my $make_frag = ''; # Setup Win32's constants. $make_frag .= $self->SUPER::platform_constants; foreach my $macro (qw(LIBPTH BASE_IMPORT NLM_VERSION MPKTOOL TOOLPATH BOOT_SYMBOL NLM_SHORT_NAME INCLUDE PATH MM_NW5_VERSION )) { next unless defined $self->{$macro}; $make_frag .= "$macro = $self->{$macro}\n"; } return $make_frag; } =item static_lib_pure_cmd Defines how to run the archive utility =cut sub static_lib_pure_cmd { my ($self, $src) = @_; $src =~ s/(\$\(\w+)(\))/$1:^"+"$2/g if $BORLAND; sprintf qq{\t\$(AR) %s\n}, ($BORLAND ? '$@ ' . $src : ($GCC ? '-ru $@ ' . $src : '-type library -o $@ ' . $src)); } =item xs_static_lib_is_xs =cut sub xs_static_lib_is_xs { return 1; } =item dynamic_lib Override of utility methods for OS-specific work. =cut sub xs_make_dynamic_lib { my ($self, $attribs, $from, $to, $todir, $ldfrom, $exportlist) = @_; my @m; # Taking care of long names like FileHandle, ByteLoader, SDBM_File etc if ($to =~ /^\$/) { if ($self->{NLM_SHORT_NAME}) { # deal with shortnames my $newto = q{$(INST_AUTODIR)\\$(NLM_SHORT_NAME).$(DLEXT)}; push @m, "$to: $newto\n\n"; $to = $newto; } } else { my ($v, $d, $f) = File::Spec->splitpath($to); # relies on $f having a literal "." in it, unlike for $(OBJ_EXT) if ($f =~ /[^\.]{9}\./) { # 9+ chars before '.', need to shorten $f = substr $f, 0, 8; } my $newto = File::Spec->catpath($v, $d, $f); push @m, "$to: $newto\n\n"; $to = $newto; } # bits below should be in dlsyms, not here # 1 2 3 4 push @m, _sprintf562 <<'MAKE_FRAG', $to, $from, $todir, $exportlist; # Create xdc data for an MT safe NLM in case of mpk build %1$s: %2$s $(MYEXTLIB) $(BOOTSTRAP) %3$s$(DFSEP).exists $(NOECHO) $(ECHO) Export boot_$(BOOT_SYMBOL) > %4$s $(NOECHO) $(ECHO) $(BASE_IMPORT) >> %4$s $(NOECHO) $(ECHO) Import @$(PERL_INC)\perl.imp >> %4$s MAKE_FRAG if ( $self->{CCFLAGS} =~ m/ -DMPK_ON /) { (my $xdc = $exportlist) =~ s#def\z#xdc#; $xdc = '$(BASEEXT).xdc'; push @m, sprintf <<'MAKE_FRAG', $xdc, $exportlist; $(MPKTOOL) $(XDCFLAGS) %s $(NOECHO) $(ECHO) xdcdata $(BASEEXT).xdc >> %s MAKE_FRAG } # Reconstruct the X.Y.Z version. my $version = join '.', map { sprintf "%d", $_ } "$]" =~ /(\d)\.(\d{3})(\d{2})/; push @m, sprintf <<'EOF', $from, $version, $to, $exportlist; $(LD) $(LDFLAGS) %s -desc "Perl %s Extension ($(BASEEXT)) XS_VERSION: $(XS_VERSION)" -nlmversion $(NLM_VERSION) -o %s $(MYEXTLIB) $(PERL_INC)\Main.lib -commandfile %s $(CHMOD) 755 $@ EOF join '', @m; } 1; __END__ =back =cut EXTUTILS_MM_NW5 $fatpacked{"ExtUtils/MM_OS2.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_MM_OS2'; package ExtUtils::MM_OS2; use strict; use ExtUtils::MakeMaker qw(neatvalue); use File::Spec; our $VERSION = '7.38'; $VERSION =~ tr/_//d; require ExtUtils::MM_Any; require ExtUtils::MM_Unix; our @ISA = qw(ExtUtils::MM_Any ExtUtils::MM_Unix); =pod =head1 NAME ExtUtils::MM_OS2 - methods to override UN*X behaviour in ExtUtils::MakeMaker =head1 SYNOPSIS use ExtUtils::MM_OS2; # Done internally by ExtUtils::MakeMaker if needed =head1 DESCRIPTION See ExtUtils::MM_Unix for a documentation of the methods provided there. This package overrides the implementation of these methods, not the semantics. =head1 METHODS =over 4 =item init_dist Define TO_UNIX to convert OS2 linefeeds to Unix style. =cut sub init_dist { my($self) = @_; $self->{TO_UNIX} ||= <<'MAKE_TEXT'; $(NOECHO) $(TEST_F) tmp.zip && $(RM_F) tmp.zip; $(ZIP) -ll -mr tmp.zip $(DISTVNAME) && unzip -o tmp.zip && $(RM_F) tmp.zip MAKE_TEXT $self->SUPER::init_dist; } sub dlsyms { my($self,%attribs) = @_; if ($self->{IMPORTS} && %{$self->{IMPORTS}}) { # Make import files (needed for static build) -d 'tmp_imp' or mkdir 'tmp_imp', 0777 or die "Can't mkdir tmp_imp"; open my $imp, '>', 'tmpimp.imp' or die "Can't open tmpimp.imp"; foreach my $name (sort keys %{$self->{IMPORTS}}) { my $exp = $self->{IMPORTS}->{$name}; my ($lib, $id) = ($exp =~ /(.*)\.(.*)/) or die "Malformed IMPORT `$exp'"; print $imp "$name $lib $id ?\n"; } close $imp or die "Can't close tmpimp.imp"; # print "emximp -o tmpimp$Config::Config{lib_ext} tmpimp.imp\n"; system "emximp -o tmpimp$Config::Config{lib_ext} tmpimp.imp" and die "Cannot make import library: $!, \$?=$?"; # May be running under miniperl, so have no glob... eval { unlink ; 1 } or system "rm tmp_imp/*"; system "cd tmp_imp; $Config::Config{ar} x ../tmpimp$Config::Config{lib_ext}" and die "Cannot extract import objects: $!, \$?=$?"; } return '' if $self->{SKIPHASH}{'dynamic'}; $self->xs_dlsyms_iterator(\%attribs); } sub xs_dlsyms_ext { '.def'; } sub xs_dlsyms_extra { join '', map { qq{, "$_" => "\$($_)"} } qw(VERSION DISTNAME INSTALLDIRS); } sub static_lib_pure_cmd { my($self) = @_; my $old = $self->SUPER::static_lib_pure_cmd; return $old unless $self->{IMPORTS} && %{$self->{IMPORTS}}; $old . <<'EOC'; $(AR) $(AR_STATIC_ARGS) "$@" tmp_imp/* $(RANLIB) "$@" EOC } sub replace_manpage_separator { my($self,$man) = @_; $man =~ s,/+,.,g; $man; } sub maybe_command { my($self,$file) = @_; $file =~ s,[/\\]+,/,g; return $file if -x $file && ! -d _; return "$file.exe" if -x "$file.exe" && ! -d _; return "$file.cmd" if -x "$file.cmd" && ! -d _; return; } =item init_linker =cut sub init_linker { my $self = shift; $self->{PERL_ARCHIVE} = "\$(PERL_INC)/libperl\$(LIB_EXT)"; $self->{PERL_ARCHIVEDEP} ||= ''; $self->{PERL_ARCHIVE_AFTER} = $OS2::is_aout ? '' : '$(PERL_INC)/libperl_override$(LIB_EXT)'; $self->{EXPORT_LIST} = '$(BASEEXT).def'; } =item os_flavor OS/2 is OS/2 =cut sub os_flavor { return('OS/2'); } =item xs_static_lib_is_xs =cut sub xs_static_lib_is_xs { return 1; } =back =cut 1; EXTUTILS_MM_OS2 $fatpacked{"ExtUtils/MM_QNX.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_MM_QNX'; package ExtUtils::MM_QNX; use strict; our $VERSION = '7.38'; $VERSION =~ tr/_//d; require ExtUtils::MM_Unix; our @ISA = qw(ExtUtils::MM_Unix); =head1 NAME ExtUtils::MM_QNX - QNX specific subclass of ExtUtils::MM_Unix =head1 SYNOPSIS Don't use this module directly. Use ExtUtils::MM and let it choose. =head1 DESCRIPTION This is a subclass of ExtUtils::MM_Unix which contains functionality for QNX. Unless otherwise stated it works just like ExtUtils::MM_Unix =head2 Overridden methods =head3 extra_clean_files Add .err files corresponding to each .c file. =cut sub extra_clean_files { my $self = shift; my @errfiles = @{$self->{C}}; for ( @errfiles ) { s/.c$/.err/; } return( @errfiles, 'perlmain.err' ); } =head1 AUTHOR Michael G Schwern with code from ExtUtils::MM_Unix =head1 SEE ALSO L =cut 1; EXTUTILS_MM_QNX $fatpacked{"ExtUtils/MM_UWIN.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_MM_UWIN'; package ExtUtils::MM_UWIN; use strict; our $VERSION = '7.38'; $VERSION =~ tr/_//d; require ExtUtils::MM_Unix; our @ISA = qw(ExtUtils::MM_Unix); =head1 NAME ExtUtils::MM_UWIN - U/WIN specific subclass of ExtUtils::MM_Unix =head1 SYNOPSIS Don't use this module directly. Use ExtUtils::MM and let it choose. =head1 DESCRIPTION This is a subclass of ExtUtils::MM_Unix which contains functionality for the AT&T U/WIN UNIX on Windows environment. Unless otherwise stated it works just like ExtUtils::MM_Unix =head2 Overridden methods =over 4 =item os_flavor In addition to being Unix, we're U/WIN. =cut sub os_flavor { return('Unix', 'U/WIN'); } =item B =cut sub replace_manpage_separator { my($self, $man) = @_; $man =~ s,/+,.,g; return $man; } =back =head1 AUTHOR Michael G Schwern with code from ExtUtils::MM_Unix =head1 SEE ALSO L, L =cut 1; EXTUTILS_MM_UWIN $fatpacked{"ExtUtils/MM_Unix.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_MM_UNIX'; package ExtUtils::MM_Unix; require 5.006; use strict; use Carp; use ExtUtils::MakeMaker::Config; use File::Basename qw(basename dirname); our %Config_Override; use ExtUtils::MakeMaker qw($Verbose neatvalue _sprintf562); # If we make $VERSION an our variable parse_version() breaks use vars qw($VERSION); $VERSION = '7.38'; $VERSION =~ tr/_//d; require ExtUtils::MM_Any; our @ISA = qw(ExtUtils::MM_Any); my %Is; BEGIN { $Is{OS2} = $^O eq 'os2'; $Is{Win32} = $^O eq 'MSWin32' || $Config{osname} eq 'NetWare'; $Is{Dos} = $^O eq 'dos'; $Is{VMS} = $^O eq 'VMS'; $Is{OSF} = $^O eq 'dec_osf'; $Is{IRIX} = $^O eq 'irix'; $Is{NetBSD} = $^O eq 'netbsd'; $Is{Interix} = $^O eq 'interix'; $Is{SunOS4} = $^O eq 'sunos'; $Is{Solaris} = $^O eq 'solaris'; $Is{SunOS} = $Is{SunOS4} || $Is{Solaris}; $Is{BSD} = ($^O =~ /^(?:free|net|open)bsd$/ or grep( $^O eq $_, qw(bsdos interix dragonfly) ) ); $Is{Android} = $^O =~ /android/; if ( $^O eq 'darwin' && $^X eq '/usr/bin/perl' ) { my @osvers = split /\./, $Config{osvers}; $Is{ApplCor} = ( $osvers[0] >= 18 ); } } BEGIN { if( $Is{VMS} ) { # For things like vmsify() require VMS::Filespec; VMS::Filespec->import; } } =head1 NAME ExtUtils::MM_Unix - methods used by ExtUtils::MakeMaker =head1 SYNOPSIS require ExtUtils::MM_Unix; =head1 DESCRIPTION The methods provided by this package are designed to be used in conjunction with ExtUtils::MakeMaker. When MakeMaker writes a Makefile, it creates one or more objects that inherit their methods from a package C. MM itself doesn't provide any methods, but it ISA ExtUtils::MM_Unix class. The inheritance tree of MM lets operating specific packages take the responsibility for all the methods provided by MM_Unix. We are trying to reduce the number of the necessary overrides by defining rather primitive operations within ExtUtils::MM_Unix. If you are going to write a platform specific MM package, please try to limit the necessary overrides to primitive methods, and if it is not possible to do so, let's work out how to achieve that gain. If you are overriding any of these methods in your Makefile.PL (in the MY class), please report that to the makemaker mailing list. We are trying to minimize the necessary method overrides and switch to data driven Makefile.PLs wherever possible. In the long run less methods will be overridable via the MY class. =head1 METHODS The following description of methods is still under development. Please refer to the code for not suitably documented sections and complain loudly to the makemaker@perl.org mailing list. Better yet, provide a patch. Not all of the methods below are overridable in a Makefile.PL. Overridable methods are marked as (o). All methods are overridable by a platform specific MM_*.pm file. Cross-platform methods are being moved into MM_Any. If you can't find something that used to be in here, look in MM_Any. =cut # So we don't have to keep calling the methods over and over again, # we have these globals to cache the values. Faster and shrtr. my $Curdir = __PACKAGE__->curdir; my $Updir = __PACKAGE__->updir; =head2 Methods =over 4 =item os_flavor Simply says that we're Unix. =cut sub os_flavor { return('Unix'); } =item c_o (o) Defines the suffix rules to compile different flavors of C files to object files. =cut sub c_o { # --- Translation Sections --- my($self) = shift; return '' unless $self->needs_linking(); my(@m); my $command = '$(CCCMD)'; my $flags = '$(CCCDLFLAGS) "-I$(PERL_INC)" $(PASTHRU_DEFINE) $(DEFINE)'; if ( $Is{ApplCor} ) { $flags =~ s/"-I(\$\(PERL_INC\))"/-iwithsysroot "$1"/; } if (my $cpp = $Config{cpprun}) { my $cpp_cmd = $self->const_cccmd; $cpp_cmd =~ s/^CCCMD\s*=\s*\$\(CC\)/$cpp/; push @m, qq{ .c.i: $cpp_cmd $flags \$*.c > \$*.i }; } my $m_o = $self->{XSMULTI} ? $self->xs_obj_opt('$*.s') : ''; push @m, sprintf <<'EOF', $command, $flags, $m_o; .c.s : %s -S %s $*.c %s EOF my @exts = qw(c cpp cxx cc); push @exts, 'C' if !$Is{OS2} and !$Is{Win32} and !$Is{Dos}; #Case-specific $m_o = $self->{XSMULTI} ? $self->xs_obj_opt('$*$(OBJ_EXT)') : ''; my $dbgout = $self->dbgoutflag; for my $ext (@exts) { push @m, "\n.$ext\$(OBJ_EXT) :\n\t$command $flags " .($dbgout?"$dbgout ":'') ."\$*.$ext" . ( $m_o ? " $m_o" : '' ) . "\n"; } return join "", @m; } =item xs_obj_opt Takes the object file as an argument, and returns the portion of compile command-line that will output to the specified object file. =cut sub xs_obj_opt { my ($self, $output_file) = @_; "-o $output_file"; } =item dbgoutflag Returns a CC flag that tells the CC to emit a separate debugging symbol file when compiling an object file. =cut sub dbgoutflag { ''; } =item cflags (o) Does very much the same as the cflags script in the perl distribution. It doesn't return the whole compiler command line, but initializes all of its parts. The const_cccmd method then actually returns the definition of the CCCMD macro which uses these parts. =cut #' sub cflags { my($self,$libperl)=@_; return $self->{CFLAGS} if $self->{CFLAGS}; return '' unless $self->needs_linking(); my($prog, $uc, $perltype, %cflags); $libperl ||= $self->{LIBPERL_A} || "libperl$self->{LIB_EXT}" ; $libperl =~ s/\.\$\(A\)$/$self->{LIB_EXT}/; @cflags{qw(cc ccflags optimize shellflags)} = @Config{qw(cc ccflags optimize shellflags)}; # Perl 5.21.4 adds the (gcc) warning (-Wall ...) and std (-std=c89) # flags to the %Config, and the modules in the core should be built # with the warning flags, but NOT the -std=c89 flags (the latter # would break using any system header files that are strict C99). my @ccextraflags = qw(ccwarnflags); if ($ENV{PERL_CORE}) { for my $x (@ccextraflags) { if (exists $Config{$x}) { $cflags{$x} = $Config{$x}; } } } my($optdebug) = ""; $cflags{shellflags} ||= ''; my(%map) = ( D => '-DDEBUGGING', E => '-DEMBED', DE => '-DDEBUGGING -DEMBED', M => '-DEMBED -DMULTIPLICITY', DM => '-DDEBUGGING -DEMBED -DMULTIPLICITY', ); if ($libperl =~ /libperl(\w*)\Q$self->{LIB_EXT}/){ $uc = uc($1); } else { $uc = ""; # avoid warning } $perltype = $map{$uc} ? $map{$uc} : ""; if ($uc =~ /^D/) { $optdebug = "-g"; } my($name); ( $name = $self->{NAME} . "_cflags" ) =~ s/:/_/g ; if ($prog = $Config{$name}) { # Expand hints for this extension via the shell print "Processing $name hint:\n" if $Verbose; my(@o)=`cc=\"$cflags{cc}\" ccflags=\"$cflags{ccflags}\" optimize=\"$cflags{optimize}\" perltype=\"$cflags{perltype}\" optdebug=\"$cflags{optdebug}\" eval '$prog' echo cc=\$cc echo ccflags=\$ccflags echo optimize=\$optimize echo perltype=\$perltype echo optdebug=\$optdebug `; foreach my $line (@o){ chomp $line; if ($line =~ /(.*?)=\s*(.*)\s*$/){ $cflags{$1} = $2; print " $1 = $2\n" if $Verbose; } else { print "Unrecognised result from hint: '$line'\n"; } } } if ($optdebug) { $cflags{optimize} = $optdebug; } for (qw(ccflags optimize perltype)) { $cflags{$_} ||= ''; $cflags{$_} =~ s/^\s+//; $cflags{$_} =~ s/\s+/ /g; $cflags{$_} =~ s/\s+$//; $self->{uc $_} ||= $cflags{$_}; } if ($self->{POLLUTE}) { $self->{CCFLAGS} .= ' -DPERL_POLLUTE '; } for my $x (@ccextraflags) { next unless exists $cflags{$x}; $self->{CCFLAGS} .= $cflags{$x} =~ m!^\s! ? $cflags{$x} : ' ' . $cflags{$x}; } my $pollute = ''; if ($Config{usemymalloc} and not $Config{bincompat5005} and not $Config{ccflags} =~ /-DPERL_POLLUTE_MALLOC\b/ and $self->{PERL_MALLOC_OK}) { $pollute = '$(PERL_MALLOC_DEF)'; } return $self->{CFLAGS} = qq{ CCFLAGS = $self->{CCFLAGS} OPTIMIZE = $self->{OPTIMIZE} PERLTYPE = $self->{PERLTYPE} MPOLLUTE = $pollute }; } =item const_cccmd (o) Returns the full compiler call for C programs and stores the definition in CONST_CCCMD. =cut sub const_cccmd { my($self,$libperl)=@_; return $self->{CONST_CCCMD} if $self->{CONST_CCCMD}; return '' unless $self->needs_linking(); return $self->{CONST_CCCMD} = q{CCCMD = $(CC) -c $(PASTHRU_INC) $(INC) \\ $(CCFLAGS) $(OPTIMIZE) \\ $(PERLTYPE) $(MPOLLUTE) $(DEFINE_VERSION) \\ $(XS_DEFINE_VERSION)}; } =item const_config (o) Sets SHELL if needed, then defines a couple of constants in the Makefile that are imported from %Config. =cut sub const_config { # --- Constants Sections --- my($self) = shift; my @m = $self->specify_shell(); # Usually returns empty string push @m, <<"END"; # These definitions are from config.sh (via $INC{'Config.pm'}). # They may have been overridden via Makefile.PL or on the command line. END my(%once_only); foreach my $key (@{$self->{CONFIG}}){ # SITE*EXP macros are defined in &constants; avoid duplicates here next if $once_only{$key}; push @m, uc($key) , ' = ' , $self->{uc $key}, "\n"; $once_only{$key} = 1; } join('', @m); } =item const_loadlibs (o) Defines EXTRALIBS, LDLOADLIBS, BSLOADLIBS, LD_RUN_PATH. See L for details. =cut sub const_loadlibs { my($self) = shift; return "" unless $self->needs_linking; my @m; push @m, qq{ # $self->{NAME} might depend on some other libraries: # See ExtUtils::Liblist for details # }; for my $tmp (qw/ EXTRALIBS LDLOADLIBS BSLOADLIBS /) { next unless defined $self->{$tmp}; push @m, "$tmp = $self->{$tmp}\n"; } # don't set LD_RUN_PATH if empty for my $tmp (qw/ LD_RUN_PATH /) { next unless $self->{$tmp}; push @m, "$tmp = $self->{$tmp}\n"; } return join "", @m; } =item constants (o) my $make_frag = $mm->constants; Prints out macros for lots of constants. =cut sub constants { my($self) = @_; my @m = (); $self->{DFSEP} = '$(DIRFILESEP)'; # alias for internal use for my $macro (qw( AR_STATIC_ARGS DIRFILESEP DFSEP NAME NAME_SYM VERSION VERSION_MACRO VERSION_SYM DEFINE_VERSION XS_VERSION XS_VERSION_MACRO XS_DEFINE_VERSION INST_ARCHLIB INST_SCRIPT INST_BIN INST_LIB INST_MAN1DIR INST_MAN3DIR MAN1EXT MAN3EXT MAN1SECTION MAN3SECTION INSTALLDIRS INSTALL_BASE DESTDIR PREFIX PERLPREFIX SITEPREFIX VENDORPREFIX ), (map { ("INSTALL".$_, "DESTINSTALL".$_) } $self->installvars), qw( PERL_LIB PERL_ARCHLIB PERL_ARCHLIBDEP LIBPERL_A MYEXTLIB FIRST_MAKEFILE MAKEFILE_OLD MAKE_APERL_FILE PERLMAINCC PERL_SRC PERL_INC PERL_INCDEP PERL FULLPERL ABSPERL PERLRUN FULLPERLRUN ABSPERLRUN PERLRUNINST FULLPERLRUNINST ABSPERLRUNINST PERL_CORE PERM_DIR PERM_RW PERM_RWX ) ) { next unless defined $self->{$macro}; # pathnames can have sharp signs in them; escape them so # make doesn't think it is a comment-start character. $self->{$macro} =~ s/#/\\#/g; $self->{$macro} = $self->quote_dep($self->{$macro}) if $ExtUtils::MakeMaker::macro_dep{$macro}; push @m, "$macro = $self->{$macro}\n"; } push @m, qq{ MAKEMAKER = $self->{MAKEMAKER} MM_VERSION = $self->{MM_VERSION} MM_REVISION = $self->{MM_REVISION} }; push @m, q{ # FULLEXT = Pathname for extension directory (eg Foo/Bar/Oracle). # BASEEXT = Basename part of FULLEXT. May be just equal FULLEXT. (eg Oracle) # PARENT_NAME = NAME without BASEEXT and no trailing :: (eg Foo::Bar) # DLBASE = Basename part of dynamic library. May be just equal BASEEXT. }; for my $macro (qw/ MAKE FULLEXT BASEEXT PARENT_NAME DLBASE VERSION_FROM INC DEFINE OBJECT LDFROM LINKTYPE BOOTDEP / ) { next unless defined $self->{$macro}; push @m, "$macro = $self->{$macro}\n"; } push @m, " # Handy lists of source code files: XS_FILES = ".$self->wraplist(sort keys %{$self->{XS}})." C_FILES = ".$self->wraplist(sort @{$self->{C}})." O_FILES = ".$self->wraplist(sort @{$self->{O_FILES}})." H_FILES = ".$self->wraplist(sort @{$self->{H}})." MAN1PODS = ".$self->wraplist(sort keys %{$self->{MAN1PODS}})." MAN3PODS = ".$self->wraplist(sort keys %{$self->{MAN3PODS}})." "; push @m, q{ SDKROOT := $(shell xcrun --show-sdk-path) PERL_SYSROOT = $(SDKROOT) } if $Is{ApplCor} && $self->{'PERL_INC'} =~ m!^/System/Library/Perl/!; push @m, q{ # Where is the Config information that we are using/depend on CONFIGDEP = $(PERL_ARCHLIBDEP)$(DFSEP)Config.pm $(PERL_SYSROOT)$(PERL_INCDEP)$(DFSEP)config.h } if $Is{ApplCor}; push @m, q{ # Where is the Config information that we are using/depend on CONFIGDEP = $(PERL_ARCHLIBDEP)$(DFSEP)Config.pm $(PERL_INCDEP)$(DFSEP)config.h } if -e $self->catfile( $self->{PERL_INC}, 'config.h' ) && !$Is{ApplCor}; push @m, qq{ # Where to build things INST_LIBDIR = $self->{INST_LIBDIR} INST_ARCHLIBDIR = $self->{INST_ARCHLIBDIR} INST_AUTODIR = $self->{INST_AUTODIR} INST_ARCHAUTODIR = $self->{INST_ARCHAUTODIR} INST_STATIC = $self->{INST_STATIC} INST_DYNAMIC = $self->{INST_DYNAMIC} INST_BOOT = $self->{INST_BOOT} }; push @m, qq{ # Extra linker info EXPORT_LIST = $self->{EXPORT_LIST} PERL_ARCHIVE = $self->{PERL_ARCHIVE} PERL_ARCHIVEDEP = $self->{PERL_ARCHIVEDEP} PERL_ARCHIVE_AFTER = $self->{PERL_ARCHIVE_AFTER} }; push @m, " TO_INST_PM = ".$self->wraplist(map $self->quote_dep($_), sort keys %{$self->{PM}})."\n"; join('',@m); } =item depend (o) Same as macro for the depend attribute. =cut sub depend { my($self,%attribs) = @_; my(@m,$key,$val); for my $key (sort keys %attribs){ my $val = $attribs{$key}; next unless defined $key and defined $val; push @m, "$key : $val\n"; } join "", @m; } =item init_DEST $mm->init_DEST Defines the DESTDIR and DEST* variables paralleling the INSTALL*. =cut sub init_DEST { my $self = shift; # Initialize DESTDIR $self->{DESTDIR} ||= ''; # Make DEST variables. foreach my $var ($self->installvars) { my $destvar = 'DESTINSTALL'.$var; $self->{$destvar} ||= '$(DESTDIR)$(INSTALL'.$var.')'; } } =item init_dist $mm->init_dist; Defines a lot of macros for distribution support. macro description default TAR tar command to use tar TARFLAGS flags to pass to TAR cvf ZIP zip command to use zip ZIPFLAGS flags to pass to ZIP -r COMPRESS compression command to gzip --best use for tarfiles SUFFIX suffix to put on .gz compressed files SHAR shar command to use shar PREOP extra commands to run before making the archive POSTOP extra commands to run after making the archive TO_UNIX a command to convert linefeeds to Unix style in your archive CI command to checkin your ci -u sources to version control RCS_LABEL command to label your sources rcs -Nv$(VERSION_SYM): -q just after CI is run DIST_CP $how argument to manicopy() best when the distdir is created DIST_DEFAULT default target to use to tardist create a distribution DISTVNAME name of the resulting archive $(DISTNAME)-$(VERSION) (minus suffixes) =cut sub init_dist { my $self = shift; $self->{TAR} ||= 'tar'; $self->{TARFLAGS} ||= 'cvf'; $self->{ZIP} ||= 'zip'; $self->{ZIPFLAGS} ||= '-r'; $self->{COMPRESS} ||= 'gzip --best'; $self->{SUFFIX} ||= '.gz'; $self->{SHAR} ||= 'shar'; $self->{PREOP} ||= '$(NOECHO) $(NOOP)'; # eg update MANIFEST $self->{POSTOP} ||= '$(NOECHO) $(NOOP)'; # eg remove the distdir $self->{TO_UNIX} ||= '$(NOECHO) $(NOOP)'; $self->{CI} ||= 'ci -u'; $self->{RCS_LABEL}||= 'rcs -Nv$(VERSION_SYM): -q'; $self->{DIST_CP} ||= 'best'; $self->{DIST_DEFAULT} ||= 'tardist'; ($self->{DISTNAME} = $self->{NAME}) =~ s{::}{-}g unless $self->{DISTNAME}; $self->{DISTVNAME} ||= $self->{DISTNAME}.'-'.$self->{VERSION}; } =item dist (o) my $dist_macros = $mm->dist(%overrides); Generates a make fragment defining all the macros initialized in init_dist. %overrides can be used to override any of the above. =cut sub dist { my($self, %attribs) = @_; my $make = ''; if ( $attribs{SUFFIX} && $attribs{SUFFIX} !~ m!^\.! ) { $attribs{SUFFIX} = '.' . $attribs{SUFFIX}; } foreach my $key (qw( TAR TARFLAGS ZIP ZIPFLAGS COMPRESS SUFFIX SHAR PREOP POSTOP TO_UNIX CI RCS_LABEL DIST_CP DIST_DEFAULT DISTNAME DISTVNAME )) { my $value = $attribs{$key} || $self->{$key}; $make .= "$key = $value\n"; } return $make; } =item dist_basics (o) Defines the targets distclean, distcheck, skipcheck, manifest, veryclean. =cut sub dist_basics { my($self) = shift; return <<'MAKE_FRAG'; distclean :: realclean distcheck $(NOECHO) $(NOOP) distcheck : $(PERLRUN) "-MExtUtils::Manifest=fullcheck" -e fullcheck skipcheck : $(PERLRUN) "-MExtUtils::Manifest=skipcheck" -e skipcheck manifest : $(PERLRUN) "-MExtUtils::Manifest=mkmanifest" -e mkmanifest veryclean : realclean $(RM_F) *~ */*~ *.orig */*.orig *.bak */*.bak *.old */*.old MAKE_FRAG } =item dist_ci (o) Defines a check in target for RCS. =cut sub dist_ci { my($self) = shift; return sprintf "ci :\n\t%s\n", $self->oneliner(<<'EOF', [qw(-MExtUtils::Manifest=maniread)]); @all = sort keys %{ maniread() }; print(qq{Executing $(CI) @all\n}); system(qq{$(CI) @all}) == 0 or die $!; print(qq{Executing $(RCS_LABEL) ...\n}); system(qq{$(RCS_LABEL) @all}) == 0 or die $!; EOF } =item dist_core (o) my $dist_make_fragment = $MM->dist_core; Puts the targets necessary for 'make dist' together into one make fragment. =cut sub dist_core { my($self) = shift; my $make_frag = ''; foreach my $target (qw(dist tardist uutardist tarfile zipdist zipfile shdist)) { my $method = $target.'_target'; $make_frag .= "\n"; $make_frag .= $self->$method(); } return $make_frag; } =item B my $make_frag = $MM->dist_target; Returns the 'dist' target to make an archive for distribution. This target simply checks to make sure the Makefile is up-to-date and depends on $(DIST_DEFAULT). =cut sub dist_target { my($self) = shift; my $date_check = $self->oneliner(<<'CODE', ['-l']); print 'Warning: Makefile possibly out of date with $(VERSION_FROM)' if -e '$(VERSION_FROM)' and -M '$(VERSION_FROM)' < -M '$(FIRST_MAKEFILE)'; CODE return sprintf <<'MAKE_FRAG', $date_check; dist : $(DIST_DEFAULT) $(FIRST_MAKEFILE) $(NOECHO) %s MAKE_FRAG } =item B my $make_frag = $MM->tardist_target; Returns the 'tardist' target which is simply so 'make tardist' works. The real work is done by the dynamically named tardistfile_target() method, tardist should have that as a dependency. =cut sub tardist_target { my($self) = shift; return <<'MAKE_FRAG'; tardist : $(DISTVNAME).tar$(SUFFIX) $(NOECHO) $(NOOP) MAKE_FRAG } =item B my $make_frag = $MM->zipdist_target; Returns the 'zipdist' target which is simply so 'make zipdist' works. The real work is done by the dynamically named zipdistfile_target() method, zipdist should have that as a dependency. =cut sub zipdist_target { my($self) = shift; return <<'MAKE_FRAG'; zipdist : $(DISTVNAME).zip $(NOECHO) $(NOOP) MAKE_FRAG } =item B my $make_frag = $MM->tarfile_target; The name of this target is the name of the tarball generated by tardist. This target does the actual work of turning the distdir into a tarball. =cut sub tarfile_target { my($self) = shift; return <<'MAKE_FRAG'; $(DISTVNAME).tar$(SUFFIX) : distdir $(PREOP) $(TO_UNIX) $(TAR) $(TARFLAGS) $(DISTVNAME).tar $(DISTVNAME) $(RM_RF) $(DISTVNAME) $(COMPRESS) $(DISTVNAME).tar $(NOECHO) $(ECHO) 'Created $(DISTVNAME).tar$(SUFFIX)' $(POSTOP) MAKE_FRAG } =item zipfile_target my $make_frag = $MM->zipfile_target; The name of this target is the name of the zip file generated by zipdist. This target does the actual work of turning the distdir into a zip file. =cut sub zipfile_target { my($self) = shift; return <<'MAKE_FRAG'; $(DISTVNAME).zip : distdir $(PREOP) $(ZIP) $(ZIPFLAGS) $(DISTVNAME).zip $(DISTVNAME) $(RM_RF) $(DISTVNAME) $(NOECHO) $(ECHO) 'Created $(DISTVNAME).zip' $(POSTOP) MAKE_FRAG } =item uutardist_target my $make_frag = $MM->uutardist_target; Converts the tarfile into a uuencoded file =cut sub uutardist_target { my($self) = shift; return <<'MAKE_FRAG'; uutardist : $(DISTVNAME).tar$(SUFFIX) uuencode $(DISTVNAME).tar$(SUFFIX) $(DISTVNAME).tar$(SUFFIX) > $(DISTVNAME).tar$(SUFFIX)_uu $(NOECHO) $(ECHO) 'Created $(DISTVNAME).tar$(SUFFIX)_uu' MAKE_FRAG } =item shdist_target my $make_frag = $MM->shdist_target; Converts the distdir into a shell archive. =cut sub shdist_target { my($self) = shift; return <<'MAKE_FRAG'; shdist : distdir $(PREOP) $(SHAR) $(DISTVNAME) > $(DISTVNAME).shar $(RM_RF) $(DISTVNAME) $(NOECHO) $(ECHO) 'Created $(DISTVNAME).shar' $(POSTOP) MAKE_FRAG } =item dlsyms (o) Used by some OS' to define DL_FUNCS and DL_VARS and write the *.exp files. Normally just returns an empty string. =cut sub dlsyms { return ''; } =item dynamic_bs (o) Defines targets for bootstrap files. =cut sub dynamic_bs { my($self, %attribs) = @_; return "\nBOOTSTRAP =\n" unless $self->has_link_code(); my @exts; if ($self->{XSMULTI}) { @exts = $self->_xs_list_basenames; } else { @exts = '$(BASEEXT)'; } return join "\n", "BOOTSTRAP = @{[map { qq{$_.bs} } @exts]}\n", map { $self->_xs_make_bs($_) } @exts; } sub _xs_make_bs { my ($self, $basename) = @_; my ($v, $d, $f) = File::Spec->splitpath($basename); my @d = File::Spec->splitdir($d); shift @d if $self->{XSMULTI} and $d[0] eq 'lib'; my $instdir = $self->catdir('$(INST_ARCHLIB)', 'auto', @d, $f); $instdir = '$(INST_ARCHAUTODIR)' if $basename eq '$(BASEEXT)'; my $instfile = $self->catfile($instdir, "$f.bs"); my $exists = "$instdir\$(DFSEP).exists"; # match blibdirs_target # 1 2 3 return _sprintf562 <<'MAKE_FRAG', $basename, $instfile, $exists; # As Mkbootstrap might not write a file (if none is required) # we use touch to prevent make continually trying to remake it. # The DynaLoader only reads a non-empty file. %1$s.bs : $(FIRST_MAKEFILE) $(BOOTDEP) $(NOECHO) $(ECHO) "Running Mkbootstrap for %1$s ($(BSLOADLIBS))" $(NOECHO) $(PERLRUN) \ "-MExtUtils::Mkbootstrap" \ -e "Mkbootstrap('%1$s','$(BSLOADLIBS)');" $(NOECHO) $(TOUCH) "%1$s.bs" $(CHMOD) $(PERM_RW) "%1$s.bs" %2$s : %1$s.bs %3$s $(NOECHO) $(RM_RF) %2$s - $(CP_NONEMPTY) %1$s.bs %2$s $(PERM_RW) MAKE_FRAG } =item dynamic_lib (o) Defines how to produce the *.so (or equivalent) files. =cut sub dynamic_lib { my($self, %attribs) = @_; return '' unless $self->needs_linking(); #might be because of a subdir return '' unless $self->has_link_code; my @m = $self->xs_dynamic_lib_macros(\%attribs); my @libs; my $dlsyms_ext = eval { $self->xs_dlsyms_ext }; if ($self->{XSMULTI}) { my @exts = $self->_xs_list_basenames; for my $ext (@exts) { my ($v, $d, $f) = File::Spec->splitpath($ext); my @d = File::Spec->splitdir($d); shift @d if $d[0] eq 'lib'; pop @d if $d[$#d] eq ''; my $instdir = $self->catdir('$(INST_ARCHLIB)', 'auto', @d, $f); # Dynamic library names may need special handling. eval { require DynaLoader }; if (defined &DynaLoader::mod2fname) { $f = &DynaLoader::mod2fname([@d, $f]); } my $instfile = $self->catfile($instdir, "$f.\$(DLEXT)"); my $objfile = $self->_xsbuild_value('xs', $ext, 'OBJECT'); $objfile = "$ext\$(OBJ_EXT)" unless defined $objfile; my $ldfrom = $self->_xsbuild_value('xs', $ext, 'LDFROM'); $ldfrom = $objfile unless defined $ldfrom; my $exportlist = "$ext.def"; my @libchunk = ($objfile, $instfile, $instdir, $ldfrom, $exportlist); push @libchunk, $dlsyms_ext ? $ext.$dlsyms_ext : undef; push @libs, \@libchunk; } } else { my @libchunk = qw($(OBJECT) $(INST_DYNAMIC) $(INST_ARCHAUTODIR) $(LDFROM) $(EXPORT_LIST)); push @libchunk, $dlsyms_ext ? '$(BASEEXT)'.$dlsyms_ext : undef; @libs = (\@libchunk); } push @m, map { $self->xs_make_dynamic_lib(\%attribs, @$_); } @libs; return join("\n",@m); } =item xs_dynamic_lib_macros Defines the macros for the C section. =cut sub xs_dynamic_lib_macros { my ($self, $attribs) = @_; my $otherldflags = $attribs->{OTHERLDFLAGS} || ""; my $inst_dynamic_dep = $attribs->{INST_DYNAMIC_DEP} || ""; my $armaybe = $self->_xs_armaybe($attribs); my $ld_opt = $Is{OS2} ? '$(OPTIMIZE) ' : ''; # Useful on other systems too? my $ld_fix = $Is{OS2} ? '|| ( $(RM_F) $@ && sh -c false )' : ''; sprintf <<'EOF', $armaybe, $ld_opt.$otherldflags, $inst_dynamic_dep, $ld_fix; # This section creates the dynamically loadable objects from relevant # objects and possibly $(MYEXTLIB). ARMAYBE = %s OTHERLDFLAGS = %s INST_DYNAMIC_DEP = %s INST_DYNAMIC_FIX = %s EOF } sub _xs_armaybe { my ($self, $attribs) = @_; my $armaybe = $attribs->{ARMAYBE} || $self->{ARMAYBE} || ":"; $armaybe = 'ar' if ($Is{OSF} and $armaybe eq ':'); $armaybe; } =item xs_make_dynamic_lib Defines the recipes for the C section. =cut sub xs_make_dynamic_lib { my ($self, $attribs, $object, $to, $todir, $ldfrom, $exportlist, $dlsyms) = @_; $exportlist = '' if $exportlist ne '$(EXPORT_LIST)'; my $armaybe = $self->_xs_armaybe($attribs); my @m = sprintf '%s : %s $(MYEXTLIB) %s$(DFSEP).exists %s $(PERL_ARCHIVEDEP) $(PERL_ARCHIVE_AFTER) $(INST_DYNAMIC_DEP) %s'."\n", $to, $object, $todir, $exportlist, ($dlsyms || ''); my $dlsyms_arg = $self->xs_dlsyms_arg($dlsyms); if ($armaybe ne ':'){ $ldfrom = 'tmp$(LIB_EXT)'; push(@m," \$(ARMAYBE) cr $ldfrom $object\n"); push(@m," \$(RANLIB) $ldfrom\n"); } $ldfrom = "-all $ldfrom -none" if $Is{OSF}; # The IRIX linker doesn't use LD_RUN_PATH my $ldrun = $Is{IRIX} && $self->{LD_RUN_PATH} ? qq{-rpath "$self->{LD_RUN_PATH}"} : ''; # For example in AIX the shared objects/libraries from previous builds # linger quite a while in the shared dynalinker cache even when nobody # is using them. This is painful if one for instance tries to restart # a failed build because the link command will fail unnecessarily 'cos # the shared object/library is 'busy'. push(@m," \$(RM_F) \$\@\n"); my $libs = '$(LDLOADLIBS)'; if (($Is{NetBSD} || $Is{Interix} || $Is{Android}) && $Config{'useshrplib'} eq 'true') { # Use nothing on static perl platforms, and to the flags needed # to link against the shared libperl library on shared perl # platforms. We peek at lddlflags to see if we need -Wl,-R # or -R to add paths to the run-time library search path. if ($Config{'lddlflags'} =~ /-Wl,-R/) { $libs .= ' "-L$(PERL_INC)" "-Wl,-R$(INSTALLARCHLIB)/CORE" "-Wl,-R$(PERL_ARCHLIB)/CORE" -lperl'; } elsif ($Config{'lddlflags'} =~ /-R/) { $libs .= ' "-L$(PERL_INC)" "-R$(INSTALLARCHLIB)/CORE" "-R$(PERL_ARCHLIB)/CORE" -lperl'; } elsif ( $Is{Android} ) { # The Android linker will not recognize symbols from # libperl unless the module explicitly depends on it. $libs .= ' "-L$(PERL_INC)" -lperl'; } } my $ld_run_path_shell = ""; if ($self->{LD_RUN_PATH} ne "") { $ld_run_path_shell = 'LD_RUN_PATH="$(LD_RUN_PATH)" '; } push @m, sprintf <<'MAKE', $ld_run_path_shell, $ldrun, $dlsyms_arg, $ldfrom, $self->xs_obj_opt('$@'), $libs, $exportlist; %s$(LD) %s $(LDDLFLAGS) %s %s $(OTHERLDFLAGS) %s $(MYEXTLIB) \ $(PERL_ARCHIVE) %s $(PERL_ARCHIVE_AFTER) %s \ $(INST_DYNAMIC_FIX) $(CHMOD) $(PERM_RWX) $@ MAKE join '', @m; } =item exescan Deprecated method. Use libscan instead. =cut sub exescan { my($self,$path) = @_; $path; } =item extliblist Called by init_others, and calls ext ExtUtils::Liblist. See L for details. =cut sub extliblist { my($self,$libs) = @_; require ExtUtils::Liblist; $self->ext($libs, $Verbose); } =item find_perl Finds the executables PERL and FULLPERL =cut sub find_perl { my($self, $ver, $names, $dirs, $trace) = @_; if ($trace >= 2){ print "Looking for perl $ver by these names: @$names in these dirs: @$dirs "; } my $stderr_duped = 0; local *STDERR_COPY; unless ($Is{BSD}) { # >& and lexical filehandles together give 5.6.2 indigestion if( open(STDERR_COPY, '>&STDERR') ) { ## no critic $stderr_duped = 1; } else { warn <file_name_is_absolute($name)) { # /foo/bar $abs = $name; } elsif ($self->canonpath($name) eq $self->canonpath(basename($name))) { # foo $use_dir = 1; } else { # foo/bar $abs = $self->catfile($Curdir, $name); } foreach my $dir ($use_dir ? @$dirs : 1){ next unless defined $dir; # $self->{PERL_SRC} may be undefined $abs = $self->catfile($dir, $name) if $use_dir; print "Checking $abs\n" if ($trace >= 2); next unless $self->maybe_command($abs); print "Executing $abs\n" if ($trace >= 2); my $val; my $version_check = qq{"$abs" -le "require $ver; print qq{VER_OK}"}; # To avoid using the unportable 2>&1 to suppress STDERR, # we close it before running the command. # However, thanks to a thread library bug in many BSDs # ( http://www.freebsd.org/cgi/query-pr.cgi?pr=51535 ) # we cannot use the fancier more portable way in here # but instead need to use the traditional 2>&1 construct. if ($Is{BSD}) { $val = `$version_check 2>&1`; } else { close STDERR if $stderr_duped; $val = `$version_check`; # 5.6.2's 3-arg open doesn't work with >& open STDERR, ">&STDERR_COPY" ## no critic if $stderr_duped; } if ($val =~ /^VER_OK/m) { print "Using PERL=$abs\n" if $trace; return $abs; } elsif ($trace >= 2) { print "Result: '$val' ".($? >> 8)."\n"; } } } print "Unable to find a perl $ver (by these names: @$names, in these dirs: @$dirs)\n"; 0; # false and not empty } =item fixin $mm->fixin(@files); Inserts the sharpbang or equivalent magic number to a set of @files. =cut sub fixin { # stolen from the pink Camel book, more or less my ( $self, @files ) = @_; for my $file (@files) { my $file_new = "$file.new"; my $file_bak = "$file.bak"; open( my $fixin, '<', $file ) or croak "Can't process '$file': $!"; local $/ = "\n"; chomp( my $line = <$fixin> ); next unless $line =~ s/^\s*\#!\s*//; # Not a shebang file. my $shb = $self->_fixin_replace_shebang( $file, $line ); next unless defined $shb; open( my $fixout, ">", "$file_new" ) or do { warn "Can't create new $file: $!\n"; next; }; # Print out the new #! line (or equivalent). local $\; local $/; print $fixout $shb, <$fixin>; close $fixin; close $fixout; chmod 0666, $file_bak; unlink $file_bak; unless ( _rename( $file, $file_bak ) ) { warn "Can't rename $file to $file_bak: $!"; next; } unless ( _rename( $file_new, $file ) ) { warn "Can't rename $file_new to $file: $!"; unless ( _rename( $file_bak, $file ) ) { warn "Can't rename $file_bak back to $file either: $!"; warn "Leaving $file renamed as $file_bak\n"; } next; } unlink $file_bak; } continue { system("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':'; } } sub _rename { my($old, $new) = @_; foreach my $file ($old, $new) { if( $Is{VMS} and basename($file) !~ /\./ ) { # rename() in 5.8.0 on VMS will not rename a file if it # does not contain a dot yet it returns success. $file = "$file."; } } return rename($old, $new); } sub _fixin_replace_shebang { my ( $self, $file, $line ) = @_; # Now figure out the interpreter name. my ( $origcmd, $arg ) = split ' ', $line, 2; (my $cmd = $origcmd) =~ s!^.*/!!; # Now look (in reverse) for interpreter in absolute PATH (unless perl). my $interpreter; if ( defined $ENV{PERL_MM_SHEBANG} && $ENV{PERL_MM_SHEBANG} eq "relocatable" ) { $interpreter = "/usr/bin/env perl"; } elsif ( $cmd =~ m{^perl(?:\z|[^a-z])} ) { if ( $Config{startperl} =~ m,^\#!.*/perl, ) { $interpreter = $Config{startperl}; $interpreter =~ s,^\#!,,; } else { $interpreter = $Config{perlpath}; } } else { my (@absdirs) = reverse grep { $self->file_name_is_absolute($_) } $self->path; $interpreter = ''; foreach my $dir (@absdirs) { my $maybefile = $self->catfile($dir,$cmd); if ( $self->maybe_command($maybefile) ) { warn "Ignoring $interpreter in $file\n" if $Verbose && $interpreter; $interpreter = $maybefile; } } # If the shebang is absolute and exists in PATH, but was not # the first one found, leave it alone if it's actually the # same file as first one. This avoids packages built on # merged-/usr systems with /usr/bin before /bin in the path # breaking when installed on systems without merged /usr if ($origcmd ne $interpreter and $self->file_name_is_absolute($origcmd)) { my $origdir = dirname($origcmd); if ($self->maybe_command($origcmd) && grep { $_ eq $origdir } @absdirs) { my ($odev, $oino) = stat $origcmd; my ($idev, $iino) = stat $interpreter; if ($odev == $idev && $oino == $iino) { warn "$origcmd is the same as $interpreter, leaving alone" if $Verbose; $interpreter = $origcmd; } } } } # Figure out how to invoke interpreter on this machine. my ($does_shbang) = $Config{'sharpbang'} =~ /^\s*\#\!/; my ($shb) = ""; if ($interpreter) { print "Changing sharpbang in $file to $interpreter" if $Verbose; # this is probably value-free on DOSISH platforms if ($does_shbang) { $shb .= "$Config{'sharpbang'}$interpreter"; $shb .= ' ' . $arg if defined $arg; $shb .= "\n"; } } else { warn "Can't find $cmd in PATH, $file unchanged" if $Verbose; return; } return $shb } =item force (o) Writes an empty FORCE: target. =cut sub force { my($self) = shift; '# Phony target to force checking subdirectories. FORCE : $(NOECHO) $(NOOP) '; } =item guess_name Guess the name of this package by examining the working directory's name. MakeMaker calls this only if the developer has not supplied a NAME attribute. =cut # '; sub guess_name { my($self) = @_; use Cwd 'cwd'; my $name = basename(cwd()); $name =~ s|[\-_][\d\.\-]+\z||; # this is new with MM 5.00, we # strip minus or underline # followed by a float or some such print "Warning: Guessing NAME [$name] from current directory name.\n"; $name; } =item has_link_code Returns true if C, XS, MYEXTLIB or similar objects exist within this object that need a compiler. Does not descend into subdirectories as needs_linking() does. =cut sub has_link_code { my($self) = shift; return $self->{HAS_LINK_CODE} if defined $self->{HAS_LINK_CODE}; if ($self->{OBJECT} or @{$self->{C} || []} or $self->{MYEXTLIB}){ $self->{HAS_LINK_CODE} = 1; return 1; } return $self->{HAS_LINK_CODE} = 0; } =item init_dirscan Scans the directory structure and initializes DIR, XS, XS_FILES, C, C_FILES, O_FILES, H, H_FILES, PL_FILES, EXE_FILES. Called by init_main. =cut sub init_dirscan { # --- File and Directory Lists (.xs .pm .pod etc) my($self) = @_; my(%dir, %xs, %c, %o, %h, %pl_files, %pm); my %ignore = map {( $_ => 1 )} qw(Makefile.PL Build.PL test.pl t); # ignore the distdir $Is{VMS} ? $ignore{"$self->{DISTVNAME}.dir"} = 1 : $ignore{$self->{DISTVNAME}} = 1; my $distprefix = $Is{VMS} ? qr/^\Q$self->{DISTNAME}\E-v?[\d\.]+\.dir$/i : qr/^\Q$self->{DISTNAME}\E-v?[\d\.]+$/; @ignore{map lc, keys %ignore} = values %ignore if $Is{VMS}; if ( defined $self->{XS} and !defined $self->{C} ) { my @c_files = grep { m/\.c(pp|xx)?\z/i } values %{$self->{XS}}; my @o_files = grep { m/(?:.(?:o(?:bj)?)|\$\(OBJ_EXT\))\z/i } values %{$self->{XS}}; %c = map { $_ => 1 } @c_files; %o = map { $_ => 1 } @o_files; } foreach my $name ($self->lsdir($Curdir)){ next if $name =~ /\#/; next if $name =~ $distprefix && -d $name; $name = lc($name) if $Is{VMS}; next if $name eq $Curdir or $name eq $Updir or $ignore{$name}; next unless $self->libscan($name); if (-d $name){ next if -l $name; # We do not support symlinks at all next if $self->{NORECURS}; $dir{$name} = $name if (-f $self->catfile($name,"Makefile.PL")); } elsif ($name =~ /\.xs\z/){ my($c); ($c = $name) =~ s/\.xs\z/.c/; $xs{$name} = $c; $c{$c} = 1; } elsif ($name =~ /\.c(pp|xx|c)?\z/i){ # .c .C .cpp .cxx .cc $c{$name} = 1 unless $name =~ m/perlmain\.c/; # See MAP_TARGET } elsif ($name =~ /\.h\z/i){ $h{$name} = 1; } elsif ($name =~ /\.PL\z/) { ($pl_files{$name} = $name) =~ s/\.PL\z// ; } elsif (($Is{VMS} || $Is{Dos}) && $name =~ /[._]pl$/i) { # case-insensitive filesystem, one dot per name, so foo.h.PL # under Unix appears as foo.h_pl under VMS or fooh.pl on Dos local($/); open(my $pl, '<', $name); my $txt = <$pl>; close $pl; if ($txt =~ /Extracting \S+ \(with variable substitutions/) { ($pl_files{$name} = $name) =~ s/[._]pl\z//i ; } else { $pm{$name} = $self->catfile($self->{INST_LIBDIR},$name); } } elsif ($name =~ /\.(p[ml]|pod)\z/){ $pm{$name} = $self->catfile($self->{INST_LIBDIR},$name); } } $self->{PL_FILES} ||= \%pl_files; $self->{DIR} ||= [sort keys %dir]; $self->{XS} ||= \%xs; $self->{C} ||= [sort keys %c]; $self->{H} ||= [sort keys %h]; $self->{PM} ||= \%pm; my @o_files = @{$self->{C}}; %o = (%o, map { $_ => 1 } grep s/\.c(pp|xx|c)?\z/$self->{OBJ_EXT}/i, @o_files); $self->{O_FILES} = [sort keys %o]; } =item init_MANPODS Determines if man pages should be generated and initializes MAN1PODS and MAN3PODS as appropriate. =cut sub init_MANPODS { my $self = shift; # Set up names of manual pages to generate from pods foreach my $man (qw(MAN1 MAN3)) { if ( $self->{"${man}PODS"} or $self->{"INSTALL${man}DIR"} =~ /^(none|\s*)$/ ) { $self->{"${man}PODS"} ||= {}; } else { my $init_method = "init_${man}PODS"; $self->$init_method(); } } # logic similar to picking man${num}ext in perl's Configure script foreach my $num (1,3) { my $installdirs = uc $self->{INSTALLDIRS}; $installdirs = '' if $installdirs eq 'PERL'; my $mandir = $self->_expand_macros( $self->{ "INSTALL${installdirs}MAN${num}DIR" } ); my $section = $num; foreach ($num, "${num}p", "${num}pm", qw< l n o C L >, "L$num") { if ( $mandir =~ /\b(?:man|cat)$_$/ ) { $section = $_; last; } } $self->{"MAN${num}SECTION"} = $section; } } sub _has_pod { my($self, $file) = @_; my($ispod)=0; if (open( my $fh, '<', $file )) { while (<$fh>) { if (/^=(?:head\d+|item|pod)\b/) { $ispod=1; last; } } close $fh; } else { # If it doesn't exist yet, we assume, it has pods in it $ispod = 1; } return $ispod; } =item init_MAN1PODS Initializes MAN1PODS from the list of EXE_FILES. =cut sub init_MAN1PODS { my($self) = @_; if ( exists $self->{EXE_FILES} ) { foreach my $name (@{$self->{EXE_FILES}}) { next unless $self->_has_pod($name); $self->{MAN1PODS}->{$name} = $self->catfile("\$(INST_MAN1DIR)", basename($name).".\$(MAN1EXT)"); } } } =item init_MAN3PODS Initializes MAN3PODS from the list of PM files. =cut sub init_MAN3PODS { my $self = shift; my %manifypods = (); # we collect the keys first, i.e. the files # we have to convert to pod foreach my $name (keys %{$self->{PM}}) { if ($name =~ /\.pod\z/ ) { $manifypods{$name} = $self->{PM}{$name}; } elsif ($name =~ /\.p[ml]\z/ ) { if( $self->_has_pod($name) ) { $manifypods{$name} = $self->{PM}{$name}; } } } my $parentlibs_re = join '|', @{$self->{PMLIBPARENTDIRS}}; # Remove "Configure.pm" and similar, if it's not the only pod listed # To force inclusion, just name it "Configure.pod", or override # MAN3PODS foreach my $name (keys %manifypods) { if ( ($self->{PERL_CORE} and $name =~ /(config|setup).*\.pm/is) or ( $name =~ m/^README\.pod$/i ) # don't manify top-level README.pod ) { delete $manifypods{$name}; next; } my($manpagename) = $name; $manpagename =~ s/\.p(od|m|l)\z//; # everything below lib is ok unless($manpagename =~ s!^\W*($parentlibs_re)\W+!!s) { $manpagename = $self->catfile( split(/::/,$self->{PARENT_NAME}),$manpagename ); } $manpagename = $self->replace_manpage_separator($manpagename); $self->{MAN3PODS}->{$name} = $self->catfile("\$(INST_MAN3DIR)", "$manpagename.\$(MAN3EXT)"); } } =item init_PM Initializes PMLIBDIRS and PM from PMLIBDIRS. =cut sub init_PM { my $self = shift; # Some larger extensions often wish to install a number of *.pm/pl # files into the library in various locations. # The attribute PMLIBDIRS holds an array reference which lists # subdirectories which we should search for library files to # install. PMLIBDIRS defaults to [ 'lib', $self->{BASEEXT} ]. We # recursively search through the named directories (skipping any # which don't exist or contain Makefile.PL files). # For each *.pm or *.pl file found $self->libscan() is called with # the default installation path in $_[1]. The return value of # libscan defines the actual installation location. The default # libscan function simply returns the path. The file is skipped # if libscan returns false. # The default installation location passed to libscan in $_[1] is: # # ./*.pm => $(INST_LIBDIR)/*.pm # ./xyz/... => $(INST_LIBDIR)/xyz/... # ./lib/... => $(INST_LIB)/... # # In this way the 'lib' directory is seen as the root of the actual # perl library whereas the others are relative to INST_LIBDIR # (which includes PARENT_NAME). This is a subtle distinction but one # that's important for nested modules. unless( $self->{PMLIBDIRS} ) { if( $Is{VMS} ) { # Avoid logical name vs directory collisions $self->{PMLIBDIRS} = ['./lib', "./$self->{BASEEXT}"]; } else { $self->{PMLIBDIRS} = ['lib', $self->{BASEEXT}]; } } #only existing directories that aren't in $dir are allowed # Avoid $_ wherever possible: # @{$self->{PMLIBDIRS}} = grep -d && !$dir{$_}, @{$self->{PMLIBDIRS}}; my (@pmlibdirs) = @{$self->{PMLIBDIRS}}; @{$self->{PMLIBDIRS}} = (); my %dir = map { ($_ => $_) } @{$self->{DIR}}; foreach my $pmlibdir (@pmlibdirs) { -d $pmlibdir && !$dir{$pmlibdir} && push @{$self->{PMLIBDIRS}}, $pmlibdir; } unless( $self->{PMLIBPARENTDIRS} ) { @{$self->{PMLIBPARENTDIRS}} = ('lib'); } return if $self->{PM} and $self->{ARGS}{PM}; if (@{$self->{PMLIBDIRS}}){ print "Searching PMLIBDIRS: @{$self->{PMLIBDIRS}}\n" if ($Verbose >= 2); require File::Find; File::Find::find(sub { if (-d $_){ unless ($self->libscan($_)){ $File::Find::prune = 1; } return; } return if /\#/; return if /~$/; # emacs temp files return if /,v$/; # RCS files return if m{\.swp$}; # vim swap files my $path = $File::Find::name; my $prefix = $self->{INST_LIBDIR}; my $striplibpath; my $parentlibs_re = join '|', @{$self->{PMLIBPARENTDIRS}}; $prefix = $self->{INST_LIB} if ($striplibpath = $path) =~ s{^(\W*)($parentlibs_re)\W} {$1}i; my($inst) = $self->catfile($prefix,$striplibpath); local($_) = $inst; # for backwards compatibility $inst = $self->libscan($inst); print "libscan($path) => '$inst'\n" if ($Verbose >= 2); return unless $inst; if ($self->{XSMULTI} and $inst =~ /\.xs\z/) { my($base); ($base = $path) =~ s/\.xs\z//; $self->{XS}{$path} = "$base.c"; push @{$self->{C}}, "$base.c"; push @{$self->{O_FILES}}, "$base$self->{OBJ_EXT}"; } else { $self->{PM}{$path} = $inst; } }, @{$self->{PMLIBDIRS}}); } } =item init_DIRFILESEP Using / for Unix. Called by init_main. =cut sub init_DIRFILESEP { my($self) = shift; $self->{DIRFILESEP} = '/'; } =item init_main Initializes AR, AR_STATIC_ARGS, BASEEXT, CONFIG, DISTNAME, DLBASE, EXE_EXT, FULLEXT, FULLPERL, FULLPERLRUN, FULLPERLRUNINST, INST_*, INSTALL*, INSTALLDIRS, LIB_EXT, LIBPERL_A, MAP_TARGET, NAME, OBJ_EXT, PARENT_NAME, PERL, PERL_ARCHLIB, PERL_INC, PERL_LIB, PERL_SRC, PERLRUN, PERLRUNINST, PREFIX, VERSION, VERSION_SYM, XS_VERSION. =cut sub init_main { my($self) = @_; # --- Initialize Module Name and Paths # NAME = Foo::Bar::Oracle # FULLEXT = Foo/Bar/Oracle # BASEEXT = Oracle # PARENT_NAME = Foo::Bar ### Only UNIX: ### ($self->{FULLEXT} = ### $self->{NAME}) =~ s!::!/!g ; #eg. BSD/Foo/Socket $self->{FULLEXT} = $self->catdir(split /::/, $self->{NAME}); # Copied from DynaLoader: my(@modparts) = split(/::/,$self->{NAME}); my($modfname) = $modparts[-1]; # Some systems have restrictions on files names for DLL's etc. # mod2fname returns appropriate file base name (typically truncated) # It may also edit @modparts if required. # We require DynaLoader to make sure that mod2fname is loaded eval { require DynaLoader }; if (defined &DynaLoader::mod2fname) { $modfname = &DynaLoader::mod2fname(\@modparts); } ($self->{PARENT_NAME}, $self->{BASEEXT}) = $self->{NAME} =~ m!(?:([\w:]+)::)?(\w+)\z! ; $self->{PARENT_NAME} ||= ''; if (defined &DynaLoader::mod2fname) { # As of 5.001m, dl_os2 appends '_' $self->{DLBASE} = $modfname; } else { $self->{DLBASE} = '$(BASEEXT)'; } # --- Initialize PERL_LIB, PERL_SRC # *Real* information: where did we get these two from? ... my $inc_config_dir = dirname($INC{'Config.pm'}); my $inc_carp_dir = dirname($INC{'Carp.pm'}); unless ($self->{PERL_SRC}){ foreach my $dir_count (1..8) { # 8 is the VMS limit for nesting my $dir = $self->catdir(($Updir) x $dir_count); if (-f $self->catfile($dir,"config_h.SH") && -f $self->catfile($dir,"perl.h") && -f $self->catfile($dir,"lib","strict.pm") ) { $self->{PERL_SRC}=$dir ; last; } } } warn "PERL_CORE is set but I can't find your PERL_SRC!\n" if $self->{PERL_CORE} and !$self->{PERL_SRC}; if ($self->{PERL_SRC}){ $self->{PERL_LIB} ||= $self->catdir("$self->{PERL_SRC}","lib"); $self->{PERL_ARCHLIB} = $self->{PERL_LIB}; $self->{PERL_INC} = ($Is{Win32}) ? $self->catdir($self->{PERL_LIB},"CORE") : $self->{PERL_SRC}; # catch a situation that has occurred a few times in the past: unless ( -s $self->catfile($self->{PERL_SRC},'cflags') or $Is{VMS} && -s $self->catfile($self->{PERL_SRC},'vmsish.h') or $Is{Win32} ){ warn qq{ You cannot build extensions below the perl source tree after executing a 'make clean' in the perl source tree. To rebuild extensions distributed with the perl source you should simply Configure (to include those extensions) and then build perl as normal. After installing perl the source tree can be deleted. It is not needed for building extensions by running 'perl Makefile.PL' usually without extra arguments. It is recommended that you unpack and build additional extensions away from the perl source tree. }; } } else { # we should also consider $ENV{PERL5LIB} here my $old = $self->{PERL_LIB} || $self->{PERL_ARCHLIB} || $self->{PERL_INC}; $self->{PERL_LIB} ||= $Config{privlibexp}; $self->{PERL_ARCHLIB} ||= $Config{archlibexp}; $self->{PERL_INC} = $self->catdir("$self->{PERL_ARCHLIB}","CORE"); # wild guess for now my $perl_h; if (not -f ($perl_h = $self->catfile($self->{PERL_INC},"perl.h")) and not $old){ # Maybe somebody tries to build an extension with an # uninstalled Perl outside of Perl build tree my $lib; for my $dir (@INC) { $lib = $dir, last if -e $self->catfile($dir, "Config.pm"); } if ($lib) { # Win32 puts its header files in /perl/src/lib/CORE. # Unix leaves them in /perl/src. my $inc = $Is{Win32} ? $self->catdir($lib, "CORE" ) : dirname $lib; if (-e $self->catfile($inc, "perl.h")) { $self->{PERL_LIB} = $lib; $self->{PERL_ARCHLIB} = $lib; $self->{PERL_INC} = $inc; $self->{UNINSTALLED_PERL} = 1; print <{PERL_LIB} = File::Spec->rel2abs($self->{PERL_LIB}); $self->{PERL_ARCHLIB} = File::Spec->rel2abs($self->{PERL_ARCHLIB}); } $self->{PERL_INCDEP} = $self->{PERL_INC}; $self->{PERL_ARCHLIBDEP} = $self->{PERL_ARCHLIB}; # We get SITELIBEXP and SITEARCHEXP directly via # Get_from_Config. When we are running standard modules, these # won't matter, we will set INSTALLDIRS to "perl". Otherwise we # set it to "site". I prefer that INSTALLDIRS be set from outside # MakeMaker. $self->{INSTALLDIRS} ||= "site"; $self->{MAN1EXT} ||= $Config{man1ext}; $self->{MAN3EXT} ||= $Config{man3ext}; # Get some stuff out of %Config if we haven't yet done so print "CONFIG must be an array ref\n" if ($self->{CONFIG} and ref $self->{CONFIG} ne 'ARRAY'); $self->{CONFIG} = [] unless (ref $self->{CONFIG}); push(@{$self->{CONFIG}}, @ExtUtils::MakeMaker::Get_from_Config); push(@{$self->{CONFIG}}, 'shellflags') if $Config{shellflags}; my(%once_only); foreach my $m (@{$self->{CONFIG}}){ next if $once_only{$m}; print "CONFIG key '$m' does not exist in Config.pm\n" unless exists $Config{$m}; $self->{uc $m} ||= $Config{$m}; $once_only{$m} = 1; } # This is too dangerous: # if ($^O eq "next") { # $self->{AR} = "libtool"; # $self->{AR_STATIC_ARGS} = "-o"; # } # But I leave it as a placeholder $self->{AR_STATIC_ARGS} ||= "cr"; # These should never be needed $self->{OBJ_EXT} ||= '.o'; $self->{LIB_EXT} ||= '.a'; $self->{MAP_TARGET} ||= "perl"; $self->{LIBPERL_A} ||= "libperl$self->{LIB_EXT}"; # make a simple check if we find strict warn "Warning: PERL_LIB ($self->{PERL_LIB}) seems not to be a perl library directory (strict.pm not found)" unless -f $self->catfile("$self->{PERL_LIB}","strict.pm") || $self->{NAME} eq "ExtUtils::MakeMaker"; } =item init_tools Initializes tools to use their common (and faster) Unix commands. =cut sub init_tools { my $self = shift; $self->{ECHO} ||= 'echo'; $self->{ECHO_N} ||= 'echo -n'; $self->{RM_F} ||= "rm -f"; $self->{RM_RF} ||= "rm -rf"; $self->{TOUCH} ||= "touch"; $self->{TEST_F} ||= "test -f"; $self->{TEST_S} ||= "test -s"; $self->{CP} ||= "cp"; $self->{MV} ||= "mv"; $self->{CHMOD} ||= "chmod"; $self->{FALSE} ||= 'false'; $self->{TRUE} ||= 'true'; $self->{LD} ||= 'ld'; return $self->SUPER::init_tools(@_); # After SUPER::init_tools so $Config{shell} has a # chance to get set. $self->{SHELL} ||= '/bin/sh'; return; } =item init_linker Unix has no need of special linker flags. =cut sub init_linker { my($self) = shift; $self->{PERL_ARCHIVE} ||= ''; $self->{PERL_ARCHIVEDEP} ||= ''; $self->{PERL_ARCHIVE_AFTER} ||= ''; $self->{EXPORT_LIST} ||= ''; } =begin _protected =item init_lib2arch $mm->init_lib2arch =end _protected =cut sub init_lib2arch { my($self) = shift; # The user who requests an installation directory explicitly # should not have to tell us an architecture installation directory # as well. We look if a directory exists that is named after the # architecture. If not we take it as a sign that it should be the # same as the requested installation directory. Otherwise we take # the found one. for my $libpair ({l=>"privlib", a=>"archlib"}, {l=>"sitelib", a=>"sitearch"}, {l=>"vendorlib", a=>"vendorarch"}, ) { my $lib = "install$libpair->{l}"; my $Lib = uc $lib; my $Arch = uc "install$libpair->{a}"; if( $self->{$Lib} && ! $self->{$Arch} ){ my($ilib) = $Config{$lib}; $self->prefixify($Arch,$ilib,$self->{$Lib}); unless (-d $self->{$Arch}) { print "Directory $self->{$Arch} not found\n" if $Verbose; $self->{$Arch} = $self->{$Lib}; } print "Defaulting $Arch to $self->{$Arch}\n" if $Verbose; } } } =item init_PERL $mm->init_PERL; Called by init_main. Sets up ABSPERL, PERL, FULLPERL and all the *PERLRUN* permutations. PERL is allowed to be miniperl FULLPERL must be a complete perl ABSPERL is PERL converted to an absolute path *PERLRUN contains everything necessary to run perl, find it's libraries, etc... *PERLRUNINST is *PERLRUN + everything necessary to find the modules being built. =cut sub init_PERL { my($self) = shift; my @defpath = (); foreach my $component ($self->{PERL_SRC}, $self->path(), $Config{binexp}) { push @defpath, $component if defined $component; } # Build up a set of file names (not command names). my $thisperl = $self->canonpath($^X); $thisperl .= $Config{exe_ext} unless # VMS might have a file version # at the end $Is{VMS} ? $thisperl =~ m/$Config{exe_ext}(;\d+)?$/i : $thisperl =~ m/$Config{exe_ext}$/i; # We need a relative path to perl when in the core. $thisperl = $self->abs2rel($thisperl) if $self->{PERL_CORE}; my @perls = ($thisperl); push @perls, map { "$_$Config{exe_ext}" } ("perl$Config{version}", 'perl5', 'perl'); # miniperl has priority over all but the canonical perl when in the # core. Otherwise its a last resort. my $miniperl = "miniperl$Config{exe_ext}"; if( $self->{PERL_CORE} ) { splice @perls, 1, 0, $miniperl; } else { push @perls, $miniperl; } $self->{PERL} ||= $self->find_perl(5.0, \@perls, \@defpath, $Verbose ); my $perl = $self->{PERL}; $perl =~ s/^"//; my $has_mcr = $perl =~ s/^MCR\s*//; my $perlflags = ''; my $stripped_perl; while ($perl) { ($stripped_perl = $perl) =~ s/"$//; last if -x $stripped_perl; last unless $perl =~ s/(\s+\S+)$//; $perlflags = $1.$perlflags; } $self->{PERL} = $stripped_perl; $self->{PERL} = 'MCR '.$self->{PERL} if $has_mcr || $Is{VMS}; # When built for debugging, VMS doesn't create perl.exe but ndbgperl.exe. my $perl_name = 'perl'; $perl_name = 'ndbgperl' if $Is{VMS} && defined $Config{usevmsdebug} && $Config{usevmsdebug} eq 'define'; # XXX This logic is flawed. If "miniperl" is anywhere in the path # it will get confused. It should be fixed to work only on the filename. # Define 'FULLPERL' to be a non-miniperl (used in test: target) unless ($self->{FULLPERL}) { ($self->{FULLPERL} = $self->{PERL}) =~ s/\Q$miniperl\E$/$perl_name$Config{exe_ext}/i; $self->{FULLPERL} = qq{"$self->{FULLPERL}"}.$perlflags; } # Can't have an image name with quotes, and findperl will have # already escaped spaces. $self->{FULLPERL} =~ tr/"//d if $Is{VMS}; # `dmake` can fail for image (aka, executable) names which start with double-quotes # * push quote inward by at least one character (or the drive prefix, if present) # * including any initial directory separator preserves the `file_name_is_absolute` property $self->{FULLPERL} =~ s/^"(\S(:\\|:)?)/$1"/ if $self->is_make_type('dmake'); # Little hack to get around VMS's find_perl putting "MCR" in front # sometimes. $self->{ABSPERL} = $self->{PERL}; $has_mcr = $self->{ABSPERL} =~ s/^MCR\s*//; if( $self->file_name_is_absolute($self->{ABSPERL}) ) { $self->{ABSPERL} = '$(PERL)'; } else { $self->{ABSPERL} = $self->rel2abs($self->{ABSPERL}); # Quote the perl command if it contains whitespace $self->{ABSPERL} = $self->quote_literal($self->{ABSPERL}) if $self->{ABSPERL} =~ /\s/; $self->{ABSPERL} = 'MCR '.$self->{ABSPERL} if $has_mcr; } $self->{PERL} = qq{"$self->{PERL}"}.$perlflags; # Can't have an image name with quotes, and findperl will have # already escaped spaces. $self->{PERL} =~ tr/"//d if $Is{VMS}; # `dmake` can fail for image (aka, executable) names which start with double-quotes # * push quote inward by at least one character (or the drive prefix, if present) # * including any initial directory separator preserves the `file_name_is_absolute` property $self->{PERL} =~ s/^"(\S(:\\|:)?)/$1"/ if $self->is_make_type('dmake'); # Are we building the core? $self->{PERL_CORE} = $ENV{PERL_CORE} unless exists $self->{PERL_CORE}; $self->{PERL_CORE} = 0 unless defined $self->{PERL_CORE}; # Make sure perl can find itself before it's installed. my $lib_paths = $self->{UNINSTALLED_PERL} || $self->{PERL_CORE} ? ( $self->{PERL_ARCHLIB} && $self->{PERL_LIB} && $self->{PERL_ARCHLIB} ne $self->{PERL_LIB} ) ? q{ "-I$(PERL_LIB)" "-I$(PERL_ARCHLIB)"} : q{ "-I$(PERL_LIB)"} : undef; my $inst_lib_paths = $self->{INST_ARCHLIB} ne $self->{INST_LIB} ? 'RUN)'.$perlflags.' "-I$(INST_ARCHLIB)" "-I$(INST_LIB)"' : 'RUN)'.$perlflags.' "-I$(INST_LIB)"'; # How do we run perl? foreach my $perl (qw(PERL FULLPERL ABSPERL)) { my $run = $perl.'RUN'; $self->{$run} = qq{\$($perl)}; $self->{$run} .= $lib_paths if $lib_paths; $self->{$perl.'RUNINST'} = '$('.$perl.$inst_lib_paths; } return 1; } =item init_platform =item platform_constants Add MM_Unix_VERSION. =cut sub init_platform { my($self) = shift; $self->{MM_Unix_VERSION} = $VERSION; $self->{PERL_MALLOC_DEF} = '-DPERL_EXTMALLOC_DEF -Dmalloc=Perl_malloc '. '-Dfree=Perl_mfree -Drealloc=Perl_realloc '. '-Dcalloc=Perl_calloc'; } sub platform_constants { my($self) = shift; my $make_frag = ''; foreach my $macro (qw(MM_Unix_VERSION PERL_MALLOC_DEF)) { next unless defined $self->{$macro}; $make_frag .= "$macro = $self->{$macro}\n"; } return $make_frag; } =item init_PERM $mm->init_PERM Called by init_main. Initializes PERL_* =cut sub init_PERM { my($self) = shift; $self->{PERM_DIR} = 755 unless defined $self->{PERM_DIR}; $self->{PERM_RW} = 644 unless defined $self->{PERM_RW}; $self->{PERM_RWX} = 755 unless defined $self->{PERM_RWX}; return 1; } =item init_xs $mm->init_xs Sets up macros having to do with XS code. Currently just INST_STATIC, INST_DYNAMIC and INST_BOOT. =cut sub init_xs { my $self = shift; if ($self->has_link_code()) { $self->{INST_STATIC} = $self->catfile('$(INST_ARCHAUTODIR)', '$(BASEEXT)$(LIB_EXT)'); $self->{INST_DYNAMIC} = $self->catfile('$(INST_ARCHAUTODIR)', '$(DLBASE).$(DLEXT)'); $self->{INST_BOOT} = $self->catfile('$(INST_ARCHAUTODIR)', '$(BASEEXT).bs'); if ($self->{XSMULTI}) { my @exts = $self->_xs_list_basenames; my (@statics, @dynamics, @boots); for my $ext (@exts) { my ($v, $d, $f) = File::Spec->splitpath($ext); my @d = File::Spec->splitdir($d); shift @d if defined $d[0] and $d[0] eq 'lib'; pop @d if $d[$#d] eq ''; my $instdir = $self->catdir('$(INST_ARCHLIB)', 'auto', @d, $f); my $instfile = $self->catfile($instdir, $f); push @statics, "$instfile\$(LIB_EXT)"; # Dynamic library names may need special handling. my $dynfile = $instfile; eval { require DynaLoader }; if (defined &DynaLoader::mod2fname) { $dynfile = $self->catfile($instdir, &DynaLoader::mod2fname([@d, $f])); } push @dynamics, "$dynfile.\$(DLEXT)"; push @boots, "$instfile.bs"; } $self->{INST_STATIC} = join ' ', @statics; $self->{INST_DYNAMIC} = join ' ', @dynamics; $self->{INST_BOOT} = join ' ', @boots; } } else { $self->{INST_STATIC} = ''; $self->{INST_DYNAMIC} = ''; $self->{INST_BOOT} = ''; } } =item install (o) Defines the install target. =cut sub install { my($self, %attribs) = @_; my(@m); push @m, q{ install :: pure_install doc_install $(NOECHO) $(NOOP) install_perl :: pure_perl_install doc_perl_install $(NOECHO) $(NOOP) install_site :: pure_site_install doc_site_install $(NOECHO) $(NOOP) install_vendor :: pure_vendor_install doc_vendor_install $(NOECHO) $(NOOP) pure_install :: pure_$(INSTALLDIRS)_install $(NOECHO) $(NOOP) doc_install :: doc_$(INSTALLDIRS)_install $(NOECHO) $(NOOP) pure__install : pure_site_install $(NOECHO) $(ECHO) INSTALLDIRS not defined, defaulting to INSTALLDIRS=site doc__install : doc_site_install $(NOECHO) $(ECHO) INSTALLDIRS not defined, defaulting to INSTALLDIRS=site pure_perl_install :: all $(NOECHO) $(MOD_INSTALL) \ }; push @m, q{ read "}.$self->catfile('$(PERL_ARCHLIB)','auto','$(FULLEXT)','.packlist').q{" \ write "}.$self->catfile('$(DESTINSTALLARCHLIB)','auto','$(FULLEXT)','.packlist').q{" \ } unless $self->{NO_PACKLIST}; push @m, q{ "$(INST_LIB)" "$(DESTINSTALLPRIVLIB)" \ "$(INST_ARCHLIB)" "$(DESTINSTALLARCHLIB)" \ "$(INST_BIN)" "$(DESTINSTALLBIN)" \ "$(INST_SCRIPT)" "$(DESTINSTALLSCRIPT)" \ "$(INST_MAN1DIR)" "$(DESTINSTALLMAN1DIR)" \ "$(INST_MAN3DIR)" "$(DESTINSTALLMAN3DIR)" $(NOECHO) $(WARN_IF_OLD_PACKLIST) \ "}.$self->catdir('$(SITEARCHEXP)','auto','$(FULLEXT)').q{" pure_site_install :: all $(NOECHO) $(MOD_INSTALL) \ }; push @m, q{ read "}.$self->catfile('$(SITEARCHEXP)','auto','$(FULLEXT)','.packlist').q{" \ write "}.$self->catfile('$(DESTINSTALLSITEARCH)','auto','$(FULLEXT)','.packlist').q{" \ } unless $self->{NO_PACKLIST}; push @m, q{ "$(INST_LIB)" "$(DESTINSTALLSITELIB)" \ "$(INST_ARCHLIB)" "$(DESTINSTALLSITEARCH)" \ "$(INST_BIN)" "$(DESTINSTALLSITEBIN)" \ "$(INST_SCRIPT)" "$(DESTINSTALLSITESCRIPT)" \ "$(INST_MAN1DIR)" "$(DESTINSTALLSITEMAN1DIR)" \ "$(INST_MAN3DIR)" "$(DESTINSTALLSITEMAN3DIR)" $(NOECHO) $(WARN_IF_OLD_PACKLIST) \ "}.$self->catdir('$(PERL_ARCHLIB)','auto','$(FULLEXT)').q{" pure_vendor_install :: all $(NOECHO) $(MOD_INSTALL) \ }; push @m, q{ read "}.$self->catfile('$(VENDORARCHEXP)','auto','$(FULLEXT)','.packlist').q{" \ write "}.$self->catfile('$(DESTINSTALLVENDORARCH)','auto','$(FULLEXT)','.packlist').q{" \ } unless $self->{NO_PACKLIST}; push @m, q{ "$(INST_LIB)" "$(DESTINSTALLVENDORLIB)" \ "$(INST_ARCHLIB)" "$(DESTINSTALLVENDORARCH)" \ "$(INST_BIN)" "$(DESTINSTALLVENDORBIN)" \ "$(INST_SCRIPT)" "$(DESTINSTALLVENDORSCRIPT)" \ "$(INST_MAN1DIR)" "$(DESTINSTALLVENDORMAN1DIR)" \ "$(INST_MAN3DIR)" "$(DESTINSTALLVENDORMAN3DIR)" }; push @m, q{ doc_perl_install :: all $(NOECHO) $(NOOP) doc_site_install :: all $(NOECHO) $(NOOP) doc_vendor_install :: all $(NOECHO) $(NOOP) } if $self->{NO_PERLLOCAL}; push @m, q{ doc_perl_install :: all $(NOECHO) $(ECHO) Appending installation info to "$(DESTINSTALLARCHLIB)/perllocal.pod" -$(NOECHO) $(MKPATH) "$(DESTINSTALLARCHLIB)" -$(NOECHO) $(DOC_INSTALL) \ "Module" "$(NAME)" \ "installed into" "$(INSTALLPRIVLIB)" \ LINKTYPE "$(LINKTYPE)" \ VERSION "$(VERSION)" \ EXE_FILES "$(EXE_FILES)" \ >> "}.$self->catfile('$(DESTINSTALLARCHLIB)','perllocal.pod').q{" doc_site_install :: all $(NOECHO) $(ECHO) Appending installation info to "$(DESTINSTALLARCHLIB)/perllocal.pod" -$(NOECHO) $(MKPATH) "$(DESTINSTALLARCHLIB)" -$(NOECHO) $(DOC_INSTALL) \ "Module" "$(NAME)" \ "installed into" "$(INSTALLSITELIB)" \ LINKTYPE "$(LINKTYPE)" \ VERSION "$(VERSION)" \ EXE_FILES "$(EXE_FILES)" \ >> "}.$self->catfile('$(DESTINSTALLARCHLIB)','perllocal.pod').q{" doc_vendor_install :: all $(NOECHO) $(ECHO) Appending installation info to "$(DESTINSTALLARCHLIB)/perllocal.pod" -$(NOECHO) $(MKPATH) "$(DESTINSTALLARCHLIB)" -$(NOECHO) $(DOC_INSTALL) \ "Module" "$(NAME)" \ "installed into" "$(INSTALLVENDORLIB)" \ LINKTYPE "$(LINKTYPE)" \ VERSION "$(VERSION)" \ EXE_FILES "$(EXE_FILES)" \ >> "}.$self->catfile('$(DESTINSTALLARCHLIB)','perllocal.pod').q{" } unless $self->{NO_PERLLOCAL}; push @m, q{ uninstall :: uninstall_from_$(INSTALLDIRS)dirs $(NOECHO) $(NOOP) uninstall_from_perldirs :: $(NOECHO) $(UNINSTALL) "}.$self->catfile('$(PERL_ARCHLIB)','auto','$(FULLEXT)','.packlist').q{" uninstall_from_sitedirs :: $(NOECHO) $(UNINSTALL) "}.$self->catfile('$(SITEARCHEXP)','auto','$(FULLEXT)','.packlist').q{" uninstall_from_vendordirs :: $(NOECHO) $(UNINSTALL) "}.$self->catfile('$(VENDORARCHEXP)','auto','$(FULLEXT)','.packlist').q{" }; join("",@m); } =item installbin (o) Defines targets to make and to install EXE_FILES. =cut sub installbin { my($self) = shift; return "" unless $self->{EXE_FILES} && ref $self->{EXE_FILES} eq "ARRAY"; my @exefiles = sort @{$self->{EXE_FILES}}; return "" unless @exefiles; @exefiles = map vmsify($_), @exefiles if $Is{VMS}; my %fromto; for my $from (@exefiles) { my($path)= $self->catfile('$(INST_SCRIPT)', basename($from)); local($_) = $path; # for backwards compatibility my $to = $self->libscan($path); print "libscan($from) => '$to'\n" if ($Verbose >=2); $to = vmsify($to) if $Is{VMS}; $fromto{$from} = $to; } my @to = sort values %fromto; my @m; push(@m, qq{ EXE_FILES = @exefiles pure_all :: @to \$(NOECHO) \$(NOOP) realclean :: }); # realclean can get rather large. push @m, map "\t$_\n", $self->split_command('$(RM_F)', @to); push @m, "\n"; # A target for each exe file. my @froms = sort keys %fromto; for my $from (@froms) { # 1 2 push @m, _sprintf562 <<'MAKE', $from, $fromto{$from}; %2$s : %1$s $(FIRST_MAKEFILE) $(INST_SCRIPT)$(DFSEP).exists $(INST_BIN)$(DFSEP).exists $(NOECHO) $(RM_F) %2$s $(CP) %1$s %2$s $(FIXIN) %2$s -$(NOECHO) $(CHMOD) $(PERM_RWX) %2$s MAKE } join "", @m; } =item linkext (o) Defines the linkext target which in turn defines the LINKTYPE. =cut # LINKTYPE => static or dynamic or '' sub linkext { my($self, %attribs) = @_; my $linktype = $attribs{LINKTYPE}; $linktype = $self->{LINKTYPE} unless defined $linktype; if (defined $linktype and $linktype eq '') { warn "Warning: LINKTYPE set to '', no longer necessary\n"; } $linktype = '$(LINKTYPE)' unless defined $linktype; " linkext :: $linktype \$(NOECHO) \$(NOOP) "; } =item lsdir Takes as arguments a directory name and a regular expression. Returns all entries in the directory that match the regular expression. =cut sub lsdir { # $self my(undef, $dir, $regex) = @_; opendir(my $dh, defined($dir) ? $dir : ".") or return; my @ls = readdir $dh; closedir $dh; @ls = grep(/$regex/, @ls) if defined $regex; @ls; } =item macro (o) Simple subroutine to insert the macros defined by the macro attribute into the Makefile. =cut sub macro { my($self,%attribs) = @_; my @m; foreach my $key (sort keys %attribs) { my $val = $attribs{$key}; push @m, "$key = $val\n"; } join "", @m; } =item makeaperl (o) Called by staticmake. Defines how to write the Makefile to produce a static new perl. By default the Makefile produced includes all the static extensions in the perl library. (Purified versions of library files, e.g., DynaLoader_pure_p1_c0_032.a are automatically ignored to avoid link errors.) =cut sub makeaperl { my($self, %attribs) = @_; my($makefilename, $searchdirs, $static, $extra, $perlinc, $target, $tmp, $libperl) = @attribs{qw(MAKE DIRS STAT EXTRA INCL TARGET TMP LIBPERL)}; s/^(.*)/"-I$1"/ for @{$perlinc || []}; my(@m); push @m, " # --- MakeMaker makeaperl section --- MAP_TARGET = $target FULLPERL = $self->{FULLPERL} MAP_PERLINC = @{$perlinc || []} "; return join '', @m if $self->{PARENT}; my($dir) = join ":", @{$self->{DIR}}; unless ($self->{MAKEAPERL}) { push @m, q{ $(MAP_TARGET) :: $(MAKE_APERL_FILE) $(MAKE) $(USEMAKEFILE) $(MAKE_APERL_FILE) $@ $(MAKE_APERL_FILE) : static $(FIRST_MAKEFILE) pm_to_blib $(NOECHO) $(ECHO) Writing \"$(MAKE_APERL_FILE)\" for this $(MAP_TARGET) $(NOECHO) $(PERLRUNINST) \ Makefile.PL DIR="}, $dir, q{" \ MAKEFILE=$(MAKE_APERL_FILE) LINKTYPE=static \ MAKEAPERL=1 NORECURS=1 CCCDLFLAGS=}; foreach (@ARGV){ my $arg = $_; # avoid lvalue aliasing if ( $arg =~ /(^.*?=)(.*['\s].*)/ ) { $arg = $1 . $self->quote_literal($2); } push @m, " \\\n\t\t$arg"; } push @m, "\n"; return join '', @m; } my $cccmd = $self->const_cccmd($libperl); $cccmd =~ s/^CCCMD\s*=\s*//; $cccmd =~ s/\$\(INC\)/ "-I$self->{PERL_INC}" /; $cccmd .= " $Config{cccdlflags}" if ($Config{useshrplib} eq 'true'); $cccmd =~ s/\(CC\)/\(PERLMAINCC\)/; # The front matter of the linkcommand... my $linkcmd = join ' ', "\$(CC)", grep($_, @Config{qw(ldflags ccdlflags)}); $linkcmd =~ s/\s+/ /g; $linkcmd =~ s,(perl\.exp),\$(PERL_INC)/$1,; # Which *.a files could we make use of... my $staticlib21 = $self->_find_static_libs($searchdirs); # We trust that what has been handed in as argument, will be buildable $static = [] unless $static; @$staticlib21{@{$static}} = (1) x @{$static}; $extra = [] unless $extra && ref $extra eq 'ARRAY'; for (sort keys %$staticlib21) { next unless /\Q$self->{LIB_EXT}\E\z/; $_ = dirname($_) . "/extralibs.ld"; push @$extra, $_; } s/^(.*)/"-I$1"/ for @{$perlinc || []}; $target ||= "perl"; $tmp ||= "."; # MAP_STATIC doesn't look into subdirs yet. Once "all" is made and we # regenerate the Makefiles, MAP_STATIC and the dependencies for # extralibs.all are computed correctly my @map_static = reverse sort keys %$staticlib21; push @m, " MAP_LINKCMD = $linkcmd MAP_STATIC = ", join(" \\\n\t", map { qq{"$_"} } @map_static), " MAP_STATICDEP = ", join(' ', map { $self->quote_dep($_) } @map_static), " MAP_PRELIBS = $Config{perllibs} $Config{cryptlib} "; my $lperl; if (defined $libperl) { ($lperl = $libperl) =~ s/\$\(A\)/$self->{LIB_EXT}/; } unless ($libperl && -f $lperl) { # Ilya's code... my $dir = $self->{PERL_SRC} || "$self->{PERL_ARCHLIB}/CORE"; $dir = "$self->{PERL_ARCHLIB}/.." if $self->{UNINSTALLED_PERL}; $libperl ||= "libperl$self->{LIB_EXT}"; $libperl = "$dir/$libperl"; $lperl ||= "libperl$self->{LIB_EXT}"; $lperl = "$dir/$lperl"; if (! -f $libperl and ! -f $lperl) { # We did not find a static libperl. Maybe there is a shared one? if ($Is{SunOS}) { $lperl = $libperl = "$dir/$Config{libperl}"; # SUNOS ld does not take the full path to a shared library $libperl = '' if $Is{SunOS4}; } } print <{PERL_SRC}); Warning: $libperl not found If you're going to build a static perl binary, make sure perl is installed otherwise ignore this warning EOF } # SUNOS ld does not take the full path to a shared library my $llibperl = $libperl ? '$(MAP_LIBPERL)' : '-lperl'; my $libperl_dep = $self->quote_dep($libperl); push @m, " MAP_LIBPERL = $libperl MAP_LIBPERLDEP = $libperl_dep LLIBPERL = $llibperl "; push @m, ' $(INST_ARCHAUTODIR)/extralibs.all : $(INST_ARCHAUTODIR)$(DFSEP).exists '.join(" \\\n\t", @$extra).' $(NOECHO) $(RM_F) $@ $(NOECHO) $(TOUCH) $@ '; foreach my $catfile (@$extra){ push @m, "\tcat $catfile >> \$\@\n"; } my $ldfrom = $self->{XSMULTI} ? '' : '$(LDFROM)'; # 1 2 3 4 push @m, _sprintf562 <<'EOF', $tmp, $ldfrom, $self->xs_obj_opt('$@'), $makefilename; $(MAP_TARGET) :: %1$s/perlmain$(OBJ_EXT) $(MAP_LIBPERLDEP) $(MAP_STATICDEP) $(INST_ARCHAUTODIR)/extralibs.all $(MAP_LINKCMD) %2$s $(OPTIMIZE) %1$s/perlmain$(OBJ_EXT) %3$s $(MAP_STATIC) "$(LLIBPERL)" `cat $(INST_ARCHAUTODIR)/extralibs.all` $(MAP_PRELIBS) $(NOECHO) $(ECHO) "To install the new '$(MAP_TARGET)' binary, call" $(NOECHO) $(ECHO) " $(MAKE) $(USEMAKEFILE) %4$s inst_perl MAP_TARGET=$(MAP_TARGET)" $(NOECHO) $(ECHO) " $(MAKE) $(USEMAKEFILE) %4$s map_clean" %1$s/perlmain\$(OBJ_EXT): %1$s/perlmain.c EOF push @m, "\t".$self->cd($tmp, qq[$cccmd "-I\$(PERL_INC)" perlmain.c])."\n"; my $maybe_DynaLoader = $Config{usedl} ? 'q(DynaLoader)' : ''; push @m, _sprintf562 <<'EOF', $tmp, $makefilename, $maybe_DynaLoader; %1$s/perlmain.c: %2$s $(NOECHO) $(ECHO) Writing $@ $(NOECHO) $(PERL) $(MAP_PERLINC) "-MExtUtils::Miniperl" \ -e "writemain(grep(s#.*/auto/##s, @ARGV), %3$s)" $(MAP_STATIC) > $@t $(MV) $@t $@ EOF push @m, "\t", q{$(NOECHO) $(PERL) "$(INSTALLSCRIPT)/fixpmain" } if (defined (&Dos::UseLFN) && Dos::UseLFN()==0); push @m, q{ doc_inst_perl : $(NOECHO) $(ECHO) Appending installation info to "$(DESTINSTALLARCHLIB)/perllocal.pod" -$(NOECHO) $(MKPATH) "$(DESTINSTALLARCHLIB)" -$(NOECHO) $(DOC_INSTALL) \ "Perl binary" "$(MAP_TARGET)" \ MAP_STATIC "$(MAP_STATIC)" \ MAP_EXTRA "`cat $(INST_ARCHAUTODIR)/extralibs.all`" \ MAP_LIBPERL "$(MAP_LIBPERL)" \ >> "}.$self->catfile('$(DESTINSTALLARCHLIB)','perllocal.pod').q{" }; push @m, q{ inst_perl : pure_inst_perl doc_inst_perl pure_inst_perl : $(MAP_TARGET) }.$self->{CP}.q{ $(MAP_TARGET) "}.$self->catfile('$(DESTINSTALLBIN)','$(MAP_TARGET)').q{" clean :: map_clean map_clean : }.$self->{RM_F}.qq{ $tmp/perlmain\$(OBJ_EXT) $tmp/perlmain.c \$(MAP_TARGET) $makefilename \$(INST_ARCHAUTODIR)/extralibs.all }; join '', @m; } # utility method sub _find_static_libs { my ($self, $searchdirs) = @_; # don't use File::Spec here because on Win32 F::F still uses "/" my $installed_version = join('/', 'auto', $self->{FULLEXT}, "$self->{BASEEXT}$self->{LIB_EXT}" ); my %staticlib21; require File::Find; File::Find::find(sub { if ($File::Find::name =~ m{/auto/share\z}) { # in a subdir of auto/share, prune because e.g. # Alien::pkgconfig uses File::ShareDir to put .a files # there. do not want $File::Find::prune = 1; return; } return unless m/\Q$self->{LIB_EXT}\E$/; return unless -f 'extralibs.ld'; # this checks is a "proper" XS installation # Skip perl's libraries. return if m/^libperl/ or m/^perl\Q$self->{LIB_EXT}\E$/; # Skip purified versions of libraries # (e.g., DynaLoader_pure_p1_c0_032.a) return if m/_pure_\w+_\w+_\w+\.\w+$/ and -f "$File::Find::dir/.pure"; if( exists $self->{INCLUDE_EXT} ){ my $found = 0; (my $xx = $File::Find::name) =~ s,.*?/auto/,,s; $xx =~ s,/?$_,,; $xx =~ s,/,::,g; # Throw away anything not explicitly marked for inclusion. # DynaLoader is implied. foreach my $incl ((@{$self->{INCLUDE_EXT}},'DynaLoader')){ if( $xx eq $incl ){ $found++; last; } } return unless $found; } elsif( exists $self->{EXCLUDE_EXT} ){ (my $xx = $File::Find::name) =~ s,.*?/auto/,,s; $xx =~ s,/?$_,,; $xx =~ s,/,::,g; # Throw away anything explicitly marked for exclusion foreach my $excl (@{$self->{EXCLUDE_EXT}}){ return if( $xx eq $excl ); } } # don't include the installed version of this extension. I # leave this line here, although it is not necessary anymore: # I patched minimod.PL instead, so that Miniperl.pm won't # include duplicates # Once the patch to minimod.PL is in the distribution, I can # drop it return if $File::Find::name =~ m:\Q$installed_version\E\z:; return if !$self->xs_static_lib_is_xs($_); use Cwd 'cwd'; $staticlib21{cwd() . "/" . $_}++; }, grep( -d $_, map { $self->catdir($_, 'auto') } @{$searchdirs || []}) ); return \%staticlib21; } =item xs_static_lib_is_xs (o) Called by a utility method of makeaperl. Checks whether a given file is an XS library by seeing whether it defines any symbols starting with C (with an optional leading underscore - needed on MacOS). =cut sub xs_static_lib_is_xs { my ($self, $libfile) = @_; my $devnull = File::Spec->devnull; return `nm $libfile 2>$devnull` =~ /\b_?boot_/; } =item makefile (o) Defines how to rewrite the Makefile. =cut sub makefile { my($self) = shift; my $m; # We do not know what target was originally specified so we # must force a manual rerun to be sure. But as it should only # happen very rarely it is not a significant problem. $m = ' $(OBJECT) : $(FIRST_MAKEFILE) ' if $self->{OBJECT}; my $newer_than_target = $Is{VMS} ? '$(MMS$SOURCE_LIST)' : '$?'; my $mpl_args = join " ", map qq["$_"], @ARGV; my $cross = ''; if (defined $::Cross::platform) { # Inherited from win32/buildext.pl $cross = "-MCross=$::Cross::platform "; } $m .= sprintf <<'MAKE_FRAG', $newer_than_target, $cross, $mpl_args; # We take a very conservative approach here, but it's worth it. # We move Makefile to Makefile.old here to avoid gnu make looping. $(FIRST_MAKEFILE) : Makefile.PL $(CONFIGDEP) $(NOECHO) $(ECHO) "Makefile out-of-date with respect to %s" $(NOECHO) $(ECHO) "Cleaning current config before rebuilding Makefile..." -$(NOECHO) $(RM_F) $(MAKEFILE_OLD) -$(NOECHO) $(MV) $(FIRST_MAKEFILE) $(MAKEFILE_OLD) - $(MAKE) $(USEMAKEFILE) $(MAKEFILE_OLD) clean $(DEV_NULL) $(PERLRUN) %sMakefile.PL %s $(NOECHO) $(ECHO) "==> Your Makefile has been rebuilt. <==" $(NOECHO) $(ECHO) "==> Please rerun the $(MAKE) command. <==" $(FALSE) MAKE_FRAG return $m; } =item maybe_command Returns true, if the argument is likely to be a command. =cut sub maybe_command { my($self,$file) = @_; return $file if -x $file && ! -d $file; return; } =item needs_linking (o) Does this module need linking? Looks into subdirectory objects (see also has_link_code()) =cut sub needs_linking { my($self) = shift; my $caller = (caller(0))[3]; confess("needs_linking called too early") if $caller =~ /^ExtUtils::MakeMaker::/; return $self->{NEEDS_LINKING} if defined $self->{NEEDS_LINKING}; if ($self->has_link_code or $self->{MAKEAPERL}){ $self->{NEEDS_LINKING} = 1; return 1; } foreach my $child (keys %{$self->{CHILDREN}}) { if ($self->{CHILDREN}->{$child}->needs_linking) { $self->{NEEDS_LINKING} = 1; return 1; } } return $self->{NEEDS_LINKING} = 0; } =item parse_abstract parse a file and return what you think is the ABSTRACT =cut sub parse_abstract { my($self,$parsefile) = @_; my $result; local $/ = "\n"; open(my $fh, '<', $parsefile) or die "Could not open '$parsefile': $!"; binmode $fh; my $inpod = 0; my $pod_encoding; my $package = $self->{DISTNAME}; $package =~ s/-/::/g; while (<$fh>) { $inpod = /^=(?!cut)/ ? 1 : /^=cut/ ? 0 : $inpod; next if !$inpod; s#\r*\n\z##; # handle CRLF input if ( /^=encoding\s*(.*)$/i ) { $pod_encoding = $1; } if ( /^($package(?:\.pm)? \s+ -+ \s+)(.*)/x ) { $result = $2; next; } next unless $result; if ( $result && ( /^\s*$/ || /^\=/ ) ) { last; } $result = join ' ', $result, $_; } close $fh; if ( $pod_encoding and !( "$]" < 5.008 or !$Config{useperlio} ) ) { # Have to wrap in an eval{} for when running under PERL_CORE # Encode isn't available during build phase and parsing # ABSTRACT isn't important there eval { require Encode; $result = Encode::decode($pod_encoding, $result); } } return $result; } =item parse_version my $version = MM->parse_version($file); Parse a $file and return what $VERSION is set to by the first assignment. It will return the string "undef" if it can't figure out what $VERSION is. $VERSION should be for all to see, so C or plain $VERSION are okay, but C is not. C is also checked for. The first version declaration found is used, but this may change as it differs from how Perl does it. parse_version() will try to C before checking for C<$VERSION> so the following will work. $VERSION = qv(1.2.3); =cut sub parse_version { my($self,$parsefile) = @_; my $result; local $/ = "\n"; local $_; open(my $fh, '<', $parsefile) or die "Could not open '$parsefile': $!"; my $inpod = 0; while (<$fh>) { $inpod = /^=(?!cut)/ ? 1 : /^=cut/ ? 0 : $inpod; next if $inpod || /^\s*#/; chop; next if /^\s*(if|unless|elsif)/; if ( m{^ \s* package \s+ \w[\w\:\']* \s+ (v?[0-9._]+) \s* (;|\{) }x ) { local $^W = 0; $result = $1; } elsif ( m{(?=!])\=[^=]}x ) { $result = $self->get_version($parsefile, $1, $2); } else { next; } last if defined $result; } close $fh; if ( defined $result && $result !~ /^v?[\d_\.]+$/ ) { require version; my $normal = eval { version->new( $result ) }; $result = $normal if defined $normal; } $result = "undef" unless defined $result; return $result; } sub get_version { my ($self, $parsefile, $sigil, $name) = @_; my $line = $_; # from the while() loop in parse_version { package ExtUtils::MakeMaker::_version; undef *version; # in case of unexpected version() sub eval { require version; version::->import; }; no strict; local *{$name}; local $^W = 0; $line = $1 if $line =~ m{^(.+)}s; eval($line); ## no critic return ${$name}; } } =item pasthru (o) Defines the string that is passed to recursive make calls in subdirectories. The variables like C are used in each level, and passed downwards on the command-line with e.g. the value of that level's DEFINE. Example: # Level 0 has DEFINE = -Dfunky # This code will define level 0's PASTHRU=PASTHRU_DEFINE="$(DEFINE) # $(PASTHRU_DEFINE)" # Level 0's $(CCCMD) will include macros $(DEFINE) and $(PASTHRU_DEFINE) # So will level 1's, so when level 1 compiles, it will get right values # And so ad infinitum =cut sub pasthru { my($self) = shift; my(@m); my(@pasthru); my($sep) = $Is{VMS} ? ',' : ''; $sep .= "\\\n\t"; foreach my $key (qw(LIB LIBPERL_A LINKTYPE OPTIMIZE PREFIX INSTALL_BASE) ) { next unless defined $self->{$key}; push @pasthru, "$key=\"\$($key)\""; } foreach my $key (qw(DEFINE INC)) { # default to the make var my $val = qq{\$($key)}; # expand within perl if given since need to use quote_literal # since INC might include space-protecting ""! chomp($val = $self->{$key}) if defined $self->{$key}; $val .= " \$(PASTHRU_$key)"; my $quoted = $self->quote_literal($val); push @pasthru, qq{PASTHRU_$key=$quoted}; } push @m, "\nPASTHRU = ", join ($sep, @pasthru), "\n"; join "", @m; } =item perl_script Takes one argument, a file name, and returns the file name, if the argument is likely to be a perl script. On MM_Unix this is true for any ordinary, readable file. =cut sub perl_script { my($self,$file) = @_; return $file if -r $file && -f _; return; } =item perldepend (o) Defines the dependency from all *.h files that come with the perl distribution. =cut sub perldepend { my($self) = shift; my(@m); my $make_config = $self->cd('$(PERL_SRC)', '$(MAKE) lib/Config.pm'); push @m, sprintf <<'MAKE_FRAG', $make_config if $self->{PERL_SRC}; # Check for unpropogated config.sh changes. Should never happen. # We do NOT just update config.h because that is not sufficient. # An out of date config.h is not fatal but complains loudly! $(PERL_INCDEP)/config.h: $(PERL_SRC)/config.sh -$(NOECHO) $(ECHO) "Warning: $(PERL_INC)/config.h out of date with $(PERL_SRC)/config.sh"; $(FALSE) $(PERL_ARCHLIB)/Config.pm: $(PERL_SRC)/config.sh $(NOECHO) $(ECHO) "Warning: $(PERL_ARCHLIB)/Config.pm may be out of date with $(PERL_SRC)/config.sh" %s MAKE_FRAG return join "", @m unless $self->needs_linking; if ($self->{OBJECT}) { # Need to add an object file dependency on the perl headers. # this is very important for XS modules in perl.git development. push @m, $self->_perl_header_files_fragment("/"); # Directory separator between $(PERL_INC)/header.h } push @m, join(" ", sort values %{$self->{XS}})." : \$(XSUBPPDEPS)\n" if %{$self->{XS}}; return join "\n", @m; } =item pm_to_blib Defines target that copies all files in the hash PM to their destination and autosplits them. See L =cut sub pm_to_blib { my $self = shift; my($autodir) = $self->catdir('$(INST_LIB)','auto'); my $r = q{ pm_to_blib : $(FIRST_MAKEFILE) $(TO_INST_PM) }; # VMS will swallow '' and PM_FILTER is often empty. So use q[] my $pm_to_blib = $self->oneliner(<split_command($pm_to_blib, map { ($self->quote_literal($_) => $self->quote_literal($self->{PM}->{$_})) } sort keys %{$self->{PM}}); $r .= join '', map { "\t\$(NOECHO) $_\n" } @cmds; $r .= qq{\t\$(NOECHO) \$(TOUCH) pm_to_blib\n}; return $r; } # transform dot-separated version string into comma-separated quadruple # examples: '1.2.3.4.5' => '1,2,3,4' # '1.2.3' => '1,2,3,0' sub _ppd_version { my ($self, $string) = @_; return join ',', ((split /\./, $string), (0) x 4)[0..3]; } =item ppd Defines target that creates a PPD (Perl Package Description) file for a binary distribution. =cut sub ppd { my($self) = @_; my $abstract = $self->{ABSTRACT} || ''; $abstract =~ s/\n/\\n/sg; $abstract =~ s//>/g; my $author = join(', ',@{ ref $self->{AUTHOR} eq 'ARRAY' ? $self->{AUTHOR} : [ $self->{AUTHOR} || '']}); $author =~ s//>/g; my $ppd_file = "$self->{DISTNAME}.ppd"; my @ppd_chunks = qq(\n); push @ppd_chunks, sprintf <<'PPD_HTML', $abstract, $author; %s %s PPD_HTML push @ppd_chunks, " \n"; if ( $self->{MIN_PERL_VERSION} ) { my $min_perl_version = $self->_ppd_version($self->{MIN_PERL_VERSION}); push @ppd_chunks, sprintf <<'PPD_PERLVERS', $min_perl_version; PPD_PERLVERS } # Don't add "perl" to requires. perl dependencies are # handles by ARCHITECTURE. my %prereqs = %{$self->{PREREQ_PM}}; delete $prereqs{perl}; # Build up REQUIRE foreach my $prereq (sort keys %prereqs) { my $name = $prereq; $name .= '::' unless $name =~ /::/; my $version = $prereqs{$prereq}; my %attrs = ( NAME => $name ); $attrs{VERSION} = $version if $version; my $attrs = join " ", map { qq[$_="$attrs{$_}"] } sort keys %attrs; push @ppd_chunks, qq( \n); } my $archname = $Config{archname}; if ("$]" >= 5.008) { # archname did not change from 5.6 to 5.8, but those versions may # not be not binary compatible so now we append the part of the # version that changes when binary compatibility may change $archname .= "-$Config{PERL_REVISION}.$Config{PERL_VERSION}"; } push @ppd_chunks, sprintf <<'PPD_OUT', $archname; PPD_OUT if ($self->{PPM_INSTALL_SCRIPT}) { if ($self->{PPM_INSTALL_EXEC}) { push @ppd_chunks, sprintf qq{ %s\n}, $self->{PPM_INSTALL_EXEC}, $self->{PPM_INSTALL_SCRIPT}; } else { push @ppd_chunks, sprintf qq{ %s\n}, $self->{PPM_INSTALL_SCRIPT}; } } if ($self->{PPM_UNINSTALL_SCRIPT}) { if ($self->{PPM_UNINSTALL_EXEC}) { push @ppd_chunks, sprintf qq{ %s\n}, $self->{PPM_UNINSTALL_EXEC}, $self->{PPM_UNINSTALL_SCRIPT}; } else { push @ppd_chunks, sprintf qq{ %s\n}, $self->{PPM_UNINSTALL_SCRIPT}; } } my ($bin_location) = $self->{BINARY_LOCATION} || ''; $bin_location =~ s/\\/\\\\/g; push @ppd_chunks, sprintf <<'PPD_XML', $bin_location; PPD_XML my @ppd_cmds = $self->stashmeta(join('', @ppd_chunks), $ppd_file); return sprintf <<'PPD_OUT', join "\n\t", @ppd_cmds; # Creates a PPD (Perl Package Description) for a binary distribution. ppd : %s PPD_OUT } =item prefixify $MM->prefixify($var, $prefix, $new_prefix, $default); Using either $MM->{uc $var} || $Config{lc $var}, it will attempt to replace it's $prefix with a $new_prefix. Should the $prefix fail to match I a PREFIX was given as an argument to WriteMakefile() it will set it to the $new_prefix + $default. This is for systems whose file layouts don't neatly fit into our ideas of prefixes. This is for heuristics which attempt to create directory structures that mirror those of the installed perl. For example: $MM->prefixify('installman1dir', '/usr', '/home/foo', 'man/man1'); this will attempt to remove '/usr' from the front of the $MM->{INSTALLMAN1DIR} path (initializing it to $Config{installman1dir} if necessary) and replace it with '/home/foo'. If this fails it will simply use '/home/foo/man/man1'. =cut sub prefixify { my($self,$var,$sprefix,$rprefix,$default) = @_; my $path = $self->{uc $var} || $Config_Override{lc $var} || $Config{lc $var} || ''; $rprefix .= '/' if $sprefix =~ m|/$|; warn " prefixify $var => $path\n" if $Verbose >= 2; warn " from $sprefix to $rprefix\n" if $Verbose >= 2; if( $self->{ARGS}{PREFIX} && $path !~ s{^\Q$sprefix\E\b}{$rprefix}s ) { warn " cannot prefix, using default.\n" if $Verbose >= 2; warn " no default!\n" if !$default && $Verbose >= 2; $path = $self->catdir($rprefix, $default) if $default; } print " now $path\n" if $Verbose >= 2; return $self->{uc $var} = $path; } =item processPL (o) Defines targets to run *.PL files. =cut sub processPL { my $self = shift; my $pl_files = $self->{PL_FILES}; return "" unless $pl_files; my $m = ''; foreach my $plfile (sort keys %$pl_files) { my $targets = $pl_files->{$plfile}; my $list = ref($targets) eq 'HASH' ? [ sort keys %$targets ] : ref($targets) eq 'ARRAY' ? $pl_files->{$plfile} : [$pl_files->{$plfile}]; foreach my $target (@$list) { if( $Is{VMS} ) { $plfile = vmsify($self->eliminate_macros($plfile)); $target = vmsify($self->eliminate_macros($target)); } # Normally a .PL file runs AFTER pm_to_blib so it can have # blib in its @INC and load the just built modules. BUT if # the generated module is something in $(TO_INST_PM) which # pm_to_blib depends on then it can't depend on pm_to_blib # else we have a dependency loop. my $pm_dep; my $perlrun; if( defined $self->{PM}{$target} ) { $pm_dep = ''; $perlrun = 'PERLRUN'; } else { $pm_dep = 'pm_to_blib'; $perlrun = 'PERLRUNINST'; } my $extra_inputs = ''; if( ref($targets) eq 'HASH' ) { my $inputs = ref($targets->{$target}) ? $targets->{$target} : [$targets->{$target}]; for my $input (@$inputs) { if( $Is{VMS} ) { $input = vmsify($self->eliminate_macros($input)); } $extra_inputs .= ' '.$input; } } $m .= < in command line arguments. Doesn't handle recursive Makefile C<$(...)> constructs, but handles simple ones. =cut sub quote_paren { my $arg = shift; $arg =~ s{\$\((.+?)\)}{\$\\\\($1\\\\)}g; # protect $(...) $arg =~ s{(?replace_manpage_separator($file_path); Takes the name of a package, which may be a nested package, in the form 'Foo/Bar.pm' and replaces the slash with C<::> or something else safe for a man page file name. Returns the replacement. =cut sub replace_manpage_separator { my($self,$man) = @_; $man =~ s,/+,::,g; return $man; } =item cd =cut sub cd { my($self, $dir, @cmds) = @_; # No leading tab and no trailing newline makes for easier embedding my $make_frag = join "\n\t", map { "cd $dir && $_" } @cmds; return $make_frag; } =item oneliner =cut sub oneliner { my($self, $cmd, $switches) = @_; $switches = [] unless defined $switches; # Strip leading and trailing newlines $cmd =~ s{^\n+}{}; $cmd =~ s{\n+$}{}; my @cmds = split /\n/, $cmd; $cmd = join " \n\t -e ", map $self->quote_literal($_), @cmds; $cmd = $self->escape_newlines($cmd); $switches = join ' ', @$switches; return qq{\$(ABSPERLRUN) $switches -e $cmd --}; } =item quote_literal Quotes macro literal value suitable for being used on a command line so that when expanded by make, will be received by command as given to this method: my $quoted = $mm->quote_literal(q{it isn't}); # returns: # 'it isn'\''t' print MAKEFILE "target:\n\techo $quoted\n"; # when run "make target", will output: # it isn't =cut sub quote_literal { my($self, $text, $opts) = @_; $opts->{allow_variables} = 1 unless defined $opts->{allow_variables}; # Quote single quotes $text =~ s{'}{'\\''}g; $text = $opts->{allow_variables} ? $self->escape_dollarsigns($text) : $self->escape_all_dollarsigns($text); return "'$text'"; } =item escape_newlines =cut sub escape_newlines { my($self, $text) = @_; $text =~ s{\n}{\\\n}g; return $text; } =item max_exec_len Using POSIX::ARG_MAX. Otherwise falling back to 4096. =cut sub max_exec_len { my $self = shift; if (!defined $self->{_MAX_EXEC_LEN}) { if (my $arg_max = eval { require POSIX; &POSIX::ARG_MAX }) { $self->{_MAX_EXEC_LEN} = $arg_max; } else { # POSIX minimum exec size $self->{_MAX_EXEC_LEN} = 4096; } } return $self->{_MAX_EXEC_LEN}; } =item static (o) Defines the static target. =cut sub static { # --- Static Loading Sections --- my($self) = shift; ' ## $(INST_PM) has been moved to the all: target. ## It remains here for awhile to allow for old usage: "make static" static :: $(FIRST_MAKEFILE) $(INST_STATIC) $(NOECHO) $(NOOP) '; } sub static_lib { my($self) = @_; return '' unless $self->has_link_code; my(@m); my @libs; if ($self->{XSMULTI}) { for my $ext ($self->_xs_list_basenames) { my ($v, $d, $f) = File::Spec->splitpath($ext); my @d = File::Spec->splitdir($d); shift @d if $d[0] eq 'lib'; my $instdir = $self->catdir('$(INST_ARCHLIB)', 'auto', @d, $f); my $instfile = $self->catfile($instdir, "$f\$(LIB_EXT)"); my $objfile = "$ext\$(OBJ_EXT)"; push @libs, [ $objfile, $instfile, $instdir ]; } } else { @libs = ([ qw($(OBJECT) $(INST_STATIC) $(INST_ARCHAUTODIR)) ]); } push @m, map { $self->xs_make_static_lib(@$_); } @libs; join "\n", @m; } =item xs_make_static_lib Defines the recipes for the C section. =cut sub xs_make_static_lib { my ($self, $from, $to, $todir) = @_; my @m = sprintf '%s: %s $(MYEXTLIB) %s$(DFSEP).exists'."\n", $to, $from, $todir; push @m, "\t\$(RM_F) \"\$\@\"\n"; push @m, $self->static_lib_fixtures; push @m, $self->static_lib_pure_cmd($from); push @m, "\t\$(CHMOD) \$(PERM_RWX) \$\@\n"; push @m, $self->static_lib_closures($todir); join '', @m; } =item static_lib_closures Records C<$(EXTRALIBS)> in F and F<$(PERL_SRC)/ext.libs>. =cut sub static_lib_closures { my ($self, $todir) = @_; my @m = sprintf <<'MAKE_FRAG', $todir; $(NOECHO) $(ECHO) "$(EXTRALIBS)" > %s$(DFSEP)extralibs.ld MAKE_FRAG # Old mechanism - still available: push @m, <<'MAKE_FRAG' if $self->{PERL_SRC} && $self->{EXTRALIBS}; $(NOECHO) $(ECHO) "$(EXTRALIBS)" >> $(PERL_SRC)$(DFSEP)ext.libs MAKE_FRAG @m; } =item static_lib_fixtures Handles copying C<$(MYEXTLIB)> as starter for final static library that then gets added to. =cut sub static_lib_fixtures { my ($self) = @_; # If this extension has its own library (eg SDBM_File) # then copy that to $(INST_STATIC) and add $(OBJECT) into it. return unless $self->{MYEXTLIB}; "\t\$(CP) \$(MYEXTLIB) \"\$\@\"\n"; } =item static_lib_pure_cmd Defines how to run the archive utility. =cut sub static_lib_pure_cmd { my ($self, $from) = @_; my $ar; if (exists $self->{FULL_AR} && -x $self->{FULL_AR}) { # Prefer the absolute pathed ar if available so that PATH # doesn't confuse us. Perl itself is built with the full_ar. $ar = 'FULL_AR'; } else { $ar = 'AR'; } sprintf <<'MAKE_FRAG', $ar, $from; $(%s) $(AR_STATIC_ARGS) "$@" %s $(RANLIB) "$@" MAKE_FRAG } =item staticmake (o) Calls makeaperl. =cut sub staticmake { my($self, %attribs) = @_; my(@static); my(@searchdirs)=($self->{PERL_ARCHLIB}, $self->{SITEARCHEXP}, $self->{INST_ARCHLIB}); # And as it's not yet built, we add the current extension # but only if it has some C code (or XS code, which implies C code) if (@{$self->{C}}) { @static = $self->catfile($self->{INST_ARCHLIB}, "auto", $self->{FULLEXT}, "$self->{BASEEXT}$self->{LIB_EXT}" ); } # Either we determine now, which libraries we will produce in the # subdirectories or we do it at runtime of the make. # We could ask all subdir objects, but I cannot imagine, why it # would be necessary. # Instead we determine all libraries for the new perl at # runtime. my(@perlinc) = ($self->{INST_ARCHLIB}, $self->{INST_LIB}, $self->{PERL_ARCHLIB}, $self->{PERL_LIB}); $self->makeaperl(MAKE => $self->{MAKEFILE}, DIRS => \@searchdirs, STAT => \@static, INCL => \@perlinc, TARGET => $self->{MAP_TARGET}, TMP => "", LIBPERL => $self->{LIBPERL_A} ); } =item subdir_x (o) Helper subroutine for subdirs =cut sub subdir_x { my($self, $subdir) = @_; my $subdir_cmd = $self->cd($subdir, '$(MAKE) $(USEMAKEFILE) $(FIRST_MAKEFILE) all $(PASTHRU)' ); return sprintf <<'EOT', $subdir_cmd; subdirs :: $(NOECHO) %s EOT } =item subdirs (o) Defines targets to process subdirectories. =cut sub subdirs { # --- Sub-directory Sections --- my($self) = shift; my(@m); # This method provides a mechanism to automatically deal with # subdirectories containing further Makefile.PL scripts. # It calls the subdir_x() method for each subdirectory. foreach my $dir (@{$self->{DIR}}){ push @m, $self->subdir_x($dir); #### print "Including $dir subdirectory\n"; } if (@m){ unshift @m, <<'EOF'; # The default clean, realclean and test targets in this Makefile # have automatically been given entries for each subdir. EOF } else { push(@m, "\n# none") } join('',@m); } =item test (o) Defines the test targets. =cut sub test { my($self, %attribs) = @_; my $tests = $attribs{TESTS} || ''; if (!$tests && -d 't' && defined $attribs{RECURSIVE_TEST_FILES}) { $tests = $self->find_tests_recursive; } elsif (!$tests && -d 't') { $tests = $self->find_tests; } # have to do this because nmake is broken $tests =~ s!/!\\!g if $self->is_make_type('nmake'); # note: 'test.pl' name is also hardcoded in init_dirscan() my @m; my $default_testtype = $Config{usedl} ? 'dynamic' : 'static'; push @m, <{SKIPHASH}{$_}, $linktype, "pure_all"; # no depend on a linktype if SKIPped push @m, "subdirs-test_$linktype :: $directdeps\n"; foreach my $dir (@{ $self->{DIR} }) { my $test = $self->cd($dir, "\$(MAKE) test_$linktype \$(PASTHRU)"); push @m, "\t\$(NOECHO) $test\n"; } push @m, "\n"; if ($tests or -f "test.pl") { for my $testspec ([ '', '' ], [ 'db', ' $(TESTDB_SW)' ]) { my ($db, $switch) = @$testspec; my ($command, $deps); # if testdb, build all but don't test all $deps = $db eq 'db' ? $directdeps : "subdirs-test_$linktype"; if ($linktype eq 'static' and $self->needs_linking) { my $target = File::Spec->rel2abs('$(MAP_TARGET)'); $command = qq{"$target" \$(MAP_PERLINC)}; $deps .= ' $(MAP_TARGET)'; } else { $command = '$(FULLPERLRUN)' . $switch; } push @m, "test${db}_$linktype :: $deps\n"; if ($db eq 'db') { push @m, $self->test_via_script($command, '$(TEST_FILE)') } else { push @m, $self->test_via_script($command, '$(TEST_FILE)') if -f "test.pl"; push @m, $self->test_via_harness($command, '$(TEST_FILES)') if $tests; } push @m, "\n"; } } else { push @m, _sprintf562 <<'EOF', $linktype; testdb_%1$s test_%1$s :: subdirs-test_%1$s $(NOECHO) $(ECHO) 'No tests defined for $(NAME) extension.' EOF } } join "", @m; } =item test_via_harness (override) For some reason which I forget, Unix machines like to have PERL_DL_NONLAZY set for tests. =cut sub test_via_harness { my($self, $perl, $tests) = @_; return $self->SUPER::test_via_harness("PERL_DL_NONLAZY=1 $perl", $tests); } =item test_via_script (override) Again, the PERL_DL_NONLAZY thing. =cut sub test_via_script { my($self, $perl, $script) = @_; return $self->SUPER::test_via_script("PERL_DL_NONLAZY=1 $perl", $script); } =item tool_xsubpp (o) Determines typemaps, xsubpp version, prototype behaviour. =cut sub tool_xsubpp { my($self) = shift; return "" unless $self->needs_linking; my $xsdir; my @xsubpp_dirs = @INC; # Make sure we pick up the new xsubpp if we're building perl. unshift @xsubpp_dirs, $self->{PERL_LIB} if $self->{PERL_CORE}; my $foundxsubpp = 0; foreach my $dir (@xsubpp_dirs) { $xsdir = $self->catdir($dir, 'ExtUtils'); if( -r $self->catfile($xsdir, "xsubpp") ) { $foundxsubpp = 1; last; } } die "ExtUtils::MM_Unix::tool_xsubpp : Can't find xsubpp" if !$foundxsubpp; my $tmdir = $self->catdir($self->{PERL_LIB},"ExtUtils"); my(@tmdeps) = $self->catfile($tmdir,'typemap'); if( $self->{TYPEMAPS} ){ foreach my $typemap (@{$self->{TYPEMAPS}}){ if( ! -f $typemap ) { warn "Typemap $typemap not found.\n"; } else { $typemap = vmsify($typemap) if $Is{VMS}; push(@tmdeps, $typemap); } } } push(@tmdeps, "typemap") if -f "typemap"; # absolutised because with deep-located typemaps, eg "lib/XS/typemap", # if xsubpp is called from top level with # $(XSUBPP) ... -typemap "lib/XS/typemap" "lib/XS/Test.xs" # it says: # Can't find lib/XS/type map in (fulldir)/lib/XS # because ExtUtils::ParseXS::process_file chdir's to .xs file's # location. This is the only way to get all specified typemaps used, # wherever located. my @tmargs = map { '-typemap '.$self->quote_literal(File::Spec->rel2abs($_)) } @tmdeps; $_ = $self->quote_dep($_) for @tmdeps; if( exists $self->{XSOPT} ){ unshift( @tmargs, $self->{XSOPT} ); } if ($Is{VMS} && $Config{'ldflags'} && $Config{'ldflags'} =~ m!/Debug!i && (!exists($self->{XSOPT}) || $self->{XSOPT} !~ /linenumbers/) ) { unshift(@tmargs,'-nolinenumbers'); } $self->{XSPROTOARG} = "" unless defined $self->{XSPROTOARG}; my $xsdirdep = $self->quote_dep($xsdir); # -dep for use when dependency not command return qq{ XSUBPPDIR = $xsdir XSUBPP = "\$(XSUBPPDIR)\$(DFSEP)xsubpp" XSUBPPRUN = \$(PERLRUN) \$(XSUBPP) XSPROTOARG = $self->{XSPROTOARG} XSUBPPDEPS = @tmdeps $xsdirdep\$(DFSEP)xsubpp XSUBPPARGS = @tmargs XSUBPP_EXTRA_ARGS = }; } =item all_target Build man pages, too =cut sub all_target { my $self = shift; return <<'MAKE_EXT'; all :: pure_all manifypods $(NOECHO) $(NOOP) MAKE_EXT } =item top_targets (o) Defines the targets all, subdirs, config, and O_FILES =cut sub top_targets { # --- Target Sections --- my($self) = shift; my(@m); push @m, $self->all_target, "\n" unless $self->{SKIPHASH}{'all'}; push @m, sprintf <<'EOF'; pure_all :: config pm_to_blib subdirs linkext $(NOECHO) $(NOOP) $(NOECHO) $(NOOP) subdirs :: $(MYEXTLIB) $(NOECHO) $(NOOP) config :: $(FIRST_MAKEFILE) blibdirs $(NOECHO) $(NOOP) EOF push @m, ' $(O_FILES) : $(H_FILES) ' if @{$self->{O_FILES} || []} && @{$self->{H} || []}; push @m, q{ help : perldoc ExtUtils::MakeMaker }; join('',@m); } =item writedoc Obsolete, deprecated method. Not used since Version 5.21. =cut sub writedoc { # --- perllocal.pod section --- my($self,$what,$name,@attribs)=@_; my $time = gmtime($ENV{SOURCE_DATE_EPOCH} || time); print "=head2 $time: $what C<$name>\n\n=over 4\n\n=item *\n\n"; print join "\n\n=item *\n\n", map("C<$_>",@attribs); print "\n\n=back\n\n"; } =item xs_c (o) Defines the suffix rules to compile XS files to C. =cut sub xs_c { my($self) = shift; return '' unless $self->needs_linking(); ' .xs.c: $(XSUBPPRUN) $(XSPROTOARG) $(XSUBPPARGS) $(XSUBPP_EXTRA_ARGS) $*.xs > $*.xsc $(MV) $*.xsc $*.c '; } =item xs_cpp (o) Defines the suffix rules to compile XS files to C++. =cut sub xs_cpp { my($self) = shift; return '' unless $self->needs_linking(); ' .xs.cpp: $(XSUBPPRUN) $(XSPROTOARG) $(XSUBPPARGS) $*.xs > $*.xsc $(MV) $*.xsc $*.cpp '; } =item xs_o (o) Defines suffix rules to go from XS to object files directly. This was originally only intended for broken make implementations, but is now necessary for per-XS file under C, since each XS file might have an individual C<$(VERSION)>. =cut sub xs_o { my ($self) = @_; return '' unless $self->needs_linking(); my $m_o = $self->{XSMULTI} ? $self->xs_obj_opt('$*$(OBJ_EXT)') : ''; my $dbgout = $self->dbgoutflag; $dbgout = $dbgout ? "$dbgout " : ''; my $frag = ''; # dmake makes noise about ambiguous rule $frag .= sprintf <<'EOF', $dbgout, $m_o unless $self->is_make_type('dmake'); .xs$(OBJ_EXT) : $(XSUBPPRUN) $(XSPROTOARG) $(XSUBPPARGS) $*.xs > $*.xsc $(MV) $*.xsc $*.c $(CCCMD) $(CCCDLFLAGS) "-I$(PERL_INC)" $(PASTHRU_DEFINE) $(DEFINE) %s$*.c %s EOF if ($self->{XSMULTI}) { for my $ext ($self->_xs_list_basenames) { my $pmfile = "$ext.pm"; croak "$ext.xs has no matching $pmfile: $!" unless -f $pmfile; my $version = $self->parse_version($pmfile); my $cccmd = $self->{CONST_CCCMD}; $cccmd =~ s/^\s*CCCMD\s*=\s*//; $cccmd =~ s/\$\(DEFINE_VERSION\)/-DVERSION=\\"$version\\"/; $cccmd =~ s/\$\(XS_DEFINE_VERSION\)/-DXS_VERSION=\\"$version\\"/; $self->_xsbuild_replace_macro($cccmd, 'xs', $ext, 'INC'); my $define = '$(DEFINE)'; $self->_xsbuild_replace_macro($define, 'xs', $ext, 'DEFINE'); # 1 2 3 4 5 $frag .= _sprintf562 <<'EOF', $ext, $cccmd, $m_o, $define, $dbgout; %1$s$(OBJ_EXT): %1$s.xs $(XSUBPPRUN) $(XSPROTOARG) $(XSUBPPARGS) $*.xs > $*.xsc $(MV) $*.xsc $*.c %2$s $(CCCDLFLAGS) "-I$(PERL_INC)" $(PASTHRU_DEFINE) %4$s %5$s$*.c %3$s EOF } } $frag =~ s/"-I(\$\(PERL_INC\))"/-iwithsysroot "$1"/sg if $Is{ApplCor}; $frag; } # param gets modified sub _xsbuild_replace_macro { my ($self, undef, $xstype, $ext, $varname) = @_; my $value = $self->_xsbuild_value($xstype, $ext, $varname); return unless defined $value; $_[1] =~ s/\$\($varname\)/$value/; } sub _xsbuild_value { my ($self, $xstype, $ext, $varname) = @_; return $self->{XSBUILD}{$xstype}{$ext}{$varname} if $self->{XSBUILD}{$xstype}{$ext}{$varname}; return $self->{XSBUILD}{$xstype}{all}{$varname} if $self->{XSBUILD}{$xstype}{all}{$varname}; (); } 1; =back =head1 SEE ALSO L =cut __END__ EXTUTILS_MM_UNIX $fatpacked{"ExtUtils/MM_VMS.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_MM_VMS'; package ExtUtils::MM_VMS; use strict; use ExtUtils::MakeMaker::Config; require Exporter; BEGIN { # so we can compile the thing on non-VMS platforms. if( $^O eq 'VMS' ) { require VMS::Filespec; VMS::Filespec->import; } } use File::Basename; our $VERSION = '7.38'; $VERSION =~ tr/_//d; require ExtUtils::MM_Any; require ExtUtils::MM_Unix; our @ISA = qw( ExtUtils::MM_Any ExtUtils::MM_Unix ); use ExtUtils::MakeMaker qw($Verbose neatvalue _sprintf562); our $Revision = $ExtUtils::MakeMaker::Revision; =head1 NAME ExtUtils::MM_VMS - methods to override UN*X behaviour in ExtUtils::MakeMaker =head1 SYNOPSIS Do not use this directly. Instead, use ExtUtils::MM and it will figure out which MM_* class to use for you. =head1 DESCRIPTION See ExtUtils::MM_Unix for a documentation of the methods provided there. This package overrides the implementation of these methods, not the semantics. =head2 Methods always loaded =over 4 =item wraplist Converts a list into a string wrapped at approximately 80 columns. =cut sub wraplist { my($self) = shift; my($line,$hlen) = ('',0); foreach my $word (@_) { # Perl bug -- seems to occasionally insert extra elements when # traversing array (scalar(@array) doesn't show them, but # foreach(@array) does) (5.00307) next unless $word =~ /\w/; $line .= ' ' if length($line); if ($hlen > 80) { $line .= "\\\n\t"; $hlen = 0; } $line .= $word; $hlen += length($word) + 2; } $line; } # This isn't really an override. It's just here because ExtUtils::MM_VMS # appears in @MM::ISA before ExtUtils::Liblist::Kid, so if there isn't an ext() # in MM_VMS, then AUTOLOAD is called, and bad things happen. So, we just # mimic inheritance here and hand off to ExtUtils::Liblist::Kid. # XXX This hackery will die soon. --Schwern sub ext { require ExtUtils::Liblist::Kid; goto &ExtUtils::Liblist::Kid::ext; } =back =head2 Methods Those methods which override default MM_Unix methods are marked "(override)", while methods unique to MM_VMS are marked "(specific)". For overridden methods, documentation is limited to an explanation of why this method overrides the MM_Unix method; see the ExtUtils::MM_Unix documentation for more details. =over 4 =item guess_name (override) Try to determine name of extension being built. We begin with the name of the current directory. Since VMS filenames are case-insensitive, however, we look for a F<.pm> file whose name matches that of the current directory (presumably the 'main' F<.pm> file for this extension), and try to find a C statement from which to obtain the Mixed::Case package name. =cut sub guess_name { my($self) = @_; my($defname,$defpm,@pm,%xs); local *PM; $defname = basename(fileify($ENV{'DEFAULT'})); $defname =~ s![\d\-_]*\.dir.*$!!; # Clip off .dir;1 suffix, and package version $defpm = $defname; # Fallback in case for some reason a user has copied the files for an # extension into a working directory whose name doesn't reflect the # extension's name. We'll use the name of a unique .pm file, or the # first .pm file with a matching .xs file. if (not -e "${defpm}.pm") { @pm = glob('*.pm'); s/.pm$// for @pm; if (@pm == 1) { ($defpm = $pm[0]) =~ s/.pm$//; } elsif (@pm) { %xs = map { s/.xs$//; ($_,1) } glob('*.xs'); ## no critic if (keys %xs) { foreach my $pm (@pm) { $defpm = $pm, last if exists $xs{$pm}; } } } } if (open(my $pm, '<', "${defpm}.pm")){ while (<$pm>) { if (/^\s*package\s+([^;]+)/i) { $defname = $1; last; } } print "Warning (non-fatal): Couldn't find package name in ${defpm}.pm;\n\t", "defaulting package name to $defname\n" if eof($pm); close $pm; } else { print "Warning (non-fatal): Couldn't find ${defpm}.pm;\n\t", "defaulting package name to $defname\n"; } $defname =~ s#[\d.\-_]+$##; $defname; } =item find_perl (override) Use VMS file specification syntax and CLI commands to find and invoke Perl images. =cut sub find_perl { my($self, $ver, $names, $dirs, $trace) = @_; my($vmsfile,@sdirs,@snames,@cand); my($rslt); my($inabs) = 0; local *TCF; if( $self->{PERL_CORE} ) { # Check in relative directories first, so we pick up the current # version of Perl if we're running MakeMaker as part of the main build. @sdirs = sort { my($absa) = $self->file_name_is_absolute($a); my($absb) = $self->file_name_is_absolute($b); if ($absa && $absb) { return $a cmp $b } else { return $absa ? 1 : ($absb ? -1 : ($a cmp $b)); } } @$dirs; # Check miniperl before perl, and check names likely to contain # version numbers before "generic" names, so we pick up an # executable that's less likely to be from an old installation. @snames = sort { my($ba) = $a =~ m!([^:>\]/]+)$!; # basename my($bb) = $b =~ m!([^:>\]/]+)$!; my($ahasdir) = (length($a) - length($ba) > 0); my($bhasdir) = (length($b) - length($bb) > 0); if ($ahasdir and not $bhasdir) { return 1; } elsif ($bhasdir and not $ahasdir) { return -1; } else { $bb =~ /\d/ <=> $ba =~ /\d/ or substr($ba,0,1) cmp substr($bb,0,1) or length($bb) <=> length($ba) } } @$names; } else { @sdirs = @$dirs; @snames = @$names; } # Image names containing Perl version use '_' instead of '.' under VMS s/\.(\d+)$/_$1/ for @snames; if ($trace >= 2){ print "Looking for perl $ver by these names:\n"; print "\t@snames,\n"; print "in these dirs:\n"; print "\t@sdirs\n"; } foreach my $dir (@sdirs){ next unless defined $dir; # $self->{PERL_SRC} may be undefined $inabs++ if $self->file_name_is_absolute($dir); if ($inabs == 1) { # We've covered relative dirs; everything else is an absolute # dir (probably an installed location). First, we'll try # potential command names, to see whether we can avoid a long # MCR expression. foreach my $name (@snames) { push(@cand,$name) if $name =~ /^[\w\-\$]+$/; } $inabs++; # Should happen above in next $dir, but just in case... } foreach my $name (@snames){ push @cand, ($name !~ m![/:>\]]!) ? $self->catfile($dir,$name) : $self->fixpath($name,0); } } foreach my $name (@cand) { print "Checking $name\n" if $trace >= 2; # If it looks like a potential command, try it without the MCR if ($name =~ /^[\w\-\$]+$/) { open(my $tcf, ">", "temp_mmvms.com") or die('unable to open temp file'); print $tcf "\$ set message/nofacil/nosever/noident/notext\n"; print $tcf "\$ $name -e \"require $ver; print \"\"VER_OK\\n\"\"\"\n"; close $tcf; $rslt = `\@temp_mmvms.com` ; unlink('temp_mmvms.com'); if ($rslt =~ /VER_OK/) { print "Using PERL=$name\n" if $trace; return $name; } } next unless $vmsfile = $self->maybe_command($name); $vmsfile =~ s/;[\d\-]*$//; # Clip off version number; we can use a newer version as well print "Executing $vmsfile\n" if ($trace >= 2); open(my $tcf, '>', "temp_mmvms.com") or die('unable to open temp file'); print $tcf "\$ set message/nofacil/nosever/noident/notext\n"; print $tcf "\$ mcr $vmsfile -e \"require $ver; print \"\"VER_OK\\n\"\"\" \n"; close $tcf; $rslt = `\@temp_mmvms.com`; unlink('temp_mmvms.com'); if ($rslt =~ /VER_OK/) { print "Using PERL=MCR $vmsfile\n" if $trace; return "MCR $vmsfile"; } } print "Unable to find a perl $ver (by these names: @$names, in these dirs: @$dirs)\n"; 0; # false and not empty } =item _fixin_replace_shebang (override) Helper routine for MM->fixin(), overridden because there's no such thing as an actual shebang line that will be interpreted by the shell, so we just prepend $Config{startperl} and preserve the shebang line argument for any switches it may contain. =cut sub _fixin_replace_shebang { my ( $self, $file, $line ) = @_; my ( undef, $arg ) = split ' ', $line, 2; return $Config{startperl} . "\n" . $Config{sharpbang} . "perl $arg\n"; } =item maybe_command (override) Follows VMS naming conventions for executable files. If the name passed in doesn't exactly match an executable file, appends F<.Exe> (or equivalent) to check for executable image, and F<.Com> to check for DCL procedure. If this fails, checks directories in DCL$PATH and finally F for an executable file having the name specified, with or without the F<.Exe>-equivalent suffix. =cut sub maybe_command { my($self,$file) = @_; return $file if -x $file && ! -d _; my(@dirs) = (''); my(@exts) = ('',$Config{'exe_ext'},'.exe','.com'); if ($file !~ m![/:>\]]!) { for (my $i = 0; defined $ENV{"DCL\$PATH;$i"}; $i++) { my $dir = $ENV{"DCL\$PATH;$i"}; $dir .= ':' unless $dir =~ m%[\]:]$%; push(@dirs,$dir); } push(@dirs,'Sys$System:'); foreach my $dir (@dirs) { my $sysfile = "$dir$file"; foreach my $ext (@exts) { return $file if -x "$sysfile$ext" && ! -d _; } } } return 0; } =item pasthru (override) The list of macro definitions to be passed through must be specified using the /MACRO qualifier and must not add another /DEFINE qualifier. We prepend our own comma here to the contents of $(PASTHRU_DEFINE) because it is often empty and a comma always present in CCFLAGS would generate a missing qualifier value error. =cut sub pasthru { my($self) = shift; my $pasthru = $self->SUPER::pasthru; $pasthru =~ s|(PASTHRU\s*=\s*)|$1/MACRO=(|; $pasthru =~ s|\n\z|)\n|m; $pasthru =~ s|/defi?n?e?=\(?([^\),]+)\)?|,$1|ig; return $pasthru; } =item pm_to_blib (override) VMS wants a dot in every file so we can't have one called 'pm_to_blib', it becomes 'pm_to_blib.' and MMS/K isn't smart enough to know that when you have a target called 'pm_to_blib' it should look for 'pm_to_blib.'. So in VMS its pm_to_blib.ts. =cut sub pm_to_blib { my $self = shift; my $make = $self->SUPER::pm_to_blib; $make =~ s{^pm_to_blib :}{pm_to_blib.ts :}m; $make =~ s{\$\(TOUCH\) pm_to_blib}{\$(TOUCH) pm_to_blib.ts}; $make = <<'MAKE' . $make; # Dummy target to match Unix target name; we use pm_to_blib.ts as # timestamp file to avoid repeated invocations under VMS pm_to_blib : pm_to_blib.ts $(NOECHO) $(NOOP) MAKE return $make; } =item perl_script (override) If name passed in doesn't specify a readable file, appends F<.com> or F<.pl> and tries again, since it's customary to have file types on all files under VMS. =cut sub perl_script { my($self,$file) = @_; return $file if -r $file && ! -d _; return "$file.com" if -r "$file.com"; return "$file.pl" if -r "$file.pl"; return ''; } =item replace_manpage_separator Use as separator a character which is legal in a VMS-syntax file name. =cut sub replace_manpage_separator { my($self,$man) = @_; $man = unixify($man); $man =~ s#/+#__#g; $man; } =item init_DEST (override) Because of the difficulty concatenating VMS filepaths we must pre-expand the DEST* variables. =cut sub init_DEST { my $self = shift; $self->SUPER::init_DEST; # Expand DEST variables. foreach my $var ($self->installvars) { my $destvar = 'DESTINSTALL'.$var; $self->{$destvar} = $self->eliminate_macros($self->{$destvar}); } } =item init_DIRFILESEP No separator between a directory path and a filename on VMS. =cut sub init_DIRFILESEP { my($self) = shift; $self->{DIRFILESEP} = ''; return 1; } =item init_main (override) =cut sub init_main { my($self) = shift; $self->SUPER::init_main; $self->{DEFINE} ||= ''; if ($self->{DEFINE} ne '') { my(@terms) = split(/\s+/,$self->{DEFINE}); my(@defs,@udefs); foreach my $def (@terms) { next unless $def; my $targ = \@defs; if ($def =~ s/^-([DU])//) { # If it was a Unix-style definition $targ = \@udefs if $1 eq 'U'; $def =~ s/='(.*)'$/=$1/; # then remove shell-protection '' $def =~ s/^'(.*)'$/$1/; # from entire term or argument } if ($def =~ /=/) { $def =~ s/"/""/g; # Protect existing " from DCL $def = qq["$def"]; # and quote to prevent parsing of = } push @$targ, $def; } $self->{DEFINE} = ''; if (@defs) { $self->{DEFINE} = '/Define=(' . join(',',@defs) . ')'; } if (@udefs) { $self->{DEFINE} .= '/Undef=(' . join(',',@udefs) . ')'; } } } =item init_tools (override) Provide VMS-specific forms of various utility commands. Sets DEV_NULL to nothing because I don't know how to do it on VMS. Changes EQUALIZE_TIMESTAMP to set revision date of target file to one second later than source file, since MMK interprets precisely equal revision dates for a source and target file as a sign that the target needs to be updated. =cut sub init_tools { my($self) = @_; $self->{NOOP} = 'Continue'; $self->{NOECHO} ||= '@ '; $self->{MAKEFILE} ||= $self->{FIRST_MAKEFILE} || 'Descrip.MMS'; $self->{FIRST_MAKEFILE} ||= $self->{MAKEFILE}; $self->{MAKE_APERL_FILE} ||= 'Makeaperl.MMS'; $self->{MAKEFILE_OLD} ||= $self->eliminate_macros('$(FIRST_MAKEFILE)_old'); # # If an extension is not specified, then MMS/MMK assumes an # an extension of .MMS. If there really is no extension, # then a trailing "." needs to be appended to specify a # a null extension. # $self->{MAKEFILE} .= '.' unless $self->{MAKEFILE} =~ m/\./; $self->{FIRST_MAKEFILE} .= '.' unless $self->{FIRST_MAKEFILE} =~ m/\./; $self->{MAKE_APERL_FILE} .= '.' unless $self->{MAKE_APERL_FILE} =~ m/\./; $self->{MAKEFILE_OLD} .= '.' unless $self->{MAKEFILE_OLD} =~ m/\./; $self->{MACROSTART} ||= '/Macro=('; $self->{MACROEND} ||= ')'; $self->{USEMAKEFILE} ||= '/Descrip='; $self->{EQUALIZE_TIMESTAMP} ||= '$(ABSPERLRUN) -we "open F,qq{>>$ARGV[1]};close F;utime(0,(stat($ARGV[0]))[9]+1,$ARGV[1])"'; $self->{MOD_INSTALL} ||= $self->oneliner(<<'CODE', ['-MExtUtils::Install']); install([ from_to => {split('\|', )}, verbose => '$(VERBINST)', uninstall_shadows => '$(UNINST)', dir_mode => '$(PERM_DIR)' ]); CODE $self->{UMASK_NULL} = '! '; $self->SUPER::init_tools; # Use the default shell $self->{SHELL} ||= 'Posix'; # Redirection on VMS goes before the command, not after as on Unix. # $(DEV_NULL) is used once and its not worth going nuts over making # it work. However, Unix's DEV_NULL is quite wrong for VMS. $self->{DEV_NULL} = ''; return; } =item init_platform (override) Add PERL_VMS, MM_VMS_REVISION and MM_VMS_VERSION. MM_VMS_REVISION is for backwards compatibility before MM_VMS had a $VERSION. =cut sub init_platform { my($self) = shift; $self->{MM_VMS_REVISION} = $Revision; $self->{MM_VMS_VERSION} = $VERSION; $self->{PERL_VMS} = $self->catdir($self->{PERL_SRC}, 'VMS') if $self->{PERL_SRC}; } =item platform_constants =cut sub platform_constants { my($self) = shift; my $make_frag = ''; foreach my $macro (qw(PERL_VMS MM_VMS_REVISION MM_VMS_VERSION)) { next unless defined $self->{$macro}; $make_frag .= "$macro = $self->{$macro}\n"; } return $make_frag; } =item init_VERSION (override) Override the *DEFINE_VERSION macros with VMS semantics. Translate the MAKEMAKER filepath to VMS style. =cut sub init_VERSION { my $self = shift; $self->SUPER::init_VERSION; $self->{DEFINE_VERSION} = '"$(VERSION_MACRO)=""$(VERSION)"""'; $self->{XS_DEFINE_VERSION} = '"$(XS_VERSION_MACRO)=""$(XS_VERSION)"""'; $self->{MAKEMAKER} = vmsify($INC{'ExtUtils/MakeMaker.pm'}); } =item constants (override) Fixes up numerous file and directory macros to insure VMS syntax regardless of input syntax. Also makes lists of files comma-separated. =cut sub constants { my($self) = @_; # Be kind about case for pollution for (@ARGV) { $_ = uc($_) if /POLLUTE/i; } # Cleanup paths for directories in MMS macros. foreach my $macro ( qw [ INST_BIN INST_SCRIPT INST_LIB INST_ARCHLIB PERL_LIB PERL_ARCHLIB PERL_ARCHLIBDEP PERL_INC PERL_SRC ], (map { 'INSTALL'.$_ } $self->installvars), (map { 'DESTINSTALL'.$_ } $self->installvars) ) { next unless defined $self->{$macro}; next if $macro =~ /MAN/ && $self->{$macro} eq 'none'; $self->{$macro} = $self->fixpath($self->{$macro},1); } # Cleanup paths for files in MMS macros. foreach my $macro ( qw[LIBPERL_A FIRST_MAKEFILE MAKEFILE_OLD MAKE_APERL_FILE MYEXTLIB] ) { next unless defined $self->{$macro}; $self->{$macro} = $self->fixpath($self->{$macro},0); } # Fixup files for MMS macros # XXX is this list complete? for my $macro (qw/ FULLEXT VERSION_FROM / ) { next unless defined $self->{$macro}; $self->{$macro} = $self->fixpath($self->{$macro},0); } for my $macro (qw/ OBJECT LDFROM / ) { next unless defined $self->{$macro}; # Must expand macros before splitting on unescaped whitespace. $self->{$macro} = $self->eliminate_macros($self->{$macro}); if ($self->{$macro} =~ /(?{$macro} =~ s/(\\)?\n+\s+/ /g; $self->{$macro} = $self->wraplist( map $self->fixpath($_,0), split /,?(?{$macro} ); } else { $self->{$macro} = $self->fixpath($self->{$macro},0); } } for my $macro (qw/ XS MAN1PODS MAN3PODS PM /) { # Where is the space coming from? --jhi next unless $self ne " " && defined $self->{$macro}; my %tmp = (); for my $key (keys %{$self->{$macro}}) { $tmp{$self->fixpath($key,0)} = $self->fixpath($self->{$macro}{$key},0); } $self->{$macro} = \%tmp; } for my $macro (qw/ C O_FILES H /) { next unless defined $self->{$macro}; my @tmp = (); for my $val (@{$self->{$macro}}) { push(@tmp,$self->fixpath($val,0)); } $self->{$macro} = \@tmp; } # mms/k does not define a $(MAKE) macro. $self->{MAKE} = '$(MMS)$(MMSQUALIFIERS)'; return $self->SUPER::constants; } =item special_targets Clear the default .SUFFIXES and put in our own list. =cut sub special_targets { my $self = shift; my $make_frag .= <<'MAKE_FRAG'; .SUFFIXES : .SUFFIXES : $(OBJ_EXT) .c .cpp .cxx .xs MAKE_FRAG return $make_frag; } =item cflags (override) Bypass shell script and produce qualifiers for CC directly (but warn user if a shell script for this extension exists). Fold multiple /Defines into one, since some C compilers pay attention to only one instance of this qualifier on the command line. =cut sub cflags { my($self,$libperl) = @_; my($quals) = $self->{CCFLAGS} || $Config{'ccflags'}; my($definestr,$undefstr,$flagoptstr) = ('','',''); my($incstr) = '/Include=($(PERL_INC)'; my($name,$sys,@m); ( $name = $self->{NAME} . "_cflags" ) =~ s/:/_/g ; print "Unix shell script ".$Config{"$self->{'BASEEXT'}_cflags"}. " required to modify CC command for $self->{'BASEEXT'}\n" if ($Config{$name}); if ($quals =~ / -[DIUOg]/) { while ($quals =~ / -([Og])(\d*)\b/) { my($type,$lvl) = ($1,$2); $quals =~ s/ -$type$lvl\b\s*//; if ($type eq 'g') { $flagoptstr = '/NoOptimize'; } else { $flagoptstr = '/Optimize' . (defined($lvl) ? "=$lvl" : ''); } } while ($quals =~ / -([DIU])(\S+)/) { my($type,$def) = ($1,$2); $quals =~ s/ -$type$def\s*//; $def =~ s/"/""/g; if ($type eq 'D') { $definestr .= qq["$def",]; } elsif ($type eq 'I') { $incstr .= ',' . $self->fixpath($def,1); } else { $undefstr .= qq["$def",]; } } } if (length $quals and $quals !~ m!/!) { warn "MM_VMS: Ignoring unrecognized CCFLAGS elements \"$quals\"\n"; $quals = ''; } $definestr .= q["PERL_POLLUTE",] if $self->{POLLUTE}; if (length $definestr) { chop($definestr); $quals .= "/Define=($definestr)"; } if (length $undefstr) { chop($undefstr); $quals .= "/Undef=($undefstr)"; } # Deal with $self->{DEFINE} here since some C compilers pay attention # to only one /Define clause on command line, so we have to # conflate the ones from $Config{'ccflags'} and $self->{DEFINE} # ($self->{DEFINE} has already been VMSified in constants() above) if ($self->{DEFINE}) { $quals .= $self->{DEFINE}; } for my $type (qw(Def Undef)) { my(@terms); while ($quals =~ m:/${type}i?n?e?=([^/]+):ig) { my $term = $1; $term =~ s:^\((.+)\)$:$1:; push @terms, $term; } if ($type eq 'Def') { push @terms, qw[ $(DEFINE_VERSION) $(XS_DEFINE_VERSION) ]; } if (@terms) { $quals =~ s:/${type}i?n?e?=[^/]+::ig; # PASTHRU_DEFINE will have its own comma $quals .= "/${type}ine=(" . join(',',@terms) . ($type eq 'Def' ? '$(PASTHRU_DEFINE)' : '') . ')'; } } $libperl or $libperl = $self->{LIBPERL_A} || "libperl.olb"; # Likewise with $self->{INC} and /Include if ($self->{'INC'}) { my(@includes) = split(/\s+/,$self->{INC}); foreach (@includes) { s/^-I//; $incstr .= ','.$self->fixpath($_,1); } } $quals .= "$incstr)"; # $quals =~ s/,,/,/g; $quals =~ s/\(,/(/g; $self->{CCFLAGS} = $quals; $self->{PERLTYPE} ||= ''; $self->{OPTIMIZE} ||= $flagoptstr || $Config{'optimize'}; if ($self->{OPTIMIZE} !~ m!/!) { if ($self->{OPTIMIZE} =~ m!-g!) { $self->{OPTIMIZE} = '/Debug/NoOptimize' } elsif ($self->{OPTIMIZE} =~ /-O(\d*)/) { $self->{OPTIMIZE} = '/Optimize' . (defined($1) ? "=$1" : ''); } else { warn "MM_VMS: Can't parse OPTIMIZE \"$self->{OPTIMIZE}\"; using default\n" if length $self->{OPTIMIZE}; $self->{OPTIMIZE} = '/Optimize'; } } return $self->{CFLAGS} = qq{ CCFLAGS = $self->{CCFLAGS} OPTIMIZE = $self->{OPTIMIZE} PERLTYPE = $self->{PERLTYPE} }; } =item const_cccmd (override) Adds directives to point C preprocessor to the right place when handling #include Esys/foo.hE directives. Also constructs CC command line a bit differently than MM_Unix method. =cut sub const_cccmd { my($self,$libperl) = @_; my(@m); return $self->{CONST_CCCMD} if $self->{CONST_CCCMD}; return '' unless $self->needs_linking(); if ($Config{'vms_cc_type'} eq 'gcc') { push @m,' .FIRST ',$self->{NOECHO},'If F$TrnLnm("Sys").eqs."" Then Define/NoLog SYS GNU_CC_Include:[VMS]'; } elsif ($Config{'vms_cc_type'} eq 'vaxc') { push @m,' .FIRST ',$self->{NOECHO},'If F$TrnLnm("Sys").eqs."" .and. F$TrnLnm("VAXC$Include").eqs."" Then Define/NoLog SYS Sys$Library ',$self->{NOECHO},'If F$TrnLnm("Sys").eqs."" .and. F$TrnLnm("VAXC$Include").nes."" Then Define/NoLog SYS VAXC$Include'; } else { push @m,' .FIRST ',$self->{NOECHO},'If F$TrnLnm("Sys").eqs."" .and. F$TrnLnm("DECC$System_Include").eqs."" Then Define/NoLog SYS ', ($Config{'archname'} eq 'VMS_AXP' ? 'Sys$Library' : 'DECC$Library_Include'),' ',$self->{NOECHO},'If F$TrnLnm("Sys").eqs."" .and. F$TrnLnm("DECC$System_Include").nes."" Then Define/NoLog SYS DECC$System_Include'; } push(@m, "\n\nCCCMD = $Config{'cc'} \$(CCFLAGS)\$(OPTIMIZE)\n"); $self->{CONST_CCCMD} = join('',@m); } =item tools_other (override) Throw in some dubious extra macros for Makefile args. Also keep around the old $(SAY) macro in case somebody's using it. =cut sub tools_other { my($self) = @_; # XXX Are these necessary? Does anyone override them? They're longer # than just typing the literal string. my $extra_tools = <<'EXTRA_TOOLS'; # Just in case anyone is using the old macro. USEMACROS = $(MACROSTART) SAY = $(ECHO) EXTRA_TOOLS return $self->SUPER::tools_other . $extra_tools; } =item init_dist (override) VMSish defaults for some values. macro description default ZIPFLAGS flags to pass to ZIP -Vu COMPRESS compression command to gzip use for tarfiles SUFFIX suffix to put on -gz compressed files SHAR shar command to use vms_share DIST_DEFAULT default target to use to tardist create a distribution DISTVNAME Use VERSION_SYM instead of $(DISTNAME)-$(VERSION_SYM) VERSION for the name =cut sub init_dist { my($self) = @_; $self->{ZIPFLAGS} ||= '-Vu'; $self->{COMPRESS} ||= 'gzip'; $self->{SUFFIX} ||= '-gz'; $self->{SHAR} ||= 'vms_share'; $self->{DIST_DEFAULT} ||= 'zipdist'; $self->SUPER::init_dist; $self->{DISTVNAME} = "$self->{DISTNAME}-$self->{VERSION_SYM}" unless $self->{ARGS}{DISTVNAME}; return; } =item c_o (override) Use VMS syntax on command line. In particular, $(DEFINE) and $(PERL_INC) have been pulled into $(CCCMD). Also use MM[SK] macros. =cut sub c_o { my($self) = @_; return '' unless $self->needs_linking(); ' .c$(OBJ_EXT) : $(CCCMD) $(CCCDLFLAGS) $(MMS$TARGET_NAME).c /OBJECT=$(MMS$TARGET_NAME)$(OBJ_EXT) .cpp$(OBJ_EXT) : $(CCCMD) $(CCCDLFLAGS) $(MMS$TARGET_NAME).cpp /OBJECT=$(MMS$TARGET_NAME)$(OBJ_EXT) .cxx$(OBJ_EXT) : $(CCCMD) $(CCCDLFLAGS) $(MMS$TARGET_NAME).cxx /OBJECT=$(MMS$TARGET_NAME)$(OBJ_EXT) '; } =item xs_c (override) Use MM[SK] macros. =cut sub xs_c { my($self) = @_; return '' unless $self->needs_linking(); ' .xs.c : $(XSUBPPRUN) $(XSPROTOARG) $(XSUBPPARGS) $(MMS$TARGET_NAME).xs >$(MMS$TARGET_NAME).xsc $(MV) $(MMS$TARGET_NAME).xsc $(MMS$TARGET_NAME).c '; } =item xs_o (override) Use MM[SK] macros, and VMS command line for C compiler. =cut sub xs_o { my ($self) = @_; return '' unless $self->needs_linking(); my $frag = ' .xs$(OBJ_EXT) : $(XSUBPPRUN) $(XSPROTOARG) $(XSUBPPARGS) $(MMS$TARGET_NAME).xs >$(MMS$TARGET_NAME).xsc $(MV) $(MMS$TARGET_NAME).xsc $(MMS$TARGET_NAME).c $(CCCMD) $(CCCDLFLAGS) $(MMS$TARGET_NAME).c /OBJECT=$(MMS$TARGET_NAME)$(OBJ_EXT) '; if ($self->{XSMULTI}) { for my $ext ($self->_xs_list_basenames) { my $version = $self->parse_version("$ext.pm"); my $ccflags = $self->{CCFLAGS}; $ccflags =~ s/\$\(DEFINE_VERSION\)/\"VERSION_MACRO=\\"\"$version\\"\"/; $ccflags =~ s/\$\(XS_DEFINE_VERSION\)/\"XS_VERSION_MACRO=\\"\"$version\\"\"/; $self->_xsbuild_replace_macro($ccflags, 'xs', $ext, 'INC'); $self->_xsbuild_replace_macro($ccflags, 'xs', $ext, 'DEFINE'); $frag .= _sprintf562 <<'EOF', $ext, $ccflags; %1$s$(OBJ_EXT) : %1$s.xs $(XSUBPPRUN) $(XSPROTOARG) $(XSUBPPARGS) $(MMS$TARGET_NAME).xs > $(MMS$TARGET_NAME).xsc $(MV) $(MMS$TARGET_NAME).xsc $(MMS$TARGET_NAME).c $(CC)%2$s$(OPTIMIZE) $(CCCDLFLAGS) $(MMS$TARGET_NAME).c /OBJECT=$(MMS$TARGET_NAME)$(OBJ_EXT) EOF } } $frag; } =item _xsbuild_replace_macro (override) There is no simple replacement possible since a qualifier and all its subqualifiers must be considered together, so we use our own utility routine for the replacement. =cut sub _xsbuild_replace_macro { my ($self, undef, $xstype, $ext, $varname) = @_; my $value = $self->_xsbuild_value($xstype, $ext, $varname); return unless defined $value; $_[1] = _vms_replace_qualifier($self, $_[1], $value, $varname); } =item _xsbuild_value (override) Convert the extension spec to Unix format, as that's what will match what's in the XSBUILD data structure. =cut sub _xsbuild_value { my ($self, $xstype, $ext, $varname) = @_; $ext = unixify($ext); return $self->SUPER::_xsbuild_value($xstype, $ext, $varname); } sub _vms_replace_qualifier { my ($self, $flags, $newflag, $macro) = @_; my $qual_type; my $type_suffix; my $quote_subquals = 0; my @subquals_new = split /\s+/, $newflag; if ($macro eq 'DEFINE') { $qual_type = 'Def'; $type_suffix = 'ine'; map { $_ =~ s/^-D// } @subquals_new; $quote_subquals = 1; } elsif ($macro eq 'INC') { $qual_type = 'Inc'; $type_suffix = 'lude'; map { $_ =~ s/^-I//; $_ = $self->fixpath($_) } @subquals_new; } my @subquals = (); while ($flags =~ m:/${qual_type}\S{0,4}=([^/]+):ig) { my $term = $1; $term =~ s/\"//g; $term =~ s:^\((.+)\)$:$1:; push @subquals, split /,/, $term; } for my $new (@subquals_new) { my ($sq_new, $sqval_new) = split /=/, $new; my $replaced_old = 0; for my $old (@subquals) { my ($sq, $sqval) = split /=/, $old; if ($sq_new eq $sq) { $old = $sq_new; $old .= '=' . $sqval_new if defined($sqval_new) and length($sqval_new); $replaced_old = 1; last; } } push @subquals, $new unless $replaced_old; } if (@subquals) { $flags =~ s:/${qual_type}\S{0,4}=[^/]+::ig; # add quotes if requested but not for unexpanded macros map { $_ = qq/"$_"/ if $_ !~ m/^\$\(/ } @subquals if $quote_subquals; $flags .= "/${qual_type}$type_suffix=(" . join(',',@subquals) . ')'; } return $flags; } sub xs_dlsyms_ext { '.opt'; } =item dlsyms (override) Create VMS linker options files specifying universal symbols for this extension's shareable image(s), and listing other shareable images or libraries to which it should be linked. =cut sub dlsyms { my ($self, %attribs) = @_; return '' unless $self->needs_linking; $self->xs_dlsyms_iterator; } sub xs_make_dlsyms { my ($self, $attribs, $target, $dep, $name, $dlbase, $funcs, $funclist, $imports, $vars, $extra) = @_; my @m; my $instloc; if ($self->{XSMULTI}) { my ($v, $d, $f) = File::Spec->splitpath($target); my @d = File::Spec->splitdir($d); shift @d if $d[0] eq 'lib'; $instloc = $self->catfile('$(INST_ARCHLIB)', 'auto', @d, $f); push @m,"\ndynamic :: $instloc\n\t\$(NOECHO) \$(NOOP)\n" unless $self->{SKIPHASH}{'dynamic'}; push @m,"\nstatic :: $instloc\n\t\$(NOECHO) \$(NOOP)\n" unless $self->{SKIPHASH}{'static'}; push @m, "\n", sprintf <<'EOF', $instloc, $target; %s : %s $(CP) $(MMS$SOURCE) $(MMS$TARGET) EOF } else { push @m,"\ndynamic :: \$(INST_ARCHAUTODIR)$self->{BASEEXT}.opt\n\t\$(NOECHO) \$(NOOP)\n" unless $self->{SKIPHASH}{'dynamic'}; push @m,"\nstatic :: \$(INST_ARCHAUTODIR)$self->{BASEEXT}.opt\n\t\$(NOECHO) \$(NOOP)\n" unless $self->{SKIPHASH}{'static'}; push @m, "\n", sprintf <<'EOF', $target; $(INST_ARCHAUTODIR)$(BASEEXT).opt : %s $(CP) $(MMS$SOURCE) $(MMS$TARGET) EOF } push @m, "\n$target : $dep\n\t", q!$(PERLRUN) -MExtUtils::Mksymlists -e "Mksymlists('NAME'=>'!, $name, q!', 'DLBASE' => '!,$dlbase, q!', 'DL_FUNCS' => !,neatvalue($funcs), q!, 'FUNCLIST' => !,neatvalue($funclist), q!, 'IMPORTS' => !,neatvalue($imports), q!, 'DL_VARS' => !, neatvalue($vars); push @m, $extra if defined $extra; push @m, qq!);"\n\t!; # Can't use dlbase as it's been through mod2fname. my $olb_base = basename($target, '.opt'); if ($self->{XSMULTI}) { # We've been passed everything but the kitchen sink -- and the location of the # static library we're using to build the dynamic library -- so concoct that # location from what we do have. my $olb_dir = $self->catdir(dirname($instloc), $olb_base); push @m, qq!\$(PERL) -e "print ""${olb_dir}${olb_base}\$(LIB_EXT)/Include=!; push @m, ($Config{d_vms_case_sensitive_symbols} ? uc($olb_base) : $olb_base); push @m, '\n' . $olb_dir . $olb_base . '$(LIB_EXT)/Library\n"";" >>$(MMS$TARGET)',"\n"; } else { push @m, qq!\$(PERL) -e "print ""\$(INST_ARCHAUTODIR)${olb_base}\$(LIB_EXT)/Include=!; if ($self->{OBJECT} =~ /\bBASEEXT\b/ or $self->{OBJECT} =~ /\b$self->{BASEEXT}\b/i) { push @m, ($Config{d_vms_case_sensitive_symbols} ? uc($self->{BASEEXT}) :'$(BASEEXT)'); } else { # We don't have a "main" object file, so pull 'em all in # Upcase module names if linker is being case-sensitive my($upcase) = $Config{d_vms_case_sensitive_symbols}; my(@omods) = split ' ', $self->eliminate_macros($self->{OBJECT}); for (@omods) { s/\.[^.]*$//; # Trim off file type s[\$\(\w+_EXT\)][]; # even as a macro s/.*[:>\/\]]//; # Trim off dir spec $_ = uc if $upcase; }; my(@lines); my $tmp = shift @omods; foreach my $elt (@omods) { $tmp .= ",$elt"; if (length($tmp) > 80) { push @lines, $tmp; $tmp = ''; } } push @lines, $tmp; push @m, '(', join( qq[, -\\n\\t"";" >>\$(MMS\$TARGET)\n\t\$(PERL) -e "print ""], @lines),')'; } push @m, '\n$(INST_ARCHAUTODIR)' . $olb_base . '$(LIB_EXT)/Library\n"";" >>$(MMS$TARGET)',"\n"; } if (length $self->{LDLOADLIBS}) { my($line) = ''; foreach my $lib (split ' ', $self->{LDLOADLIBS}) { $lib =~ s%\$%\\\$%g; # Escape '$' in VMS filespecs if (length($line) + length($lib) > 160) { push @m, "\t\$(PERL) -e \"print qq{$line}\" >>\$(MMS\$TARGET)\n"; $line = $lib . '\n'; } else { $line .= $lib . '\n'; } } push @m, "\t\$(PERL) -e \"print qq{$line}\" >>\$(MMS\$TARGET)\n" if $line; } join '', @m; } =item xs_obj_opt Override to fixup -o flags. =cut sub xs_obj_opt { my ($self, $output_file) = @_; "/OBJECT=$output_file"; } =item dynamic_lib (override) Use VMS Link command. =cut sub xs_dynamic_lib_macros { my ($self, $attribs) = @_; my $otherldflags = $attribs->{OTHERLDFLAGS} || ""; my $inst_dynamic_dep = $attribs->{INST_DYNAMIC_DEP} || ""; sprintf <<'EOF', $otherldflags, $inst_dynamic_dep; # This section creates the dynamically loadable objects from relevant # objects and possibly $(MYEXTLIB). OTHERLDFLAGS = %s INST_DYNAMIC_DEP = %s EOF } sub xs_make_dynamic_lib { my ($self, $attribs, $from, $to, $todir, $ldfrom, $exportlist) = @_; my $shr = $Config{'dbgprefix'} . 'PerlShr'; $exportlist =~ s/.def$/.opt/; # it's a linker options file # 1 2 3 4 5 _sprintf562 <<'EOF', $to, $todir, $exportlist, $shr, "$shr Sys\$Share:$shr.$Config{'dlext'}"; %1$s : $(INST_STATIC) $(PERL_INC)perlshr_attr.opt %2$s$(DFSEP).exists %3$s $(PERL_ARCHIVE) $(INST_DYNAMIC_DEP) If F$TrnLNm("%4$s").eqs."" Then Define/NoLog/User %5$s Link $(LDFLAGS) /Shareable=$(MMS$TARGET)$(OTHERLDFLAGS) %3$s/Option,$(PERL_INC)perlshr_attr.opt/Option EOF } =item xs_make_static_lib (override) Use VMS commands to manipulate object library. =cut sub xs_make_static_lib { my ($self, $object, $to, $todir) = @_; my @objects; if ($self->{XSMULTI}) { # The extension name should be the main object file name minus file type. my $lib = $object; $lib =~ s/\$\(OBJ_EXT\)\z//; my $override = $self->_xsbuild_value('xs', $lib, 'OBJECT'); $object = $override if defined $override; @objects = map { $self->fixpath($_,0) } split /(?{MYEXTLIB}; push(@m,"\t",'If F$Search("$(MMS$TARGET)").eqs."" Then Library/Object/Create $(MMS$TARGET)',"\n"); # if there was a library to copy, then we can't use MMS$SOURCE_LIST, # 'cause it's a library and you can't stick them in other libraries. # In that case, we use $OBJECT instead and hope for the best if ($self->{MYEXTLIB}) { for my $obj (@objects) { push(@m,"\t",'Library/Object/Replace $(MMS$TARGET) ' . $obj,"\n"); } } else { push(@m,"\t",'Library/Object/Replace $(MMS$TARGET) $(MMS$SOURCE_LIST)',"\n"); } push @m, "\t\$(NOECHO) \$(PERL) -e 1 >\$(INST_ARCHAUTODIR)extralibs.ld\n"; foreach my $lib (split ' ', $self->{EXTRALIBS}) { push(@m,"\t",'$(NOECHO) $(PERL) -e "print qq{',$lib,'\n}" >>$(INST_ARCHAUTODIR)extralibs.ld',"\n"); } join('',@m); } =item static_lib_pure_cmd (override) Use VMS commands to manipulate object library. =cut sub static_lib_pure_cmd { my ($self, $from) = @_; sprintf <<'MAKE_FRAG', $from; If F$Search("$(MMS$TARGET)").eqs."" Then Library/Object/Create $(MMS$TARGET) Library/Object/Replace $(MMS$TARGET) %s MAKE_FRAG } =item xs_static_lib_is_xs =cut sub xs_static_lib_is_xs { return 1; } =item extra_clean_files Clean up some OS specific files. Plus the temp file used to shorten a lot of commands. And the name mangler database. =cut sub extra_clean_files { return qw( *.Map *.Dmp *.Lis *.cpp *.$(DLEXT) *.Opt $(BASEEXT).bso .MM_Tmp cxx_repository ); } =item zipfile_target =item tarfile_target =item shdist_target Syntax for invoking shar, tar and zip differs from that for Unix. =cut sub zipfile_target { my($self) = shift; return <<'MAKE_FRAG'; $(DISTVNAME).zip : distdir $(PREOP) $(ZIP) "$(ZIPFLAGS)" $(MMS$TARGET) [.$(DISTVNAME)...]*.*; $(RM_RF) $(DISTVNAME) $(POSTOP) MAKE_FRAG } sub tarfile_target { my($self) = shift; return <<'MAKE_FRAG'; $(DISTVNAME).tar$(SUFFIX) : distdir $(PREOP) $(TO_UNIX) $(TAR) "$(TARFLAGS)" $(DISTVNAME).tar [.$(DISTVNAME)...] $(RM_RF) $(DISTVNAME) $(COMPRESS) $(DISTVNAME).tar $(POSTOP) MAKE_FRAG } sub shdist_target { my($self) = shift; return <<'MAKE_FRAG'; shdist : distdir $(PREOP) $(SHAR) [.$(DISTVNAME)...]*.*; $(DISTVNAME).share $(RM_RF) $(DISTVNAME) $(POSTOP) MAKE_FRAG } # --- Test and Installation Sections --- =item install (override) Work around DCL's 255 character limit several times,and use VMS-style command line quoting in a few cases. =cut sub install { my($self, %attribs) = @_; my(@m); push @m, q[ install :: all pure_install doc_install $(NOECHO) $(NOOP) install_perl :: all pure_perl_install doc_perl_install $(NOECHO) $(NOOP) install_site :: all pure_site_install doc_site_install $(NOECHO) $(NOOP) install_vendor :: all pure_vendor_install doc_vendor_install $(NOECHO) $(NOOP) pure_install :: pure_$(INSTALLDIRS)_install $(NOECHO) $(NOOP) doc_install :: doc_$(INSTALLDIRS)_install $(NOECHO) $(NOOP) pure__install : pure_site_install $(NOECHO) $(ECHO) "INSTALLDIRS not defined, defaulting to INSTALLDIRS=site" doc__install : doc_site_install $(NOECHO) $(ECHO) "INSTALLDIRS not defined, defaulting to INSTALLDIRS=site" # This hack brought to you by DCL's 255-character command line limit pure_perl_install :: ]; push @m, q[ $(NOECHO) $(PERLRUN) "-MFile::Spec" -e "print 'read|'.File::Spec->catfile('$(PERL_ARCHLIB)','auto','$(FULLEXT)','.packlist').'|'" >.MM_tmp $(NOECHO) $(PERLRUN) "-MFile::Spec" -e "print 'write|'.File::Spec->catfile('$(DESTINSTALLARCHLIB)','auto','$(FULLEXT)','.packlist').'|'" >>.MM_tmp ] unless $self->{NO_PACKLIST}; push @m, q[ $(NOECHO) $(ECHO_N) "$(INST_LIB)|$(DESTINSTALLPRIVLIB)|" >>.MM_tmp $(NOECHO) $(ECHO_N) "$(INST_ARCHLIB)|$(DESTINSTALLARCHLIB)|" >>.MM_tmp $(NOECHO) $(ECHO_N) "$(INST_BIN)|$(DESTINSTALLBIN)|" >>.MM_tmp $(NOECHO) $(ECHO_N) "$(INST_SCRIPT)|$(DESTINSTALLSCRIPT)|" >>.MM_tmp $(NOECHO) $(ECHO_N) "$(INST_MAN1DIR) $(DESTINSTALLMAN1DIR) " >>.MM_tmp $(NOECHO) $(ECHO_N) "$(INST_MAN3DIR)|$(DESTINSTALLMAN3DIR)" >>.MM_tmp $(NOECHO) $(MOD_INSTALL) <.MM_tmp $(NOECHO) $(RM_F) .MM_tmp $(NOECHO) $(WARN_IF_OLD_PACKLIST) "].$self->catfile($self->{SITEARCHEXP},'auto',$self->{FULLEXT},'.packlist').q[" # Likewise pure_site_install :: ]; push @m, q[ $(NOECHO) $(PERLRUN) "-MFile::Spec" -e "print 'read|'.File::Spec->catfile('$(SITEARCHEXP)','auto','$(FULLEXT)','.packlist').'|'" >.MM_tmp $(NOECHO) $(PERLRUN) "-MFile::Spec" -e "print 'write|'.File::Spec->catfile('$(DESTINSTALLSITEARCH)','auto','$(FULLEXT)','.packlist').'|'" >>.MM_tmp ] unless $self->{NO_PACKLIST}; push @m, q[ $(NOECHO) $(ECHO_N) "$(INST_LIB)|$(DESTINSTALLSITELIB)|" >>.MM_tmp $(NOECHO) $(ECHO_N) "$(INST_ARCHLIB)|$(DESTINSTALLSITEARCH)|" >>.MM_tmp $(NOECHO) $(ECHO_N) "$(INST_BIN)|$(DESTINSTALLSITEBIN)|" >>.MM_tmp $(NOECHO) $(ECHO_N) "$(INST_SCRIPT)|$(DESTINSTALLSCRIPT)|" >>.MM_tmp $(NOECHO) $(ECHO_N) "$(INST_MAN1DIR)|$(DESTINSTALLSITEMAN1DIR)|" >>.MM_tmp $(NOECHO) $(ECHO_N) "$(INST_MAN3DIR)|$(DESTINSTALLSITEMAN3DIR)" >>.MM_tmp $(NOECHO) $(MOD_INSTALL) <.MM_tmp $(NOECHO) $(RM_F) .MM_tmp $(NOECHO) $(WARN_IF_OLD_PACKLIST) "].$self->catfile($self->{PERL_ARCHLIB},'auto',$self->{FULLEXT},'.packlist').q[" pure_vendor_install :: ]; push @m, q[ $(NOECHO) $(PERLRUN) "-MFile::Spec" -e "print 'read|'.File::Spec->catfile('$(VENDORARCHEXP)','auto','$(FULLEXT)','.packlist').'|'" >.MM_tmp $(NOECHO) $(PERLRUN) "-MFile::Spec" -e "print 'write|'.File::Spec->catfile('$(DESTINSTALLVENDORARCH)','auto','$(FULLEXT)','.packlist').'|'" >>.MM_tmp ] unless $self->{NO_PACKLIST}; push @m, q[ $(NOECHO) $(ECHO_N) "$(INST_LIB)|$(DESTINSTALLVENDORLIB)|" >>.MM_tmp $(NOECHO) $(ECHO_N) "$(INST_ARCHLIB)|$(DESTINSTALLVENDORARCH)|" >>.MM_tmp $(NOECHO) $(ECHO_N) "$(INST_BIN)|$(DESTINSTALLVENDORBIN)|" >>.MM_tmp $(NOECHO) $(ECHO_N) "$(INST_SCRIPT)|$(DESTINSTALLSCRIPT)|" >>.MM_tmp $(NOECHO) $(ECHO_N) "$(INST_MAN1DIR)|$(DESTINSTALLVENDORMAN1DIR)|" >>.MM_tmp $(NOECHO) $(ECHO_N) "$(INST_MAN3DIR)|$(DESTINSTALLVENDORMAN3DIR)" >>.MM_tmp $(NOECHO) $(MOD_INSTALL) <.MM_tmp $(NOECHO) $(RM_F) .MM_tmp ]; push @m, q[ # Ditto doc_perl_install :: $(NOECHO) $(NOOP) # And again doc_site_install :: $(NOECHO) $(NOOP) doc_vendor_install :: $(NOECHO) $(NOOP) ] if $self->{NO_PERLLOCAL}; push @m, q[ # Ditto doc_perl_install :: $(NOECHO) $(ECHO) "Appending installation info to ].$self->catfile($self->{DESTINSTALLARCHLIB}, 'perllocal.pod').q[" $(NOECHO) $(MKPATH) $(DESTINSTALLARCHLIB) $(NOECHO) $(ECHO_N) "installed into|$(INSTALLPRIVLIB)|" >.MM_tmp $(NOECHO) $(ECHO_N) "LINKTYPE|$(LINKTYPE)|VERSION|$(VERSION)|EXE_FILES|$(EXE_FILES) " >>.MM_tmp $(NOECHO) $(DOC_INSTALL) "Module" "$(NAME)" <.MM_tmp >>].$self->catfile($self->{DESTINSTALLARCHLIB},'perllocal.pod').q[ $(NOECHO) $(RM_F) .MM_tmp # And again doc_site_install :: $(NOECHO) $(ECHO) "Appending installation info to ].$self->catfile($self->{DESTINSTALLARCHLIB}, 'perllocal.pod').q[" $(NOECHO) $(MKPATH) $(DESTINSTALLARCHLIB) $(NOECHO) $(ECHO_N) "installed into|$(INSTALLSITELIB)|" >.MM_tmp $(NOECHO) $(ECHO_N) "LINKTYPE|$(LINKTYPE)|VERSION|$(VERSION)|EXE_FILES|$(EXE_FILES) " >>.MM_tmp $(NOECHO) $(DOC_INSTALL) "Module" "$(NAME)" <.MM_tmp >>].$self->catfile($self->{DESTINSTALLARCHLIB},'perllocal.pod').q[ $(NOECHO) $(RM_F) .MM_tmp doc_vendor_install :: $(NOECHO) $(ECHO) "Appending installation info to ].$self->catfile($self->{DESTINSTALLARCHLIB}, 'perllocal.pod').q[" $(NOECHO) $(MKPATH) $(DESTINSTALLARCHLIB) $(NOECHO) $(ECHO_N) "installed into|$(INSTALLVENDORLIB)|" >.MM_tmp $(NOECHO) $(ECHO_N) "LINKTYPE|$(LINKTYPE)|VERSION|$(VERSION)|EXE_FILES|$(EXE_FILES) " >>.MM_tmp $(NOECHO) $(DOC_INSTALL) "Module" "$(NAME)" <.MM_tmp >>].$self->catfile($self->{DESTINSTALLARCHLIB},'perllocal.pod').q[ $(NOECHO) $(RM_F) .MM_tmp ] unless $self->{NO_PERLLOCAL}; push @m, q[ uninstall :: uninstall_from_$(INSTALLDIRS)dirs $(NOECHO) $(NOOP) uninstall_from_perldirs :: $(NOECHO) $(UNINSTALL) ].$self->catfile($self->{PERL_ARCHLIB},'auto',$self->{FULLEXT},'.packlist').q[ uninstall_from_sitedirs :: $(NOECHO) $(UNINSTALL) ].$self->catfile($self->{SITEARCHEXP},'auto',$self->{FULLEXT},'.packlist').q[ uninstall_from_vendordirs :: $(NOECHO) $(UNINSTALL) ].$self->catfile($self->{VENDORARCHEXP},'auto',$self->{FULLEXT},'.packlist').q[ ]; join('',@m); } =item perldepend (override) Use VMS-style syntax for files; it's cheaper to just do it directly here than to have the MM_Unix method call C repeatedly. Also, if we have to rebuild Config.pm, use MM[SK] to do it. =cut sub perldepend { my($self) = @_; my(@m); if ($self->{OBJECT}) { # Need to add an object file dependency on the perl headers. # this is very important for XS modules in perl.git development. push @m, $self->_perl_header_files_fragment(""); # empty separator on VMS as its in the $(PERL_INC) } if ($self->{PERL_SRC}) { my(@macros); my($mmsquals) = '$(USEMAKEFILE)[.vms]$(FIRST_MAKEFILE)'; push(@macros,'__AXP__=1') if $Config{'archname'} eq 'VMS_AXP'; push(@macros,'DECC=1') if $Config{'vms_cc_type'} eq 'decc'; push(@macros,'GNUC=1') if $Config{'vms_cc_type'} eq 'gcc'; push(@macros,'SOCKET=1') if $Config{'d_has_sockets'}; push(@macros,qq["CC=$Config{'cc'}"]) if $Config{'cc'} =~ m!/!; $mmsquals .= '$(USEMACROS)' . join(',',@macros) . '$(MACROEND)' if @macros; push(@m,q[ # Check for unpropagated config.sh changes. Should never happen. # We do NOT just update config.h because that is not sufficient. # An out of date config.h is not fatal but complains loudly! $(PERL_INC)config.h : $(PERL_SRC)config.sh $(NOOP) $(PERL_ARCHLIB)Config.pm : $(PERL_SRC)config.sh $(NOECHO) Write Sys$Error "$(PERL_ARCHLIB)Config.pm may be out of date with config.h or genconfig.pl" olddef = F$Environment("Default") Set Default $(PERL_SRC) $(MMS)],$mmsquals,); if ($self->{PERL_ARCHLIB} =~ m|\[-| && $self->{PERL_SRC} =~ m|(\[-+)|) { my($prefix,$target) = ($1,$self->fixpath('$(PERL_ARCHLIB)Config.pm',0)); $target =~ s/\Q$prefix/[/; push(@m," $target"); } else { push(@m,' $(MMS$TARGET)'); } push(@m,q[ Set Default 'olddef' ]); } push(@m, join(" ", map($self->fixpath($_,0),sort values %{$self->{XS}}))." : \$(XSUBPPDEPS)\n") if %{$self->{XS}}; join('',@m); } =item makeaperl (override) Undertake to build a new set of Perl images using VMS commands. Since VMS does dynamic loading, it's not necessary to statically link each extension into the Perl image, so this isn't the normal build path. Consequently, it hasn't really been tested, and may well be incomplete. =cut our %olbs; # needs to be localized sub makeaperl { my($self, %attribs) = @_; my($makefilename, $searchdirs, $static, $extra, $perlinc, $target, $tmpdir, $libperl) = @attribs{qw(MAKE DIRS STAT EXTRA INCL TARGET TMP LIBPERL)}; my(@m); push @m, " # --- MakeMaker makeaperl section --- MAP_TARGET = $target "; return join '', @m if $self->{PARENT}; my($dir) = join ":", @{$self->{DIR}}; unless ($self->{MAKEAPERL}) { push @m, q{ $(MAKE_APERL_FILE) : $(FIRST_MAKEFILE) $(NOECHO) $(ECHO) "Writing ""$(MMS$TARGET)"" for this $(MAP_TARGET)" $(NOECHO) $(PERLRUNINST) \ Makefile.PL DIR=}, $dir, q{ \ FIRST_MAKEFILE=$(MAKE_APERL_FILE) LINKTYPE=static \ MAKEAPERL=1 NORECURS=1 }; push @m, map(q[ \\\n\t\t"$_"], @ARGV),q{ $(MAP_TARGET) :: $(MAKE_APERL_FILE) $(MAKE)$(USEMAKEFILE)$(MAKE_APERL_FILE) static $(MMS$TARGET) }; push @m, "\n"; return join '', @m; } my($linkcmd,@optlibs,@staticpkgs,$extralist,$targdir,$libperldir,%libseen); local($_); # The front matter of the linkcommand... $linkcmd = join ' ', $Config{'ld'}, grep($_, @Config{qw(large split ldflags ccdlflags)}); $linkcmd =~ s/\s+/ /g; # Which *.olb files could we make use of... local(%olbs); # XXX can this be lexical? $olbs{$self->{INST_ARCHAUTODIR}} = "$self->{BASEEXT}\$(LIB_EXT)"; require File::Find; File::Find::find(sub { return unless m/\Q$self->{LIB_EXT}\E$/; return if m/^libperl/; if( exists $self->{INCLUDE_EXT} ){ my $found = 0; (my $xx = $File::Find::name) =~ s,.*?/auto/,,; $xx =~ s,/?$_,,; $xx =~ s,/,::,g; # Throw away anything not explicitly marked for inclusion. # DynaLoader is implied. foreach my $incl ((@{$self->{INCLUDE_EXT}},'DynaLoader')){ if( $xx eq $incl ){ $found++; last; } } return unless $found; } elsif( exists $self->{EXCLUDE_EXT} ){ (my $xx = $File::Find::name) =~ s,.*?/auto/,,; $xx =~ s,/?$_,,; $xx =~ s,/,::,g; # Throw away anything explicitly marked for exclusion foreach my $excl (@{$self->{EXCLUDE_EXT}}){ return if( $xx eq $excl ); } } $olbs{$ENV{DEFAULT}} = $_; }, grep( -d $_, @{$searchdirs || []})); # We trust that what has been handed in as argument will be buildable $static = [] unless $static; @olbs{@{$static}} = (1) x @{$static}; $extra = [] unless $extra && ref $extra eq 'ARRAY'; # Sort the object libraries in inverse order of # filespec length to try to insure that dependent extensions # will appear before their parents, so the linker will # search the parent library to resolve references. # (e.g. Intuit::DWIM will precede Intuit, so unresolved # references from [.intuit.dwim]dwim.obj can be found # in [.intuit]intuit.olb). for (sort { length($a) <=> length($b) || $a cmp $b } keys %olbs) { next unless $olbs{$_} =~ /\Q$self->{LIB_EXT}\E$/; my($dir) = $self->fixpath($_,1); my($extralibs) = $dir . "extralibs.ld"; my($extopt) = $dir . $olbs{$_}; $extopt =~ s/$self->{LIB_EXT}$/.opt/; push @optlibs, "$dir$olbs{$_}"; # Get external libraries this extension will need if (-f $extralibs ) { my %seenthis; open my $list, "<", $extralibs or warn $!,next; while (<$list>) { chomp; # Include a library in the link only once, unless it's mentioned # multiple times within a single extension's options file, in which # case we assume the builder needed to search it again later in the # link. my $skip = exists($libseen{$_}) && !exists($seenthis{$_}); $libseen{$_}++; $seenthis{$_}++; next if $skip; push @$extra,$_; } } # Get full name of extension for ExtUtils::Miniperl if (-f $extopt) { open my $opt, '<', $extopt or die $!; while (<$opt>) { next unless /(?:UNIVERSAL|VECTOR)=boot_([\w_]+)/; my $pkg = $1; $pkg =~ s#__*#::#g; push @staticpkgs,$pkg; } } } # Place all of the external libraries after all of the Perl extension # libraries in the final link, in order to maximize the opportunity # for XS code from multiple extensions to resolve symbols against the # same external library while only including that library once. push @optlibs, @$extra; $target = "Perl$Config{'exe_ext'}" unless $target; my $shrtarget; ($shrtarget,$targdir) = fileparse($target); $shrtarget =~ s/^([^.]*)/$1Shr/; $shrtarget = $targdir . $shrtarget; $target = "Perlshr.$Config{'dlext'}" unless $target; $tmpdir = "[]" unless $tmpdir; $tmpdir = $self->fixpath($tmpdir,1); if (@optlibs) { $extralist = join(' ',@optlibs); } else { $extralist = ''; } # Let ExtUtils::Liblist find the necessary libs for us (but skip PerlShr) # that's what we're building here). push @optlibs, grep { !/PerlShr/i } split ' ', +($self->ext())[2]; if ($libperl) { unless (-f $libperl || -f ($libperl = $self->catfile($Config{'installarchlib'},'CORE',$libperl))) { print "Warning: $libperl not found\n"; undef $libperl; } } unless ($libperl) { if (defined $self->{PERL_SRC}) { $libperl = $self->catfile($self->{PERL_SRC},"libperl$self->{LIB_EXT}"); } elsif (-f ($libperl = $self->catfile($Config{'installarchlib'},'CORE',"libperl$self->{LIB_EXT}")) ) { } else { print "Warning: $libperl not found If you're going to build a static perl binary, make sure perl is installed otherwise ignore this warning\n"; } } $libperldir = $self->fixpath((fileparse($libperl))[1],1); push @m, ' # Fill in the target you want to produce if it\'s not perl MAP_TARGET = ',$self->fixpath($target,0),' MAP_SHRTARGET = ',$self->fixpath($shrtarget,0)," MAP_LINKCMD = $linkcmd MAP_PERLINC = ", $perlinc ? map('"$_" ',@{$perlinc}) : ''," MAP_EXTRA = $extralist MAP_LIBPERL = ",$self->fixpath($libperl,0),' '; push @m,"\n${tmpdir}Makeaperl.Opt : \$(MAP_EXTRA)\n"; foreach (@optlibs) { push @m,' $(NOECHO) $(PERL) -e "print q{',$_,'}" >>$(MMS$TARGET)',"\n"; } push @m,"\n${tmpdir}PerlShr.Opt :\n\t"; push @m,'$(NOECHO) $(PERL) -e "print q{$(MAP_SHRTARGET)}" >$(MMS$TARGET)',"\n"; push @m,' $(MAP_SHRTARGET) : $(MAP_LIBPERL) Makeaperl.Opt ',"${libperldir}Perlshr_Attr.Opt",' $(MAP_LINKCMD)/Shareable=$(MMS$TARGET) $(MAP_LIBPERL), Makeaperl.Opt/Option ',"${libperldir}Perlshr_Attr.Opt/Option",' $(MAP_TARGET) : $(MAP_SHRTARGET) ',"${tmpdir}perlmain\$(OBJ_EXT) ${tmpdir}PerlShr.Opt",' $(MAP_LINKCMD) ',"${tmpdir}perlmain\$(OBJ_EXT)",', PerlShr.Opt/Option $(NOECHO) $(ECHO) "To install the new ""$(MAP_TARGET)"" binary, say" $(NOECHO) $(ECHO) " $(MAKE)$(USEMAKEFILE)$(FIRST_MAKEFILE) inst_perl $(USEMACROS)MAP_TARGET=$(MAP_TARGET)$(ENDMACRO)" $(NOECHO) $(ECHO) "To remove the intermediate files, say $(NOECHO) $(ECHO) " $(MAKE)$(USEMAKEFILE)$(FIRST_MAKEFILE) map_clean" '; push @m,"\n${tmpdir}perlmain.c : \$(FIRST_MAKEFILE)\n\t\$(NOECHO) \$(PERL) -e 1 >${tmpdir}Writemain.tmp\n"; push @m, "# More from the 255-char line length limit\n"; foreach (@staticpkgs) { push @m,' $(NOECHO) $(PERL) -e "print q{',$_,qq[}" >>${tmpdir}Writemain.tmp\n]; } push @m, sprintf <<'MAKE_FRAG', $tmpdir, $tmpdir; $(NOECHO) $(PERL) $(MAP_PERLINC) -ane "use ExtUtils::Miniperl; writemain(@F)" %sWritemain.tmp >$(MMS$TARGET) $(NOECHO) $(RM_F) %sWritemain.tmp MAKE_FRAG push @m, q[ # Still more from the 255-char line length limit doc_inst_perl : $(NOECHO) $(MKPATH) $(DESTINSTALLARCHLIB) $(NOECHO) $(ECHO) "Perl binary $(MAP_TARGET)|" >.MM_tmp $(NOECHO) $(ECHO) "MAP_STATIC|$(MAP_STATIC)|" >>.MM_tmp $(NOECHO) $(PERL) -pl040 -e " " ].$self->catfile('$(INST_ARCHAUTODIR)','extralibs.all'),q[ >>.MM_tmp $(NOECHO) $(ECHO) -e "MAP_LIBPERL|$(MAP_LIBPERL)|" >>.MM_tmp $(NOECHO) $(DOC_INSTALL) <.MM_tmp >>].$self->catfile('$(DESTINSTALLARCHLIB)','perllocal.pod').q[ $(NOECHO) $(RM_F) .MM_tmp ]; push @m, " inst_perl : pure_inst_perl doc_inst_perl \$(NOECHO) \$(NOOP) pure_inst_perl : \$(MAP_TARGET) $self->{CP} \$(MAP_SHRTARGET) ",$self->fixpath($Config{'installbin'},1)," $self->{CP} \$(MAP_TARGET) ",$self->fixpath($Config{'installbin'},1)," clean :: map_clean \$(NOECHO) \$(NOOP) map_clean : \$(RM_F) ${tmpdir}perlmain\$(OBJ_EXT) ${tmpdir}perlmain.c \$(FIRST_MAKEFILE) \$(RM_F) ${tmpdir}Makeaperl.Opt ${tmpdir}PerlShr.Opt \$(MAP_TARGET) "; join '', @m; } # --- Output postprocessing section --- =item maketext_filter (override) Ensure that colons marking targets are preceded by space, in order to distinguish the target delimiter from a colon appearing as part of a filespec. =cut sub maketext_filter { my($self, $text) = @_; $text =~ s/^([^\s:=]+)(:+\s)/$1 $2/mg; return $text; } =item prefixify (override) prefixifying on VMS is simple. Each should simply be: perl_root:[some.dir] which can just be converted to: volume:[your.prefix.some.dir] otherwise you get the default layout. In effect, your search prefix is ignored and $Config{vms_prefix} is used instead. =cut sub prefixify { my($self, $var, $sprefix, $rprefix, $default) = @_; # Translate $(PERLPREFIX) to a real path. $rprefix = $self->eliminate_macros($rprefix); $rprefix = vmspath($rprefix) if $rprefix; $sprefix = vmspath($sprefix) if $sprefix; $default = vmsify($default) unless $default =~ /\[.*\]/; (my $var_no_install = $var) =~ s/^install//; my $path = $self->{uc $var} || $ExtUtils::MM_Unix::Config_Override{lc $var} || $Config{lc $var} || $Config{lc $var_no_install}; if( !$path ) { warn " no Config found for $var.\n" if $Verbose >= 2; $path = $self->_prefixify_default($rprefix, $default); } elsif( !$self->{ARGS}{PREFIX} || !$self->file_name_is_absolute($path) ) { # do nothing if there's no prefix or if its relative } elsif( $sprefix eq $rprefix ) { warn " no new prefix.\n" if $Verbose >= 2; } else { warn " prefixify $var => $path\n" if $Verbose >= 2; warn " from $sprefix to $rprefix\n" if $Verbose >= 2; my($path_vol, $path_dirs) = $self->splitpath( $path ); if( $path_vol eq $Config{vms_prefix}.':' ) { warn " $Config{vms_prefix}: seen\n" if $Verbose >= 2; $path_dirs =~ s{^\[}{\[.} unless $path_dirs =~ m{^\[\.}; $path = $self->_catprefix($rprefix, $path_dirs); } else { $path = $self->_prefixify_default($rprefix, $default); } } print " now $path\n" if $Verbose >= 2; return $self->{uc $var} = $path; } sub _prefixify_default { my($self, $rprefix, $default) = @_; warn " cannot prefix, using default.\n" if $Verbose >= 2; if( !$default ) { warn "No default!\n" if $Verbose >= 1; return; } if( !$rprefix ) { warn "No replacement prefix!\n" if $Verbose >= 1; return ''; } return $self->_catprefix($rprefix, $default); } sub _catprefix { my($self, $rprefix, $default) = @_; my($rvol, $rdirs) = $self->splitpath($rprefix); if( $rvol ) { return $self->catpath($rvol, $self->catdir($rdirs, $default), '' ) } else { return $self->catdir($rdirs, $default); } } =item cd =cut sub cd { my($self, $dir, @cmds) = @_; $dir = vmspath($dir); my $cmd = join "\n\t", map "$_", @cmds; # No leading tab makes it look right when embedded my $make_frag = sprintf <<'MAKE_FRAG', $dir, $cmd; startdir = F$Environment("Default") Set Default %s %s Set Default 'startdir' MAKE_FRAG # No trailing newline makes this easier to embed chomp $make_frag; return $make_frag; } =item oneliner =cut sub oneliner { my($self, $cmd, $switches) = @_; $switches = [] unless defined $switches; # Strip leading and trailing newlines $cmd =~ s{^\n+}{}; $cmd =~ s{\n+$}{}; my @cmds = split /\n/, $cmd; $cmd = join " \n\t -e ", map $self->quote_literal($_), @cmds; $cmd = $self->escape_newlines($cmd); # Switches must be quoted else they will be lowercased. $switches = join ' ', map { qq{"$_"} } @$switches; return qq{\$(ABSPERLRUN) $switches -e $cmd "--"}; } =item B perl trips up on "" thinking it's an input redirect. So we use the native Write command instead. Besides, it's faster. =cut sub echo { my($self, $text, $file, $opts) = @_; # Compatibility with old options if( !ref $opts ) { my $append = $opts; $opts = { append => $append || 0 }; } my $opencmd = $opts->{append} ? 'Open/Append' : 'Open/Write'; $opts->{allow_variables} = 0 unless defined $opts->{allow_variables}; my $ql_opts = { allow_variables => $opts->{allow_variables} }; my @cmds = ("\$(NOECHO) $opencmd MMECHOFILE $file "); push @cmds, map { '$(NOECHO) Write MMECHOFILE '.$self->quote_literal($_, $ql_opts) } split /\n/, $text; push @cmds, '$(NOECHO) Close MMECHOFILE'; return @cmds; } =item quote_literal =cut sub quote_literal { my($self, $text, $opts) = @_; $opts->{allow_variables} = 1 unless defined $opts->{allow_variables}; # I believe this is all we should need. $text =~ s{"}{""}g; $text = $opts->{allow_variables} ? $self->escape_dollarsigns($text) : $self->escape_all_dollarsigns($text); return qq{"$text"}; } =item escape_dollarsigns Quote, don't escape. =cut sub escape_dollarsigns { my($self, $text) = @_; # Quote dollar signs which are not starting a variable $text =~ s{\$ (?!\() }{"\$"}gx; return $text; } =item escape_all_dollarsigns Quote, don't escape. =cut sub escape_all_dollarsigns { my($self, $text) = @_; # Quote dollar signs $text =~ s{\$}{"\$\"}gx; return $text; } =item escape_newlines =cut sub escape_newlines { my($self, $text) = @_; $text =~ s{\n}{-\n}g; return $text; } =item max_exec_len 256 characters. =cut sub max_exec_len { my $self = shift; return $self->{_MAX_EXEC_LEN} ||= 256; } =item init_linker =cut sub init_linker { my $self = shift; $self->{EXPORT_LIST} ||= '$(BASEEXT).opt'; my $shr = $Config{dbgprefix} . 'PERLSHR'; if ($self->{PERL_SRC}) { $self->{PERL_ARCHIVE} ||= $self->catfile($self->{PERL_SRC}, "$shr.$Config{'dlext'}"); } else { $self->{PERL_ARCHIVE} ||= $ENV{$shr} ? $ENV{$shr} : "Sys\$Share:$shr.$Config{'dlext'}"; } $self->{PERL_ARCHIVEDEP} ||= ''; $self->{PERL_ARCHIVE_AFTER} ||= ''; } =item catdir (override) =item catfile (override) Eliminate the macros in the output to the MMS/MMK file. (File::Spec::VMS used to do this for us, but it's being removed) =cut sub catdir { my $self = shift; # Process the macros on VMS MMS/MMK my @args = map { m{\$\(} ? $self->eliminate_macros($_) : $_ } @_; my $dir = $self->SUPER::catdir(@args); # Fix up the directory and force it to VMS format. $dir = $self->fixpath($dir, 1); return $dir; } sub catfile { my $self = shift; # Process the macros on VMS MMS/MMK my @args = map { m{\$\(} ? $self->eliminate_macros($_) : $_ } @_; my $file = $self->SUPER::catfile(@args); $file = vmsify($file); return $file } =item eliminate_macros Expands MM[KS]/Make macros in a text string, using the contents of identically named elements of C<%$self>, and returns the result as a file specification in Unix syntax. NOTE: This is the canonical version of the method. The version in File::Spec::VMS is deprecated. =cut sub eliminate_macros { my($self,$path) = @_; return '' unless $path; $self = {} unless ref $self; my($npath) = unixify($path); # sometimes unixify will return a string with an off-by-one trailing null $npath =~ s{\0$}{}; my($complex) = 0; my($head,$macro,$tail); # perform m##g in scalar context so it acts as an iterator while ($npath =~ m#(.*?)\$\((\S+?)\)(.*)#gs) { if (defined $self->{$2}) { ($head,$macro,$tail) = ($1,$2,$3); if (ref $self->{$macro}) { if (ref $self->{$macro} eq 'ARRAY') { $macro = join ' ', @{$self->{$macro}}; } else { print "Note: can't expand macro \$($macro) containing ",ref($self->{$macro}), "\n\t(using MMK-specific deferred substitutuon; MMS will break)\n"; $macro = "\cB$macro\cB"; $complex = 1; } } else { $macro = $self->{$macro}; # Don't unixify if there is unescaped whitespace $macro = unixify($macro) unless ($macro =~ /(?fixpath($path); my $path = $mm->fixpath($path, $is_dir); Catchall routine to clean up problem MM[SK]/Make macros. Expands macros in any directory specification, in order to avoid juxtaposing two VMS-syntax directories when MM[SK] is run. Also expands expressions which are all macro, so that we can tell how long the expansion is, and avoid overrunning DCL's command buffer when MM[KS] is running. fixpath() checks to see whether the result matches the name of a directory in the current default directory and returns a directory or file specification accordingly. C<$is_dir> can be set to true to force fixpath() to consider the path to be a directory or false to force it to be a file. NOTE: This is the canonical version of the method. The version in File::Spec::VMS is deprecated. =cut sub fixpath { my($self,$path,$force_path) = @_; return '' unless $path; $self = bless {}, $self unless ref $self; my($fixedpath,$prefix,$name); if ($path =~ m#^\$\([^\)]+\)\Z(?!\n)#s || $path =~ m#[/:>\]]#) { if ($force_path or $path =~ /(?:DIR\)|\])\Z(?!\n)/) { $fixedpath = vmspath($self->eliminate_macros($path)); } else { $fixedpath = vmsify($self->eliminate_macros($path)); } } elsif ((($prefix,$name) = ($path =~ m#^\$\(([^\)]+)\)(.+)#s)) && $self->{$prefix}) { my($vmspre) = $self->eliminate_macros("\$($prefix)"); # is it a dir or just a name? $vmspre = ($vmspre =~ m|/| or $prefix =~ /DIR\Z(?!\n)/) ? vmspath($vmspre) : ''; $fixedpath = ($vmspre ? $vmspre : $self->{$prefix}) . $name; $fixedpath = vmspath($fixedpath) if $force_path; } else { $fixedpath = $path; $fixedpath = vmspath($fixedpath) if $force_path; } # No hints, so we try to guess if (!defined($force_path) and $fixedpath !~ /[:>(.\]]/) { $fixedpath = vmspath($fixedpath) if -d $fixedpath; } # Trim off root dirname if it's had other dirs inserted in front of it. $fixedpath =~ s/\.000000([\]>])/$1/; # Special case for VMS absolute directory specs: these will have had device # prepended during trip through Unix syntax in eliminate_macros(), since # Unix syntax has no way to express "absolute from the top of this device's # directory tree". if ($path =~ /^[\[>][^.\-]/) { $fixedpath =~ s/^[^\[<]+//; } return $fixedpath; } =item os_flavor VMS is VMS. =cut sub os_flavor { return('VMS'); } =item is_make_type (override) None of the make types being checked for is viable on VMS, plus our $self->{MAKE} is an unexpanded (and unexpandable) macro whose value is known only to the make utility itself. =cut sub is_make_type { my($self, $type) = @_; return 0; } =item make_type (override) Returns a suitable string describing the type of makefile being written. =cut sub make_type { "$Config{make}-style"; } =back =head1 AUTHOR Original author Charles Bailey F Maintained by Michael G Schwern F See L for patching and contact information. =cut 1; EXTUTILS_MM_VMS $fatpacked{"ExtUtils/MM_VOS.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_MM_VOS'; package ExtUtils::MM_VOS; use strict; our $VERSION = '7.38'; $VERSION =~ tr/_//d; require ExtUtils::MM_Unix; our @ISA = qw(ExtUtils::MM_Unix); =head1 NAME ExtUtils::MM_VOS - VOS specific subclass of ExtUtils::MM_Unix =head1 SYNOPSIS Don't use this module directly. Use ExtUtils::MM and let it choose. =head1 DESCRIPTION This is a subclass of ExtUtils::MM_Unix which contains functionality for VOS. Unless otherwise stated it works just like ExtUtils::MM_Unix =head2 Overridden methods =head3 extra_clean_files Cleanup VOS core files =cut sub extra_clean_files { return qw(*.kp); } =head1 AUTHOR Michael G Schwern with code from ExtUtils::MM_Unix =head1 SEE ALSO L =cut 1; EXTUTILS_MM_VOS $fatpacked{"ExtUtils/MM_Win32.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_MM_WIN32'; package ExtUtils::MM_Win32; use strict; =head1 NAME ExtUtils::MM_Win32 - methods to override UN*X behaviour in ExtUtils::MakeMaker =head1 SYNOPSIS use ExtUtils::MM_Win32; # Done internally by ExtUtils::MakeMaker if needed =head1 DESCRIPTION See ExtUtils::MM_Unix for a documentation of the methods provided there. This package overrides the implementation of these methods, not the semantics. =cut use ExtUtils::MakeMaker::Config; use File::Basename; use File::Spec; use ExtUtils::MakeMaker qw(neatvalue _sprintf562); require ExtUtils::MM_Any; require ExtUtils::MM_Unix; our @ISA = qw( ExtUtils::MM_Any ExtUtils::MM_Unix ); our $VERSION = '7.38'; $VERSION =~ tr/_//d; $ENV{EMXSHELL} = 'sh'; # to run `commands` my ( $BORLAND, $GCC, $MSVC ) = _identify_compiler_environment( \%Config ); sub _identify_compiler_environment { my ( $config ) = @_; my $BORLAND = $config->{cc} =~ /\bbcc/i ? 1 : 0; my $GCC = $config->{cc} =~ /\bgcc\b/i ? 1 : 0; my $MSVC = $config->{cc} =~ /\b(?:cl|icl)/i ? 1 : 0; # MSVC can come as clarm.exe, icl=Intel C return ( $BORLAND, $GCC, $MSVC ); } =head2 Overridden methods =over 4 =item B =cut sub dlsyms { my($self,%attribs) = @_; return '' if $self->{SKIPHASH}{'dynamic'}; $self->xs_dlsyms_iterator(\%attribs); } =item xs_dlsyms_ext On Win32, is C<.def>. =cut sub xs_dlsyms_ext { '.def'; } =item replace_manpage_separator Changes the path separator with . =cut sub replace_manpage_separator { my($self,$man) = @_; $man =~ s,[/\\]+,.,g; $man; } =item B Since Windows has nothing as simple as an executable bit, we check the file extension. The PATHEXT env variable will be used to get a list of extensions that might indicate a command, otherwise .com, .exe, .bat and .cmd will be used by default. =cut sub maybe_command { my($self,$file) = @_; my @e = exists($ENV{'PATHEXT'}) ? split(/;/, $ENV{PATHEXT}) : qw(.com .exe .bat .cmd); my $e = ''; for (@e) { $e .= "\Q$_\E|" } chop $e; # see if file ends in one of the known extensions if ($file =~ /($e)$/i) { return $file if -e $file; } else { for (@e) { return "$file$_" if -e "$file$_"; } } return; } =item B Using \ for Windows, except for "gmake" where it is /. =cut sub init_DIRFILESEP { my($self) = shift; # The ^ makes sure its not interpreted as an escape in nmake $self->{DIRFILESEP} = $self->is_make_type('nmake') ? '^\\' : $self->is_make_type('dmake') ? '\\\\' : $self->is_make_type('gmake') ? '/' : '\\'; } =item init_tools Override some of the slower, portable commands with Windows specific ones. =cut sub init_tools { my ($self) = @_; $self->{NOOP} ||= 'rem'; $self->{DEV_NULL} ||= '> NUL'; $self->{FIXIN} ||= $self->{PERL_CORE} ? "\$(PERLRUN) -I$self->{PERL_SRC}\\cpan\\ExtUtils-PL2Bat\\lib $self->{PERL_SRC}\\win32\\bin\\pl2bat.pl" : 'pl2bat.bat'; $self->SUPER::init_tools; # Setting SHELL from $Config{sh} can break dmake. Its ok without it. delete $self->{SHELL}; return; } =item init_others Override the default link and compile tools. LDLOADLIBS's default is changed to $Config{libs}. Adjustments are made for Borland's quirks needing -L to come first. =cut sub init_others { my $self = shift; $self->{LD} ||= 'link'; $self->{AR} ||= 'lib'; $self->SUPER::init_others; $self->{LDLOADLIBS} ||= $Config{libs}; # -Lfoo must come first for Borland, so we put it in LDDLFLAGS if ($BORLAND) { my $libs = $self->{LDLOADLIBS}; my $libpath = ''; while ($libs =~ s/(?:^|\s)(("?)-L.+?\2)(?:\s|$)/ /) { $libpath .= ' ' if length $libpath; $libpath .= $1; } $self->{LDLOADLIBS} = $libs; $self->{LDDLFLAGS} ||= $Config{lddlflags}; $self->{LDDLFLAGS} .= " $libpath"; } return; } =item init_platform Add MM_Win32_VERSION. =item platform_constants =cut sub init_platform { my($self) = shift; $self->{MM_Win32_VERSION} = $VERSION; return; } sub platform_constants { my($self) = shift; my $make_frag = ''; foreach my $macro (qw(MM_Win32_VERSION)) { next unless defined $self->{$macro}; $make_frag .= "$macro = $self->{$macro}\n"; } return $make_frag; } =item specify_shell Set SHELL to $ENV{COMSPEC} only if make is type 'gmake'. =cut sub specify_shell { my $self = shift; return '' unless $self->is_make_type('gmake'); "\nSHELL = $ENV{COMSPEC}\n"; } =item constants Add MAXLINELENGTH for dmake before all the constants are output. =cut sub constants { my $self = shift; my $make_text = $self->SUPER::constants; return $make_text unless $self->is_make_type('dmake'); # dmake won't read any single "line" (even those with escaped newlines) # larger than a certain size which can be as small as 8k. PM_TO_BLIB # on large modules like DateTime::TimeZone can create lines over 32k. # So we'll crank it up to a WHOPPING 64k. # # This has to come here before all the constants and not in # platform_constants which is after constants. my $size = $self->{MAXLINELENGTH} || 800000; my $prefix = qq{ # Get dmake to read long commands like PM_TO_BLIB MAXLINELENGTH = $size }; return $prefix . $make_text; } =item special_targets Add .USESHELL target for dmake. =cut sub special_targets { my($self) = @_; my $make_frag = $self->SUPER::special_targets; $make_frag .= <<'MAKE_FRAG' if $self->is_make_type('dmake'); .USESHELL : MAKE_FRAG return $make_frag; } =item static_lib_pure_cmd Defines how to run the archive utility =cut sub static_lib_pure_cmd { my ($self, $from) = @_; $from =~ s/(\$\(\w+)(\))/$1:^"+"$2/g if $BORLAND; sprintf qq{\t\$(AR) %s\n}, ($BORLAND ? '$@ ' . $from : ($GCC ? '-ru $@ ' . $from : '-out:$@ ' . $from)); } =item dynamic_lib Methods are overridden here: not dynamic_lib itself, but the utility ones that do the OS-specific work. =cut sub xs_make_dynamic_lib { my ($self, $attribs, $from, $to, $todir, $ldfrom, $exportlist) = @_; my @m = sprintf '%s : %s $(MYEXTLIB) %s$(DFSEP).exists %s $(PERL_ARCHIVEDEP) $(INST_DYNAMIC_DEP)'."\n", $to, $from, $todir, $exportlist; if ($GCC) { # per https://rt.cpan.org/Ticket/Display.html?id=78395 no longer # uses dlltool - relies on post 2002 MinGW # 1 2 push @m, _sprintf562 <<'EOF', $exportlist, $ldfrom; $(LD) %1$s -o $@ $(LDDLFLAGS) %2$s $(OTHERLDFLAGS) $(MYEXTLIB) "$(PERL_ARCHIVE)" $(LDLOADLIBS) -Wl,--enable-auto-image-base EOF } elsif ($BORLAND) { my $ldargs = $self->is_make_type('dmake') ? q{"$(PERL_ARCHIVE:s,/,\,)" $(LDLOADLIBS:s,/,\,) $(MYEXTLIB:s,/,\,),} : q{"$(subst /,\,$(PERL_ARCHIVE))" $(subst /,\,$(LDLOADLIBS)) $(subst /,\,$(MYEXTLIB)),}; my $subbed; if ($exportlist eq '$(EXPORT_LIST)') { $subbed = $self->is_make_type('dmake') ? q{$(EXPORT_LIST:s,/,\,)} : q{$(subst /,\,$(EXPORT_LIST))}; } else { # in XSMULTI, exportlist is per-XS, so have to sub in perl not make ($subbed = $exportlist) =~ s#/#\\#g; } push @m, sprintf <<'EOF', $ldfrom, $ldargs . $subbed; $(LD) $(LDDLFLAGS) $(OTHERLDFLAGS) %s,$@,,%s,$(RESFILES) EOF } else { # VC push @m, sprintf <<'EOF', $ldfrom, $exportlist; $(LD) -out:$@ $(LDDLFLAGS) %s $(OTHERLDFLAGS) $(MYEXTLIB) "$(PERL_ARCHIVE)" $(LDLOADLIBS) -def:%s EOF # Embed the manifest file if it exists push(@m, q{ if exist $@.manifest mt -nologo -manifest $@.manifest -outputresource:$@;2 if exist $@.manifest del $@.manifest}); } push @m, "\n\t\$(CHMOD) \$(PERM_RWX) \$\@\n"; join '', @m; } sub xs_dynamic_lib_macros { my ($self, $attribs) = @_; my $otherldflags = $attribs->{OTHERLDFLAGS} || ($BORLAND ? 'c0d32.obj': ''); my $inst_dynamic_dep = $attribs->{INST_DYNAMIC_DEP} || ""; sprintf <<'EOF', $otherldflags, $inst_dynamic_dep; # This section creates the dynamically loadable objects from relevant # objects and possibly $(MYEXTLIB). OTHERLDFLAGS = %s INST_DYNAMIC_DEP = %s EOF } =item extra_clean_files Clean out some extra dll.{base,exp} files which might be generated by gcc. Otherwise, take out all *.pdb files. =cut sub extra_clean_files { my $self = shift; return $GCC ? (qw(dll.base dll.exp)) : ('*.pdb'); } =item init_linker =cut sub init_linker { my $self = shift; $self->{PERL_ARCHIVE} = "\$(PERL_INC)\\$Config{libperl}"; $self->{PERL_ARCHIVEDEP} = "\$(PERL_INCDEP)\\$Config{libperl}"; $self->{PERL_ARCHIVE_AFTER} = ''; $self->{EXPORT_LIST} = '$(BASEEXT).def'; } =item perl_script Checks for the perl program under several common perl extensions. =cut sub perl_script { my($self,$file) = @_; return $file if -r $file && -f _; return "$file.pl" if -r "$file.pl" && -f _; return "$file.plx" if -r "$file.plx" && -f _; return "$file.bat" if -r "$file.bat" && -f _; return; } sub can_dep_space { my $self = shift; 1; # with Win32::GetShortPathName } =item quote_dep =cut sub quote_dep { my ($self, $arg) = @_; if ($arg =~ / / and not $self->is_make_type('gmake')) { require Win32; $arg = Win32::GetShortPathName($arg); die <SUPER::quote_dep($arg); } =item xs_obj_opt Override to fixup -o flags for MSVC. =cut sub xs_obj_opt { my ($self, $output_file) = @_; ($MSVC ? "/Fo" : "-o ") . $output_file; } =item pasthru All we send is -nologo to nmake to prevent it from printing its damned banner. =cut sub pasthru { my($self) = shift; my $old = $self->SUPER::pasthru; return $old unless $self->is_make_type('nmake'); $old =~ s/(PASTHRU\s*=\s*)/$1 -nologo /; $old; } =item arch_check (override) Normalize all arguments for consistency of comparison. =cut sub arch_check { my $self = shift; # Win32 is an XS module, minperl won't have it. # arch_check() is not critical, so just fake it. return 1 unless $self->can_load_xs; return $self->SUPER::arch_check( map { $self->_normalize_path_name($_) } @_); } sub _normalize_path_name { my $self = shift; my $file = shift; require Win32; my $short = Win32::GetShortPathName($file); return defined $short ? lc $short : lc $file; } =item oneliner These are based on what command.com does on Win98. They may be wrong for other Windows shells, I don't know. =cut sub oneliner { my($self, $cmd, $switches) = @_; $switches = [] unless defined $switches; # Strip leading and trailing newlines $cmd =~ s{^\n+}{}; $cmd =~ s{\n+$}{}; $cmd = $self->quote_literal($cmd); $cmd = $self->escape_newlines($cmd); $switches = join ' ', @$switches; return qq{\$(ABSPERLRUN) $switches -e $cmd --}; } sub quote_literal { my($self, $text, $opts) = @_; $opts->{allow_variables} = 1 unless defined $opts->{allow_variables}; # See: http://www.autohotkey.net/~deleyd/parameters/parameters.htm#CPP # Apply the Microsoft C/C++ parsing rules $text =~ s{\\\\"}{\\\\\\\\\\"}g; # \\" -> \\\\\" $text =~ s{(? \\\" $text =~ s{(? \" $text = qq{"$text"} if $text =~ /[ \t#]/; # hash because gmake 4.2.1 # Apply the Command Prompt parsing rules (cmd.exe) my @text = split /("[^"]*")/, $text; # We should also escape parentheses, but it breaks one-liners containing # $(MACRO)s in makefiles. s{([<>|&^@!])}{^$1}g foreach grep { !/^"[^"]*"$/ } @text; $text = join('', @text); # dmake expands {{ to { and }} to }. if( $self->is_make_type('dmake') ) { $text =~ s/{/{{/g; $text =~ s/}/}}/g; } $text = $opts->{allow_variables} ? $self->escape_dollarsigns($text) : $self->escape_all_dollarsigns($text); return $text; } sub escape_newlines { my($self, $text) = @_; # Escape newlines $text =~ s{\n}{\\\n}g; return $text; } =item cd dmake can handle Unix style cd'ing but nmake (at least 1.5) cannot. It wants: cd dir1\dir2 command another_command cd ..\.. =cut sub cd { my($self, $dir, @cmds) = @_; return $self->SUPER::cd($dir, @cmds) unless $self->is_make_type('nmake'); my $cmd = join "\n\t", map "$_", @cmds; my $updirs = $self->catdir(map { $self->updir } $self->splitdir($dir)); # No leading tab and no trailing newline makes for easier embedding. my $make_frag = sprintf <<'MAKE_FRAG', $dir, $cmd, $updirs; cd %s %s cd %s MAKE_FRAG chomp $make_frag; return $make_frag; } =item max_exec_len nmake 1.50 limits command length to 2048 characters. =cut sub max_exec_len { my $self = shift; return $self->{_MAX_EXEC_LEN} ||= 2 * 1024; } =item os_flavor Windows is Win32. =cut sub os_flavor { return('Win32'); } =item dbgoutflag Returns a CC flag that tells the CC to emit a separate debugging symbol file when compiling an object file. =cut sub dbgoutflag { $MSVC ? '-Fd$(*).pdb' : ''; } =item cflags Defines the PERLDLL symbol if we are configured for static building since all code destined for the perl5xx.dll must be compiled with the PERLDLL symbol defined. =cut sub cflags { my($self,$libperl)=@_; return $self->{CFLAGS} if $self->{CFLAGS}; return '' unless $self->needs_linking(); my $base = $self->SUPER::cflags($libperl); foreach (split /\n/, $base) { /^(\S*)\s*=\s*(\S*)$/ and $self->{$1} = $2; }; $self->{CCFLAGS} .= " -DPERLDLL" if ($self->{LINKTYPE} eq 'static'); return $self->{CFLAGS} = qq{ CCFLAGS = $self->{CCFLAGS} OPTIMIZE = $self->{OPTIMIZE} PERLTYPE = $self->{PERLTYPE} }; } =item make_type Returns a suitable string describing the type of makefile being written. =cut sub make_type { my ($self) = @_; my $make = $self->make; $make = +( File::Spec->splitpath( $make ) )[-1]; $make =~ s!\.exe$!!i; if ( $make =~ m![^A-Z0-9]!i ) { ($make) = grep { m!make!i } split m![^A-Z0-9]!i, $make; } return "$make-style"; } 1; __END__ =back EXTUTILS_MM_WIN32 $fatpacked{"ExtUtils/MM_Win95.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_MM_WIN95'; package ExtUtils::MM_Win95; use strict; our $VERSION = '7.38'; $VERSION =~ tr/_//d; require ExtUtils::MM_Win32; our @ISA = qw(ExtUtils::MM_Win32); use ExtUtils::MakeMaker::Config; =head1 NAME ExtUtils::MM_Win95 - method to customize MakeMaker for Win9X =head1 SYNOPSIS You should not be using this module directly. =head1 DESCRIPTION This is a subclass of ExtUtils::MM_Win32 containing changes necessary to get MakeMaker playing nice with command.com and other Win9Xisms. =head2 Overridden methods Most of these make up for limitations in the Win9x/nmake command shell. =over 4 =item max_exec_len Win98 chokes on things like Encode if we set the max length to nmake's max of 2K. So we go for a more conservative value of 1K. =cut sub max_exec_len { my $self = shift; return $self->{_MAX_EXEC_LEN} ||= 1024; } =item os_flavor Win95 and Win98 and WinME are collectively Win9x and Win32 =cut sub os_flavor { my $self = shift; return ($self->SUPER::os_flavor, 'Win9x'); } =back =head1 AUTHOR Code originally inside MM_Win32. Original author unknown. Currently maintained by Michael G Schwern C. Send patches and ideas to C. See https://metacpan.org/release/ExtUtils-MakeMaker. =cut 1; EXTUTILS_MM_WIN95 $fatpacked{"ExtUtils/MY.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_MY'; package ExtUtils::MY; use strict; require ExtUtils::MM; our $VERSION = '7.38'; $VERSION =~ tr/_//d; our @ISA = qw(ExtUtils::MM); { package MY; our @ISA = qw(ExtUtils::MY); } sub DESTROY {} =head1 NAME ExtUtils::MY - ExtUtils::MakeMaker subclass for customization =head1 SYNOPSIS # in your Makefile.PL sub MY::whatever { ... } =head1 DESCRIPTION B ExtUtils::MY is a subclass of ExtUtils::MM. Its provided in your Makefile.PL for you to add and override MakeMaker functionality. It also provides a convenient alias via the MY class. ExtUtils::MY might turn out to be a temporary solution, but MY won't go away. =cut EXTUTILS_MY $fatpacked{"ExtUtils/MakeMaker.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_MAKEMAKER'; # $Id$ package ExtUtils::MakeMaker; use strict; BEGIN {require 5.006;} require Exporter; use ExtUtils::MakeMaker::Config; use ExtUtils::MakeMaker::version; # ensure we always have our fake version.pm use Carp; use File::Path; my $CAN_DECODE = eval { require ExtUtils::MakeMaker::Locale; }; # 2 birds, 1 stone eval { ExtUtils::MakeMaker::Locale::reinit('UTF-8') } if $CAN_DECODE and Encode::find_encoding('locale')->name eq 'ascii'; our $Verbose = 0; # exported our @Parent; # needs to be localized our @Get_from_Config; # referenced by MM_Unix our @MM_Sections; our @Overridable; my @Prepend_parent; my %Recognized_Att_Keys; our %macro_fsentity; # whether a macro is a filesystem name our %macro_dep; # whether a macro is a dependency our $VERSION = '7.38'; $VERSION =~ tr/_//d; # Emulate something resembling CVS $Revision$ (our $Revision = $VERSION) =~ s{_}{}; $Revision = int $Revision * 10000; our $Filename = __FILE__; # referenced outside MakeMaker our @ISA = qw(Exporter); our @EXPORT = qw(&WriteMakefile $Verbose &prompt &os_unsupported); our @EXPORT_OK = qw($VERSION &neatvalue &mkbootstrap &mksymlists &WriteEmptyMakefile &open_for_writing &write_file_via_tmp &_sprintf562); # These will go away once the last of the Win32 & VMS specific code is # purged. my $Is_VMS = $^O eq 'VMS'; my $Is_Win32 = $^O eq 'MSWin32'; our $UNDER_CORE = $ENV{PERL_CORE}; # needs to be our full_setup(); require ExtUtils::MM; # Things like CPAN assume loading ExtUtils::MakeMaker # will give them MM. require ExtUtils::MY; # XXX pre-5.8 versions of ExtUtils::Embed expect # loading ExtUtils::MakeMaker will give them MY. # This will go when Embed is its own CPAN module. # 5.6.2 can't do sprintf "%1$s" - this can only do %s sub _sprintf562 { my ($format, @args) = @_; for (my $i = 1; $i <= @args; $i++) { $format =~ s#%$i\$s#$args[$i-1]#g; } $format; } sub WriteMakefile { croak "WriteMakefile: Need even number of args" if @_ % 2; require ExtUtils::MY; my %att = @_; _convert_compat_attrs(\%att); _verify_att(\%att); my $mm = MM->new(\%att); $mm->flush; return $mm; } # Basic signatures of the attributes WriteMakefile takes. Each is the # reference type. Empty value indicate it takes a non-reference # scalar. my %Att_Sigs; my %Special_Sigs = ( AUTHOR => 'ARRAY', C => 'ARRAY', CONFIG => 'ARRAY', CONFIGURE => 'CODE', DIR => 'ARRAY', DL_FUNCS => 'HASH', DL_VARS => 'ARRAY', EXCLUDE_EXT => 'ARRAY', EXE_FILES => 'ARRAY', FUNCLIST => 'ARRAY', H => 'ARRAY', IMPORTS => 'HASH', INCLUDE_EXT => 'ARRAY', LIBS => ['ARRAY',''], MAN1PODS => 'HASH', MAN3PODS => 'HASH', META_ADD => 'HASH', META_MERGE => 'HASH', OBJECT => ['ARRAY', ''], PL_FILES => 'HASH', PM => 'HASH', PMLIBDIRS => 'ARRAY', PMLIBPARENTDIRS => 'ARRAY', PREREQ_PM => 'HASH', BUILD_REQUIRES => 'HASH', CONFIGURE_REQUIRES => 'HASH', TEST_REQUIRES => 'HASH', SKIP => 'ARRAY', TYPEMAPS => 'ARRAY', XS => 'HASH', XSBUILD => 'HASH', VERSION => ['version',''], _KEEP_AFTER_FLUSH => '', clean => 'HASH', depend => 'HASH', dist => 'HASH', dynamic_lib=> 'HASH', linkext => 'HASH', macro => 'HASH', postamble => 'HASH', realclean => 'HASH', test => 'HASH', tool_autosplit => 'HASH', ); @Att_Sigs{keys %Recognized_Att_Keys} = ('') x keys %Recognized_Att_Keys; @Att_Sigs{keys %Special_Sigs} = values %Special_Sigs; sub _convert_compat_attrs { #result of running several times should be same my($att) = @_; if (exists $att->{AUTHOR}) { if ($att->{AUTHOR}) { if (!ref($att->{AUTHOR})) { my $t = $att->{AUTHOR}; $att->{AUTHOR} = [$t]; } } else { $att->{AUTHOR} = []; } } } sub _verify_att { my($att) = @_; foreach my $key (sort keys %$att) { my $val = $att->{$key}; my $sig = $Att_Sigs{$key}; unless( defined $sig ) { warn "WARNING: $key is not a known parameter.\n"; next; } my @sigs = ref $sig ? @$sig : $sig; my $given = ref $val; unless( grep { _is_of_type($val, $_) } @sigs ) { my $takes = join " or ", map { _format_att($_) } @sigs; my $has = _format_att($given); warn "WARNING: $key takes a $takes not a $has.\n". " Please inform the author.\n"; } } } # Check if a given thing is a reference or instance of $type sub _is_of_type { my($thing, $type) = @_; return 1 if ref $thing eq $type; local $SIG{__DIE__}; return 1 if eval{ $thing->isa($type) }; return 0; } sub _format_att { my $given = shift; return $given eq '' ? "string/number" : uc $given eq $given ? "$given reference" : "$given object" ; } sub prompt ($;$) { ## no critic my($mess, $def) = @_; confess("prompt function called without an argument") unless defined $mess; my $isa_tty = -t STDIN && (-t STDOUT || !(-f STDOUT || -c STDOUT)) ; my $dispdef = defined $def ? "[$def] " : " "; $def = defined $def ? $def : ""; local $|=1; local $\; print "$mess $dispdef"; my $ans; if ($ENV{PERL_MM_USE_DEFAULT} || (!$isa_tty && eof STDIN)) { print "$def\n"; } else { $ans = ; if( defined $ans ) { $ans =~ s{\015?\012$}{}; } else { # user hit ctrl-D print "\n"; } } return (!defined $ans || $ans eq '') ? $def : $ans; } sub os_unsupported { die "OS unsupported\n"; } sub eval_in_subdirs { my($self) = @_; use Cwd qw(cwd abs_path); my $pwd = cwd() || die "Can't figure out your cwd!"; local @INC = map eval {abs_path($_) if -e} || $_, @INC; push @INC, '.'; # '.' has to always be at the end of @INC foreach my $dir (@{$self->{DIR}}){ my($abs) = $self->catdir($pwd,$dir); eval { $self->eval_in_x($abs); }; last if $@; } chdir $pwd; die $@ if $@; } sub eval_in_x { my($self,$dir) = @_; chdir $dir or carp("Couldn't change to directory $dir: $!"); { package main; do './Makefile.PL'; }; if ($@) { # if ($@ =~ /prerequisites/) { # die "MakeMaker WARNING: $@"; # } else { # warn "WARNING from evaluation of $dir/Makefile.PL: $@"; # } die "ERROR from evaluation of $dir/Makefile.PL: $@"; } } # package name for the classes into which the first object will be blessed my $PACKNAME = 'PACK000'; sub full_setup { $Verbose ||= 0; my @dep_macros = qw/ PERL_INCDEP PERL_ARCHLIBDEP PERL_ARCHIVEDEP /; my @fs_macros = qw/ FULLPERL XSUBPPDIR INST_ARCHLIB INST_SCRIPT INST_BIN INST_LIB INST_MAN1DIR INST_MAN3DIR INSTALLDIRS DESTDIR PREFIX INSTALL_BASE PERLPREFIX SITEPREFIX VENDORPREFIX INSTALLPRIVLIB INSTALLSITELIB INSTALLVENDORLIB INSTALLARCHLIB INSTALLSITEARCH INSTALLVENDORARCH INSTALLBIN INSTALLSITEBIN INSTALLVENDORBIN INSTALLMAN1DIR INSTALLMAN3DIR INSTALLSITEMAN1DIR INSTALLSITEMAN3DIR INSTALLVENDORMAN1DIR INSTALLVENDORMAN3DIR INSTALLSCRIPT INSTALLSITESCRIPT INSTALLVENDORSCRIPT PERL_LIB PERL_ARCHLIB SITELIBEXP SITEARCHEXP MAKE LIBPERL_A LIB PERL_SRC PERL_INC PPM_INSTALL_EXEC PPM_UNINSTALL_EXEC PPM_INSTALL_SCRIPT PPM_UNINSTALL_SCRIPT /; my @attrib_help = qw/ AUTHOR ABSTRACT ABSTRACT_FROM BINARY_LOCATION C CAPI CCFLAGS CONFIG CONFIGURE DEFINE DIR DISTNAME DISTVNAME DL_FUNCS DL_VARS EXCLUDE_EXT EXE_FILES FIRST_MAKEFILE FULLPERLRUN FULLPERLRUNINST FUNCLIST H IMPORTS INC INCLUDE_EXT LDFROM LIBS LICENSE LINKTYPE MAKEAPERL MAKEFILE MAKEFILE_OLD MAN1PODS MAN3PODS MAP_TARGET META_ADD META_MERGE MIN_PERL_VERSION BUILD_REQUIRES CONFIGURE_REQUIRES MYEXTLIB NAME NEEDS_LINKING NOECHO NO_META NO_MYMETA NO_PACKLIST NO_PERLLOCAL NORECURS NO_VC OBJECT OPTIMIZE PERL_MALLOC_OK PERL PERLMAINCC PERLRUN PERLRUNINST PERL_CORE PERM_DIR PERM_RW PERM_RWX MAGICXS PL_FILES PM PM_FILTER PMLIBDIRS PMLIBPARENTDIRS POLLUTE PREREQ_FATAL PREREQ_PM PREREQ_PRINT PRINT_PREREQ PUREPERL_ONLY SIGN SKIP TEST_REQUIRES TYPEMAPS UNINST VERSION VERSION_FROM XS XSBUILD XSMULTI XSOPT XSPROTOARG XS_VERSION clean depend dist dynamic_lib linkext macro realclean tool_autosplit MAN1EXT MAN3EXT MACPERL_SRC MACPERL_LIB MACLIBS_68K MACLIBS_PPC MACLIBS_SC MACLIBS_MRC MACLIBS_ALL_68K MACLIBS_ALL_PPC MACLIBS_SHARED /; push @attrib_help, @fs_macros; @macro_fsentity{@fs_macros, @dep_macros} = (1) x (@fs_macros+@dep_macros); @macro_dep{@dep_macros} = (1) x @dep_macros; # IMPORTS is used under OS/2 and Win32 # @Overridable is close to @MM_Sections but not identical. The # order is important. Many subroutines declare macros. These # depend on each other. Let's try to collect the macros up front, # then pasthru, then the rules. # MM_Sections are the sections we have to call explicitly # in Overridable we have subroutines that are used indirectly @MM_Sections = qw( post_initialize const_config constants platform_constants tool_autosplit tool_xsubpp tools_other makemakerdflt dist macro depend cflags const_loadlibs const_cccmd post_constants pasthru special_targets c_o xs_c xs_o top_targets blibdirs linkext dlsyms dynamic_bs dynamic dynamic_lib static static_lib manifypods processPL installbin subdirs clean_subdirs clean realclean_subdirs realclean metafile signature dist_basics dist_core distdir dist_test dist_ci distmeta distsignature install force perldepend makefile staticmake test ppd ); # loses section ordering @Overridable = @MM_Sections; push @Overridable, qw[ libscan makeaperl needs_linking subdir_x test_via_harness test_via_script init_VERSION init_dist init_INST init_INSTALL init_DEST init_dirscan init_PM init_MANPODS init_xs init_PERL init_DIRFILESEP init_linker ]; push @MM_Sections, qw[ pm_to_blib selfdocument ]; # Postamble needs to be the last that was always the case push @MM_Sections, "postamble"; push @Overridable, "postamble"; # All sections are valid keys. @Recognized_Att_Keys{@MM_Sections} = (1) x @MM_Sections; # we will use all these variables in the Makefile @Get_from_Config = qw( ar cc cccdlflags ccdlflags dlext dlsrc exe_ext full_ar ld lddlflags ldflags libc lib_ext obj_ext osname osvers ranlib sitelibexp sitearchexp so ); # 5.5.3 doesn't have any concept of vendor libs push @Get_from_Config, qw( vendorarchexp vendorlibexp ) if "$]" >= 5.006; foreach my $item (@attrib_help){ $Recognized_Att_Keys{$item} = 1; } foreach my $item (@Get_from_Config) { $Recognized_Att_Keys{uc $item} = $Config{$item}; print "Attribute '\U$item\E' => '$Config{$item}'\n" if ($Verbose >= 2); } # # When we eval a Makefile.PL in a subdirectory, that one will ask # us (the parent) for the values and will prepend "..", so that # all files to be installed end up below OUR ./blib # @Prepend_parent = qw( INST_BIN INST_LIB INST_ARCHLIB INST_SCRIPT MAP_TARGET INST_MAN1DIR INST_MAN3DIR PERL_SRC PERL FULLPERL ); } sub _has_cpan_meta_requirements { return eval { require CPAN::Meta::Requirements; CPAN::Meta::Requirements->VERSION(2.130); require B; # CMR requires this, for core we have to too. }; } sub new { my($class,$self) = @_; my($key); _convert_compat_attrs($self) if defined $self && $self; # Store the original args passed to WriteMakefile() foreach my $k (keys %$self) { $self->{ARGS}{$k} = $self->{$k}; } $self = {} unless defined $self; # Temporarily bless it into MM so it can be used as an # object. It will be blessed into a temp package later. bless $self, "MM"; # Cleanup all the module requirement bits my %key2cmr; for my $key (qw(PREREQ_PM BUILD_REQUIRES CONFIGURE_REQUIRES TEST_REQUIRES)) { $self->{$key} ||= {}; if (_has_cpan_meta_requirements) { my $cmr = CPAN::Meta::Requirements->from_string_hash( $self->{$key}, { bad_version_hook => sub { #no warnings 'numeric'; # module doesn't use warnings my $fallback; if ( $_[0] =~ m!^[-+]?[0-9]*\.?[0-9]+([eE][-+]?[0-9]+)?$! ) { $fallback = sprintf "%f", $_[0]; } else { ($fallback) = $_[0] ? ($_[0] =~ /^([0-9.]+)/) : 0; $fallback += 0; carp "Unparsable version '$_[0]' for prerequisite $_[1] treated as $fallback"; } version->new($fallback); }, }, ); $self->{$key} = $cmr->as_string_hash; $key2cmr{$key} = $cmr; } else { for my $module (sort keys %{ $self->{$key} }) { my $version = $self->{$key}->{$module}; my $fallback = 0; if (!defined($version) or !length($version)) { carp "Undefined requirement for $module treated as '0' (CPAN::Meta::Requirements not available)"; } elsif ($version =~ /^\d+(?:\.\d+(?:_\d+)*)?$/) { next; } else { if ( $version =~ m!^[-+]?[0-9]*\.?[0-9]+([eE][-+]?[0-9]+)?$! ) { $fallback = sprintf "%f", $version; } else { ($fallback) = $version ? ($version =~ /^([0-9.]+)/) : 0; $fallback += 0; carp "Unparsable version '$version' for prerequisite $module treated as $fallback (CPAN::Meta::Requirements not available)"; } } $self->{$key}->{$module} = $fallback; } } } if ("@ARGV" =~ /\bPREREQ_PRINT\b/) { $self->_PREREQ_PRINT; } # PRINT_PREREQ is RedHatism. if ("@ARGV" =~ /\bPRINT_PREREQ\b/) { $self->_PRINT_PREREQ; } print "MakeMaker (v$VERSION)\n" if $Verbose; if (-f "MANIFEST" && ! -f "Makefile" && ! $UNDER_CORE){ check_manifest(); } check_hints($self); if ( defined $self->{MIN_PERL_VERSION} && $self->{MIN_PERL_VERSION} !~ /^v?[\d_\.]+$/ ) { require version; my $normal = eval { local $SIG{__WARN__} = sub { # simulate "use warnings FATAL => 'all'" for vintage perls die @_; }; version->new( $self->{MIN_PERL_VERSION} ) }; $self->{MIN_PERL_VERSION} = $normal if defined $normal && !$@; } # Translate X.Y.Z to X.00Y00Z if( defined $self->{MIN_PERL_VERSION} ) { $self->{MIN_PERL_VERSION} =~ s{ ^v? (\d+) \. (\d+) \. (\d+) $ } {sprintf "%d.%03d%03d", $1, $2, $3}ex; } my $perl_version_ok = eval { local $SIG{__WARN__} = sub { # simulate "use warnings FATAL => 'all'" for vintage perls die @_; }; !$self->{MIN_PERL_VERSION} or $self->{MIN_PERL_VERSION} <= "$]" }; if (!$perl_version_ok) { if (!defined $perl_version_ok) { die <<'END'; Warning: MIN_PERL_VERSION is not in a recognized format. Recommended is a quoted numerical value like '5.005' or '5.008001'. END } elsif ($self->{PREREQ_FATAL}) { die sprintf <<"END", $self->{MIN_PERL_VERSION}, $]; MakeMaker FATAL: perl version too low for this distribution. Required is %s. We run %s. END } else { warn sprintf "Warning: Perl version %s or higher required. We run %s.\n", $self->{MIN_PERL_VERSION}, $]; } } my %configure_att; # record &{$self->{CONFIGURE}} attributes my(%initial_att) = %$self; # record initial attributes my(%unsatisfied) = (); my %prereq2version; my $cmr; if (_has_cpan_meta_requirements) { $cmr = CPAN::Meta::Requirements->new; for my $key (qw(PREREQ_PM BUILD_REQUIRES CONFIGURE_REQUIRES TEST_REQUIRES)) { $cmr->add_requirements($key2cmr{$key}) if $key2cmr{$key}; } foreach my $prereq ($cmr->required_modules) { $prereq2version{$prereq} = $cmr->requirements_for_module($prereq); } } else { for my $key (qw(PREREQ_PM BUILD_REQUIRES CONFIGURE_REQUIRES TEST_REQUIRES)) { next unless my $module2version = $self->{$key}; $prereq2version{$_} = $module2version->{$_} for keys %$module2version; } } foreach my $prereq (sort keys %prereq2version) { my $required_version = $prereq2version{$prereq}; my $pr_version = 0; my $installed_file; if ( $prereq eq 'perl' ) { if ( defined $required_version && $required_version =~ /^v?[\d_\.]+$/ || $required_version !~ /^v?[\d_\.]+$/ ) { require version; my $normal = eval { version->new( $required_version ) }; $required_version = $normal if defined $normal; } $installed_file = $prereq; $pr_version = $]; } else { $installed_file = MM->_installed_file_for_module($prereq); $pr_version = MM->parse_version($installed_file) if $installed_file; $pr_version = 0 if $pr_version eq 'undef'; if ( !eval { version->new( $pr_version ); 1 } ) { #no warnings 'numeric'; # module doesn't use warnings my $fallback; if ( $pr_version =~ m!^[-+]?[0-9]*\.?[0-9]+([eE][-+]?[0-9]+)?$! ) { $fallback = sprintf '%f', $pr_version; } else { ($fallback) = $pr_version ? ($pr_version =~ /^([0-9.]+)/) : 0; $fallback += 0; carp "Unparsable version '$pr_version' for installed prerequisite $prereq treated as $fallback"; } $pr_version = $fallback; } } # convert X.Y_Z alpha version #s to X.YZ for easier comparisons $pr_version =~ s/(\d+)\.(\d+)_(\d+)/$1.$2$3/; if (!$installed_file) { warn sprintf "Warning: prerequisite %s %s not found.\n", $prereq, $required_version unless $self->{PREREQ_FATAL} or $UNDER_CORE; $unsatisfied{$prereq} = 'not installed'; } elsif ( $cmr ? !$cmr->accepts_module($prereq, $pr_version) : $required_version > $pr_version ) { warn sprintf "Warning: prerequisite %s %s not found. We have %s.\n", $prereq, $required_version, ($pr_version || 'unknown version') unless $self->{PREREQ_FATAL} or $UNDER_CORE; $unsatisfied{$prereq} = $required_version || 'unknown version' ; } } if (%unsatisfied && $self->{PREREQ_FATAL}){ my $failedprereqs = join "\n", map {" $_ $unsatisfied{$_}"} sort { $a cmp $b } keys %unsatisfied; die <<"END"; MakeMaker FATAL: prerequisites not found. $failedprereqs Please install these modules first and rerun 'perl Makefile.PL'. END } if (defined $self->{CONFIGURE}) { if (ref $self->{CONFIGURE} eq 'CODE') { %configure_att = %{&{$self->{CONFIGURE}}}; _convert_compat_attrs(\%configure_att); $self = { %$self, %configure_att }; } else { croak "Attribute 'CONFIGURE' to WriteMakefile() not a code reference\n"; } } my $newclass = ++$PACKNAME; local @Parent = @Parent; # Protect against non-local exits { print "Blessing Object into class [$newclass]\n" if $Verbose>=2; mv_all_methods("MY",$newclass); bless $self, $newclass; push @Parent, $self; require ExtUtils::MY; no strict 'refs'; ## no critic; @{"$newclass\:\:ISA"} = 'MM'; } if (defined $Parent[-2]){ $self->{PARENT} = $Parent[-2]; for my $key (@Prepend_parent) { next unless defined $self->{PARENT}{$key}; # Don't stomp on WriteMakefile() args. next if defined $self->{ARGS}{$key} and $self->{ARGS}{$key} eq $self->{$key}; $self->{$key} = $self->{PARENT}{$key}; if ($Is_VMS && $key =~ /PERL$/) { # PERL or FULLPERL will be a command verb or even a # command with an argument instead of a full file # specification under VMS. So, don't turn the command # into a filespec, but do add a level to the path of # the argument if not already absolute. my @cmd = split /\s+/, $self->{$key}; $cmd[1] = $self->catfile('[-]',$cmd[1]) unless (@cmd < 2) || $self->file_name_is_absolute($cmd[1]); $self->{$key} = join(' ', @cmd); } else { my $value = $self->{$key}; # not going to test in FS so only stripping start $value =~ s/"// if $key =~ /PERL$/ and $self->is_make_type('dmake'); $value =~ s/^"// if $key =~ /PERL$/; $value = $self->catdir("..", $value) unless $self->file_name_is_absolute($value); $value = qq{"$value} if $key =~ /PERL$/; $self->{$key} = $value; } } if ($self->{PARENT}) { $self->{PARENT}->{CHILDREN}->{$newclass} = $self; foreach my $opt (qw(POLLUTE PERL_CORE LINKTYPE AR FULL_AR CC CCFLAGS OPTIMIZE LD LDDLFLAGS LDFLAGS PERL_ARCHLIB DESTDIR)) { if (exists $self->{PARENT}->{$opt} and not exists $self->{$opt}) { # inherit, but only if already unspecified $self->{$opt} = $self->{PARENT}->{$opt}; } } } my @fm = grep /^FIRST_MAKEFILE=/, @ARGV; parse_args($self,@fm) if @fm; } else { parse_args($self, _shellwords($ENV{PERL_MM_OPT} || ''),@ARGV); } # RT#91540 PREREQ_FATAL not recognized on command line if (%unsatisfied && $self->{PREREQ_FATAL}){ my $failedprereqs = join "\n", map {" $_ $unsatisfied{$_}"} sort { $a cmp $b } keys %unsatisfied; die <<"END"; MakeMaker FATAL: prerequisites not found. $failedprereqs Please install these modules first and rerun 'perl Makefile.PL'. END } $self->{NAME} ||= $self->guess_name; warn "Warning: NAME must be a package name\n" unless $self->{NAME} =~ m!^[A-Z_a-z][0-9A-Z_a-z]*(?:::[0-9A-Z_a-z]+)*$!; ($self->{NAME_SYM} = $self->{NAME}) =~ s/\W+/_/g; $self->init_MAKE; $self->init_main; $self->init_VERSION; $self->init_dist; $self->init_INST; $self->init_INSTALL; $self->init_DEST; $self->init_dirscan; $self->init_PM; $self->init_MANPODS; $self->init_xs; $self->init_PERL; $self->init_DIRFILESEP; $self->init_linker; $self->init_ABSTRACT; $self->arch_check( $INC{'Config.pm'}, $self->catfile($Config{'archlibexp'}, "Config.pm") ); $self->init_tools(); $self->init_others(); $self->init_platform(); $self->init_PERM(); my @args = @ARGV; @args = map { Encode::decode(locale => $_) } @args if $CAN_DECODE; my($argv) = neatvalue(\@args); $argv =~ s/^\[/(/; $argv =~ s/\]$/)/; push @{$self->{RESULT}}, <{NAME} extension to perl. # # It was generated automatically by MakeMaker version # $VERSION (Revision: $Revision) from the contents of # Makefile.PL. Don't edit this file, edit Makefile.PL instead. # # ANY CHANGES MADE HERE WILL BE LOST! # # MakeMaker ARGV: $argv # END push @{$self->{RESULT}}, $self->_MakeMaker_Parameters_section(\%initial_att); if (defined $self->{CONFIGURE}) { push @{$self->{RESULT}}, < 0) { foreach my $key (sort keys %configure_att){ next if $key eq 'ARGS'; my($v) = neatvalue($configure_att{$key}); $v =~ s/(CODE|HASH|ARRAY|SCALAR)\([\dxa-f]+\)/$1\(...\)/; $v =~ tr/\n/ /s; push @{$self->{RESULT}}, "# $key => $v"; } } else { push @{$self->{RESULT}}, "# no values returned"; } undef %configure_att; # free memory } # turn the SKIP array into a SKIPHASH hash for my $skip (@{$self->{SKIP} || []}) { $self->{SKIPHASH}{$skip} = 1; } delete $self->{SKIP}; # free memory if ($self->{PARENT}) { for (qw/install dist dist_basics dist_core distdir dist_test dist_ci/) { $self->{SKIPHASH}{$_} = 1; } } # We run all the subdirectories now. They don't have much to query # from the parent, but the parent has to query them: if they need linking! unless ($self->{NORECURS}) { $self->eval_in_subdirs if @{$self->{DIR}}; } foreach my $section ( @MM_Sections ){ # Support for new foo_target() methods. my $method = $section; $method .= '_target' unless $self->can($method); print "Processing Makefile '$section' section\n" if ($Verbose >= 2); my($skipit) = $self->skipcheck($section); if ($skipit){ push @{$self->{RESULT}}, "\n# --- MakeMaker $section section $skipit."; } else { my(%a) = %{$self->{$section} || {}}; push @{$self->{RESULT}}, "\n# --- MakeMaker $section section:"; push @{$self->{RESULT}}, "# " . join ", ", %a if $Verbose && %a; push @{$self->{RESULT}}, $self->maketext_filter( $self->$method( %a ) ); } } push @{$self->{RESULT}}, "\n# End."; $self; } sub WriteEmptyMakefile { croak "WriteEmptyMakefile: Need an even number of args" if @_ % 2; my %att = @_; $att{DIR} = [] unless $att{DIR}; # don't recurse by default my $self = MM->new(\%att); my $new = $self->{MAKEFILE}; my $old = $self->{MAKEFILE_OLD}; if (-f $old) { _unlink($old) or warn "unlink $old: $!"; } if ( -f $new ) { _rename($new, $old) or warn "rename $new => $old: $!" } open my $mfh, '>', $new or die "open $new for write: $!"; print $mfh <<'EOP'; all : manifypods : subdirs : dynamic : static : clean : install : makemakerdflt : test : test_dynamic : test_static : EOP close $mfh or die "close $new for write: $!"; } =begin private =head3 _installed_file_for_module my $file = MM->_installed_file_for_module($module); Return the first installed .pm $file associated with the $module. The one which will show up when you C. $module is something like "strict" or "Test::More". =end private =cut sub _installed_file_for_module { my $class = shift; my $prereq = shift; my $file = "$prereq.pm"; $file =~ s{::}{/}g; my $path; for my $dir (@INC) { my $tmp = File::Spec->catfile($dir, $file); if ( -r $tmp ) { $path = $tmp; last; } } return $path; } # Extracted from MakeMaker->new so we can test it sub _MakeMaker_Parameters_section { my $self = shift; my $att = shift; my @result = <<'END'; # MakeMaker Parameters: END foreach my $key (sort keys %$att){ next if $key eq 'ARGS'; my $v; if ($key eq 'PREREQ_PM') { # CPAN.pm takes prereqs from this field in 'Makefile' # and does not know about BUILD_REQUIRES $v = neatvalue({ %{ $att->{PREREQ_PM} || {} }, %{ $att->{BUILD_REQUIRES} || {} }, %{ $att->{TEST_REQUIRES} || {} }, }); } else { $v = neatvalue($att->{$key}); } $v =~ s/(CODE|HASH|ARRAY|SCALAR)\([\dxa-f]+\)/$1\(...\)/; $v =~ tr/\n/ /s; push @result, "# $key => $v"; } return @result; } # _shellwords and _parseline borrowed from Text::ParseWords sub _shellwords { my (@lines) = @_; my @allwords; foreach my $line (@lines) { $line =~ s/^\s+//; my @words = _parse_line('\s+', 0, $line); pop @words if (@words and !defined $words[-1]); return() unless (@words || !length($line)); push(@allwords, @words); } return(@allwords); } sub _parse_line { my($delimiter, $keep, $line) = @_; my($word, @pieces); no warnings 'uninitialized'; # we will be testing undef strings while (length($line)) { # This pattern is optimised to be stack conservative on older perls. # Do not refactor without being careful and testing it on very long strings. # See Perl bug #42980 for an example of a stack busting input. $line =~ s/^ (?: # double quoted string (") # $quote ((?>[^\\"]*(?:\\.[^\\"]*)*))" # $quoted | # --OR-- # singe quoted string (') # $quote ((?>[^\\']*(?:\\.[^\\']*)*))' # $quoted | # --OR-- # unquoted string ( # $unquoted (?:\\.|[^\\"'])*? ) # followed by ( # $delim \Z(?!\n) # EOL | # --OR-- (?-x:$delimiter) # delimiter | # --OR-- (?!^)(?=["']) # a quote ) )//xs or return; # extended layout my ($quote, $quoted, $unquoted, $delim) = (($1 ? ($1,$2) : ($3,$4)), $5, $6); return() unless( defined($quote) || length($unquoted) || length($delim)); if ($keep) { $quoted = "$quote$quoted$quote"; } else { $unquoted =~ s/\\(.)/$1/sg; if (defined $quote) { $quoted =~ s/\\(.)/$1/sg if ($quote eq '"'); #$quoted =~ s/\\([\\'])/$1/g if ( $PERL_SINGLE_QUOTE && $quote eq "'"); } } $word .= substr($line, 0, 0); # leave results tainted $word .= defined $quote ? $quoted : $unquoted; if (length($delim)) { push(@pieces, $word); push(@pieces, $delim) if ($keep eq 'delimiters'); undef $word; } if (!length($line)) { push(@pieces, $word); } } return(@pieces); } sub check_manifest { print "Checking if your kit is complete...\n"; require ExtUtils::Manifest; # avoid warning $ExtUtils::Manifest::Quiet = $ExtUtils::Manifest::Quiet = 1; my(@missed) = ExtUtils::Manifest::manicheck(); if (@missed) { print "Warning: the following files are missing in your kit:\n"; print "\t", join "\n\t", @missed; print "\n"; print "Please inform the author.\n"; } else { print "Looks good\n"; } } sub parse_args{ my($self, @args) = @_; @args = map { Encode::decode(locale => $_) } @args if $CAN_DECODE; foreach (@args) { unless (m/(.*?)=(.*)/) { ++$Verbose if m/^verb/; next; } my($name, $value) = ($1, $2); if ($value =~ m/^~(\w+)?/) { # tilde with optional username $value =~ s [^~(\w*)] [$1 ? ((getpwnam($1))[7] || "~$1") : (getpwuid($>))[7] ]ex; } # Remember the original args passed it. It will be useful later. $self->{ARGS}{uc $name} = $self->{uc $name} = $value; } # catch old-style 'potential_libs' and inform user how to 'upgrade' if (defined $self->{potential_libs}){ my($msg)="'potential_libs' => '$self->{potential_libs}' should be"; if ($self->{potential_libs}){ print "$msg changed to:\n\t'LIBS' => ['$self->{potential_libs}']\n"; } else { print "$msg deleted.\n"; } $self->{LIBS} = [$self->{potential_libs}]; delete $self->{potential_libs}; } # catch old-style 'ARMAYBE' and inform user how to 'upgrade' if (defined $self->{ARMAYBE}){ my($armaybe) = $self->{ARMAYBE}; print "ARMAYBE => '$armaybe' should be changed to:\n", "\t'dynamic_lib' => {ARMAYBE => '$armaybe'}\n"; my(%dl) = %{$self->{dynamic_lib} || {}}; $self->{dynamic_lib} = { %dl, ARMAYBE => $armaybe}; delete $self->{ARMAYBE}; } if (defined $self->{LDTARGET}){ print "LDTARGET should be changed to LDFROM\n"; $self->{LDFROM} = $self->{LDTARGET}; delete $self->{LDTARGET}; } # Turn a DIR argument on the command line into an array if (defined $self->{DIR} && ref \$self->{DIR} eq 'SCALAR') { # So they can choose from the command line, which extensions they want # the grep enables them to have some colons too much in case they # have to build a list with the shell $self->{DIR} = [grep $_, split ":", $self->{DIR}]; } # Turn a INCLUDE_EXT argument on the command line into an array if (defined $self->{INCLUDE_EXT} && ref \$self->{INCLUDE_EXT} eq 'SCALAR') { $self->{INCLUDE_EXT} = [grep $_, split '\s+', $self->{INCLUDE_EXT}]; } # Turn a EXCLUDE_EXT argument on the command line into an array if (defined $self->{EXCLUDE_EXT} && ref \$self->{EXCLUDE_EXT} eq 'SCALAR') { $self->{EXCLUDE_EXT} = [grep $_, split '\s+', $self->{EXCLUDE_EXT}]; } foreach my $mmkey (sort keys %$self){ next if $mmkey eq 'ARGS'; print " $mmkey => ", neatvalue($self->{$mmkey}), "\n" if $Verbose; print "'$mmkey' is not a known MakeMaker parameter name.\n" unless exists $Recognized_Att_Keys{$mmkey}; } $| = 1 if $Verbose; } sub check_hints { my($self) = @_; # We allow extension-specific hints files. require File::Spec; my $curdir = File::Spec->curdir; my $hint_dir = File::Spec->catdir($curdir, "hints"); return unless -d $hint_dir; # First we look for the best hintsfile we have my($hint)="${^O}_$Config{osvers}"; $hint =~ s/\./_/g; $hint =~ s/_$//; return unless $hint; # Also try without trailing minor version numbers. while (1) { last if -f File::Spec->catfile($hint_dir, "$hint.pl"); # found } continue { last unless $hint =~ s/_[^_]*$//; # nothing to cut off } my $hint_file = File::Spec->catfile($hint_dir, "$hint.pl"); return unless -f $hint_file; # really there _run_hintfile($self, $hint_file); } sub _run_hintfile { our $self; local($self) = shift; # make $self available to the hint file. my($hint_file) = shift; local($@, $!); print "Processing hints file $hint_file\n" if $Verbose; # Just in case the ./ isn't on the hint file, which File::Spec can # often strip off, we bung the curdir into @INC local @INC = (File::Spec->curdir, @INC); my $ret = do $hint_file; if( !defined $ret ) { my $error = $@ || $!; warn $error; } } sub mv_all_methods { my($from,$to) = @_; local $SIG{__WARN__} = sub { # can't use 'no warnings redefined', 5.6 only warn @_ unless $_[0] =~ /^Subroutine .* redefined/ }; foreach my $method (@Overridable) { next unless defined &{"${from}::$method"}; no strict 'refs'; ## no critic *{"${to}::$method"} = \&{"${from}::$method"}; # If we delete a method, then it will be undefined and cannot # be called. But as long as we have Makefile.PLs that rely on # %MY:: being intact, we have to fill the hole with an # inheriting method: { package MY; my $super = "SUPER::".$method; *{$method} = sub { shift->$super(@_); }; } } } sub skipcheck { my($self) = shift; my($section) = @_; return 'skipped' if $section eq 'metafile' && $UNDER_CORE; if ($section eq 'dynamic') { print "Warning (non-fatal): Target 'dynamic' depends on targets ", "in skipped section 'dynamic_bs'\n" if $self->{SKIPHASH}{dynamic_bs} && $Verbose; print "Warning (non-fatal): Target 'dynamic' depends on targets ", "in skipped section 'dynamic_lib'\n" if $self->{SKIPHASH}{dynamic_lib} && $Verbose; } if ($section eq 'dynamic_lib') { print "Warning (non-fatal): Target '\$(INST_DYNAMIC)' depends on ", "targets in skipped section 'dynamic_bs'\n" if $self->{SKIPHASH}{dynamic_bs} && $Verbose; } if ($section eq 'static') { print "Warning (non-fatal): Target 'static' depends on targets ", "in skipped section 'static_lib'\n" if $self->{SKIPHASH}{static_lib} && $Verbose; } return 'skipped' if $self->{SKIPHASH}{$section}; return ''; } # returns filehandle, dies on fail. :raw so no :crlf sub open_for_writing { my ($file) = @_; open my $fh ,">", $file or die "Unable to open $file: $!"; my @layers = ':raw'; push @layers, join ' ', ':encoding(locale)' if $CAN_DECODE; binmode $fh, join ' ', @layers; $fh; } sub flush { my $self = shift; my $finalname = $self->{MAKEFILE}; printf "Generating a %s %s\n", $self->make_type, $finalname if $Verbose || !$self->{PARENT}; print "Writing $finalname for $self->{NAME}\n" if $Verbose || !$self->{PARENT}; unlink($finalname, "MakeMaker.tmp", $Is_VMS ? 'Descrip.MMS' : ()); write_file_via_tmp($finalname, $self->{RESULT}); # Write MYMETA.yml to communicate metadata up to the CPAN clients print "Writing MYMETA.yml and MYMETA.json\n" if !$self->{NO_MYMETA} and $self->write_mymeta( $self->mymeta ); # save memory if ($self->{PARENT} && !$self->{_KEEP_AFTER_FLUSH}) { my %keep = map { ($_ => 1) } qw(NEEDS_LINKING HAS_LINK_CODE); delete $self->{$_} for grep !$keep{$_}, keys %$self; } system("$Config::Config{eunicefix} $finalname") if $Config::Config{eunicefix} ne ":"; return; } sub write_file_via_tmp { my ($finalname, $contents) = @_; my $fh = open_for_writing("MakeMaker.tmp"); die "write_file_via_tmp: 2nd arg must be ref" unless ref $contents; for my $chunk (@$contents) { my $to_write = $chunk; utf8::encode $to_write if !$CAN_DECODE && "$]" > 5.008; print $fh "$to_write\n" or die "Can't write to MakeMaker.tmp: $!"; } close $fh or die "Can't write to MakeMaker.tmp: $!"; _rename("MakeMaker.tmp", $finalname) or warn "rename MakeMaker.tmp => $finalname: $!"; chmod 0644, $finalname if !$Is_VMS; return; } # This is a rename for OS's where the target must be unlinked first. sub _rename { my($src, $dest) = @_; _unlink($dest); return rename $src, $dest; } # This is an unlink for OS's where the target must be writable first. sub _unlink { my @files = @_; chmod 0666, @files; return unlink @files; } # The following mkbootstrap() is only for installations that are calling # the pre-4.1 mkbootstrap() from their old Makefiles. This MakeMaker # writes Makefiles, that use ExtUtils::Mkbootstrap directly. sub mkbootstrap { die <".neatvalue($v->{$key}); } return "{ ".join(', ',@m)." }"; } sub _find_magic_vstring { my $value = shift; return $value if $UNDER_CORE; my $tvalue = ''; require B; my $sv = B::svref_2object(\$value); my $magic = ref($sv) eq 'B::PVMG' ? $sv->MAGIC : undef; while ( $magic ) { if ( $magic->TYPE eq 'V' ) { $tvalue = $magic->PTR; $tvalue =~ s/^v?(.+)$/v$1/; last; } else { $magic = $magic->MOREMAGIC; } } return $tvalue; } sub selfdocument { my($self) = @_; my(@m); if ($Verbose){ push @m, "\n# Full list of MakeMaker attribute values:"; foreach my $key (sort keys %$self){ next if $key eq 'RESULT' || $key =~ /^[A-Z][a-z]/; my($v) = neatvalue($self->{$key}); $v =~ s/(CODE|HASH|ARRAY|SCALAR)\([\dxa-f]+\)/$1\(...\)/; $v =~ tr/\n/ /s; push @m, "# $key => $v"; } } # added here as selfdocument is not overridable push @m, <<'EOF'; # here so even if top_targets is overridden, these will still be defined # gmake will silently still work if any are .PHONY-ed but nmake won't EOF push @m, join "\n", map "$_ ::\n\t\$(NOECHO) \$(NOOP)\n", # config is so manifypods won't puke if no subdirs grep !$self->{SKIPHASH}{$_}, qw(static dynamic config); join "\n", @m; } 1; __END__ =head1 NAME ExtUtils::MakeMaker - Create a module Makefile =head1 SYNOPSIS use ExtUtils::MakeMaker; WriteMakefile( NAME => "Foo::Bar", VERSION_FROM => "lib/Foo/Bar.pm", ); =head1 DESCRIPTION This utility is designed to write a Makefile for an extension module from a Makefile.PL. It is based on the Makefile.SH model provided by Andy Dougherty and the perl5-porters. It splits the task of generating the Makefile into several subroutines that can be individually overridden. Each subroutine returns the text it wishes to have written to the Makefile. As there are various Make programs with incompatible syntax, which use operating system shells, again with incompatible syntax, it is important for users of this module to know which flavour of Make a Makefile has been written for so they'll use the correct one and won't have to face the possibly bewildering errors resulting from using the wrong one. On POSIX systems, that program will likely be GNU Make; on Microsoft Windows, it will be either Microsoft NMake, DMake or GNU Make. See the section on the L parameter for details. ExtUtils::MakeMaker (EUMM) is object oriented. Each directory below the current directory that contains a Makefile.PL is treated as a separate object. This makes it possible to write an unlimited number of Makefiles with a single invocation of WriteMakefile(). All inputs to WriteMakefile are Unicode characters, not just octets. EUMM seeks to handle all of these correctly. It is currently still not possible to portably use Unicode characters in module names, because this requires Perl to handle Unicode filenames, which is not yet the case on Windows. =head2 How To Write A Makefile.PL See L. The long answer is the rest of the manpage :-) =head2 Default Makefile Behaviour The generated Makefile enables the user of the extension to invoke perl Makefile.PL # optionally "perl Makefile.PL verbose" make make test # optionally set TEST_VERBOSE=1 make install # See below The Makefile to be produced may be altered by adding arguments of the form C. E.g. perl Makefile.PL INSTALL_BASE=~ Other interesting targets in the generated Makefile are make config # to check if the Makefile is up-to-date make clean # delete local temp files (Makefile gets renamed) make realclean # delete derived files (including ./blib) make ci # check in all the files in the MANIFEST file make dist # see below the Distribution Support section =head2 make test MakeMaker checks for the existence of a file named F in the current directory, and if it exists it executes the script with the proper set of perl C<-I> options. MakeMaker also checks for any files matching glob("t/*.t"). It will execute all matching files in alphabetical order via the L module with the C<-I> switches set correctly. You can also organize your tests within subdirectories in the F directory. To do so, use the F directive in your I. For example, if you had tests in: t/foo t/foo/bar You could tell make to run tests in both of those directories with the following directives: test => {TESTS => 't/*/*.t t/*/*/*.t'} test => {TESTS => 't/foo/*.t t/foo/bar/*.t'} The first will run all test files in all first-level subdirectories and all subdirectories they contain. The second will run tests in only the F and F. If you'd like to see the raw output of your tests, set the C variable to true. make test TEST_VERBOSE=1 If you want to run particular test files, set the C variable. It is possible to use globbing with this mechanism. make test TEST_FILES='t/foobar.t t/dagobah*.t' Windows users who are using C should note that due to a bug in C, when specifying C you must use back-slashes instead of forward-slashes. nmake test TEST_FILES='t\foobar.t t\dagobah*.t' =head2 make testdb A useful variation of the above is the target C. It runs the test under the Perl debugger (see L). If the file F exists in the current directory, it is used for the test. If you want to debug some other testfile, set the C variable thusly: make testdb TEST_FILE=t/mytest.t By default the debugger is called using C<-d> option to perl. If you want to specify some other option, set the C variable: make testdb TESTDB_SW=-Dx =head2 make install make alone puts all relevant files into directories that are named by the macros INST_LIB, INST_ARCHLIB, INST_SCRIPT, INST_MAN1DIR and INST_MAN3DIR. All these default to something below ./blib if you are I building below the perl source directory. If you I building below the perl source, INST_LIB and INST_ARCHLIB default to ../../lib, and INST_SCRIPT is not defined. The I target of the generated Makefile copies the files found below each of the INST_* directories to their INSTALL* counterparts. Which counterparts are chosen depends on the setting of INSTALLDIRS according to the following table: INSTALLDIRS set to perl site vendor PERLPREFIX SITEPREFIX VENDORPREFIX INST_ARCHLIB INSTALLARCHLIB INSTALLSITEARCH INSTALLVENDORARCH INST_LIB INSTALLPRIVLIB INSTALLSITELIB INSTALLVENDORLIB INST_BIN INSTALLBIN INSTALLSITEBIN INSTALLVENDORBIN INST_SCRIPT INSTALLSCRIPT INSTALLSITESCRIPT INSTALLVENDORSCRIPT INST_MAN1DIR INSTALLMAN1DIR INSTALLSITEMAN1DIR INSTALLVENDORMAN1DIR INST_MAN3DIR INSTALLMAN3DIR INSTALLSITEMAN3DIR INSTALLVENDORMAN3DIR The INSTALL... macros in turn default to their %Config ($Config{installprivlib}, $Config{installarchlib}, etc.) counterparts. You can check the values of these variables on your system with perl '-V:install.*' And to check the sequence in which the library directories are searched by perl, run perl -le 'print join $/, @INC' Sometimes older versions of the module you're installing live in other directories in @INC. Because Perl loads the first version of a module it finds, not the newest, you might accidentally get one of these older versions even after installing a brand new version. To delete I (not simply older ones) set the C variable. make install UNINST=1 =head2 INSTALL_BASE INSTALL_BASE can be passed into Makefile.PL to change where your module will be installed. INSTALL_BASE is more like what everyone else calls "prefix" than PREFIX is. To have everything installed in your home directory, do the following. # Unix users, INSTALL_BASE=~ works fine perl Makefile.PL INSTALL_BASE=/path/to/your/home/dir Like PREFIX, it sets several INSTALL* attributes at once. Unlike PREFIX it is easy to predict where the module will end up. The installation pattern looks like this: INSTALLARCHLIB INSTALL_BASE/lib/perl5/$Config{archname} INSTALLPRIVLIB INSTALL_BASE/lib/perl5 INSTALLBIN INSTALL_BASE/bin INSTALLSCRIPT INSTALL_BASE/bin INSTALLMAN1DIR INSTALL_BASE/man/man1 INSTALLMAN3DIR INSTALL_BASE/man/man3 INSTALL_BASE in MakeMaker and C<--install_base> in Module::Build (as of 0.28) install to the same location. If you want MakeMaker and Module::Build to install to the same location simply set INSTALL_BASE and C<--install_base> to the same location. INSTALL_BASE was added in 6.31. =head2 PREFIX and LIB attribute PREFIX and LIB can be used to set several INSTALL* attributes in one go. Here's an example for installing into your home directory. # Unix users, PREFIX=~ works fine perl Makefile.PL PREFIX=/path/to/your/home/dir This will install all files in the module under your home directory, with man pages and libraries going into an appropriate place (usually ~/man and ~/lib). How the exact location is determined is complicated and depends on how your Perl was configured. INSTALL_BASE works more like what other build systems call "prefix" than PREFIX and we recommend you use that instead. Another way to specify many INSTALL directories with a single parameter is LIB. perl Makefile.PL LIB=~/lib This will install the module's architecture-independent files into ~/lib, the architecture-dependent files into ~/lib/$archname. Note, that in both cases the tilde expansion is done by MakeMaker, not by perl by default, nor by make. Conflicts between parameters LIB, PREFIX and the various INSTALL* arguments are resolved so that: =over 4 =item * setting LIB overrides any setting of INSTALLPRIVLIB, INSTALLARCHLIB, INSTALLSITELIB, INSTALLSITEARCH (and they are not affected by PREFIX); =item * without LIB, setting PREFIX replaces the initial C<$Config{prefix}> part of those INSTALL* arguments, even if the latter are explicitly set (but are set to still start with C<$Config{prefix}>). =back If the user has superuser privileges, and is not working on AFS or relatives, then the defaults for INSTALLPRIVLIB, INSTALLARCHLIB, INSTALLSCRIPT, etc. will be appropriate, and this incantation will be the best: perl Makefile.PL; make; make test make install make install by default writes some documentation of what has been done into the file C<$(INSTALLARCHLIB)/perllocal.pod>. This feature can be bypassed by calling make pure_install. =head2 AFS users will have to specify the installation directories as these most probably have changed since perl itself has been installed. They will have to do this by calling perl Makefile.PL INSTALLSITELIB=/afs/here/today \ INSTALLSCRIPT=/afs/there/now INSTALLMAN3DIR=/afs/for/manpages make Be careful to repeat this procedure every time you recompile an extension, unless you are sure the AFS installation directories are still valid. =head2 Static Linking of a new Perl Binary An extension that is built with the above steps is ready to use on systems supporting dynamic loading. On systems that do not support dynamic loading, any newly created extension has to be linked together with the available resources. MakeMaker supports the linking process by creating appropriate targets in the Makefile whenever an extension is built. You can invoke the corresponding section of the makefile with make perl That produces a new perl binary in the current directory with all extensions linked in that can be found in INST_ARCHLIB, SITELIBEXP, and PERL_ARCHLIB. To do that, MakeMaker writes a new Makefile, on UNIX, this is called F (may be system dependent). If you want to force the creation of a new perl, it is recommended that you delete this F, so the directories are searched through for linkable libraries again. The binary can be installed into the directory where perl normally resides on your machine with make inst_perl To produce a perl binary with a different name than C, either say perl Makefile.PL MAP_TARGET=myperl make myperl make inst_perl or say perl Makefile.PL make myperl MAP_TARGET=myperl make inst_perl MAP_TARGET=myperl In any case you will be prompted with the correct invocation of the C target that installs the new binary into INSTALLBIN. make inst_perl by default writes some documentation of what has been done into the file C<$(INSTALLARCHLIB)/perllocal.pod>. This can be bypassed by calling make pure_inst_perl. Warning: the inst_perl: target will most probably overwrite your existing perl binary. Use with care! Sometimes you might want to build a statically linked perl although your system supports dynamic loading. In this case you may explicitly set the linktype with the invocation of the Makefile.PL or make: perl Makefile.PL LINKTYPE=static # recommended or make LINKTYPE=static # works on most systems =head2 Determination of Perl Library and Installation Locations MakeMaker needs to know, or to guess, where certain things are located. Especially INST_LIB and INST_ARCHLIB (where to put the files during the make(1) run), PERL_LIB and PERL_ARCHLIB (where to read existing modules from), and PERL_INC (header files and C). Extensions may be built either using the contents of the perl source directory tree or from the installed perl library. The recommended way is to build extensions after you have run 'make install' on perl itself. You can do that in any directory on your hard disk that is not below the perl source tree. The support for extensions below the ext directory of the perl distribution is only good for the standard extensions that come with perl. If an extension is being built below the C directory of the perl source then MakeMaker will set PERL_SRC automatically (e.g., C<../..>). If PERL_SRC is defined and the extension is recognized as a standard extension, then other variables default to the following: PERL_INC = PERL_SRC PERL_LIB = PERL_SRC/lib PERL_ARCHLIB = PERL_SRC/lib INST_LIB = PERL_LIB INST_ARCHLIB = PERL_ARCHLIB If an extension is being built away from the perl source then MakeMaker will leave PERL_SRC undefined and default to using the installed copy of the perl library. The other variables default to the following: PERL_INC = $archlibexp/CORE PERL_LIB = $privlibexp PERL_ARCHLIB = $archlibexp INST_LIB = ./blib/lib INST_ARCHLIB = ./blib/arch If perl has not yet been installed then PERL_SRC can be defined on the command line as shown in the previous section. =head2 Which architecture dependent directory? If you don't want to keep the defaults for the INSTALL* macros, MakeMaker helps you to minimize the typing needed: the usual relationship between INSTALLPRIVLIB and INSTALLARCHLIB is determined by Configure at perl compilation time. MakeMaker supports the user who sets INSTALLPRIVLIB. If INSTALLPRIVLIB is set, but INSTALLARCHLIB not, then MakeMaker defaults the latter to be the same subdirectory of INSTALLPRIVLIB as Configure decided for the counterparts in %Config, otherwise it defaults to INSTALLPRIVLIB. The same relationship holds for INSTALLSITELIB and INSTALLSITEARCH. MakeMaker gives you much more freedom than needed to configure internal variables and get different results. It is worth mentioning that make(1) also lets you configure most of the variables that are used in the Makefile. But in the majority of situations this will not be necessary, and should only be done if the author of a package recommends it (or you know what you're doing). =head2 Using Attributes and Parameters The following attributes may be specified as arguments to WriteMakefile() or as NAME=VALUE pairs on the command line. Attributes that became available with later versions of MakeMaker are indicated. In order to maintain portability of attributes with older versions of MakeMaker you may want to use L with your C. =over 2 =item ABSTRACT One line description of the module. Will be included in PPD file. =item ABSTRACT_FROM Name of the file that contains the package description. MakeMaker looks for a line in the POD matching /^($package\s-\s)(.*)/. This is typically the first line in the "=head1 NAME" section. $2 becomes the abstract. =item AUTHOR Array of strings containing name (and email address) of package author(s). Is used in CPAN Meta files (META.yml or META.json) and PPD (Perl Package Description) files for PPM (Perl Package Manager). =item BINARY_LOCATION Used when creating PPD files for binary packages. It can be set to a full or relative path or URL to the binary archive for a particular architecture. For example: perl Makefile.PL BINARY_LOCATION=x86/Agent.tar.gz builds a PPD package that references a binary of the C package, located in the C directory relative to the PPD itself. =item BUILD_REQUIRES Available in version 6.55_03 and above. A hash of modules that are needed to build your module but not run it. This will go into the C field of your F and the C of the C field of your F. Defaults to C<<< { "ExtUtils::MakeMaker" => 0 } >>> if this attribute is not specified. The format is the same as PREREQ_PM. =item C Ref to array of *.c file names. Initialised from a directory scan and the values portion of the XS attribute hash. This is not currently used by MakeMaker but may be handy in Makefile.PLs. =item CCFLAGS String that will be included in the compiler call command line between the arguments INC and OPTIMIZE. =item CONFIG Arrayref. E.g. [qw(archname manext)] defines ARCHNAME & MANEXT from config.sh. MakeMaker will add to CONFIG the following values anyway: ar cc cccdlflags ccdlflags dlext dlsrc ld lddlflags ldflags libc lib_ext obj_ext ranlib sitelibexp sitearchexp so =item CONFIGURE CODE reference. The subroutine should return a hash reference. The hash may contain further attributes, e.g. {LIBS =E ...}, that have to be determined by some evaluation method. =item CONFIGURE_REQUIRES Available in version 6.52 and above. A hash of modules that are required to run Makefile.PL itself, but not to run your distribution. This will go into the C field of your F and the C of the C field of your F. Defaults to C<<< { "ExtUtils::MakeMaker" => 0 } >>> if this attribute is not specified. The format is the same as PREREQ_PM. =item DEFINE Something like C<"-DHAVE_UNISTD_H"> =item DESTDIR This is the root directory into which the code will be installed. It I. For example, if your code would normally go into F you could set DESTDIR=~/tmp/ and installation would go into F<~/tmp/usr/local/lib/perl>. This is primarily of use for people who repackage Perl modules. NOTE: Due to the nature of make, it is important that you put the trailing slash on your DESTDIR. F<~/tmp/> not F<~/tmp>. =item DIR Ref to array of subdirectories containing Makefile.PLs e.g. ['sdbm'] in ext/SDBM_File =item DISTNAME A safe filename for the package. Defaults to NAME below but with :: replaced with -. For example, Foo::Bar becomes Foo-Bar. =item DISTVNAME Your name for distributing the package with the version number included. This is used by 'make dist' to name the resulting archive file. Defaults to DISTNAME-VERSION. For example, version 1.04 of Foo::Bar becomes Foo-Bar-1.04. On some OS's where . has special meaning VERSION_SYM may be used in place of VERSION. =item DLEXT Specifies the extension of the module's loadable object. For example: DLEXT => 'unusual_ext', # Default value is $Config{so} NOTE: When using this option to alter the extension of a module's loadable object, it is also necessary that the module's pm file specifies the same change: local $DynaLoader::dl_dlext = 'unusual_ext'; =item DL_FUNCS Hashref of symbol names for routines to be made available as universal symbols. Each key/value pair consists of the package name and an array of routine names in that package. Used only under AIX, OS/2, VMS and Win32 at present. The routine names supplied will be expanded in the same way as XSUB names are expanded by the XS() macro. Defaults to {"$(NAME)" => ["boot_$(NAME)" ] } e.g. {"RPC" => [qw( boot_rpcb rpcb_gettime getnetconfigent )], "NetconfigPtr" => [ 'DESTROY'] } Please see the L documentation for more information about the DL_FUNCS, DL_VARS and FUNCLIST attributes. =item DL_VARS Array of symbol names for variables to be made available as universal symbols. Used only under AIX, OS/2, VMS and Win32 at present. Defaults to []. (e.g. [ qw(Foo_version Foo_numstreams Foo_tree ) ]) =item EXCLUDE_EXT Array of extension names to exclude when doing a static build. This is ignored if INCLUDE_EXT is present. Consult INCLUDE_EXT for more details. (e.g. [ qw( Socket POSIX ) ] ) This attribute may be most useful when specified as a string on the command line: perl Makefile.PL EXCLUDE_EXT='Socket Safe' =item EXE_FILES Ref to array of executable files. The files will be copied to the INST_SCRIPT directory. Make realclean will delete them from there again. If your executables start with something like #!perl or #!/usr/bin/perl MakeMaker will change this to the path of the perl 'Makefile.PL' was invoked with so the programs will be sure to run properly even if perl is not in /usr/bin/perl. =item FIRST_MAKEFILE The name of the Makefile to be produced. This is used for the second Makefile that will be produced for the MAP_TARGET. Defaults to 'Makefile' or 'Descrip.MMS' on VMS. (Note: we couldn't use MAKEFILE because dmake uses this for something else). =item FULLPERL Perl binary able to run this extension, load XS modules, etc... =item FULLPERLRUN Like PERLRUN, except it uses FULLPERL. =item FULLPERLRUNINST Like PERLRUNINST, except it uses FULLPERL. =item FUNCLIST This provides an alternate means to specify function names to be exported from the extension. Its value is a reference to an array of function names to be exported by the extension. These names are passed through unaltered to the linker options file. =item H Ref to array of *.h file names. Similar to C. =item IMPORTS This attribute is used to specify names to be imported into the extension. Takes a hash ref. It is only used on OS/2 and Win32. =item INC Include file dirs eg: C<"-I/usr/5include -I/path/to/inc"> =item INCLUDE_EXT Array of extension names to be included when doing a static build. MakeMaker will normally build with all of the installed extensions when doing a static build, and that is usually the desired behavior. If INCLUDE_EXT is present then MakeMaker will build only with those extensions which are explicitly mentioned. (e.g. [ qw( Socket POSIX ) ]) It is not necessary to mention DynaLoader or the current extension when filling in INCLUDE_EXT. If the INCLUDE_EXT is mentioned but is empty then only DynaLoader and the current extension will be included in the build. This attribute may be most useful when specified as a string on the command line: perl Makefile.PL INCLUDE_EXT='POSIX Socket Devel::Peek' =item INSTALLARCHLIB Used by 'make install', which copies files from INST_ARCHLIB to this directory if INSTALLDIRS is set to perl. =item INSTALLBIN Directory to install binary files (e.g. tkperl) into if INSTALLDIRS=perl. =item INSTALLDIRS Determines which of the sets of installation directories to choose: perl, site or vendor. Defaults to site. =item INSTALLMAN1DIR =item INSTALLMAN3DIR These directories get the man pages at 'make install' time if INSTALLDIRS=perl. Defaults to $Config{installman*dir}. If set to 'none', no man pages will be installed. =item INSTALLPRIVLIB Used by 'make install', which copies files from INST_LIB to this directory if INSTALLDIRS is set to perl. Defaults to $Config{installprivlib}. =item INSTALLSCRIPT Available in version 6.30_02 and above. Used by 'make install' which copies files from INST_SCRIPT to this directory if INSTALLDIRS=perl. =item INSTALLSITEARCH Used by 'make install', which copies files from INST_ARCHLIB to this directory if INSTALLDIRS is set to site (default). =item INSTALLSITEBIN Used by 'make install', which copies files from INST_BIN to this directory if INSTALLDIRS is set to site (default). =item INSTALLSITELIB Used by 'make install', which copies files from INST_LIB to this directory if INSTALLDIRS is set to site (default). =item INSTALLSITEMAN1DIR =item INSTALLSITEMAN3DIR These directories get the man pages at 'make install' time if INSTALLDIRS=site (default). Defaults to $(SITEPREFIX)/man/man$(MAN*EXT). If set to 'none', no man pages will be installed. =item INSTALLSITESCRIPT Used by 'make install' which copies files from INST_SCRIPT to this directory if INSTALLDIRS is set to site (default). =item INSTALLVENDORARCH Used by 'make install', which copies files from INST_ARCHLIB to this directory if INSTALLDIRS is set to vendor. Note that if you do not set this, the value of INSTALLVENDORLIB will be used, which is probably not what you want. =item INSTALLVENDORBIN Used by 'make install', which copies files from INST_BIN to this directory if INSTALLDIRS is set to vendor. =item INSTALLVENDORLIB Used by 'make install', which copies files from INST_LIB to this directory if INSTALLDIRS is set to vendor. =item INSTALLVENDORMAN1DIR =item INSTALLVENDORMAN3DIR These directories get the man pages at 'make install' time if INSTALLDIRS=vendor. Defaults to $(VENDORPREFIX)/man/man$(MAN*EXT). If set to 'none', no man pages will be installed. =item INSTALLVENDORSCRIPT Available in version 6.30_02 and above. Used by 'make install' which copies files from INST_SCRIPT to this directory if INSTALLDIRS is set to vendor. =item INST_ARCHLIB Same as INST_LIB for architecture dependent files. =item INST_BIN Directory to put real binary files during 'make'. These will be copied to INSTALLBIN during 'make install' =item INST_LIB Directory where we put library files of this extension while building it. =item INST_MAN1DIR Directory to hold the man pages at 'make' time =item INST_MAN3DIR Directory to hold the man pages at 'make' time =item INST_SCRIPT Directory where executable files should be installed during 'make'. Defaults to "./blib/script", just to have a dummy location during testing. make install will copy the files in INST_SCRIPT to INSTALLSCRIPT. =item LD Program to be used to link libraries for dynamic loading. Defaults to $Config{ld}. =item LDDLFLAGS Any special flags that might need to be passed to ld to create a shared library suitable for dynamic loading. It is up to the makefile to use it. (See L) Defaults to $Config{lddlflags}. =item LDFROM Defaults to "$(OBJECT)" and is used in the ld command to specify what files to link/load from (also see dynamic_lib below for how to specify ld flags) =item LIB LIB should only be set at C time but is allowed as a MakeMaker argument. It has the effect of setting both INSTALLPRIVLIB and INSTALLSITELIB to that value regardless any explicit setting of those arguments (or of PREFIX). INSTALLARCHLIB and INSTALLSITEARCH are set to the corresponding architecture subdirectory. =item LIBPERL_A The filename of the perllibrary that will be used together with this extension. Defaults to libperl.a. =item LIBS An anonymous array of alternative library specifications to be searched for (in order) until at least one library is found. E.g. 'LIBS' => ["-lgdbm", "-ldbm -lfoo", "-L/path -ldbm.nfs"] Mind, that any element of the array contains a complete set of arguments for the ld command. So do not specify 'LIBS' => ["-ltcl", "-ltk", "-lX11"] See ODBM_File/Makefile.PL for an example, where an array is needed. If you specify a scalar as in 'LIBS' => "-ltcl -ltk -lX11" MakeMaker will turn it into an array with one element. =item LICENSE Available in version 6.31 and above. The licensing terms of your distribution. Generally it's "perl_5" for the same license as Perl itself. See L for the list of options. Defaults to "unknown". =item LINKTYPE 'static' or 'dynamic' (default unless usedl=undef in config.sh). Should only be used to force static linking (also see linkext below). =item MAGICXS Available in version 6.8305 and above. When this is set to C<1>, C will be automagically derived from C. =item MAKE Available in version 6.30_01 and above. Variant of make you intend to run the generated Makefile with. This parameter lets Makefile.PL know what make quirks to account for when generating the Makefile. MakeMaker also honors the MAKE environment variable. This parameter takes precedence. Currently the only significant values are 'dmake' and 'nmake' for Windows users, instructing MakeMaker to generate a Makefile in the flavour of DMake ("Dennis Vadura's Make") or Microsoft NMake respectively. Defaults to $Config{make}, which may go looking for a Make program in your environment. How are you supposed to know what flavour of Make a Makefile has been generated for if you didn't specify a value explicitly? Search the generated Makefile for the definition of the MAKE variable, which is used to recursively invoke the Make utility. That will tell you what Make you're supposed to invoke the Makefile with. =item MAKEAPERL Boolean which tells MakeMaker that it should include the rules to make a perl. This is handled automatically as a switch by MakeMaker. The user normally does not need it. =item MAKEFILE_OLD When 'make clean' or similar is run, the $(FIRST_MAKEFILE) will be backed up at this location. Defaults to $(FIRST_MAKEFILE).old or $(FIRST_MAKEFILE)_old on VMS. =item MAN1PODS Hashref of pod-containing files. MakeMaker will default this to all EXE_FILES files that include POD directives. The files listed here will be converted to man pages and installed as was requested at Configure time. This hash should map POD files (or scripts containing POD) to the man file names under the C directory, as in the following example: MAN1PODS => { 'doc/command.pod' => 'blib/man1/command.1', 'scripts/script.pl' => 'blib/man1/script.1', } =item MAN3PODS Hashref that assigns to *.pm and *.pod files the files into which the manpages are to be written. MakeMaker parses all *.pod and *.pm files for POD directives. Files that contain POD will be the default keys of the MAN3PODS hashref. These will then be converted to man pages during C and will be installed during C. Example similar to MAN1PODS. =item MAP_TARGET If it is intended that a new perl binary be produced, this variable may hold a name for that binary. Defaults to perl =item META_ADD =item META_MERGE Available in version 6.46 and above. A hashref of items to add to the CPAN Meta file (F or F). They differ in how they behave if they have the same key as the default metadata. META_ADD will override the default value with its own. META_MERGE will merge its value with the default. Unless you want to override the defaults, prefer META_MERGE so as to get the advantage of any future defaults. Where prereqs are concerned, if META_MERGE is used, prerequisites are merged with their counterpart C argument (PREREQ_PM is merged into {prereqs}{runtime}{requires}, BUILD_REQUIRES into C<{prereqs}{build}{requires}>, CONFIGURE_REQUIRES into C<{prereqs}{configure}{requires}>, and TEST_REQUIRES into C<{prereqs}{test}{requires})>. When prereqs are specified with META_ADD, the only prerequisites added to the file come from the metadata, not C arguments. Note that these configuration options are only used for generating F and F -- they are NOT used for F and F. Therefore data in these fields should NOT be used for dynamic (user-side) configuration. By default CPAN Meta specification C<1.4> is used. In order to use CPAN Meta specification C<2.0>, indicate with C the version you want to use. META_MERGE => { "meta-spec" => { version => 2 }, resources => { repository => { type => 'git', url => 'git://github.com/Perl-Toolchain-Gang/ExtUtils-MakeMaker.git', web => 'https://github.com/Perl-Toolchain-Gang/ExtUtils-MakeMaker', }, }, }, =item MIN_PERL_VERSION Available in version 6.48 and above. The minimum required version of Perl for this distribution. Either the 5.006001 or the 5.6.1 format is acceptable. =item MYEXTLIB If the extension links to a library that it builds, set this to the name of the library (see SDBM_File) =item NAME The package representing the distribution. For example, C or C. It will be used to derive information about the distribution such as the L, installation locations within the Perl library and where XS files will be looked for by default (see L). C I be a valid Perl package name and it I have an associated C<.pm> file. For example, C is a valid C and there must exist F. Any XS code should be in F unless stated otherwise. Your distribution B have a C. =item NEEDS_LINKING MakeMaker will figure out if an extension contains linkable code anywhere down the directory tree, and will set this variable accordingly, but you can speed it up a very little bit if you define this boolean variable yourself. =item NOECHO Command so make does not print the literal commands it's running. By setting it to an empty string you can generate a Makefile that prints all commands. Mainly used in debugging MakeMaker itself. Defaults to C<@>. =item NORECURS Boolean. Attribute to inhibit descending into subdirectories. =item NO_META When true, suppresses the generation and addition to the MANIFEST of the META.yml and META.json module meta-data files during 'make distdir'. Defaults to false. =item NO_MYMETA Available in version 6.57_02 and above. When true, suppresses the generation of MYMETA.yml and MYMETA.json module meta-data files during 'perl Makefile.PL'. Defaults to false. =item NO_PACKLIST Available in version 6.7501 and above. When true, suppresses the writing of C files for installs. Defaults to false. =item NO_PERLLOCAL Available in version 6.7501 and above. When true, suppresses the appending of installations to C. Defaults to false. =item NO_VC In general, any generated Makefile checks for the current version of MakeMaker and the version the Makefile was built under. If NO_VC is set, the version check is neglected. Do not write this into your Makefile.PL, use it interactively instead. =item OBJECT List of object files, defaults to '$(BASEEXT)$(OBJ_EXT)', but can be a long string or an array containing all object files, e.g. "tkpBind.o tkpButton.o tkpCanvas.o" or ["tkpBind.o", "tkpButton.o", "tkpCanvas.o"] (Where BASEEXT is the last component of NAME, and OBJ_EXT is $Config{obj_ext}.) =item OPTIMIZE Defaults to C<-O>. Set it to C<-g> to turn debugging on. The flag is passed to subdirectory makes. =item PERL Perl binary for tasks that can be done by miniperl. If it contains spaces or other shell metacharacters, it needs to be quoted in a way that protects them, since this value is intended to be inserted in a shell command line in the Makefile. E.g.: # Perl executable lives in "C:/Program Files/Perl/bin" # Normally you don't need to set this yourself! $ perl Makefile.PL PERL='"C:/Program Files/Perl/bin/perl.exe" -w' =item PERL_CORE Set only when MakeMaker is building the extensions of the Perl core distribution. =item PERLMAINCC The call to the program that is able to compile perlmain.c. Defaults to $(CC). =item PERL_ARCHLIB Same as for PERL_LIB, but for architecture dependent files. Used only when MakeMaker is building the extensions of the Perl core distribution (because normally $(PERL_ARCHLIB) is automatically in @INC, and adding it would get in the way of PERL5LIB). =item PERL_LIB Directory containing the Perl library to use. Used only when MakeMaker is building the extensions of the Perl core distribution (because normally $(PERL_LIB) is automatically in @INC, and adding it would get in the way of PERL5LIB). =item PERL_MALLOC_OK defaults to 0. Should be set to TRUE if the extension can work with the memory allocation routines substituted by the Perl malloc() subsystem. This should be applicable to most extensions with exceptions of those =over 4 =item * with bugs in memory allocations which are caught by Perl's malloc(); =item * which interact with the memory allocator in other ways than via malloc(), realloc(), free(), calloc(), sbrk() and brk(); =item * which rely on special alignment which is not provided by Perl's malloc(). =back B Neglecting to set this flag in I of the loaded extension nullifies many advantages of Perl's malloc(), such as better usage of system resources, error detection, memory usage reporting, catchable failure of memory allocations, etc. =item PERLPREFIX Directory under which core modules are to be installed. Defaults to $Config{installprefixexp}, falling back to $Config{installprefix}, $Config{prefixexp} or $Config{prefix} should $Config{installprefixexp} not exist. Overridden by PREFIX. =item PERLRUN Use this instead of $(PERL) when you wish to run perl. It will set up extra necessary flags for you. =item PERLRUNINST Use this instead of $(PERL) when you wish to run perl to work with modules. It will add things like -I$(INST_ARCH) and other necessary flags so perl can see the modules you're about to install. =item PERL_SRC Directory containing the Perl source code (use of this should be avoided, it may be undefined) =item PERM_DIR Available in version 6.51_01 and above. Desired permission for directories. Defaults to C<755>. =item PERM_RW Desired permission for read/writable files. Defaults to C<644>. =item PERM_RWX Desired permission for executable files. Defaults to C<755>. =item PL_FILES MakeMaker can run programs to generate files for you at build time. By default any file named *.PL (except Makefile.PL and Build.PL) in the top level directory will be assumed to be a Perl program and run passing its own basename in as an argument. This basename is actually a build target, and there is an intention, but not a requirement, that the *.PL file make the file passed to to as an argument. For example... perl foo.PL foo This behavior can be overridden by supplying your own set of files to search. PL_FILES accepts a hash ref, the key being the file to run and the value is passed in as the first argument when the PL file is run. PL_FILES => {'bin/foobar.PL' => 'bin/foobar'} PL_FILES => {'foo.PL' => 'foo.c'} Would run bin/foobar.PL like this: perl bin/foobar.PL bin/foobar If multiple files from one program are desired an array ref can be used. PL_FILES => {'bin/foobar.PL' => [qw(bin/foobar1 bin/foobar2)]} In this case the program will be run multiple times using each target file. perl bin/foobar.PL bin/foobar1 perl bin/foobar.PL bin/foobar2 If an output file depends on extra input files beside the script itself, a hash ref can be used in version 7.36 and above: PL_FILES => { 'foo.PL' => { 'foo.out' => 'foo.in', 'bar.out' => [qw(bar1.in bar2.in)], } In this case the extra input files will be passed to the program after the target file: perl foo.PL foo.out foo.in perl foo.PL bar.out bar1.in bar2.in PL files are normally run B pm_to_blib and include INST_LIB and INST_ARCH in their C<@INC>, so the just built modules can be accessed... unless the PL file is making a module (or anything else in PM) in which case it is run B pm_to_blib and does not include INST_LIB and INST_ARCH in its C<@INC>. This apparently odd behavior is there for backwards compatibility (and it's somewhat DWIM). The argument passed to the .PL is set up as a target to build in the Makefile. In other sections such as C you can specify a dependency on the filename/argument that the .PL is supposed (or will have, now that that is is a dependency) to generate. Note the file to be generated will still be generated and the .PL will still run even without an explicit dependency created by you, since the C target still depends on running all eligible to run.PL files. =item PM Hashref of .pm files and *.pl files to be installed. e.g. {'name_of_file.pm' => '$(INST_LIB)/install_as.pm'} By default this will include *.pm and *.pl and the files found in the PMLIBDIRS directories. Defining PM in the Makefile.PL will override PMLIBDIRS. =item PMLIBDIRS Ref to array of subdirectories containing library files. Defaults to [ 'lib', $(BASEEXT) ]. The directories will be scanned and I files they contain will be installed in the corresponding location in the library. A libscan() method can be used to alter the behaviour. Defining PM in the Makefile.PL will override PMLIBDIRS. (Where BASEEXT is the last component of NAME.) =item PM_FILTER A filter program, in the traditional Unix sense (input from stdin, output to stdout) that is passed on each .pm file during the build (in the pm_to_blib() phase). It is empty by default, meaning no filtering is done. You could use: PM_FILTER => 'perl -ne "print unless /^\\#/"', to remove all the leading comments on the fly during the build. In order to be as portable as possible, please consider using a Perl one-liner rather than Unix (or other) utilities, as above. The # is escaped for the Makefile, since what is going to be generated will then be: PM_FILTER = perl -ne "print unless /^\#/" Without the \ before the #, we'd have the start of a Makefile comment, and the macro would be incorrectly defined. You will almost certainly be better off using the C system, instead. See above, or the L entry. =item POLLUTE Release 5.005 grandfathered old global symbol names by providing preprocessor macros for extension source compatibility. As of release 5.6, these preprocessor definitions are not available by default. The POLLUTE flag specifies that the old names should still be defined: perl Makefile.PL POLLUTE=1 Please inform the module author if this is necessary to successfully install a module under 5.6 or later. =item PPM_INSTALL_EXEC Name of the executable used to run C below. (e.g. perl) =item PPM_INSTALL_SCRIPT Name of the script that gets executed by the Perl Package Manager after the installation of a package. =item PPM_UNINSTALL_EXEC Available in version 6.8502 and above. Name of the executable used to run C below. (e.g. perl) =item PPM_UNINSTALL_SCRIPT Available in version 6.8502 and above. Name of the script that gets executed by the Perl Package Manager before the removal of a package. =item PREFIX This overrides all the default install locations. Man pages, libraries, scripts, etc... MakeMaker will try to make an educated guess about where to place things under the new PREFIX based on your Config defaults. Failing that, it will fall back to a structure which should be sensible for your platform. If you specify LIB or any INSTALL* variables they will not be affected by the PREFIX. =item PREREQ_FATAL Bool. If this parameter is true, failing to have the required modules (or the right versions thereof) will be fatal. C will C instead of simply informing the user of the missing dependencies. It is I rare to have to use C. Its use by module authors is I and should never be used lightly. For dependencies that are required in order to run C, see C. Module installation tools have ways of resolving unmet dependencies but to do that they need a F. Using C breaks this. That's bad. Assuming you have good test coverage, your tests should fail with missing dependencies informing the user more strongly that something is wrong. You can write a F test which will simply check that your code compiles and stop "make test" prematurely if it doesn't. See L for more details. =item PREREQ_PM A hash of modules that are needed to run your module. The keys are the module names ie. Test::More, and the minimum version is the value. If the required version number is 0 any version will do. The versions given may be a Perl v-string (see L) or a range (see L). This will go into the C field of your F and the C of the C field of your F. PREREQ_PM => { # Require Test::More at least 0.47 "Test::More" => "0.47", # Require any version of Acme::Buffy "Acme::Buffy" => 0, } =item PREREQ_PRINT Bool. If this parameter is true, the prerequisites will be printed to stdout and MakeMaker will exit. The output format is an evalable hash ref. $PREREQ_PM = { 'A::B' => Vers1, 'C::D' => Vers2, ... }; If a distribution defines a minimal required perl version, this is added to the output as an additional line of the form: $MIN_PERL_VERSION = '5.008001'; If BUILD_REQUIRES is not empty, it will be dumped as $BUILD_REQUIRES hashref. =item PRINT_PREREQ RedHatism for C. The output format is different, though: perl(A::B)>=Vers1 perl(C::D)>=Vers2 ... A minimal required perl version, if present, will look like this: perl(perl)>=5.008001 =item SITEPREFIX Like PERLPREFIX, but only for the site install locations. Defaults to $Config{siteprefixexp}. Perls prior to 5.6.0 didn't have an explicit siteprefix in the Config. In those cases $Config{installprefix} will be used. Overridable by PREFIX =item SIGN Available in version 6.18 and above. When true, perform the generation and addition to the MANIFEST of the SIGNATURE file in the distdir during 'make distdir', via 'cpansign -s'. Note that you need to install the Module::Signature module to perform this operation. Defaults to false. =item SKIP Arrayref. E.g. [qw(name1 name2)] skip (do not write) sections of the Makefile. Caution! Do not use the SKIP attribute for the negligible speedup. It may seriously damage the resulting Makefile. Only use it if you really need it. =item TEST_REQUIRES Available in version 6.64 and above. A hash of modules that are needed to test your module but not run or build it. This will go into the C field of your F and the C of the C field of your F. The format is the same as PREREQ_PM. =item TYPEMAPS Ref to array of typemap file names. Use this when the typemaps are in some directory other than the current directory or when they are not named B. The last typemap in the list takes precedence. A typemap in the current directory has highest precedence, even if it isn't listed in TYPEMAPS. The default system typemap has lowest precedence. =item VENDORPREFIX Like PERLPREFIX, but only for the vendor install locations. Defaults to $Config{vendorprefixexp}. Overridable by PREFIX =item VERBINST If true, make install will be verbose =item VERSION Your version number for distributing the package. This defaults to 0.1. =item VERSION_FROM Instead of specifying the VERSION in the Makefile.PL you can let MakeMaker parse a file to determine the version number. The parsing routine requires that the file named by VERSION_FROM contains one single line to compute the version number. The first line in the file that contains something like a $VERSION assignment or C will be used. The following lines will be parsed o.k.: # Good package Foo::Bar 1.23; # 1.23 $VERSION = '1.00'; # 1.00 *VERSION = \'1.01'; # 1.01 ($VERSION) = q$Revision$ =~ /(\d+)/g; # The digits in $Revision$ $FOO::VERSION = '1.10'; # 1.10 *FOO::VERSION = \'1.11'; # 1.11 but these will fail: # Bad my $VERSION = '1.01'; local $VERSION = '1.02'; local $FOO::VERSION = '1.30'; (Putting C or C on the preceding line will work o.k.) "Version strings" are incompatible and should not be used. # Bad $VERSION = 1.2.3; $VERSION = v1.2.3; L objects are fine. As of MakeMaker 6.35 version.pm will be automatically loaded, but you must declare the dependency on version.pm. For compatibility with older MakeMaker you should load on the same line as $VERSION is declared. # All on one line use version; our $VERSION = qv(1.2.3); The file named in VERSION_FROM is not added as a dependency to Makefile. This is not really correct, but it would be a major pain during development to have to rewrite the Makefile for any smallish change in that file. If you want to make sure that the Makefile contains the correct VERSION macro after any change of the file, you would have to do something like depend => { Makefile => '$(VERSION_FROM)' } See attribute C below. =item VERSION_SYM A sanitized VERSION with . replaced by _. For places where . has special meaning (some filesystems, RCS labels, etc...) =item XS Hashref of .xs files. MakeMaker will default this. e.g. {'name_of_file.xs' => 'name_of_file.c'} The .c files will automatically be included in the list of files deleted by a make clean. =item XSBUILD Available in version 7.12 and above. Hashref with options controlling the operation of C: { xs => { all => { # options applying to all .xs files for this distribution }, 'lib/Class/Name/File' => { # specifically for this file DEFINE => '-Dfunktastic', # defines for only this file INC => "-I$funkyliblocation", # include flags for only this file # OBJECT => 'lib/Class/Name/File$(OBJ_EXT)', # default LDFROM => "lib/Class/Name/File\$(OBJ_EXT) $otherfile\$(OBJ_EXT)", # what's linked }, }, } Note C is the file-extension. More possibilities may arise in the future. Note that object names are specified without their XS extension. C defaults to the same as C. C defaults to, for C, just the XS filename with the extension replaced with the compiler-specific object-file extension. The distinction between C and C: C is the make target, so make will try to build it. However, C is what will actually be linked together to make the shared object or static library (SO/SL), so if you override it, make sure it includes what you want to make the final SO/SL, almost certainly including the XS basename with C<$(OBJ_EXT)> appended. =item XSMULTI Available in version 7.12 and above. When this is set to C<1>, multiple XS files may be placed under F next to their corresponding C<*.pm> files (this is essential for compiling with the correct C values). This feature should be considered experimental, and details of it may change. This feature was inspired by, and small portions of code copied from, L. Hopefully this feature will render that module mainly obsolete. =item XSOPT String of options to pass to xsubpp. This might include C<-C++> or C<-extern>. Do not include typemaps here; the TYPEMAP parameter exists for that purpose. =item XSPROTOARG May be set to C<-protoypes>, C<-noprototypes> or the empty string. The empty string is equivalent to the xsubpp default, or C<-noprototypes>. See the xsubpp documentation for details. MakeMaker defaults to the empty string. =item XS_VERSION Your version number for the .xs file of this package. This defaults to the value of the VERSION attribute. =back =head2 Additional lowercase attributes can be used to pass parameters to the methods which implement that part of the Makefile. Parameters are specified as a hash ref but are passed to the method as a hash. =over 2 =item clean {FILES => "*.xyz foo"} =item depend {ANY_TARGET => ANY_DEPENDENCY, ...} (ANY_TARGET must not be given a double-colon rule by MakeMaker.) =item dist {TARFLAGS => 'cvfF', COMPRESS => 'gzip', SUFFIX => '.gz', SHAR => 'shar -m', DIST_CP => 'ln', ZIP => '/bin/zip', ZIPFLAGS => '-rl', DIST_DEFAULT => 'private tardist' } If you specify COMPRESS, then SUFFIX should also be altered, as it is needed to tell make the target file of the compression. Setting DIST_CP to ln can be useful, if you need to preserve the timestamps on your files. DIST_CP can take the values 'cp', which copies the file, 'ln', which links the file, and 'best' which copies symbolic links and links the rest. Default is 'best'. =item dynamic_lib {ARMAYBE => 'ar', OTHERLDFLAGS => '...', INST_DYNAMIC_DEP => '...'} =item linkext {LINKTYPE => 'static', 'dynamic' or ''} NB: Extensions that have nothing but *.pm files had to say {LINKTYPE => ''} with Pre-5.0 MakeMakers. Since version 5.00 of MakeMaker such a line can be deleted safely. MakeMaker recognizes when there's nothing to be linked. =item macro {ANY_MACRO => ANY_VALUE, ...} =item postamble Anything put here will be passed to MY::postamble() if you have one. =item realclean {FILES => '$(INST_ARCHAUTODIR)/*.xyz'} =item test Specify the targets for testing. {TESTS => 't/*.t'} C can be used to include all directories recursively under C that contain C<.t> files. It will be ignored if you provide your own C attribute, defaults to false. {RECURSIVE_TEST_FILES=>1} This is supported since 6.76 =item tool_autosplit {MAXLEN => 8} =back =head2 Overriding MakeMaker Methods If you cannot achieve the desired Makefile behaviour by specifying attributes you may define private subroutines in the Makefile.PL. Each subroutine returns the text it wishes to have written to the Makefile. To override a section of the Makefile you can either say: sub MY::c_o { "new literal text" } or you can edit the default by saying something like: package MY; # so that "SUPER" works right sub c_o { my $inherited = shift->SUPER::c_o(@_); $inherited =~ s/old text/new text/; $inherited; } If you are running experiments with embedding perl as a library into other applications, you might find MakeMaker is not sufficient. You'd better have a look at ExtUtils::Embed which is a collection of utilities for embedding. If you still need a different solution, try to develop another subroutine that fits your needs and submit the diffs to C For a complete description of all MakeMaker methods see L. Here is a simple example of how to add a new target to the generated Makefile: sub MY::postamble { return <<'MAKE_FRAG'; $(MYEXTLIB): sdbm/Makefile cd sdbm && $(MAKE) all MAKE_FRAG } =head2 The End Of Cargo Cult Programming WriteMakefile() now does some basic sanity checks on its parameters to protect against typos and malformatted values. This means some things which happened to work in the past will now throw warnings and possibly produce internal errors. Some of the most common mistakes: =over 2 =item C<< MAN3PODS => ' ' >> This is commonly used to suppress the creation of man pages. MAN3PODS takes a hash ref not a string, but the above worked by accident in old versions of MakeMaker. The correct code is C<< MAN3PODS => { } >>. =back =head2 Hintsfile support MakeMaker.pm uses the architecture-specific information from Config.pm. In addition it evaluates architecture specific hints files in a C directory. The hints files are expected to be named like their counterparts in C, but with an C<.pl> file name extension (eg. C). They are simply Ced by MakeMaker within the WriteMakefile() subroutine, and can be used to execute commands as well as to include special variables. The rules which hintsfile is chosen are the same as in Configure. The hintsfile is eval()ed immediately after the arguments given to WriteMakefile are stuffed into a hash reference $self but before this reference becomes blessed. So if you want to do the equivalent to override or create an attribute you would say something like $self->{LIBS} = ['-ldbm -lucb -lc']; =head2 Distribution Support For authors of extensions MakeMaker provides several Makefile targets. Most of the support comes from the ExtUtils::Manifest module, where additional documentation can be found. =over 4 =item make distcheck reports which files are below the build directory but not in the MANIFEST file and vice versa. (See ExtUtils::Manifest::fullcheck() for details) =item make skipcheck reports which files are skipped due to the entries in the C file (See ExtUtils::Manifest::skipcheck() for details) =item make distclean does a realclean first and then the distcheck. Note that this is not needed to build a new distribution as long as you are sure that the MANIFEST file is ok. =item make veryclean does a realclean first and then removes backup files such as C<*~>, C<*.bak>, C<*.old> and C<*.orig> =item make manifest rewrites the MANIFEST file, adding all remaining files found (See ExtUtils::Manifest::mkmanifest() for details) =item make distdir Copies all the files that are in the MANIFEST file to a newly created directory with the name C<$(DISTNAME)-$(VERSION)>. If that directory exists, it will be removed first. Additionally, it will create META.yml and META.json module meta-data file in the distdir and add this to the distdir's MANIFEST. You can shut this behavior off with the NO_META flag. =item make disttest Makes a distdir first, and runs a C, a make, and a make test in that directory. =item make tardist First does a distdir. Then a command $(PREOP) which defaults to a null command, followed by $(TO_UNIX), which defaults to a null command under UNIX, and will convert files in distribution directory to UNIX format otherwise. Next it runs C on that directory into a tarfile and deletes the directory. Finishes with a command $(POSTOP) which defaults to a null command. =item make dist Defaults to $(DIST_DEFAULT) which in turn defaults to tardist. =item make uutardist Runs a tardist first and uuencodes the tarfile. =item make shdist First does a distdir. Then a command $(PREOP) which defaults to a null command. Next it runs C on that directory into a sharfile and deletes the intermediate directory again. Finishes with a command $(POSTOP) which defaults to a null command. Note: For shdist to work properly a C program that can handle directories is mandatory. =item make zipdist First does a distdir. Then a command $(PREOP) which defaults to a null command. Runs C<$(ZIP) $(ZIPFLAGS)> on that directory into a zipfile. Then deletes that directory. Finishes with a command $(POSTOP) which defaults to a null command. =item make ci Does a $(CI) and a $(RCS_LABEL) on all files in the MANIFEST file. =back Customization of the dist targets can be done by specifying a hash reference to the dist attribute of the WriteMakefile call. The following parameters are recognized: CI ('ci -u') COMPRESS ('gzip --best') POSTOP ('@ :') PREOP ('@ :') TO_UNIX (depends on the system) RCS_LABEL ('rcs -q -Nv$(VERSION_SYM):') SHAR ('shar') SUFFIX ('.gz') TAR ('tar') TARFLAGS ('cvf') ZIP ('zip') ZIPFLAGS ('-r') An example: WriteMakefile( ...other options... dist => { COMPRESS => "bzip2", SUFFIX => ".bz2" } ); =head2 Module Meta-Data (META and MYMETA) Long plaguing users of MakeMaker based modules has been the problem of getting basic information about the module out of the sources I running the F and doing a bunch of messy heuristics on the resulting F. Over the years, it has become standard to keep this information in one or more CPAN Meta files distributed with each distribution. The original format of CPAN Meta files was L and the corresponding file was called F. In 2010, version 2 of the L was released, which mandates JSON format for the metadata in order to overcome certain compatibility issues between YAML serializers and to avoid breaking older clients unable to handle a new version of the spec. The L library is now standard for accessing old and new-style Meta files. If L is installed, MakeMaker will automatically generate F and F files for you and add them to your F as part of the 'distdir' target (and thus the 'dist' target). This is intended to seamlessly and rapidly populate CPAN with module meta-data. If you wish to shut this feature off, set the C C flag to true. At the 2008 QA Hackathon in Oslo, Perl module toolchain maintainers agreed to use the CPAN Meta format to communicate post-configuration requirements between toolchain components. These files, F and F, are generated when F generates a F (if L is installed). Clients like L or L will read these files to see what prerequisites must be fulfilled before building or testing the distribution. If you wish to shut this feature off, set the C C flag to true. =head2 Disabling an extension If some events detected in F imply that there is no way to create the Module, but this is a normal state of things, then you can create a F which does nothing, but succeeds on all the "usual" build targets. To do so, use use ExtUtils::MakeMaker qw(WriteEmptyMakefile); WriteEmptyMakefile(); instead of WriteMakefile(). This may be useful if other modules expect this module to be I OK, as opposed to I OK (say, this system-dependent module builds in a subdirectory of some other distribution, or is listed as a dependency in a CPAN::Bundle, but the functionality is supported by different means on the current architecture). =head2 Other Handy Functions =over 4 =item prompt my $value = prompt($message); my $value = prompt($message, $default); The C function provides an easy way to request user input used to write a makefile. It displays the $message as a prompt for input. If a $default is provided it will be used as a default. The function returns the $value selected by the user. If C detects that it is not running interactively and there is nothing on STDIN or if the PERL_MM_USE_DEFAULT environment variable is set to true, the $default will be used without prompting. This prevents automated processes from blocking on user input. If no $default is provided an empty string will be used instead. =item os_unsupported os_unsupported(); os_unsupported if $^O eq 'MSWin32'; The C function provides a way to correctly exit your C before calling C. It is essentially a C with the message "OS unsupported". This is supported since 7.26 =back =head2 Supported versions of Perl Please note that while this module works on Perl 5.6, it is no longer being routinely tested on 5.6 - the earliest Perl version being routinely tested, and expressly supported, is 5.8.1. However, patches to repair any breakage on 5.6 are still being accepted. =head1 ENVIRONMENT =over 4 =item PERL_MM_OPT Command line options used by Cnew()>, and thus by C. The string is split as the shell would, and the result is processed before any actual command line arguments are processed. PERL_MM_OPT='CCFLAGS="-Wl,-rpath -Wl,/foo/bar/lib" LIBS="-lwibble -lwobble"' =item PERL_MM_USE_DEFAULT If set to a true value then MakeMaker's prompt function will always return the default without waiting for user input. =item PERL_CORE Same as the PERL_CORE parameter. The parameter overrides this. =back =head1 SEE ALSO L is a pure-Perl alternative to MakeMaker which does not rely on make or any other external utility. It is easier to extend to suit your needs. L is a wrapper around MakeMaker which adds features not normally available. L and L are both modules to help you setup your distribution. L and L explain CPAN Meta files in detail. L makes it easy to install static, sometimes also referred to as 'shared' files. L helps accessing the shared files after installation. L makes it easy for the module author to create MakeMaker-based distributions with lots of bells and whistles. =head1 AUTHORS Andy Dougherty C, Andreas KEnig C, Tim Bunce C. VMS support by Charles Bailey C. OS/2 support by Ilya Zakharevich C. Currently maintained by Michael G Schwern C Send patches and ideas to C. Send bug reports via http://rt.cpan.org/. Please send your generated Makefile along with your report. For more up-to-date information, see L. Repository available at L. =head1 LICENSE This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See L =cut EXTUTILS_MAKEMAKER $fatpacked{"ExtUtils/MakeMaker/Config.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_MAKEMAKER_CONFIG'; package ExtUtils::MakeMaker::Config; use strict; our $VERSION = '7.38'; $VERSION =~ tr/_//d; use Config (); # Give us an overridable config. our %Config = %Config::Config; sub import { my $caller = caller; no strict 'refs'; ## no critic *{$caller.'::Config'} = \%Config; } 1; =head1 NAME ExtUtils::MakeMaker::Config - Wrapper around Config.pm =head1 SYNOPSIS use ExtUtils::MakeMaker::Config; print $Config{installbin}; # or whatever =head1 DESCRIPTION B A very thin wrapper around Config.pm so MakeMaker is easier to test. =cut EXTUTILS_MAKEMAKER_CONFIG $fatpacked{"ExtUtils/MakeMaker/Locale.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_MAKEMAKER_LOCALE'; package ExtUtils::MakeMaker::Locale; use strict; our $VERSION = "7.38"; $VERSION =~ tr/_//d; use base 'Exporter'; our @EXPORT_OK = qw( decode_argv env $ENCODING_LOCALE $ENCODING_LOCALE_FS $ENCODING_CONSOLE_IN $ENCODING_CONSOLE_OUT ); use Encode (); use Encode::Alias (); our $ENCODING_LOCALE; our $ENCODING_LOCALE_FS; our $ENCODING_CONSOLE_IN; our $ENCODING_CONSOLE_OUT; sub DEBUG () { 0 } sub _init { if ($^O eq "MSWin32") { unless ($ENCODING_LOCALE) { # Try to obtain what the Windows ANSI code page is eval { unless (defined &GetConsoleCP) { require Win32; # manually "import" it since Win32->import refuses *GetConsoleCP = sub { &Win32::GetConsoleCP } if defined &Win32::GetConsoleCP; } unless (defined &GetConsoleCP) { require Win32::API; Win32::API->Import('kernel32', 'int GetConsoleCP()'); } if (defined &GetConsoleCP) { my $cp = GetConsoleCP(); $ENCODING_LOCALE = "cp$cp" if $cp; } }; } unless ($ENCODING_CONSOLE_IN) { # only test one since set together unless (defined &GetInputCP) { eval { require Win32; eval { local $SIG{__WARN__} = sub {} if ( "$]" < 5.014 ); # suppress deprecation warning for inherited AUTOLOAD of Win32::GetConsoleCP() Win32::GetConsoleCP(); }; # manually "import" it since Win32->import refuses *GetInputCP = sub { &Win32::GetConsoleCP } if defined &Win32::GetConsoleCP; *GetOutputCP = sub { &Win32::GetConsoleOutputCP } if defined &Win32::GetConsoleOutputCP; }; unless (defined &GetInputCP) { eval { # try Win32::Console module for codepage to use require Win32::Console; *GetInputCP = sub { &Win32::Console::InputCP } if defined &Win32::Console::InputCP; *GetOutputCP = sub { &Win32::Console::OutputCP } if defined &Win32::Console::OutputCP; }; } unless (defined &GetInputCP) { # final fallback *GetInputCP = *GetOutputCP = sub { # another fallback that could work is: # reg query HKLM\System\CurrentControlSet\Control\Nls\CodePage /v ACP ((qx(chcp) || '') =~ /^Active code page: (\d+)/) ? $1 : (); }; } } my $cp = GetInputCP(); $ENCODING_CONSOLE_IN = "cp$cp" if $cp; $cp = GetOutputCP(); $ENCODING_CONSOLE_OUT = "cp$cp" if $cp; } } unless ($ENCODING_LOCALE) { eval { require I18N::Langinfo; $ENCODING_LOCALE = I18N::Langinfo::langinfo(I18N::Langinfo::CODESET()); # Workaround of Encode < v2.25. The "646" encoding alias was # introduced in Encode-2.25, but we don't want to require that version # quite yet. Should avoid the CPAN testers failure reported from # openbsd-4.7/perl-5.10.0 combo. $ENCODING_LOCALE = "ascii" if $ENCODING_LOCALE eq "646"; # https://rt.cpan.org/Ticket/Display.html?id=66373 $ENCODING_LOCALE = "hp-roman8" if $^O eq "hpux" && $ENCODING_LOCALE eq "roman8"; }; $ENCODING_LOCALE ||= $ENCODING_CONSOLE_IN; } # Workaround of Encode < v2.71 for "cp65000" and "cp65001" # The "cp65000" and "cp65001" aliases were added in [Encode v2.71](https://github.com/dankogai/p5-encode/commit/7874bd95aa10967a3b5dbae333d16bcd703ac6c6) # via commit . # This will avoid test failures for Win32 machines using the UTF-7 or UTF-8 code pages. $ENCODING_LOCALE = 'UTF-7' if $ENCODING_LOCALE && lc($ENCODING_LOCALE) eq "cp65000"; $ENCODING_LOCALE = 'utf-8-strict' if $ENCODING_LOCALE && lc($ENCODING_LOCALE) eq "cp65001"; if ($^O eq "darwin") { $ENCODING_LOCALE_FS ||= "UTF-8"; } # final fallback $ENCODING_LOCALE ||= $^O eq "MSWin32" ? "cp1252" : "UTF-8"; $ENCODING_LOCALE_FS ||= $ENCODING_LOCALE; $ENCODING_CONSOLE_IN ||= $ENCODING_LOCALE; $ENCODING_CONSOLE_OUT ||= $ENCODING_CONSOLE_IN; unless (Encode::find_encoding($ENCODING_LOCALE)) { my $foundit; if (lc($ENCODING_LOCALE) eq "gb18030") { eval { require Encode::HanExtra; }; if ($@) { die "Need Encode::HanExtra to be installed to support locale codeset ($ENCODING_LOCALE), stopped"; } $foundit++ if Encode::find_encoding($ENCODING_LOCALE); } die "The locale codeset ($ENCODING_LOCALE) isn't one that perl can decode, stopped" unless $foundit; } # use Data::Dump; ddx $ENCODING_LOCALE, $ENCODING_LOCALE_FS, $ENCODING_CONSOLE_IN, $ENCODING_CONSOLE_OUT; } _init(); Encode::Alias::define_alias(sub { no strict 'refs'; no warnings 'once'; return ${"ENCODING_" . uc(shift)}; }, "locale"); sub _flush_aliases { no strict 'refs'; for my $a (sort keys %Encode::Alias::Alias) { if (defined ${"ENCODING_" . uc($a)}) { delete $Encode::Alias::Alias{$a}; warn "Flushed alias cache for $a" if DEBUG; } } } sub reinit { $ENCODING_LOCALE = shift; $ENCODING_LOCALE_FS = shift; $ENCODING_CONSOLE_IN = $ENCODING_LOCALE; $ENCODING_CONSOLE_OUT = $ENCODING_LOCALE; _init(); _flush_aliases(); } sub decode_argv { die if defined wantarray; for (@ARGV) { $_ = Encode::decode(locale => $_, @_); } } sub env { my $k = Encode::encode(locale => shift); my $old = $ENV{$k}; if (@_) { my $v = shift; if (defined $v) { $ENV{$k} = Encode::encode(locale => $v); } else { delete $ENV{$k}; } } return Encode::decode(locale => $old) if defined wantarray; } 1; __END__ =head1 NAME ExtUtils::MakeMaker::Locale - bundled Encode::Locale =head1 SYNOPSIS use Encode::Locale; use Encode; $string = decode(locale => $bytes); $bytes = encode(locale => $string); if (-t) { binmode(STDIN, ":encoding(console_in)"); binmode(STDOUT, ":encoding(console_out)"); binmode(STDERR, ":encoding(console_out)"); } # Processing file names passed in as arguments my $uni_filename = decode(locale => $ARGV[0]); open(my $fh, "<", encode(locale_fs => $uni_filename)) || die "Can't open '$uni_filename': $!"; binmode($fh, ":encoding(locale)"); ... =head1 DESCRIPTION In many applications it's wise to let Perl use Unicode for the strings it processes. Most of the interfaces Perl has to the outside world are still byte based. Programs therefore need to decode byte strings that enter the program from the outside and encode them again on the way out. The POSIX locale system is used to specify both the language conventions requested by the user and the preferred character set to consume and output. The C module looks up the charset and encoding (called a CODESET in the locale jargon) and arranges for the L module to know this encoding under the name "locale". It means bytes obtained from the environment can be converted to Unicode strings by calling C<< Encode::encode(locale => $bytes) >> and converted back again with C<< Encode::decode(locale => $string) >>. Where file systems interfaces pass file names in and out of the program we also need care. The trend is for operating systems to use a fixed file encoding that don't actually depend on the locale; and this module determines the most appropriate encoding for file names. The L module will know this encoding under the name "locale_fs". For traditional Unix systems this will be an alias to the same encoding as "locale". For programs running in a terminal window (called a "Console" on some systems) the "locale" encoding is usually a good choice for what to expect as input and output. Some systems allows us to query the encoding set for the terminal and C will do that if available and make these encodings known under the C aliases "console_in" and "console_out". For systems where we can't determine the terminal encoding these will be aliased as the same encoding as "locale". The advice is to use "console_in" for input known to come from the terminal and "console_out" for output to the terminal. In addition to arranging for various Encode aliases the following functions and variables are provided: =over =item decode_argv( ) =item decode_argv( Encode::FB_CROAK ) This will decode the command line arguments to perl (the C<@ARGV> array) in-place. The function will by default replace characters that can't be decoded by "\x{FFFD}", the Unicode replacement character. Any argument provided is passed as CHECK to underlying Encode::decode() call. Pass the value C to have the decoding croak if not all the command line arguments can be decoded. See L for details on other options for CHECK. =item env( $uni_key ) =item env( $uni_key => $uni_value ) Interface to get/set environment variables. Returns the current value as a Unicode string. The $uni_key and $uni_value arguments are expected to be Unicode strings as well. Passing C as $uni_value deletes the environment variable named $uni_key. The returned value will have the characters that can't be decoded replaced by "\x{FFFD}", the Unicode replacement character. There is no interface to request alternative CHECK behavior as for decode_argv(). If you need that you need to call encode/decode yourself. For example: my $key = Encode::encode(locale => $uni_key, Encode::FB_CROAK); my $uni_value = Encode::decode(locale => $ENV{$key}, Encode::FB_CROAK); =item reinit( ) =item reinit( $encoding ) Reinitialize the encodings from the locale. You want to call this function if you changed anything in the environment that might influence the locale. This function will croak if the determined encoding isn't recognized by the Encode module. With argument force $ENCODING_... variables to set to the given value. =item $ENCODING_LOCALE The encoding name determined to be suitable for the current locale. L know this encoding as "locale". =item $ENCODING_LOCALE_FS The encoding name determined to be suitable for file system interfaces involving file names. L know this encoding as "locale_fs". =item $ENCODING_CONSOLE_IN =item $ENCODING_CONSOLE_OUT The encodings to be used for reading and writing output to the a console. L know these encodings as "console_in" and "console_out". =back =head1 NOTES This table summarizes the mapping of the encodings set up by the C module: Encode | | | Alias | Windows | Mac OS X | POSIX ------------+---------+--------------+------------ locale | ANSI | nl_langinfo | nl_langinfo locale_fs | ANSI | UTF-8 | nl_langinfo console_in | OEM | nl_langinfo | nl_langinfo console_out | OEM | nl_langinfo | nl_langinfo =head2 Windows Windows has basically 2 sets of APIs. A wide API (based on passing UTF-16 strings) and a byte based API based a character set called ANSI. The regular Perl interfaces to the OS currently only uses the ANSI APIs. Unfortunately ANSI is not a single character set. The encoding that corresponds to ANSI varies between different editions of Windows. For many western editions of Windows ANSI corresponds to CP-1252 which is a character set similar to ISO-8859-1. Conceptually the ANSI character set is a similar concept to the POSIX locale CODESET so this module figures out what the ANSI code page is and make this available as $ENCODING_LOCALE and the "locale" Encoding alias. Windows systems also operate with another byte based character set. It's called the OEM code page. This is the encoding that the Console takes as input and output. It's common for the OEM code page to differ from the ANSI code page. =head2 Mac OS X On Mac OS X the file system encoding is always UTF-8 while the locale can otherwise be set up as normal for POSIX systems. File names on Mac OS X will at the OS-level be converted to NFD-form. A file created by passing a NFC-filename will come in NFD-form from readdir(). See L for details of NFD/NFC. Actually, Apple does not follow the Unicode NFD standard since not all character ranges are decomposed. The claim is that this avoids problems with round trip conversions from old Mac text encodings. See L for details. =head2 POSIX (Linux and other Unixes) File systems might vary in what encoding is to be used for filenames. Since this module has no way to actually figure out what the is correct it goes with the best guess which is to assume filenames are encoding according to the current locale. Users are advised to always specify UTF-8 as the locale charset. =head1 SEE ALSO L, L, L =head1 AUTHOR Copyright 2010 Gisle Aas . This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut EXTUTILS_MAKEMAKER_LOCALE $fatpacked{"ExtUtils/MakeMaker/version.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_MAKEMAKER_VERSION'; #--------------------------------------------------------------------------# # This is a modified copy of version.pm 0.9909, bundled exclusively for # use by ExtUtils::Makemaker and its dependencies to bootstrap when # version.pm is not available. It should not be used by ordinary modules. # # When loaded, it will try to load version.pm. If that fails, it will load # ExtUtils::MakeMaker::version::vpp and alias various *version functions # to functions in that module. It will also override UNIVERSAL::VERSION. #--------------------------------------------------------------------------# package ExtUtils::MakeMaker::version; use 5.006001; use strict; use vars qw(@ISA $VERSION $CLASS $STRICT $LAX *declare *qv); $VERSION = '7.38'; $VERSION =~ tr/_//d; $CLASS = 'version'; { local $SIG{'__DIE__'}; eval "use version"; if ( $@ ) { # don't have any version.pm installed eval "use ExtUtils::MakeMaker::version::vpp"; die "$@" if ( $@ ); local $^W; delete $INC{'version.pm'}; $INC{'version.pm'} = $INC{'ExtUtils/MakeMaker/version.pm'}; push @version::ISA, "ExtUtils::MakeMaker::version::vpp"; $version::VERSION = $VERSION; *version::qv = \&ExtUtils::MakeMaker::version::vpp::qv; *version::declare = \&ExtUtils::MakeMaker::version::vpp::declare; *version::_VERSION = \&ExtUtils::MakeMaker::version::vpp::_VERSION; *version::vcmp = \&ExtUtils::MakeMaker::version::vpp::vcmp; *version::new = \&ExtUtils::MakeMaker::version::vpp::new; if ("$]" >= 5.009000) { no strict 'refs'; *version::stringify = \&ExtUtils::MakeMaker::version::vpp::stringify; *{'version::(""'} = \&ExtUtils::MakeMaker::version::vpp::stringify; *{'version::(<=>'} = \&ExtUtils::MakeMaker::version::vpp::vcmp; *version::parse = \&ExtUtils::MakeMaker::version::vpp::parse; } require ExtUtils::MakeMaker::version::regex; *version::is_lax = \&ExtUtils::MakeMaker::version::regex::is_lax; *version::is_strict = \&ExtUtils::MakeMaker::version::regex::is_strict; *LAX = \$ExtUtils::MakeMaker::version::regex::LAX; *STRICT = \$ExtUtils::MakeMaker::version::regex::STRICT; } elsif ( ! version->can('is_qv') ) { *version::is_qv = sub { exists $_[0]->{qv} }; } } 1; EXTUTILS_MAKEMAKER_VERSION $fatpacked{"ExtUtils/MakeMaker/version/regex.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_MAKEMAKER_VERSION_REGEX'; #--------------------------------------------------------------------------# # This is a modified copy of version.pm 0.9909, bundled exclusively for # use by ExtUtils::Makemaker and its dependencies to bootstrap when # version.pm is not available. It should not be used by ordinary modules. #--------------------------------------------------------------------------# package ExtUtils::MakeMaker::version::regex; use strict; use vars qw($VERSION $CLASS $STRICT $LAX); $VERSION = '7.38'; $VERSION =~ tr/_//d; #--------------------------------------------------------------------------# # Version regexp components #--------------------------------------------------------------------------# # Fraction part of a decimal version number. This is a common part of # both strict and lax decimal versions my $FRACTION_PART = qr/\.[0-9]+/; # First part of either decimal or dotted-decimal strict version number. # Unsigned integer with no leading zeroes (except for zero itself) to # avoid confusion with octal. my $STRICT_INTEGER_PART = qr/0|[1-9][0-9]*/; # First part of either decimal or dotted-decimal lax version number. # Unsigned integer, but allowing leading zeros. Always interpreted # as decimal. However, some forms of the resulting syntax give odd # results if used as ordinary Perl expressions, due to how perl treats # octals. E.g. # version->new("010" ) == 10 # version->new( 010 ) == 8 # version->new( 010.2) == 82 # "8" . "2" my $LAX_INTEGER_PART = qr/[0-9]+/; # Second and subsequent part of a strict dotted-decimal version number. # Leading zeroes are permitted, and the number is always decimal. # Limited to three digits to avoid overflow when converting to decimal # form and also avoid problematic style with excessive leading zeroes. my $STRICT_DOTTED_DECIMAL_PART = qr/\.[0-9]{1,3}/; # Second and subsequent part of a lax dotted-decimal version number. # Leading zeroes are permitted, and the number is always decimal. No # limit on the numerical value or number of digits, so there is the # possibility of overflow when converting to decimal form. my $LAX_DOTTED_DECIMAL_PART = qr/\.[0-9]+/; # Alpha suffix part of lax version number syntax. Acts like a # dotted-decimal part. my $LAX_ALPHA_PART = qr/_[0-9]+/; #--------------------------------------------------------------------------# # Strict version regexp definitions #--------------------------------------------------------------------------# # Strict decimal version number. my $STRICT_DECIMAL_VERSION = qr/ $STRICT_INTEGER_PART $FRACTION_PART? /x; # Strict dotted-decimal version number. Must have both leading "v" and # at least three parts, to avoid confusion with decimal syntax. my $STRICT_DOTTED_DECIMAL_VERSION = qr/ v $STRICT_INTEGER_PART $STRICT_DOTTED_DECIMAL_PART{2,} /x; # Complete strict version number syntax -- should generally be used # anchored: qr/ \A $STRICT \z /x $STRICT = qr/ $STRICT_DECIMAL_VERSION | $STRICT_DOTTED_DECIMAL_VERSION /x; #--------------------------------------------------------------------------# # Lax version regexp definitions #--------------------------------------------------------------------------# # Lax decimal version number. Just like the strict one except for # allowing an alpha suffix or allowing a leading or trailing # decimal-point my $LAX_DECIMAL_VERSION = qr/ $LAX_INTEGER_PART (?: \. | $FRACTION_PART $LAX_ALPHA_PART? )? | $FRACTION_PART $LAX_ALPHA_PART? /x; # Lax dotted-decimal version number. Distinguished by having either # leading "v" or at least three non-alpha parts. Alpha part is only # permitted if there are at least two non-alpha parts. Strangely # enough, without the leading "v", Perl takes .1.2 to mean v0.1.2, # so when there is no "v", the leading part is optional my $LAX_DOTTED_DECIMAL_VERSION = qr/ v $LAX_INTEGER_PART (?: $LAX_DOTTED_DECIMAL_PART+ $LAX_ALPHA_PART? )? | $LAX_INTEGER_PART? $LAX_DOTTED_DECIMAL_PART{2,} $LAX_ALPHA_PART? /x; # Complete lax version number syntax -- should generally be used # anchored: qr/ \A $LAX \z /x # # The string 'undef' is a special case to make for easier handling # of return values from ExtUtils::MM->parse_version $LAX = qr/ undef | $LAX_DECIMAL_VERSION | $LAX_DOTTED_DECIMAL_VERSION /x; #--------------------------------------------------------------------------# # Preloaded methods go here. sub is_strict { defined $_[0] && $_[0] =~ qr/ \A $STRICT \z /x } sub is_lax { defined $_[0] && $_[0] =~ qr/ \A $LAX \z /x } 1; EXTUTILS_MAKEMAKER_VERSION_REGEX $fatpacked{"ExtUtils/MakeMaker/version/vpp.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_MAKEMAKER_VERSION_VPP'; #--------------------------------------------------------------------------# # This is a modified copy of version.pm 0.9909, bundled exclusively for # use by ExtUtils::Makemaker and its dependencies to bootstrap when # version.pm is not available. It should not be used by ordinary modules. #--------------------------------------------------------------------------# package ExtUtils::MakeMaker::charstar; # a little helper class to emulate C char* semantics in Perl # so that prescan_version can use the same code as in C use overload ( '""' => \&thischar, '0+' => \&thischar, '++' => \&increment, '--' => \&decrement, '+' => \&plus, '-' => \&minus, '*' => \&multiply, 'cmp' => \&cmp, '<=>' => \&spaceship, 'bool' => \&thischar, '=' => \&clone, ); sub new { my ($self, $string) = @_; my $class = ref($self) || $self; my $obj = { string => [split(//,$string)], current => 0, }; return bless $obj, $class; } sub thischar { my ($self) = @_; my $last = $#{$self->{string}}; my $curr = $self->{current}; if ($curr >= 0 && $curr <= $last) { return $self->{string}->[$curr]; } else { return ''; } } sub increment { my ($self) = @_; $self->{current}++; } sub decrement { my ($self) = @_; $self->{current}--; } sub plus { my ($self, $offset) = @_; my $rself = $self->clone; $rself->{current} += $offset; return $rself; } sub minus { my ($self, $offset) = @_; my $rself = $self->clone; $rself->{current} -= $offset; return $rself; } sub multiply { my ($left, $right, $swapped) = @_; my $char = $left->thischar(); return $char * $right; } sub spaceship { my ($left, $right, $swapped) = @_; unless (ref($right)) { # not an object already $right = $left->new($right); } return $left->{current} <=> $right->{current}; } sub cmp { my ($left, $right, $swapped) = @_; unless (ref($right)) { # not an object already if (length($right) == 1) { # comparing single character only return $left->thischar cmp $right; } $right = $left->new($right); } return $left->currstr cmp $right->currstr; } sub bool { my ($self) = @_; my $char = $self->thischar; return ($char ne ''); } sub clone { my ($left, $right, $swapped) = @_; $right = { string => [@{$left->{string}}], current => $left->{current}, }; return bless $right, ref($left); } sub currstr { my ($self, $s) = @_; my $curr = $self->{current}; my $last = $#{$self->{string}}; if (defined($s) && $s->{current} < $last) { $last = $s->{current}; } my $string = join('', @{$self->{string}}[$curr..$last]); return $string; } package ExtUtils::MakeMaker::version::vpp; use 5.006001; use strict; use Config; use vars qw($VERSION $CLASS @ISA $LAX $STRICT); $VERSION = '7.38'; $VERSION =~ tr/_//d; $CLASS = 'ExtUtils::MakeMaker::version::vpp'; require ExtUtils::MakeMaker::version::regex; *ExtUtils::MakeMaker::version::vpp::is_strict = \&ExtUtils::MakeMaker::version::regex::is_strict; *ExtUtils::MakeMaker::version::vpp::is_lax = \&ExtUtils::MakeMaker::version::regex::is_lax; *LAX = \$ExtUtils::MakeMaker::version::regex::LAX; *STRICT = \$ExtUtils::MakeMaker::version::regex::STRICT; use overload ( '""' => \&stringify, '0+' => \&numify, 'cmp' => \&vcmp, '<=>' => \&vcmp, 'bool' => \&vbool, '+' => \&vnoop, '-' => \&vnoop, '*' => \&vnoop, '/' => \&vnoop, '+=' => \&vnoop, '-=' => \&vnoop, '*=' => \&vnoop, '/=' => \&vnoop, 'abs' => \&vnoop, ); eval "use warnings"; if ($@) { eval ' package warnings; sub enabled {return $^W;} 1; '; } sub import { no strict 'refs'; my ($class) = shift; # Set up any derived class unless ($class eq $CLASS) { local $^W; *{$class.'::declare'} = \&{$CLASS.'::declare'}; *{$class.'::qv'} = \&{$CLASS.'::qv'}; } my %args; if (@_) { # any remaining terms are arguments map { $args{$_} = 1 } @_ } else { # no parameters at all on use line %args = ( qv => 1, 'UNIVERSAL::VERSION' => 1, ); } my $callpkg = caller(); if (exists($args{declare})) { *{$callpkg.'::declare'} = sub {return $class->declare(shift) } unless defined(&{$callpkg.'::declare'}); } if (exists($args{qv})) { *{$callpkg.'::qv'} = sub {return $class->qv(shift) } unless defined(&{$callpkg.'::qv'}); } if (exists($args{'UNIVERSAL::VERSION'})) { local $^W; *UNIVERSAL::VERSION = \&{$CLASS.'::_VERSION'}; } if (exists($args{'VERSION'})) { *{$callpkg.'::VERSION'} = \&{$CLASS.'::_VERSION'}; } if (exists($args{'is_strict'})) { *{$callpkg.'::is_strict'} = \&{$CLASS.'::is_strict'} unless defined(&{$callpkg.'::is_strict'}); } if (exists($args{'is_lax'})) { *{$callpkg.'::is_lax'} = \&{$CLASS.'::is_lax'} unless defined(&{$callpkg.'::is_lax'}); } } my $VERSION_MAX = 0x7FFFFFFF; # implement prescan_version as closely to the C version as possible use constant TRUE => 1; use constant FALSE => 0; sub isDIGIT { my ($char) = shift->thischar(); return ($char =~ /\d/); } sub isALPHA { my ($char) = shift->thischar(); return ($char =~ /[a-zA-Z]/); } sub isSPACE { my ($char) = shift->thischar(); return ($char =~ /\s/); } sub BADVERSION { my ($s, $errstr, $error) = @_; if ($errstr) { $$errstr = $error; } return $s; } sub prescan_version { my ($s, $strict, $errstr, $sqv, $ssaw_decimal, $swidth, $salpha) = @_; my $qv = defined $sqv ? $$sqv : FALSE; my $saw_decimal = defined $ssaw_decimal ? $$ssaw_decimal : 0; my $width = defined $swidth ? $$swidth : 3; my $alpha = defined $salpha ? $$salpha : FALSE; my $d = $s; if ($qv && isDIGIT($d)) { goto dotted_decimal_version; } if ($d eq 'v') { # explicit v-string $d++; if (isDIGIT($d)) { $qv = TRUE; } else { # degenerate v-string # requires v1.2.3 return BADVERSION($s,$errstr,"Invalid version format (dotted-decimal versions require at least three parts)"); } dotted_decimal_version: if ($strict && $d eq '0' && isDIGIT($d+1)) { # no leading zeros allowed return BADVERSION($s,$errstr,"Invalid version format (no leading zeros)"); } while (isDIGIT($d)) { # integer part $d++; } if ($d eq '.') { $saw_decimal++; $d++; # decimal point } else { if ($strict) { # require v1.2.3 return BADVERSION($s,$errstr,"Invalid version format (dotted-decimal versions require at least three parts)"); } else { goto version_prescan_finish; } } { my $i = 0; my $j = 0; while (isDIGIT($d)) { # just keep reading $i++; while (isDIGIT($d)) { $d++; $j++; # maximum 3 digits between decimal if ($strict && $j > 3) { return BADVERSION($s,$errstr,"Invalid version format (maximum 3 digits between decimals)"); } } if ($d eq '_') { if ($strict) { return BADVERSION($s,$errstr,"Invalid version format (no underscores)"); } if ( $alpha ) { return BADVERSION($s,$errstr,"Invalid version format (multiple underscores)"); } $d++; $alpha = TRUE; } elsif ($d eq '.') { if ($alpha) { return BADVERSION($s,$errstr,"Invalid version format (underscores before decimal)"); } $saw_decimal++; $d++; } elsif (!isDIGIT($d)) { last; } $j = 0; } if ($strict && $i < 2) { # requires v1.2.3 return BADVERSION($s,$errstr,"Invalid version format (dotted-decimal versions require at least three parts)"); } } } # end if dotted-decimal else { # decimal versions my $j = 0; # special $strict case for leading '.' or '0' if ($strict) { if ($d eq '.') { return BADVERSION($s,$errstr,"Invalid version format (0 before decimal required)"); } if ($d eq '0' && isDIGIT($d+1)) { return BADVERSION($s,$errstr,"Invalid version format (no leading zeros)"); } } # and we never support negative version numbers if ($d eq '-') { return BADVERSION($s,$errstr,"Invalid version format (negative version number)"); } # consume all of the integer part while (isDIGIT($d)) { $d++; } # look for a fractional part if ($d eq '.') { # we found it, so consume it $saw_decimal++; $d++; } elsif (!$d || $d eq ';' || isSPACE($d) || $d eq '}') { if ( $d == $s ) { # found nothing return BADVERSION($s,$errstr,"Invalid version format (version required)"); } # found just an integer goto version_prescan_finish; } elsif ( $d == $s ) { # didn't find either integer or period return BADVERSION($s,$errstr,"Invalid version format (non-numeric data)"); } elsif ($d eq '_') { # underscore can't come after integer part if ($strict) { return BADVERSION($s,$errstr,"Invalid version format (no underscores)"); } elsif (isDIGIT($d+1)) { return BADVERSION($s,$errstr,"Invalid version format (alpha without decimal)"); } else { return BADVERSION($s,$errstr,"Invalid version format (misplaced underscore)"); } } elsif ($d) { # anything else after integer part is just invalid data return BADVERSION($s,$errstr,"Invalid version format (non-numeric data)"); } # scan the fractional part after the decimal point if ($d && !isDIGIT($d) && ($strict || ! ($d eq ';' || isSPACE($d) || $d eq '}') )) { # $strict or lax-but-not-the-end return BADVERSION($s,$errstr,"Invalid version format (fractional part required)"); } while (isDIGIT($d)) { $d++; $j++; if ($d eq '.' && isDIGIT($d-1)) { if ($alpha) { return BADVERSION($s,$errstr,"Invalid version format (underscores before decimal)"); } if ($strict) { return BADVERSION($s,$errstr,"Invalid version format (dotted-decimal versions must begin with 'v')"); } $d = $s; # start all over again $qv = TRUE; goto dotted_decimal_version; } if ($d eq '_') { if ($strict) { return BADVERSION($s,$errstr,"Invalid version format (no underscores)"); } if ( $alpha ) { return BADVERSION($s,$errstr,"Invalid version format (multiple underscores)"); } if ( ! isDIGIT($d+1) ) { return BADVERSION($s,$errstr,"Invalid version format (misplaced underscore)"); } $width = $j; $d++; $alpha = TRUE; } } } version_prescan_finish: while (isSPACE($d)) { $d++; } if ($d && !isDIGIT($d) && (! ($d eq ';' || $d eq '}') )) { # trailing non-numeric data return BADVERSION($s,$errstr,"Invalid version format (non-numeric data)"); } if (defined $sqv) { $$sqv = $qv; } if (defined $swidth) { $$swidth = $width; } if (defined $ssaw_decimal) { $$ssaw_decimal = $saw_decimal; } if (defined $salpha) { $$salpha = $alpha; } return $d; } sub scan_version { my ($s, $rv, $qv) = @_; my $start; my $pos; my $last; my $errstr; my $saw_decimal = 0; my $width = 3; my $alpha = FALSE; my $vinf = FALSE; my @av; $s = new ExtUtils::MakeMaker::charstar $s; while (isSPACE($s)) { # leading whitespace is OK $s++; } $last = prescan_version($s, FALSE, \$errstr, \$qv, \$saw_decimal, \$width, \$alpha); if ($errstr) { # 'undef' is a special case and not an error if ( $s ne 'undef') { require Carp; Carp::croak($errstr); } } $start = $s; if ($s eq 'v') { $s++; } $pos = $s; if ( $qv ) { $$rv->{qv} = $qv; } if ( $alpha ) { $$rv->{alpha} = $alpha; } if ( !$qv && $width < 3 ) { $$rv->{width} = $width; } while (isDIGIT($pos)) { $pos++; } if (!isALPHA($pos)) { my $rev; for (;;) { $rev = 0; { # this is atoi() that delimits on underscores my $end = $pos; my $mult = 1; my $orev; # the following if() will only be true after the decimal # point of a version originally created with a bare # floating point number, i.e. not quoted in any way # if ( !$qv && $s > $start && $saw_decimal == 1 ) { $mult *= 100; while ( $s < $end ) { $orev = $rev; $rev += $s * $mult; $mult /= 10; if ( (abs($orev) > abs($rev)) || (abs($rev) > $VERSION_MAX )) { warn("Integer overflow in version %d", $VERSION_MAX); $s = $end - 1; $rev = $VERSION_MAX; $vinf = 1; } $s++; if ( $s eq '_' ) { $s++; } } } else { while (--$end >= $s) { $orev = $rev; $rev += $end * $mult; $mult *= 10; if ( (abs($orev) > abs($rev)) || (abs($rev) > $VERSION_MAX )) { warn("Integer overflow in version"); $end = $s - 1; $rev = $VERSION_MAX; $vinf = 1; } } } } # Append revision push @av, $rev; if ( $vinf ) { $s = $last; last; } elsif ( $pos eq '.' ) { $s = ++$pos; } elsif ( $pos eq '_' && isDIGIT($pos+1) ) { $s = ++$pos; } elsif ( $pos eq ',' && isDIGIT($pos+1) ) { $s = ++$pos; } elsif ( isDIGIT($pos) ) { $s = $pos; } else { $s = $pos; last; } if ( $qv ) { while ( isDIGIT($pos) ) { $pos++; } } else { my $digits = 0; while ( ( isDIGIT($pos) || $pos eq '_' ) && $digits < 3 ) { if ( $pos ne '_' ) { $digits++; } $pos++; } } } } if ( $qv ) { # quoted versions always get at least three terms my $len = $#av; # This for loop appears to trigger a compiler bug on OS X, as it # loops infinitely. Yes, len is negative. No, it makes no sense. # Compiler in question is: # gcc version 3.3 20030304 (Apple Computer, Inc. build 1640) # for ( len = 2 - len; len > 0; len-- ) # av_push(MUTABLE_AV(sv), newSViv(0)); # $len = 2 - $len; while ($len-- > 0) { push @av, 0; } } # need to save off the current version string for later if ( $vinf ) { $$rv->{original} = "v.Inf"; $$rv->{vinf} = 1; } elsif ( $s > $start ) { $$rv->{original} = $start->currstr($s); if ( $qv && $saw_decimal == 1 && $start ne 'v' ) { # need to insert a v to be consistent $$rv->{original} = 'v' . $$rv->{original}; } } else { $$rv->{original} = '0'; push(@av, 0); } # And finally, store the AV in the hash $$rv->{version} = \@av; # fix RT#19517 - special case 'undef' as string if ($s eq 'undef') { $s += 5; } return $s; } sub new { my $class = shift; unless (defined $class or $#_ > 1) { require Carp; Carp::croak('Usage: version::new(class, version)'); } my $self = bless ({}, ref ($class) || $class); my $qv = FALSE; if ( $#_ == 1 ) { # must be CVS-style $qv = TRUE; } my $value = pop; # always going to be the last element if ( ref($value) && eval('$value->isa("version")') ) { # Can copy the elements directly $self->{version} = [ @{$value->{version} } ]; $self->{qv} = 1 if $value->{qv}; $self->{alpha} = 1 if $value->{alpha}; $self->{original} = ''.$value->{original}; return $self; } if ( not defined $value or $value =~ /^undef$/ ) { # RT #19517 - special case for undef comparison # or someone forgot to pass a value push @{$self->{version}}, 0; $self->{original} = "0"; return ($self); } if (ref($value) =~ m/ARRAY|HASH/) { require Carp; Carp::croak("Invalid version format (non-numeric data)"); } $value = _un_vstring($value); if ($Config{d_setlocale} && eval { require POSIX } ) { require locale; my $currlocale = POSIX::setlocale(&POSIX::LC_ALL); # if the current locale uses commas for decimal points, we # just replace commas with decimal places, rather than changing # locales if ( POSIX::localeconv()->{decimal_point} eq ',' ) { $value =~ tr/,/./; } } # exponential notation if ( $value =~ /\d+.?\d*e[-+]?\d+/ ) { $value = sprintf("%.9f",$value); $value =~ s/(0+)$//; # trim trailing zeros } my $s = scan_version($value, \$self, $qv); if ($s) { # must be something left over warn("Version string '%s' contains invalid data; " ."ignoring: '%s'", $value, $s); } return ($self); } *parse = \&new; sub numify { my ($self) = @_; unless (_verify($self)) { require Carp; Carp::croak("Invalid version object"); } my $width = $self->{width} || 3; my $alpha = $self->{alpha} || ""; my $len = $#{$self->{version}}; my $digit = $self->{version}[0]; my $string = sprintf("%d.", $digit ); for ( my $i = 1 ; $i < $len ; $i++ ) { $digit = $self->{version}[$i]; if ( $width < 3 ) { my $denom = 10**(3-$width); my $quot = int($digit/$denom); my $rem = $digit - ($quot * $denom); $string .= sprintf("%0".$width."d_%d", $quot, $rem); } else { $string .= sprintf("%03d", $digit); } } if ( $len > 0 ) { $digit = $self->{version}[$len]; if ( $alpha && $width == 3 ) { $string .= "_"; } $string .= sprintf("%0".$width."d", $digit); } else # $len = 0 { $string .= sprintf("000"); } return $string; } sub normal { my ($self) = @_; unless (_verify($self)) { require Carp; Carp::croak("Invalid version object"); } my $alpha = $self->{alpha} || ""; my $len = $#{$self->{version}}; my $digit = $self->{version}[0]; my $string = sprintf("v%d", $digit ); for ( my $i = 1 ; $i < $len ; $i++ ) { $digit = $self->{version}[$i]; $string .= sprintf(".%d", $digit); } if ( $len > 0 ) { $digit = $self->{version}[$len]; if ( $alpha ) { $string .= sprintf("_%0d", $digit); } else { $string .= sprintf(".%0d", $digit); } } if ( $len <= 2 ) { for ( $len = 2 - $len; $len != 0; $len-- ) { $string .= sprintf(".%0d", 0); } } return $string; } sub stringify { my ($self) = @_; unless (_verify($self)) { require Carp; Carp::croak("Invalid version object"); } return exists $self->{original} ? $self->{original} : exists $self->{qv} ? $self->normal : $self->numify; } sub vcmp { require UNIVERSAL; my ($left,$right,$swap) = @_; my $class = ref($left); unless ( UNIVERSAL::isa($right, $class) ) { $right = $class->new($right); } if ( $swap ) { ($left, $right) = ($right, $left); } unless (_verify($left)) { require Carp; Carp::croak("Invalid version object"); } unless (_verify($right)) { require Carp; Carp::croak("Invalid version format"); } my $l = $#{$left->{version}}; my $r = $#{$right->{version}}; my $m = $l < $r ? $l : $r; my $lalpha = $left->is_alpha; my $ralpha = $right->is_alpha; my $retval = 0; my $i = 0; while ( $i <= $m && $retval == 0 ) { $retval = $left->{version}[$i] <=> $right->{version}[$i]; $i++; } # tiebreaker for alpha with identical terms if ( $retval == 0 && $l == $r && $left->{version}[$m] == $right->{version}[$m] && ( $lalpha || $ralpha ) ) { if ( $lalpha && !$ralpha ) { $retval = -1; } elsif ( $ralpha && !$lalpha) { $retval = +1; } } # possible match except for trailing 0's if ( $retval == 0 && $l != $r ) { if ( $l < $r ) { while ( $i <= $r && $retval == 0 ) { if ( $right->{version}[$i] != 0 ) { $retval = -1; # not a match after all } $i++; } } else { while ( $i <= $l && $retval == 0 ) { if ( $left->{version}[$i] != 0 ) { $retval = +1; # not a match after all } $i++; } } } return $retval; } sub vbool { my ($self) = @_; return vcmp($self,$self->new("0"),1); } sub vnoop { require Carp; Carp::croak("operation not supported with version object"); } sub is_alpha { my ($self) = @_; return (exists $self->{alpha}); } sub qv { my $value = shift; my $class = $CLASS; if (@_) { $class = ref($value) || $value; $value = shift; } $value = _un_vstring($value); $value = 'v'.$value unless $value =~ /(^v|\d+\.\d+\.\d)/; my $obj = $CLASS->new($value); return bless $obj, $class; } *declare = \&qv; sub is_qv { my ($self) = @_; return (exists $self->{qv}); } sub _verify { my ($self) = @_; if ( ref($self) && eval { exists $self->{version} } && ref($self->{version}) eq 'ARRAY' ) { return 1; } else { return 0; } } sub _is_non_alphanumeric { my $s = shift; $s = new ExtUtils::MakeMaker::charstar $s; while ($s) { return 0 if isSPACE($s); # early out return 1 unless (isALPHA($s) || isDIGIT($s) || $s =~ /[.-]/); $s++; } return 0; } sub _un_vstring { my $value = shift; # may be a v-string if ( length($value) >= 3 && $value !~ /[._]/ && _is_non_alphanumeric($value)) { my $tvalue; if ( "$]" >= 5.008_001 ) { $tvalue = _find_magic_vstring($value); $value = $tvalue if length $tvalue; } elsif ( "$]" >= 5.006_000 ) { $tvalue = sprintf("v%vd",$value); if ( $tvalue =~ /^v\d+(\.\d+){2,}$/ ) { # must be a v-string $value = $tvalue; } } } return $value; } sub _find_magic_vstring { my $value = shift; my $tvalue = ''; require B; my $sv = B::svref_2object(\$value); my $magic = ref($sv) eq 'B::PVMG' ? $sv->MAGIC : undef; while ( $magic ) { if ( $magic->TYPE eq 'V' ) { $tvalue = $magic->PTR; $tvalue =~ s/^v?(.+)$/v$1/; last; } else { $magic = $magic->MOREMAGIC; } } return $tvalue; } sub _VERSION { my ($obj, $req) = @_; my $class = ref($obj) || $obj; no strict 'refs'; if ( exists $INC{"$class.pm"} and not %{"$class\::"} and "$]" >= 5.008) { # file but no package require Carp; Carp::croak( "$class defines neither package nor VERSION" ."--version check failed"); } my $version = eval "\$$class\::VERSION"; if ( defined $version ) { local $^W if "$]" <= 5.008; $version = ExtUtils::MakeMaker::version::vpp->new($version); } if ( defined $req ) { unless ( defined $version ) { require Carp; my $msg = "$]" < 5.006 ? "$class version $req required--this is only version " : "$class does not define \$$class\::VERSION" ."--version check failed"; if ( $ENV{VERSION_DEBUG} ) { Carp::confess($msg); } else { Carp::croak($msg); } } $req = ExtUtils::MakeMaker::version::vpp->new($req); if ( $req > $version ) { require Carp; if ( $req->is_qv ) { Carp::croak( sprintf ("%s version %s required--". "this is only version %s", $class, $req->normal, $version->normal) ); } else { Carp::croak( sprintf ("%s version %s required--". "this is only version %s", $class, $req->stringify, $version->stringify) ); } } } return defined $version ? $version->stringify : undef; } 1; #this line is important and will help the module return a true value EXTUTILS_MAKEMAKER_VERSION_VPP $fatpacked{"ExtUtils/Manifest.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_MANIFEST'; package ExtUtils::Manifest; require Exporter; use Config; use File::Basename; use File::Copy 'copy'; use File::Find; use File::Spec 0.8; use Carp; use strict; use warnings; our $VERSION = '1.70'; our @ISA = ('Exporter'); our @EXPORT_OK = qw(mkmanifest manicheck filecheck fullcheck skipcheck manifind maniread manicopy maniadd maniskip ); our $Is_MacOS = $^O eq 'MacOS'; our $Is_VMS = $^O eq 'VMS'; our $Is_VMS_mode = 0; our $Is_VMS_lc = 0; our $Is_VMS_nodot = 0; # No dots in dir names or double dots in files if ($Is_VMS) { require VMS::Filespec if $Is_VMS; my $vms_unix_rpt; my $vms_efs; my $vms_case; $Is_VMS_mode = 1; $Is_VMS_lc = 1; $Is_VMS_nodot = 1; if (eval { local $SIG{__DIE__}; require VMS::Feature; }) { $vms_unix_rpt = VMS::Feature::current("filename_unix_report"); $vms_efs = VMS::Feature::current("efs_charset"); $vms_case = VMS::Feature::current("efs_case_preserve"); } else { my $unix_rpt = $ENV{'DECC$FILENAME_UNIX_REPORT'} || ''; my $efs_charset = $ENV{'DECC$EFS_CHARSET'} || ''; my $efs_case = $ENV{'DECC$EFS_CASE_PRESERVE'} || ''; $vms_unix_rpt = $unix_rpt =~ /^[ET1]/i; $vms_efs = $efs_charset =~ /^[ET1]/i; $vms_case = $efs_case =~ /^[ET1]/i; } $Is_VMS_lc = 0 if ($vms_case); $Is_VMS_mode = 0 if ($vms_unix_rpt); $Is_VMS_nodot = 0 if ($vms_efs); } our $Debug = $ENV{PERL_MM_MANIFEST_DEBUG} || 0; our $Verbose = defined $ENV{PERL_MM_MANIFEST_VERBOSE} ? $ENV{PERL_MM_MANIFEST_VERBOSE} : 1; our $Quiet = 0; our $MANIFEST = 'MANIFEST'; our $DEFAULT_MSKIP = File::Spec->catfile( dirname(__FILE__), "$MANIFEST.SKIP" ); =head1 NAME ExtUtils::Manifest - utilities to write and check a MANIFEST file =head1 VERSION version 1.70 =head1 SYNOPSIS use ExtUtils::Manifest qw(...funcs to import...); mkmanifest(); my @missing_files = manicheck; my @skipped = skipcheck; my @extra_files = filecheck; my($missing, $extra) = fullcheck; my $found = manifind(); my $manifest = maniread(); manicopy($read,$target); maniadd({$file => $comment, ...}); =head1 DESCRIPTION =head2 Functions ExtUtils::Manifest exports no functions by default. The following are exported on request =over 4 =item mkmanifest mkmanifest(); Writes all files in and below the current directory to your F. It works similar to the result of the Unix command find . > MANIFEST All files that match any regular expression in a file F (if it exists) are ignored. Any existing F file will be saved as F. =cut sub _sort { return sort { lc $a cmp lc $b } @_; } sub mkmanifest { my $manimiss = 0; my $read = (-r 'MANIFEST' && maniread()) or $manimiss++; $read = {} if $manimiss; local *M; my $bakbase = $MANIFEST; $bakbase =~ s/\./_/g if $Is_VMS_nodot; # avoid double dots rename $MANIFEST, "$bakbase.bak" unless $manimiss; open M, "> $MANIFEST" or die "Could not open $MANIFEST: $!"; binmode M, ':raw'; my $skip = maniskip(); my $found = manifind(); my($key,$val,$file,%all); %all = (%$found, %$read); $all{$MANIFEST} = ($Is_VMS_mode ? "$MANIFEST\t\t" : '') . 'This list of files' if $manimiss; # add new MANIFEST to known file list foreach $file (_sort keys %all) { if ($skip->($file)) { # Policy: only remove files if they're listed in MANIFEST.SKIP. # Don't remove files just because they don't exist. warn "Removed from $MANIFEST: $file\n" if $Verbose and exists $read->{$file}; next; } if ($Verbose){ warn "Added to $MANIFEST: $file\n" unless exists $read->{$file}; } my $text = $all{$file}; $file = _unmacify($file); my $tabs = (5 - (length($file)+1)/8); $tabs = 1 if $tabs < 1; $tabs = 0 unless $text; if ($file =~ /\s/) { $file =~ s/([\\'])/\\$1/g; $file = "'$file'"; } print M $file, "\t" x $tabs, $text, "\n"; } close M; } # Geez, shouldn't this use File::Spec or File::Basename or something? # Why so careful about dependencies? sub clean_up_filename { my $filename = shift; $filename =~ s|^\./||; $filename =~ s/^:([^:]+)$/$1/ if $Is_MacOS; if ( $Is_VMS ) { $filename =~ s/\.$//; # trim trailing dot $filename = VMS::Filespec::unixify($filename); # unescape spaces, etc. if( $Is_VMS_lc ) { $filename = lc($filename); $filename = uc($filename) if $filename =~ /^MANIFEST(\.SKIP)?$/i; } } return $filename; } =item manifind my $found = manifind(); returns a hash reference. The keys of the hash are the files found below the current directory. =cut sub manifind { my $p = shift || {}; my $found = {}; my $wanted = sub { my $name = clean_up_filename($File::Find::name); warn "Debug: diskfile $name\n" if $Debug; return if -d $_; $found->{$name} = ""; }; # We have to use "$File::Find::dir/$_" in preprocess, because # $File::Find::name is unavailable. # Also, it's okay to use / here, because MANIFEST files use Unix-style # paths. find({wanted => $wanted, follow_fast => 1}, $Is_MacOS ? ":" : "."); return $found; } =item manicheck my @missing_files = manicheck(); checks if all the files within a C in the current directory really do exist. If C and the tree below the current directory are in sync it silently returns an empty list. Otherwise it returns a list of files which are listed in the C but missing from the directory, and by default also outputs these names to STDERR. =cut sub manicheck { return _check_files(); } =item filecheck my @extra_files = filecheck(); finds files below the current directory that are not mentioned in the C file. An optional file C will be consulted. Any file matching a regular expression in such a file will not be reported as missing in the C file. The list of any extraneous files found is returned, and by default also reported to STDERR. =cut sub filecheck { return _check_manifest(); } =item fullcheck my($missing, $extra) = fullcheck(); does both a manicheck() and a filecheck(), returning then as two array refs. =cut sub fullcheck { return [_check_files()], [_check_manifest()]; } =item skipcheck my @skipped = skipcheck(); lists all the files that are skipped due to your C file. =cut sub skipcheck { my($p) = @_; my $found = manifind(); my $matches = maniskip(); my @skipped = (); foreach my $file (_sort keys %$found){ if (&$matches($file)){ warn "Skipping $file\n" unless $Quiet; push @skipped, $file; next; } } return @skipped; } sub _check_files { my $p = shift; my $dosnames=(defined(&Dos::UseLFN) && Dos::UseLFN()==0); my $read = maniread() || {}; my $found = manifind($p); my(@missfile) = (); foreach my $file (_sort keys %$read){ warn "Debug: manicheck checking from $MANIFEST $file\n" if $Debug; if ($dosnames){ $file = lc $file; $file =~ s=(\.(\w|-)+)=substr ($1,0,4)=ge; $file =~ s=((\w|-)+)=substr ($1,0,8)=ge; } unless ( exists $found->{$file} ) { warn "No such file: $file\n" unless $Quiet; push @missfile, $file; } } return @missfile; } sub _check_manifest { my($p) = @_; my $read = maniread() || {}; my $found = manifind($p); my $skip = maniskip(); my @missentry = (); foreach my $file (_sort keys %$found){ next if $skip->($file); warn "Debug: manicheck checking from disk $file\n" if $Debug; unless ( exists $read->{$file} ) { my $canon = $Is_MacOS ? "\t" . _unmacify($file) : ''; warn "Not in $MANIFEST: $file$canon\n" unless $Quiet; push @missentry, $file; } } return @missentry; } =item maniread my $manifest = maniread(); my $manifest = maniread($manifest_file); reads a named C file (defaults to C in the current directory) and returns a HASH reference with files being the keys and comments being the values of the HASH. Blank lines and lines which start with C<#> in the C file are discarded. =cut sub maniread { my ($mfile) = @_; $mfile ||= $MANIFEST; my $read = {}; local *M; unless (open M, "< $mfile"){ warn "Problem opening $mfile: $!"; return $read; } local $_; while (){ chomp; next if /^\s*#/; my($file, $comment); # filename may contain spaces if enclosed in '' # (in which case, \\ and \' are escapes) if (($file, $comment) = /^'((?:\\[\\']|.+)+)'\s*(.*)/) { $file =~ s/\\([\\'])/$1/g; } else { ($file, $comment) = /^(\S+)\s*(.*)/; } next unless $file; if ($Is_MacOS) { $file = _macify($file); $file =~ s/\\([0-3][0-7][0-7])/sprintf("%c", oct($1))/ge; } elsif ($Is_VMS_mode) { require File::Basename; my($base,$dir) = File::Basename::fileparse($file); # Resolve illegal file specifications in the same way as tar if ($Is_VMS_nodot) { $dir =~ tr/./_/; my(@pieces) = split(/\./,$base); if (@pieces > 2) { $base = shift(@pieces) . '.' . join('_',@pieces); } my $okfile = "$dir$base"; warn "Debug: Illegal name $file changed to $okfile\n" if $Debug; $file = $okfile; } if( $Is_VMS_lc ) { $file = lc($file); $file = uc($file) if $file =~ /^MANIFEST(\.SKIP)?$/i; } } $read->{$file} = $comment; } close M; $read; } =item maniskip my $skipchk = maniskip(); my $skipchk = maniskip($manifest_skip_file); if ($skipchk->($file)) { .. } reads a named C file (defaults to C in the current directory) and returns a CODE reference that tests whether a given filename should be skipped. =cut # returns an anonymous sub that decides if an argument matches sub maniskip { my @skip ; my $mfile = shift || "$MANIFEST.SKIP"; _check_mskip_directives($mfile) if -f $mfile; local(*M, $_); open M, "< $mfile" or open M, "< $DEFAULT_MSKIP" or return sub {0}; while (){ chomp; s/\r//; $_ =~ qr{^\s*(?:(?:'([^\\']*(?:\\.[^\\']*)*)')|([^#\s]\S*))?(?:(?:\s*)|(?:\s+(.*?)\s*))$}; #my $comment = $3; my $filename = $2; if ( defined($1) ) { $filename = $1; $filename =~ s/\\(['\\])/$1/g; } next if (not defined($filename) or not $filename); push @skip, _macify($filename); } close M; return sub {0} unless (scalar @skip > 0); my $opts = $Is_VMS_mode ? '(?i)' : ''; # Make sure each entry is isolated in its own parentheses, in case # any of them contain alternations my $regex = join '|', map "(?:$_)", @skip; return sub { $_[0] =~ qr{$opts$regex} }; } # checks for the special directives # #!include_default # #!include /path/to/some/manifest.skip # in a custom MANIFEST.SKIP for, for including # the content of, respectively, the default MANIFEST.SKIP # and an external manifest.skip file sub _check_mskip_directives { my $mfile = shift; local (*M, $_); my @lines = (); my $flag = 0; unless (open M, "< $mfile") { warn "Problem opening $mfile: $!"; return; } while () { if (/^#!include_default\s*$/) { if (my @default = _include_mskip_file()) { push @lines, @default; warn "Debug: Including default MANIFEST.SKIP\n" if $Debug; $flag++; } next; } if (/^#!include\s+(.*)\s*$/) { my $external_file = $1; if (my @external = _include_mskip_file($external_file)) { push @lines, @external; warn "Debug: Including external $external_file\n" if $Debug; $flag++; } next; } push @lines, $_; } close M; return unless $flag; my $bakbase = $mfile; $bakbase =~ s/\./_/g if $Is_VMS_nodot; # avoid double dots rename $mfile, "$bakbase.bak"; warn "Debug: Saving original $mfile as $bakbase.bak\n" if $Debug; unless (open M, "> $mfile") { warn "Problem opening $mfile: $!"; return; } binmode M, ':raw'; print M $_ for (@lines); close M; return; } # returns an array containing the lines of an external # manifest.skip file, if given, or $DEFAULT_MSKIP sub _include_mskip_file { my $mskip = shift || $DEFAULT_MSKIP; unless (-f $mskip) { warn qq{Included file "$mskip" not found - skipping}; return; } local (*M, $_); unless (open M, "< $mskip") { warn "Problem opening $mskip: $!"; return; } my @lines = (); push @lines, "\n#!start included $mskip\n"; push @lines, $_ while ; close M; push @lines, "#!end included $mskip\n\n"; return @lines; } =item manicopy manicopy(\%src, $dest_dir); manicopy(\%src, $dest_dir, $how); Copies the files that are the keys in %src to the $dest_dir. %src is typically returned by the maniread() function. manicopy( maniread(), $dest_dir ); This function is useful for producing a directory tree identical to the intended distribution tree. $how can be used to specify a different methods of "copying". Valid values are C, which actually copies the files, C which creates hard links, and C which mostly links the files but copies any symbolic link to make a tree without any symbolic link. C is the default. =cut sub manicopy { my($read,$target,$how)=@_; croak "manicopy() called without target argument" unless defined $target; $how ||= 'cp'; require File::Path; require File::Basename; $target = VMS::Filespec::unixify($target) if $Is_VMS_mode; File::Path::mkpath([ $target ],! $Quiet,$Is_VMS ? undef : 0755); foreach my $file (keys %$read){ if ($Is_MacOS) { if ($file =~ m!:!) { my $dir = _maccat($target, $file); $dir =~ s/[^:]+$//; File::Path::mkpath($dir,1,0755); } cp_if_diff($file, _maccat($target, $file), $how); } else { $file = VMS::Filespec::unixify($file) if $Is_VMS_mode; if ($file =~ m!/!) { # Ilya, that hurts, I fear, or maybe not? my $dir = File::Basename::dirname($file); $dir = VMS::Filespec::unixify($dir) if $Is_VMS_mode; File::Path::mkpath(["$target/$dir"],! $Quiet,$Is_VMS ? undef : 0755); } cp_if_diff($file, "$target/$file", $how); } } } sub cp_if_diff { my($from, $to, $how)=@_; if (! -f $from) { carp "$from not found"; return; } my($diff) = 0; local(*F,*T); open(F,"< $from\0") or die "Can't read $from: $!\n"; if (open(T,"< $to\0")) { local $_; while () { $diff++,last if $_ ne ; } $diff++ unless eof(T); close T; } else { $diff++; } close F; if ($diff) { if (-e $to) { unlink($to) or confess "unlink $to: $!"; } STRICT_SWITCH: { best($from,$to), last STRICT_SWITCH if $how eq 'best'; cp($from,$to), last STRICT_SWITCH if $how eq 'cp'; ln($from,$to), last STRICT_SWITCH if $how eq 'ln'; croak("ExtUtils::Manifest::cp_if_diff " . "called with illegal how argument [$how]. " . "Legal values are 'best', 'cp', and 'ln'."); } } } sub cp { my ($srcFile, $dstFile) = @_; my ($access,$mod) = (stat $srcFile)[8,9]; copy($srcFile,$dstFile); utime $access, $mod + ($Is_VMS ? 1 : 0), $dstFile; _manicopy_chmod($srcFile, $dstFile); } sub ln { my ($srcFile, $dstFile) = @_; # Fix-me - VMS can support links. return &cp if $Is_VMS or ($^O eq 'MSWin32' and Win32::IsWin95()); link($srcFile, $dstFile); unless( _manicopy_chmod($srcFile, $dstFile) ) { unlink $dstFile; return; } 1; } # 1) Strip off all group and world permissions. # 2) Let everyone read it. # 3) If the owner can execute it, everyone can. sub _manicopy_chmod { my($srcFile, $dstFile) = @_; my $perm = 0444 | (stat $srcFile)[2] & 0700; chmod( $perm | ( $perm & 0100 ? 0111 : 0 ), $dstFile ); } # Files that are often modified in the distdir. Don't hard link them. my @Exceptions = qw(MANIFEST META.yml SIGNATURE); sub best { my ($srcFile, $dstFile) = @_; my $is_exception = grep $srcFile =~ /$_/, @Exceptions; if ($is_exception or !$Config{d_link} or -l $srcFile) { cp($srcFile, $dstFile); } else { ln($srcFile, $dstFile) or cp($srcFile, $dstFile); } } sub _macify { my($file) = @_; return $file unless $Is_MacOS; $file =~ s|^\./||; if ($file =~ m|/|) { $file =~ s|/+|:|g; $file = ":$file"; } $file; } sub _maccat { my($f1, $f2) = @_; return "$f1/$f2" unless $Is_MacOS; $f1 .= ":$f2"; $f1 =~ s/([^:]:):/$1/g; return $f1; } sub _unmacify { my($file) = @_; return $file unless $Is_MacOS; $file =~ s|^:||; $file =~ s|([/ \n])|sprintf("\\%03o", unpack("c", $1))|ge; $file =~ y|:|/|; $file; } =item maniadd maniadd({ $file => $comment, ...}); Adds an entry to an existing F unless its already there. $file will be normalized (ie. Unixified). B =cut sub maniadd { my($additions) = shift; _normalize($additions); _fix_manifest($MANIFEST); my $manifest = maniread(); my @needed = grep { !exists $manifest->{$_} } keys %$additions; return 1 unless @needed; open(MANIFEST, ">>$MANIFEST") or die "maniadd() could not open $MANIFEST: $!"; binmode MANIFEST, ':raw'; foreach my $file (_sort @needed) { my $comment = $additions->{$file} || ''; if ($file =~ /\s/) { $file =~ s/([\\'])/\\$1/g; $file = "'$file'"; } printf MANIFEST "%-40s %s\n", $file, $comment; } close MANIFEST or die "Error closing $MANIFEST: $!"; return 1; } # Make sure this MANIFEST is consistently written with native # newlines and has a terminal newline. sub _fix_manifest { my $manifest_file = shift; open MANIFEST, $MANIFEST or die "Could not open $MANIFEST: $!"; local $/; my @manifest = split /(\015\012|\012|\015)/, , -1; close MANIFEST; my $must_rewrite = ""; if ($manifest[-1] eq ""){ # sane case: last line had a terminal newline pop @manifest; for (my $i=1; $i<=$#manifest; $i+=2) { unless ($manifest[$i] eq "\n") { $must_rewrite = "not a newline at pos $i"; last; } } } else { $must_rewrite = "last line without newline"; } if ( $must_rewrite ) { 1 while unlink $MANIFEST; # avoid multiple versions on VMS open MANIFEST, ">", $MANIFEST or die "(must_rewrite=$must_rewrite) Could not open >$MANIFEST: $!"; binmode MANIFEST, ':raw'; for (my $i=0; $i<=$#manifest; $i+=2) { print MANIFEST "$manifest[$i]\n"; } close MANIFEST or die "could not write $MANIFEST: $!"; } } # UNIMPLEMENTED sub _normalize { return; } =back =head2 MANIFEST A list of files in the distribution, one file per line. The MANIFEST always uses Unix filepath conventions even if you're not on Unix. This means F style not F. Anything between white space and an end of line within a C file is considered to be a comment. Any line beginning with # is also a comment. Beginning with ExtUtils::Manifest 1.52, a filename may contain whitespace characters if it is enclosed in single quotes; single quotes or backslashes in that filename must be backslash-escaped. # this a comment some/file some/other/file comment about some/file 'some/third file' comment =head2 MANIFEST.SKIP The file MANIFEST.SKIP may contain regular expressions of files that should be ignored by mkmanifest() and filecheck(). The regular expressions should appear one on each line. Blank lines and lines which start with C<#> are skipped. Use C<\#> if you need a regular expression to start with a C<#>. For example: # Version control files and dirs. \bRCS\b \bCVS\b ,v$ \B\.svn\b # Makemaker generated files and dirs. ^MANIFEST\. ^Makefile$ ^blib/ ^MakeMaker-\d # Temp, old and emacs backup files. ~$ \.old$ ^#.*#$ ^\.# If no MANIFEST.SKIP file is found, a default set of skips will be used, similar to the example above. If you want nothing skipped, simply make an empty MANIFEST.SKIP file. In one's own MANIFEST.SKIP file, certain directives can be used to include the contents of other MANIFEST.SKIP files. At present two such directives are recognized. =over 4 =item #!include_default This inserts the contents of the default MANIFEST.SKIP file =item #!include /Path/to/another/manifest.skip This inserts the contents of the specified external file =back The included contents will be inserted into the MANIFEST.SKIP file in between I<#!start included /path/to/manifest.skip> and I<#!end included /path/to/manifest.skip> markers. The original MANIFEST.SKIP is saved as MANIFEST.SKIP.bak. =head2 EXPORT_OK C<&mkmanifest>, C<&manicheck>, C<&filecheck>, C<&fullcheck>, C<&maniread>, and C<&manicopy> are exportable. =head2 GLOBAL VARIABLES C<$ExtUtils::Manifest::MANIFEST> defaults to C. Changing it results in both a different C and a different C file. This is useful if you want to maintain different distributions for different audiences (say a user version and a developer version including RCS). C<$ExtUtils::Manifest::Quiet> defaults to 0. If set to a true value, all functions act silently. C<$ExtUtils::Manifest::Debug> defaults to 0. If set to a true value, or if PERL_MM_MANIFEST_DEBUG is true, debugging output will be produced. =head1 DIAGNOSTICS All diagnostic output is sent to C. =over 4 =item C I is reported if a file is found which is not in C. =item C I is reported if a file is skipped due to an entry in C. =item C I is reported if a file mentioned in a C file does not exist. =item C I<$!> is reported if C could not be opened. =item C I is reported by mkmanifest() if $Verbose is set and a file is added to MANIFEST. $Verbose is set to 1 by default. =back =head1 ENVIRONMENT =over 4 =item B Turns on debugging =back =head1 SEE ALSO L which has handy targets for most of the functionality. =head1 AUTHOR Andreas Koenig C Currently maintained by the Perl Toolchain Gang. =head1 COPYRIGHT AND LICENSE This software is copyright (c) 1996- by Andreas Koenig. 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 1; EXTUTILS_MANIFEST $fatpacked{"ExtUtils/Mkbootstrap.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_MKBOOTSTRAP'; package ExtUtils::Mkbootstrap; # There's just too much Dynaloader incest here to turn on strict vars. use strict 'refs'; our $VERSION = '7.38'; $VERSION =~ tr/_//d; require Exporter; our @ISA = ('Exporter'); our @EXPORT = ('&Mkbootstrap'); use Config; our $Verbose = 0; sub Mkbootstrap { my($baseext, @bsloadlibs)=@_; @bsloadlibs = grep($_, @bsloadlibs); # strip empty libs print " bsloadlibs=@bsloadlibs\n" if $Verbose; # We need DynaLoader here because we and/or the *_BS file may # call dl_findfile(). We don't say `use' here because when # first building perl extensions the DynaLoader will not have # been built when MakeMaker gets first used. require DynaLoader; rename "$baseext.bs", "$baseext.bso" if -s "$baseext.bs"; if (-f "${baseext}_BS"){ $_ = "${baseext}_BS"; package DynaLoader; # execute code as if in DynaLoader local($osname, $dlsrc) = (); # avoid warnings ($osname, $dlsrc) = @Config::Config{qw(osname dlsrc)}; $bscode = ""; unshift @INC, "."; require $_; shift @INC; } if ($Config{'dlsrc'} =~ /^dl_dld/){ package DynaLoader; push(@dl_resolve_using, dl_findfile('-lc')); } my(@all) = (@bsloadlibs, @DynaLoader::dl_resolve_using); my($method) = ''; if (@all || (defined $DynaLoader::bscode && length $DynaLoader::bscode)){ open my $bs, ">", "$baseext.bs" or die "Unable to open $baseext.bs: $!"; print "Writing $baseext.bs\n"; print " containing: @all" if $Verbose; print $bs "# $baseext DynaLoader bootstrap file for $^O architecture.\n"; print $bs "# Do not edit this file, changes will be lost.\n"; print $bs "# This file was automatically generated by the\n"; print $bs "# Mkbootstrap routine in ExtUtils::Mkbootstrap (v$VERSION).\n"; if (@all) { print $bs "\@DynaLoader::dl_resolve_using = "; # If @all contains names in the form -lxxx or -Lxxx then it's asking for # runtime library location so we automatically add a call to dl_findfile() if (" @all" =~ m/ -[lLR]/){ print $bs " dl_findfile(qw(\n @all\n ));\n"; } else { print $bs " qw(@all);\n"; } } # write extra code if *_BS says so print $bs $DynaLoader::bscode if $DynaLoader::bscode; print $bs "\n1;\n"; close $bs; } } 1; __END__ =head1 NAME ExtUtils::Mkbootstrap - make a bootstrap file for use by DynaLoader =head1 SYNOPSIS Mkbootstrap =head1 DESCRIPTION Mkbootstrap typically gets called from an extension Makefile. There is no C<*.bs> file supplied with the extension. Instead, there may be a C<*_BS> file which has code for the special cases, like posix for berkeley db on the NeXT. This file will get parsed, and produce a maybe empty C<@DynaLoader::dl_resolve_using> array for the current architecture. That will be extended by $BSLOADLIBS, which was computed by ExtUtils::Liblist::ext(). If this array still is empty, we do nothing, else we write a .bs file with an C<@DynaLoader::dl_resolve_using> array. The C<*_BS> file can put some code into the generated C<*.bs> file by placing it in C<$bscode>. This is a handy 'escape' mechanism that may prove useful in complex situations. If @DynaLoader::dl_resolve_using contains C<-L*> or C<-l*> entries then Mkbootstrap will automatically add a dl_findfile() call to the generated C<*.bs> file. =cut EXTUTILS_MKBOOTSTRAP $fatpacked{"ExtUtils/Mksymlists.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_MKSYMLISTS'; package ExtUtils::Mksymlists; use 5.006; use strict qw[ subs refs ]; # no strict 'vars'; # until filehandles are exempted use Carp; use Exporter; use Config; our @ISA = qw(Exporter); our @EXPORT = qw(&Mksymlists); our $VERSION = '7.38'; $VERSION =~ tr/_//d; sub Mksymlists { my(%spec) = @_; my($osname) = $^O; croak("Insufficient information specified to Mksymlists") unless ( $spec{NAME} or ($spec{FILE} and ($spec{DL_FUNCS} or $spec{FUNCLIST})) ); $spec{DL_VARS} = [] unless $spec{DL_VARS}; ($spec{FILE} = $spec{NAME}) =~ s/.*::// unless $spec{FILE}; $spec{FUNCLIST} = [] unless $spec{FUNCLIST}; $spec{DL_FUNCS} = { $spec{NAME} => [] } unless ( ($spec{DL_FUNCS} and keys %{$spec{DL_FUNCS}}) or @{$spec{FUNCLIST}}); if (defined $spec{DL_FUNCS}) { foreach my $package (sort keys %{$spec{DL_FUNCS}}) { my($packprefix,$bootseen); ($packprefix = $package) =~ s/\W/_/g; foreach my $sym (@{$spec{DL_FUNCS}->{$package}}) { if ($sym =~ /^boot_/) { push(@{$spec{FUNCLIST}},$sym); $bootseen++; } else { push(@{$spec{FUNCLIST}},"XS_${packprefix}_$sym"); } } push(@{$spec{FUNCLIST}},"boot_$packprefix") unless $bootseen; } } # We'll need this if we ever add any OS which uses mod2fname # not as pseudo-builtin. # require DynaLoader; if (defined &DynaLoader::mod2fname and not $spec{DLBASE}) { $spec{DLBASE} = DynaLoader::mod2fname([ split(/::/,$spec{NAME}) ]); } if ($osname eq 'aix') { _write_aix(\%spec); } elsif ($osname eq 'MacOS'){ _write_aix(\%spec) } elsif ($osname eq 'VMS') { _write_vms(\%spec) } elsif ($osname eq 'os2') { _write_os2(\%spec) } elsif ($osname eq 'MSWin32') { _write_win32(\%spec) } else { croak("Don't know how to create linker option file for $osname\n"); } } sub _write_aix { my($data) = @_; rename "$data->{FILE}.exp", "$data->{FILE}.exp_old"; open( my $exp, ">", "$data->{FILE}.exp") or croak("Can't create $data->{FILE}.exp: $!\n"); print $exp join("\n",@{$data->{DL_VARS}}, "\n") if @{$data->{DL_VARS}}; print $exp join("\n",@{$data->{FUNCLIST}}, "\n") if @{$data->{FUNCLIST}}; close $exp; } sub _write_os2 { my($data) = @_; require Config; my $threaded = ($Config::Config{archname} =~ /-thread/ ? " threaded" : ""); if (not $data->{DLBASE}) { ($data->{DLBASE} = $data->{NAME}) =~ s/.*:://; $data->{DLBASE} = substr($data->{DLBASE},0,7) . '_'; } my $distname = $data->{DISTNAME} || $data->{NAME}; $distname = "Distribution $distname"; my $patchlevel = " pl$Config{perl_patchlevel}" || ''; my $comment = sprintf "Perl (v%s%s%s) module %s", $Config::Config{version}, $threaded, $patchlevel, $data->{NAME}; chomp $comment; if ($data->{INSTALLDIRS} and $data->{INSTALLDIRS} eq 'perl') { $distname = 'perl5-porters@perl.org'; $comment = "Core $comment"; } $comment = "$comment (Perl-config: $Config{config_args})"; $comment = substr($comment, 0, 200) . "...)" if length $comment > 203; rename "$data->{FILE}.def", "$data->{FILE}_def.old"; open(my $def, ">", "$data->{FILE}.def") or croak("Can't create $data->{FILE}.def: $!\n"); print $def "LIBRARY '$data->{DLBASE}' INITINSTANCE TERMINSTANCE\n"; print $def "DESCRIPTION '\@#$distname:$data->{VERSION}#\@ $comment'\n"; print $def "CODE LOADONCALL\n"; print $def "DATA LOADONCALL NONSHARED MULTIPLE\n"; print $def "EXPORTS\n "; print $def join("\n ",@{$data->{DL_VARS}}, "\n") if @{$data->{DL_VARS}}; print $def join("\n ",@{$data->{FUNCLIST}}, "\n") if @{$data->{FUNCLIST}}; _print_imports($def, $data); close $def; } sub _print_imports { my ($def, $data)= @_; my $imports= $data->{IMPORTS} or return; if ( keys %$imports ) { print $def "IMPORTS\n"; foreach my $name (sort keys %$imports) { print $def " $name=$imports->{$name}\n"; } } } sub _write_win32 { my($data) = @_; require Config; if (not $data->{DLBASE}) { ($data->{DLBASE} = $data->{NAME}) =~ s/.*:://; $data->{DLBASE} = substr($data->{DLBASE},0,7) . '_'; } rename "$data->{FILE}.def", "$data->{FILE}_def.old"; open( my $def, ">", "$data->{FILE}.def" ) or croak("Can't create $data->{FILE}.def: $!\n"); # put library name in quotes (it could be a keyword, like 'Alias') if ($Config::Config{'cc'} !~ /\bgcc/i) { print $def "LIBRARY \"$data->{DLBASE}\"\n"; } print $def "EXPORTS\n "; my @syms; # Export public symbols both with and without underscores to # ensure compatibility between DLLs from Borland C and Visual C # NOTE: DynaLoader itself only uses the names without underscores, # so this is only to cover the case when the extension DLL may be # linked to directly from C. GSAR 97-07-10 #bcc dropped in 5.16, so dont create useless extra symbols for export table unless("$]" >= 5.016) { if ($Config::Config{'cc'} =~ /^bcc/i) { push @syms, "_$_", "$_ = _$_" for (@{$data->{DL_VARS}}, @{$data->{FUNCLIST}}); } else { push @syms, "$_", "_$_ = $_" for (@{$data->{DL_VARS}}, @{$data->{FUNCLIST}}); } } else { push @syms, "$_" for (@{$data->{DL_VARS}}, @{$data->{FUNCLIST}}); } print $def join("\n ",@syms, "\n") if @syms; _print_imports($def, $data); close $def; } sub _write_vms { my($data) = @_; require Config; # a reminder for once we do $^O require ExtUtils::XSSymSet; my($isvax) = $Config::Config{'archname'} =~ /VAX/i; my($set) = new ExtUtils::XSSymSet; rename "$data->{FILE}.opt", "$data->{FILE}.opt_old"; open(my $opt,">", "$data->{FILE}.opt") or croak("Can't create $data->{FILE}.opt: $!\n"); # Options file declaring universal symbols # Used when linking shareable image for dynamic extension, # or when linking PerlShr into which we've added this package # as a static extension # We don't do anything to preserve order, so we won't relax # the GSMATCH criteria for a dynamic extension print $opt "case_sensitive=yes\n" if $Config::Config{d_vms_case_sensitive_symbols}; foreach my $sym (@{$data->{FUNCLIST}}) { my $safe = $set->addsym($sym); if ($isvax) { print $opt "UNIVERSAL=$safe\n" } else { print $opt "SYMBOL_VECTOR=($safe=PROCEDURE)\n"; } } foreach my $sym (@{$data->{DL_VARS}}) { my $safe = $set->addsym($sym); print $opt "PSECT_ATTR=${sym},PIC,OVR,RD,NOEXE,WRT,NOSHR\n"; if ($isvax) { print $opt "UNIVERSAL=$safe\n" } else { print $opt "SYMBOL_VECTOR=($safe=DATA)\n"; } } close $opt; } 1; __END__ =head1 NAME ExtUtils::Mksymlists - write linker options files for dynamic extension =head1 SYNOPSIS use ExtUtils::Mksymlists; Mksymlists( NAME => $name , DL_VARS => [ $var1, $var2, $var3 ], DL_FUNCS => { $pkg1 => [ $func1, $func2 ], $pkg2 => [ $func3 ] ); =head1 DESCRIPTION C produces files used by the linker under some OSs during the creation of shared libraries for dynamic extensions. It is normally called from a MakeMaker-generated Makefile when the extension is built. The linker option file is generated by calling the function C, which is exported by default from C. It takes one argument, a list of key-value pairs, in which the following keys are recognized: =over 4 =item DLBASE This item specifies the name by which the linker knows the extension, which may be different from the name of the extension itself (for instance, some linkers add an '_' to the name of the extension). If it is not specified, it is derived from the NAME attribute. It is presently used only by OS2 and Win32. =item DL_FUNCS This is identical to the DL_FUNCS attribute available via MakeMaker, from which it is usually taken. Its value is a reference to an associative array, in which each key is the name of a package, and each value is an a reference to an array of function names which should be exported by the extension. For instance, one might say C { Homer::Iliad =E [ qw(trojans greeks) ], Homer::Odyssey =E [ qw(travellers family suitors) ] }>. The function names should be identical to those in the XSUB code; C will alter the names written to the linker option file to match the changes made by F. In addition, if none of the functions in a list begin with the string B, C will add a bootstrap function for that package, just as xsubpp does. (If a BpkgE> function is present in the list, it is passed through unchanged.) If DL_FUNCS is not specified, it defaults to the bootstrap function for the extension specified in NAME. =item DL_VARS This is identical to the DL_VARS attribute available via MakeMaker, and, like DL_FUNCS, it is usually specified via MakeMaker. Its value is a reference to an array of variable names which should be exported by the extension. =item FILE This key can be used to specify the name of the linker option file (minus the OS-specific extension), if for some reason you do not want to use the default value, which is the last word of the NAME attribute (I for C, FILE defaults to C). =item FUNCLIST This provides an alternate means to specify function names to be exported from the extension. Its value is a reference to an array of function names to be exported by the extension. These names are passed through unaltered to the linker options file. Specifying a value for the FUNCLIST attribute suppresses automatic generation of the bootstrap function for the package. To still create the bootstrap name you have to specify the package name in the DL_FUNCS hash: Mksymlists( NAME => $name , FUNCLIST => [ $func1, $func2 ], DL_FUNCS => { $pkg => [] } ); =item IMPORTS This attribute is used to specify names to be imported into the extension. It is currently only used by OS/2 and Win32. =item NAME This gives the name of the extension (I C) for which the linker option file will be produced. =back When calling C, one should always specify the NAME attribute. In most cases, this is all that's necessary. In the case of unusual extensions, however, the other attributes can be used to provide additional information to the linker. =head1 AUTHOR Charles Bailey Ibailey@newman.upenn.eduE> =head1 REVISION Last revised 14-Feb-1996, for Perl 5.002. EXTUTILS_MKSYMLISTS $fatpacked{"ExtUtils/Packlist.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_PACKLIST'; package ExtUtils::Packlist; use 5.00503; use strict; use Carp qw(); use Config; use vars qw($VERSION $Relocations); $VERSION = '2.06'; $VERSION = eval $VERSION; # Used for generating filehandle globs. IO::File might not be available! my $fhname = "FH1"; =begin _undocumented =over =item mkfh() Make a filehandle. Same kind of idea as Symbol::gensym(). =cut sub mkfh() { no strict; local $^W; my $fh = \*{$fhname++}; use strict; return($fh); } =item __find_relocations Works out what absolute paths in the configuration have been located at run time relative to $^X, and generates a regexp that matches them =back =end _undocumented =cut sub __find_relocations { my %paths; while (my ($raw_key, $raw_val) = each %Config) { my $exp_key = $raw_key . "exp"; next unless exists $Config{$exp_key}; next unless $raw_val =~ m!\.\.\./!; $paths{$Config{$exp_key}}++; } # Longest prefixes go first in the alternatives my $alternations = join "|", map {quotemeta $_} sort {length $b <=> length $a} keys %paths; qr/^($alternations)/o; } sub new($$) { my ($class, $packfile) = @_; $class = ref($class) || $class; my %self; tie(%self, $class, $packfile); return(bless(\%self, $class)); } sub TIEHASH { my ($class, $packfile) = @_; my $self = { packfile => $packfile }; bless($self, $class); $self->read($packfile) if (defined($packfile) && -f $packfile); return($self); } sub STORE { $_[0]->{data}->{$_[1]} = $_[2]; } sub FETCH { return($_[0]->{data}->{$_[1]}); } sub FIRSTKEY { my $reset = scalar(keys(%{$_[0]->{data}})); return(each(%{$_[0]->{data}})); } sub NEXTKEY { return(each(%{$_[0]->{data}})); } sub EXISTS { return(exists($_[0]->{data}->{$_[1]})); } sub DELETE { return(delete($_[0]->{data}->{$_[1]})); } sub CLEAR { %{$_[0]->{data}} = (); } sub DESTROY { } sub read($;$) { my ($self, $packfile) = @_; $self = tied(%$self) || $self; if (defined($packfile)) { $self->{packfile} = $packfile; } else { $packfile = $self->{packfile}; } Carp::croak("No packlist filename specified") if (! defined($packfile)); my $fh = mkfh(); open($fh, "<$packfile") || Carp::croak("Can't open file $packfile: $!"); $self->{data} = {}; my ($line); while (defined($line = <$fh>)) { chomp $line; my ($key, $data) = $line; if ($key =~ /^(.*?)( \w+=.*)$/) { $key = $1; $data = { map { split('=', $_) } split(' ', $2)}; if ($Config{userelocatableinc} && $data->{relocate_as}) { require File::Spec; require Cwd; my ($vol, $dir) = File::Spec->splitpath($packfile); my $newpath = File::Spec->catpath($vol, $dir, $data->{relocate_as}); $key = Cwd::realpath($newpath); } } $key =~ s!/\./!/!g; # Some .packlists have spurious '/./' bits in the paths $self->{data}->{$key} = $data; } close($fh); } sub write($;$) { my ($self, $packfile) = @_; $self = tied(%$self) || $self; if (defined($packfile)) { $self->{packfile} = $packfile; } else { $packfile = $self->{packfile}; } Carp::croak("No packlist filename specified") if (! defined($packfile)); my $fh = mkfh(); open($fh, ">$packfile") || Carp::croak("Can't open file $packfile: $!"); foreach my $key (sort(keys(%{$self->{data}}))) { my $data = $self->{data}->{$key}; if ($Config{userelocatableinc}) { $Relocations ||= __find_relocations(); if ($packfile =~ $Relocations) { # We are writing into a subdirectory of a run-time relocated # path. Figure out if the this file is also within a subdir. my $prefix = $1; if (File::Spec->no_upwards(File::Spec->abs2rel($key, $prefix))) { # The relocated path is within the found prefix my $packfile_prefix; (undef, $packfile_prefix) = File::Spec->splitpath($packfile); my $relocate_as = File::Spec->abs2rel($key, $packfile_prefix); if (!ref $data) { $data = {}; } $data->{relocate_as} = $relocate_as; } } } print $fh ("$key"); if (ref($data)) { foreach my $k (sort(keys(%$data))) { print $fh (" $k=$data->{$k}"); } } print $fh ("\n"); } close($fh); } sub validate($;$) { my ($self, $remove) = @_; $self = tied(%$self) || $self; my @missing; foreach my $key (sort(keys(%{$self->{data}}))) { if (! -e $key) { push(@missing, $key); delete($self->{data}{$key}) if ($remove); } } return(@missing); } sub packlist_file($) { my ($self) = @_; $self = tied(%$self) || $self; return($self->{packfile}); } 1; __END__ =head1 NAME ExtUtils::Packlist - manage .packlist files =head1 SYNOPSIS use ExtUtils::Packlist; my ($pl) = ExtUtils::Packlist->new('.packlist'); $pl->read('/an/old/.packlist'); my @missing_files = $pl->validate(); $pl->write('/a/new/.packlist'); $pl->{'/some/file/name'}++; or $pl->{'/some/other/file/name'} = { type => 'file', from => '/some/file' }; =head1 DESCRIPTION ExtUtils::Packlist provides a standard way to manage .packlist files. Functions are provided to read and write .packlist files. The original .packlist format is a simple list of absolute pathnames, one per line. In addition, this package supports an extended format, where as well as a filename each line may contain a list of attributes in the form of a space separated list of key=value pairs. This is used by the installperl script to differentiate between files and links, for example. =head1 USAGE The hash reference returned by the new() function can be used to examine and modify the contents of the .packlist. Items may be added/deleted from the .packlist by modifying the hash. If the value associated with a hash key is a scalar, the entry written to the .packlist by any subsequent write() will be a simple filename. If the value is a hash, the entry written will be the filename followed by the key=value pairs from the hash. Reading back the .packlist will recreate the original entries. =head1 FUNCTIONS =over 4 =item new() This takes an optional parameter, the name of a .packlist. If the file exists, it will be opened and the contents of the file will be read. The new() method returns a reference to a hash. This hash holds an entry for each line in the .packlist. In the case of old-style .packlists, the value associated with each key is undef. In the case of new-style .packlists, the value associated with each key is a hash containing the key=value pairs following the filename in the .packlist. =item read() This takes an optional parameter, the name of the .packlist to be read. If no file is specified, the .packlist specified to new() will be read. If the .packlist does not exist, Carp::croak will be called. =item write() This takes an optional parameter, the name of the .packlist to be written. If no file is specified, the .packlist specified to new() will be overwritten. =item validate() This checks that every file listed in the .packlist actually exists. If an argument which evaluates to true is given, any missing files will be removed from the internal hash. The return value is a list of the missing files, which will be empty if they all exist. =item packlist_file() This returns the name of the associated .packlist file =back =head1 EXAMPLE Here's C, a little utility to cleanly remove an installed module. #!/usr/local/bin/perl -w use strict; use IO::Dir; use ExtUtils::Packlist; use ExtUtils::Installed; sub emptydir($) { my ($dir) = @_; my $dh = IO::Dir->new($dir) || return(0); my @count = $dh->read(); $dh->close(); return(@count == 2 ? 1 : 0); } # Find all the installed packages print("Finding all installed modules...\n"); my $installed = ExtUtils::Installed->new(); foreach my $module (grep(!/^Perl$/, $installed->modules())) { my $version = $installed->version($module) || "???"; print("Found module $module Version $version\n"); print("Do you want to delete $module? [n] "); my $r = ; chomp($r); if ($r && $r =~ /^y/i) { # Remove all the files foreach my $file (sort($installed->files($module))) { print("rm $file\n"); unlink($file); } my $pf = $installed->packlist($module)->packlist_file(); print("rm $pf\n"); unlink($pf); foreach my $dir (sort($installed->directory_tree($module))) { if (emptydir($dir)) { print("rmdir $dir\n"); rmdir($dir); } } } } =head1 AUTHOR Alan Burlison =cut EXTUTILS_PACKLIST $fatpacked{"ExtUtils/testlib.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_TESTLIB'; package ExtUtils::testlib; use strict; use warnings; our $VERSION = '7.38'; $VERSION =~ tr/_//d; use Cwd; use File::Spec; # So the tests can chdir around and not break @INC. # We use getcwd() because otherwise rel2abs will blow up under taint # mode pre-5.8. We detaint is so @INC won't be tainted. This is # no worse, and probably better, than just shoving an untainted, # relative "blib/lib" onto @INC. my $cwd; BEGIN { ($cwd) = getcwd() =~ /(.*)/; } use lib map { File::Spec->rel2abs($_, $cwd) } qw(blib/arch blib/lib); 1; __END__ =head1 NAME ExtUtils::testlib - add blib/* directories to @INC =head1 SYNOPSIS use ExtUtils::testlib; =head1 DESCRIPTION After an extension has been built and before it is installed it may be desirable to test it bypassing C. By adding use ExtUtils::testlib; to a test program the intermediate directories used by C are added to @INC. EXTUTILS_TESTLIB $fatpacked{"File/Path.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'FILE_PATH'; package File::Path; use 5.005_04; use strict; use Cwd 'getcwd'; use File::Basename (); use File::Spec (); BEGIN { if ($] < 5.006) { # can't say 'opendir my $dh, $dirname' # need to initialise $dh eval "use Symbol"; } } use Exporter (); use vars qw($VERSION @ISA @EXPORT @EXPORT_OK); $VERSION = '2.09'; @ISA = qw(Exporter); @EXPORT = qw(mkpath rmtree); @EXPORT_OK = qw(make_path remove_tree); my $Is_VMS = $^O eq 'VMS'; my $Is_MacOS = $^O eq 'MacOS'; # These OSes complain if you want to remove a file that you have no # write permission to: my $Force_Writeable = grep {$^O eq $_} qw(amigaos dos epoc MSWin32 MacOS os2); # Unix-like systems need to stat each directory in order to detect # race condition. MS-Windows is immune to this particular attack. my $Need_Stat_Check = !($^O eq 'MSWin32'); sub _carp { require Carp; goto &Carp::carp; } sub _croak { require Carp; goto &Carp::croak; } sub _error { my $arg = shift; my $message = shift; my $object = shift; if ($arg->{error}) { $object = '' unless defined $object; $message .= ": $!" if $!; push @{${$arg->{error}}}, {$object => $message}; } else { _carp(defined($object) ? "$message for $object: $!" : "$message: $!"); } } sub make_path { push @_, {} unless @_ and UNIVERSAL::isa($_[-1],'HASH'); goto &mkpath; } sub mkpath { my $old_style = !(@_ and UNIVERSAL::isa($_[-1],'HASH')); my $arg; my $paths; if ($old_style) { my ($verbose, $mode); ($paths, $verbose, $mode) = @_; $paths = [$paths] unless UNIVERSAL::isa($paths,'ARRAY'); $arg->{verbose} = $verbose; $arg->{mode} = defined $mode ? $mode : 0777; } else { $arg = pop @_; $arg->{mode} = delete $arg->{mask} if exists $arg->{mask}; $arg->{mode} = 0777 unless exists $arg->{mode}; ${$arg->{error}} = [] if exists $arg->{error}; $arg->{owner} = delete $arg->{user} if exists $arg->{user}; $arg->{owner} = delete $arg->{uid} if exists $arg->{uid}; if (exists $arg->{owner} and $arg->{owner} =~ /\D/) { my $uid = (getpwnam $arg->{owner})[2]; if (defined $uid) { $arg->{owner} = $uid; } else { _error($arg, "unable to map $arg->{owner} to a uid, ownership not changed"); delete $arg->{owner}; } } if (exists $arg->{group} and $arg->{group} =~ /\D/) { my $gid = (getgrnam $arg->{group})[2]; if (defined $gid) { $arg->{group} = $gid; } else { _error($arg, "unable to map $arg->{group} to a gid, group ownership not changed"); delete $arg->{group}; } } if (exists $arg->{owner} and not exists $arg->{group}) { $arg->{group} = -1; # chown will leave group unchanged } if (exists $arg->{group} and not exists $arg->{owner}) { $arg->{owner} = -1; # chown will leave owner unchanged } $paths = [@_]; } return _mkpath($arg, $paths); } sub _mkpath { my $arg = shift; my $paths = shift; my(@created,$path); foreach $path (@$paths) { next unless defined($path) and length($path); $path .= '/' if $^O eq 'os2' and $path =~ /^\w:\z/s; # feature of CRT # Logic wants Unix paths, so go with the flow. if ($Is_VMS) { next if $path eq '/'; $path = VMS::Filespec::unixify($path); } next if -d $path; my $parent = File::Basename::dirname($path); unless (-d $parent or $path eq $parent) { push(@created,_mkpath($arg, [$parent])); } print "mkdir $path\n" if $arg->{verbose}; if (mkdir($path,$arg->{mode})) { push(@created, $path); if (exists $arg->{owner}) { # NB: $arg->{group} guaranteed to be set during initialisation if (!chown $arg->{owner}, $arg->{group}, $path) { _error($arg, "Cannot change ownership of $path to $arg->{owner}:$arg->{group}"); } } } else { my $save_bang = $!; my ($e, $e1) = ($save_bang, $^E); $e .= "; $e1" if $e ne $e1; # allow for another process to have created it meanwhile if (!-d $path) { $! = $save_bang; if ($arg->{error}) { push @{${$arg->{error}}}, {$path => $e}; } else { _croak("mkdir $path: $e"); } } } } return @created; } sub remove_tree { push @_, {} unless @_ and UNIVERSAL::isa($_[-1],'HASH'); goto &rmtree; } sub _is_subdir { my($dir, $test) = @_; my($dv, $dd) = File::Spec->splitpath($dir, 1); my($tv, $td) = File::Spec->splitpath($test, 1); # not on same volume return 0 if $dv ne $tv; my @d = File::Spec->splitdir($dd); my @t = File::Spec->splitdir($td); # @t can't be a subdir if it's shorter than @d return 0 if @t < @d; return join('/', @d) eq join('/', splice @t, 0, +@d); } sub rmtree { my $old_style = !(@_ and UNIVERSAL::isa($_[-1],'HASH')); my $arg; my $paths; if ($old_style) { my ($verbose, $safe); ($paths, $verbose, $safe) = @_; $arg->{verbose} = $verbose; $arg->{safe} = defined $safe ? $safe : 0; if (defined($paths) and length($paths)) { $paths = [$paths] unless UNIVERSAL::isa($paths,'ARRAY'); } else { _carp ("No root path(s) specified\n"); return 0; } } else { $arg = pop @_; ${$arg->{error}} = [] if exists $arg->{error}; ${$arg->{result}} = [] if exists $arg->{result}; $paths = [@_]; } $arg->{prefix} = ''; $arg->{depth} = 0; my @clean_path; $arg->{cwd} = getcwd() or do { _error($arg, "cannot fetch initial working directory"); return 0; }; for ($arg->{cwd}) { /\A(.*)\Z/; $_ = $1 } # untaint for my $p (@$paths) { # need to fixup case and map \ to / on Windows my $ortho_root = $^O eq 'MSWin32' ? _slash_lc($p) : $p; my $ortho_cwd = $^O eq 'MSWin32' ? _slash_lc($arg->{cwd}) : $arg->{cwd}; my $ortho_root_length = length($ortho_root); $ortho_root_length-- if $^O eq 'VMS'; # don't compare '.' with ']' if ($ortho_root_length && _is_subdir($ortho_root, $ortho_cwd)) { local $! = 0; _error($arg, "cannot remove path when cwd is $arg->{cwd}", $p); next; } if ($Is_MacOS) { $p = ":$p" unless $p =~ /:/; $p .= ":" unless $p =~ /:\z/; } elsif ($^O eq 'MSWin32') { $p =~ s{[/\\]\z}{}; } else { $p =~ s{/\z}{}; } push @clean_path, $p; } @{$arg}{qw(device inode perm)} = (lstat $arg->{cwd})[0,1] or do { _error($arg, "cannot stat initial working directory", $arg->{cwd}); return 0; }; return _rmtree($arg, \@clean_path); } sub _rmtree { my $arg = shift; my $paths = shift; my $count = 0; my $curdir = File::Spec->curdir(); my $updir = File::Spec->updir(); my (@files, $root); ROOT_DIR: foreach $root (@$paths) { # since we chdir into each directory, it may not be obvious # to figure out where we are if we generate a message about # a file name. We therefore construct a semi-canonical # filename, anchored from the directory being unlinked (as # opposed to being truly canonical, anchored from the root (/). my $canon = $arg->{prefix} ? File::Spec->catfile($arg->{prefix}, $root) : $root ; my ($ldev, $lino, $perm) = (lstat $root)[0,1,2] or next ROOT_DIR; if ( -d _ ) { $root = VMS::Filespec::vmspath(VMS::Filespec::pathify($root)) if $Is_VMS; if (!chdir($root)) { # see if we can escalate privileges to get in # (e.g. funny protection mask such as -w- instead of rwx) $perm &= 07777; my $nperm = $perm | 0700; if (!($arg->{safe} or $nperm == $perm or chmod($nperm, $root))) { _error($arg, "cannot make child directory read-write-exec", $canon); next ROOT_DIR; } elsif (!chdir($root)) { _error($arg, "cannot chdir to child", $canon); next ROOT_DIR; } } my ($cur_dev, $cur_inode, $perm) = (stat $curdir)[0,1,2] or do { _error($arg, "cannot stat current working directory", $canon); next ROOT_DIR; }; if ($Need_Stat_Check) { ($ldev eq $cur_dev and $lino eq $cur_inode) or _croak("directory $canon changed before chdir, expected dev=$ldev ino=$lino, actual dev=$cur_dev ino=$cur_inode, aborting."); } $perm &= 07777; # don't forget setuid, setgid, sticky bits my $nperm = $perm | 0700; # notabene: 0700 is for making readable in the first place, # it's also intended to change it to writable in case we have # to recurse in which case we are better than rm -rf for # subtrees with strange permissions if (!($arg->{safe} or $nperm == $perm or chmod($nperm, $curdir))) { _error($arg, "cannot make directory read+writeable", $canon); $nperm = $perm; } my $d; $d = gensym() if $] < 5.006; if (!opendir $d, $curdir) { _error($arg, "cannot opendir", $canon); @files = (); } else { no strict 'refs'; if (!defined ${"\cTAINT"} or ${"\cTAINT"}) { # Blindly untaint dir names if taint mode is # active, or any perl < 5.006 @files = map { /\A(.*)\z/s; $1 } readdir $d; } else { @files = readdir $d; } closedir $d; } if ($Is_VMS) { # Deleting large numbers of files from VMS Files-11 # filesystems is faster if done in reverse ASCIIbetical order. # include '.' to '.;' from blead patch #31775 @files = map {$_ eq '.' ? '.;' : $_} reverse @files; } @files = grep {$_ ne $updir and $_ ne $curdir} @files; if (@files) { # remove the contained files before the directory itself my $narg = {%$arg}; @{$narg}{qw(device inode cwd prefix depth)} = ($cur_dev, $cur_inode, $updir, $canon, $arg->{depth}+1); $count += _rmtree($narg, \@files); } # restore directory permissions of required now (in case the rmdir # below fails), while we are still in the directory and may do so # without a race via '.' if ($nperm != $perm and not chmod($perm, $curdir)) { _error($arg, "cannot reset chmod", $canon); } # don't leave the client code in an unexpected directory chdir($arg->{cwd}) or _croak("cannot chdir to $arg->{cwd} from $canon: $!, aborting."); # ensure that a chdir upwards didn't take us somewhere other # than we expected (see CVE-2002-0435) ($cur_dev, $cur_inode) = (stat $curdir)[0,1] or _croak("cannot stat prior working directory $arg->{cwd}: $!, aborting."); if ($Need_Stat_Check) { ($arg->{device} eq $cur_dev and $arg->{inode} eq $cur_inode) or _croak("previous directory $arg->{cwd} changed before entering $canon, expected dev=$ldev ino=$lino, actual dev=$cur_dev ino=$cur_inode, aborting."); } if ($arg->{depth} or !$arg->{keep_root}) { if ($arg->{safe} && ($Is_VMS ? !&VMS::Filespec::candelete($root) : !-w $root)) { print "skipped $root\n" if $arg->{verbose}; next ROOT_DIR; } if ($Force_Writeable and !chmod $perm | 0700, $root) { _error($arg, "cannot make directory writeable", $canon); } print "rmdir $root\n" if $arg->{verbose}; if (rmdir $root) { push @{${$arg->{result}}}, $root if $arg->{result}; ++$count; } else { _error($arg, "cannot remove directory", $canon); if ($Force_Writeable && !chmod($perm, ($Is_VMS ? VMS::Filespec::fileify($root) : $root)) ) { _error($arg, sprintf("cannot restore permissions to 0%o",$perm), $canon); } } } } else { # not a directory $root = VMS::Filespec::vmsify("./$root") if $Is_VMS && !File::Spec->file_name_is_absolute($root) && ($root !~ m/(?]+/); # not already in VMS syntax if ($arg->{safe} && ($Is_VMS ? !&VMS::Filespec::candelete($root) : !(-l $root || -w $root))) { print "skipped $root\n" if $arg->{verbose}; next ROOT_DIR; } my $nperm = $perm & 07777 | 0600; if ($Force_Writeable and $nperm != $perm and not chmod $nperm, $root) { _error($arg, "cannot make file writeable", $canon); } print "unlink $canon\n" if $arg->{verbose}; # delete all versions under VMS for (;;) { if (unlink $root) { push @{${$arg->{result}}}, $root if $arg->{result}; } else { _error($arg, "cannot unlink file", $canon); $Force_Writeable and chmod($perm, $root) or _error($arg, sprintf("cannot restore permissions to 0%o",$perm), $canon); last; } ++$count; last unless $Is_VMS && lstat $root; } } } return $count; } sub _slash_lc { # fix up slashes and case on MSWin32 so that we can determine that # c:\path\to\dir is underneath C:/Path/To my $path = shift; $path =~ tr{\\}{/}; return lc($path); } 1; __END__ =head1 NAME File::Path - Create or remove directory trees =head1 VERSION This document describes version 2.09 of File::Path, released 2013-01-17. =head1 SYNOPSIS use File::Path qw(make_path remove_tree); make_path('foo/bar/baz', '/zug/zwang'); make_path('foo/bar/baz', '/zug/zwang', { verbose => 1, mode => 0711, }); remove_tree('foo/bar/baz', '/zug/zwang'); remove_tree('foo/bar/baz', '/zug/zwang', { verbose => 1, error => \my $err_list, }); # legacy (interface promoted before v2.00) mkpath('/foo/bar/baz'); mkpath('/foo/bar/baz', 1, 0711); mkpath(['/foo/bar/baz', 'blurfl/quux'], 1, 0711); rmtree('foo/bar/baz', 1, 1); rmtree(['foo/bar/baz', 'blurfl/quux'], 1, 1); # legacy (interface promoted before v2.06) mkpath('foo/bar/baz', '/zug/zwang', { verbose => 1, mode => 0711 }); rmtree('foo/bar/baz', '/zug/zwang', { verbose => 1, mode => 0711 }); =head1 DESCRIPTION This module provide a convenient way to create directories of arbitrary depth and to delete an entire directory subtree from the filesystem. The following functions are provided: =over =item make_path( $dir1, $dir2, .... ) =item make_path( $dir1, $dir2, ...., \%opts ) The C function creates the given directories if they don't exists before, much like the Unix command C. The function accepts a list of directories to be created. Its behaviour may be tuned by an optional hashref appearing as the last parameter on the call. The function returns the list of directories actually created during the call; in scalar context the number of directories created. The following keys are recognised in the option hash: =over =item mode => $num The numeric permissions mode to apply to each created directory (defaults to 0777), to be modified by the current C. If the directory already exists (and thus does not need to be created), the permissions will not be modified. C is recognised as an alias for this parameter. =item verbose => $bool If present, will cause C to print the name of each directory as it is created. By default nothing is printed. =item error => \$err If present, it should be a reference to a scalar. This scalar will be made to reference an array, which will be used to store any errors that are encountered. See the L section for more information. If this parameter is not used, certain error conditions may raise a fatal error that will cause the program will halt, unless trapped in an C block. =item owner => $owner =item user => $owner =item uid => $owner If present, will cause any created directory to be owned by C<$owner>. If the value is numeric, it will be interpreted as a uid, otherwise as username is assumed. An error will be issued if the username cannot be mapped to a uid, or the uid does not exist, or the process lacks the privileges to change ownership. Ownwership of directories that already exist will not be changed. C and C are aliases of C. =item group => $group If present, will cause any created directory to be owned by the group C<$group>. If the value is numeric, it will be interpreted as a gid, otherwise as group name is assumed. An error will be issued if the group name cannot be mapped to a gid, or the gid does not exist, or the process lacks the privileges to change group ownership. Group ownwership of directories that already exist will not be changed. make_path '/var/tmp/webcache', {owner=>'nobody', group=>'nogroup'}; =back =item mkpath( $dir ) =item mkpath( $dir, $verbose, $mode ) =item mkpath( [$dir1, $dir2,...], $verbose, $mode ) =item mkpath( $dir1, $dir2,..., \%opt ) The mkpath() function provide the legacy interface of make_path() with a different interpretation of the arguments passed. The behaviour and return value of the function is otherwise identical to make_path(). =item remove_tree( $dir1, $dir2, .... ) =item remove_tree( $dir1, $dir2, ...., \%opts ) The C function deletes the given directories and any files and subdirectories they might contain, much like the Unix command C or C on Windows. The function accepts a list of directories to be removed. Its behaviour may be tuned by an optional hashref appearing as the last parameter on the call. The functions returns the number of files successfully deleted. The following keys are recognised in the option hash: =over =item verbose => $bool If present, will cause C to print the name of each file as it is unlinked. By default nothing is printed. =item safe => $bool When set to a true value, will cause C to skip the files for which the process lacks the required privileges needed to delete files, such as delete privileges on VMS. In other words, the code will make no attempt to alter file permissions. Thus, if the process is interrupted, no filesystem object will be left in a more permissive mode. =item keep_root => $bool When set to a true value, will cause all files and subdirectories to be removed, except the initially specified directories. This comes in handy when cleaning out an application's scratch directory. remove_tree( '/tmp', {keep_root => 1} ); =item result => \$res If present, it should be a reference to a scalar. This scalar will be made to reference an array, which will be used to store all files and directories unlinked during the call. If nothing is unlinked, the array will be empty. remove_tree( '/tmp', {result => \my $list} ); print "unlinked $_\n" for @$list; This is a useful alternative to the C key. =item error => \$err If present, it should be a reference to a scalar. This scalar will be made to reference an array, which will be used to store any errors that are encountered. See the L section for more information. Removing things is a much more dangerous proposition than creating things. As such, there are certain conditions that C may encounter that are so dangerous that the only sane action left is to kill the program. Use C to trap all that is reasonable (problems with permissions and the like), and let it die if things get out of hand. This is the safest course of action. =back =item rmtree( $dir ) =item rmtree( $dir, $verbose, $safe ) =item rmtree( [$dir1, $dir2,...], $verbose, $safe ) =item rmtree( $dir1, $dir2,..., \%opt ) The rmtree() function provide the legacy interface of remove_tree() with a different interpretation of the arguments passed. The behaviour and return value of the function is otherwise identical to remove_tree(). =back =head2 ERROR HANDLING =over 4 =item B The following error handling mechanism is considered experimental and is subject to change pending feedback from users. =back If C or C encounter an error, a diagnostic message will be printed to C via C (for non-fatal errors), or via C (for fatal errors). If this behaviour is not desirable, the C attribute may be used to hold a reference to a variable, which will be used to store the diagnostics. The variable is made a reference to an array of hash references. Each hash contain a single key/value pair where the key is the name of the file, and the value is the error message (including the contents of C<$!> when appropriate). If a general error is encountered the diagnostic key will be empty. An example usage looks like: remove_tree( 'foo/bar', 'bar/rat', {error => \my $err} ); if (@$err) { for my $diag (@$err) { my ($file, $message) = %$diag; if ($file eq '') { print "general error: $message\n"; } else { print "problem unlinking $file: $message\n"; } } } else { print "No error encountered\n"; } Note that if no errors are encountered, C<$err> will reference an empty array. This means that C<$err> will always end up TRUE; so you need to test C<@$err> to determine if errors occured. =head2 NOTES C blindly exports C and C into the current namespace. These days, this is considered bad style, but to change it now would break too much code. Nonetheless, you are invited to specify what it is you are expecting to use: use File::Path 'rmtree'; The routines C and C are B exported by default. You must specify which ones you want to use. use File::Path 'remove_tree'; Note that a side-effect of the above is that C and C are no longer exported at all. This is due to the way the C module works. If you are migrating a codebase to use the new interface, you will have to list everything explicitly. But that's just good practice anyway. use File::Path qw(remove_tree rmtree); =head3 API CHANGES The API was changed in the 2.0 branch. For a time, C and C tried, unsuccessfully, to deal with the two different calling mechanisms. This approach was considered a failure. The new semantics are now only available with C and C. The old semantics are only available through C and C. Users are strongly encouraged to upgrade to at least 2.08 in order to avoid surprises. =head3 SECURITY CONSIDERATIONS There were race conditions 1.x implementations of File::Path's C function (although sometimes patched depending on the OS distribution or platform). The 2.0 version contains code to avoid the problem mentioned in CVE-2002-0435. See the following pages for more information: http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=286905 http://www.nntp.perl.org/group/perl.perl5.porters/2005/01/msg97623.html http://www.debian.org/security/2005/dsa-696 Additionally, unless the C parameter is set (or the third parameter in the traditional interface is TRUE), should a C be interrupted, files that were originally in read-only mode may now have their permissions set to a read-write (or "delete OK") mode. =head1 DIAGNOSTICS FATAL errors will cause the program to halt (C), since the problem is so severe that it would be dangerous to continue. (This can always be trapped with C, but it's not a good idea. Under the circumstances, dying is the best thing to do). SEVERE errors may be trapped using the modern interface. If the they are not trapped, or the old interface is used, such an error will cause the program will halt. All other errors may be trapped using the modern interface, otherwise they will be Ced about. Program execution will not be halted. =over 4 =item mkdir [path]: [errmsg] (SEVERE) C was unable to create the path. Probably some sort of permissions error at the point of departure, or insufficient resources (such as free inodes on Unix). =item No root path(s) specified C was not given any paths to create. This message is only emitted if the routine is called with the traditional interface. The modern interface will remain silent if given nothing to do. =item No such file or directory On Windows, if C gives you this warning, it may mean that you have exceeded your filesystem's maximum path length. =item cannot fetch initial working directory: [errmsg] C attempted to determine the initial directory by calling C, but the call failed for some reason. No attempt will be made to delete anything. =item cannot stat initial working directory: [errmsg] C attempted to stat the initial directory (after having successfully obtained its name via C), however, the call failed for some reason. No attempt will be made to delete anything. =item cannot chdir to [dir]: [errmsg] C attempted to set the working directory in order to begin deleting the objects therein, but was unsuccessful. This is usually a permissions issue. The routine will continue to delete other things, but this directory will be left intact. =item directory [dir] changed before chdir, expected dev=[n] ino=[n], actual dev=[n] ino=[n], aborting. (FATAL) C recorded the device and inode of a directory, and then moved into it. It then performed a C on the current directory and detected that the device and inode were no longer the same. As this is at the heart of the race condition problem, the program will die at this point. =item cannot make directory [dir] read+writeable: [errmsg] C attempted to change the permissions on the current directory to ensure that subsequent unlinkings would not run into problems, but was unable to do so. The permissions remain as they were, and the program will carry on, doing the best it can. =item cannot read [dir]: [errmsg] C tried to read the contents of the directory in order to acquire the names of the directory entries to be unlinked, but was unsuccessful. This is usually a permissions issue. The program will continue, but the files in this directory will remain after the call. =item cannot reset chmod [dir]: [errmsg] C, after having deleted everything in a directory, attempted to restore its permissions to the original state but failed. The directory may wind up being left behind. =item cannot remove [dir] when cwd is [dir] The current working directory of the program is F and you are attempting to remove an ancestor, such as F. The directory tree is left untouched. The solution is to C out of the child directory to a place outside the directory tree to be removed. =item cannot chdir to [parent-dir] from [child-dir]: [errmsg], aborting. (FATAL) C, after having deleted everything and restored the permissions of a directory, was unable to chdir back to the parent. The program halts to avoid a race condition from occurring. =item cannot stat prior working directory [dir]: [errmsg], aborting. (FATAL) C was unable to stat the parent directory after have returned from the child. Since there is no way of knowing if we returned to where we think we should be (by comparing device and inode) the only way out is to C. =item previous directory [parent-dir] changed before entering [child-dir], expected dev=[n] ino=[n], actual dev=[n] ino=[n], aborting. (FATAL) When C returned from deleting files in a child directory, a check revealed that the parent directory it returned to wasn't the one it started out from. This is considered a sign of malicious activity. =item cannot make directory [dir] writeable: [errmsg] Just before removing a directory (after having successfully removed everything it contained), C attempted to set the permissions on the directory to ensure it could be removed and failed. Program execution continues, but the directory may possibly not be deleted. =item cannot remove directory [dir]: [errmsg] C attempted to remove a directory, but failed. This may because some objects that were unable to be removed remain in the directory, or a permissions issue. The directory will be left behind. =item cannot restore permissions of [dir] to [0nnn]: [errmsg] After having failed to remove a directory, C was unable to restore its permissions from a permissive state back to a possibly more restrictive setting. (Permissions given in octal). =item cannot make file [file] writeable: [errmsg] C attempted to force the permissions of a file to ensure it could be deleted, but failed to do so. It will, however, still attempt to unlink the file. =item cannot unlink file [file]: [errmsg] C failed to remove a file. Probably a permissions issue. =item cannot restore permissions of [file] to [0nnn]: [errmsg] After having failed to remove a file, C was also unable to restore the permissions on the file to a possibly less permissive setting. (Permissions given in octal). =item unable to map [owner] to a uid, ownership not changed"); C was instructed to give the ownership of created directories to the symbolic name [owner], but C did not return the corresponding numeric uid. The directory will be created, but ownership will not be changed. =item unable to map [group] to a gid, group ownership not changed C was instructed to give the group ownership of created directories to the symbolic name [group], but C did not return the corresponding numeric gid. The directory will be created, but group ownership will not be changed. =back =head1 SEE ALSO =over 4 =item * L Allows files and directories to be moved to the Trashcan/Recycle Bin (where they may later be restored if necessary) if the operating system supports such functionality. This feature may one day be made available directly in C. =item * L When removing directory trees, if you want to examine each file to decide whether to delete it (and possibly leaving large swathes alone), F offers a convenient and flexible approach to examining directory trees. =back =head1 BUGS Please report all bugs on the RT queue: L You can also send pull requests to the Github repository: L =head1 ACKNOWLEDGEMENTS Paul Szabo identified the race condition originally, and Brendan O'Dea wrote an implementation for Debian that addressed the problem. That code was used as a basis for the current code. Their efforts are greatly appreciated. Gisle Aas made a number of improvements to the documentation for 2.07 and his advice and assistance is also greatly appreciated. =head1 AUTHORS Tim Bunce and Charles Bailey. Currently maintained by David Landgren >. =head1 COPYRIGHT This module is copyright (C) Charles Bailey, Tim Bunce and David Landgren 1995-2013. All rights reserved. =head1 LICENSE This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut FILE_PATH $fatpacked{"File/Temp.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'FILE_TEMP'; package File::Temp; # ABSTRACT: return name and handle of a temporary file safely our $VERSION = '0.2301'; # VERSION # 5.6.0 gives us S_IWOTH, S_IWGRP, our and auto-vivifying filehandls # People would like a version on 5.004 so give them what they want :-) use 5.004; use strict; use Carp; use File::Spec 0.8; use Cwd (); use File::Path qw/ rmtree /; use Fcntl 1.03; use IO::Seekable; # For SEEK_* use Errno; use Scalar::Util 'refaddr'; require VMS::Stdio if $^O eq 'VMS'; # pre-emptively load Carp::Heavy. If we don't when we run out of file # handles and attempt to call croak() we get an error message telling # us that Carp::Heavy won't load rather than an error telling us we # have run out of file handles. We either preload croak() or we # switch the calls to croak from _gettemp() to use die. eval { require Carp::Heavy; }; # Need the Symbol package if we are running older perl require Symbol if $] < 5.006; ### For the OO interface use base qw/ IO::Handle IO::Seekable /; use overload '""' => "STRINGIFY", '0+' => "NUMIFY", fallback => 1; # use 'our' on v5.6.0 use vars qw(@EXPORT_OK %EXPORT_TAGS $DEBUG $KEEP_ALL); $DEBUG = 0; $KEEP_ALL = 0; # We are exporting functions use base qw/Exporter/; # Export list - to allow fine tuning of export table @EXPORT_OK = qw{ tempfile tempdir tmpnam tmpfile mktemp mkstemp mkstemps mkdtemp unlink0 cleanup SEEK_SET SEEK_CUR SEEK_END }; # Groups of functions for export %EXPORT_TAGS = ( 'POSIX' => [qw/ tmpnam tmpfile /], 'mktemp' => [qw/ mktemp mkstemp mkstemps mkdtemp/], 'seekable' => [qw/ SEEK_SET SEEK_CUR SEEK_END /], ); # add contents of these tags to @EXPORT Exporter::export_tags('POSIX','mktemp','seekable'); # This is a list of characters that can be used in random filenames my @CHARS = (qw/ A B C D E F G H I J K L M N O P Q R S T U V W X Y Z a b c d e f g h i j k l m n o p q r s t u v w x y z 0 1 2 3 4 5 6 7 8 9 _ /); # Maximum number of tries to make a temp file before failing use constant MAX_TRIES => 1000; # Minimum number of X characters that should be in a template use constant MINX => 4; # Default template when no template supplied use constant TEMPXXX => 'X' x 10; # Constants for the security level use constant STANDARD => 0; use constant MEDIUM => 1; use constant HIGH => 2; # OPENFLAGS. If we defined the flag to use with Sysopen here this gives # us an optimisation when many temporary files are requested my $OPENFLAGS = O_CREAT | O_EXCL | O_RDWR; my $LOCKFLAG; unless ($^O eq 'MacOS') { for my $oflag (qw/ NOFOLLOW BINARY LARGEFILE NOINHERIT /) { my ($bit, $func) = (0, "Fcntl::O_" . $oflag); no strict 'refs'; $OPENFLAGS |= $bit if eval { # Make sure that redefined die handlers do not cause problems # e.g. CGI::Carp local $SIG{__DIE__} = sub {}; local $SIG{__WARN__} = sub {}; $bit = &$func(); 1; }; } # Special case O_EXLOCK $LOCKFLAG = eval { local $SIG{__DIE__} = sub {}; local $SIG{__WARN__} = sub {}; &Fcntl::O_EXLOCK(); }; } # On some systems the O_TEMPORARY flag can be used to tell the OS # to automatically remove the file when it is closed. This is fine # in most cases but not if tempfile is called with UNLINK=>0 and # the filename is requested -- in the case where the filename is to # be passed to another routine. This happens on windows. We overcome # this by using a second open flags variable my $OPENTEMPFLAGS = $OPENFLAGS; unless ($^O eq 'MacOS') { for my $oflag (qw/ TEMPORARY /) { my ($bit, $func) = (0, "Fcntl::O_" . $oflag); local($@); no strict 'refs'; $OPENTEMPFLAGS |= $bit if eval { # Make sure that redefined die handlers do not cause problems # e.g. CGI::Carp local $SIG{__DIE__} = sub {}; local $SIG{__WARN__} = sub {}; $bit = &$func(); 1; }; } } # Private hash tracking which files have been created by each process id via the OO interface my %FILES_CREATED_BY_OBJECT; # INTERNAL ROUTINES - not to be used outside of package # Generic routine for getting a temporary filename # modelled on OpenBSD _gettemp() in mktemp.c # The template must contain X's that are to be replaced # with the random values # Arguments: # TEMPLATE - string containing the XXXXX's that is converted # to a random filename and opened if required # Optionally, a hash can also be supplied containing specific options # "open" => if true open the temp file, else just return the name # default is 0 # "mkdir"=> if true, we are creating a temp directory rather than tempfile # default is 0 # "suffixlen" => number of characters at end of PATH to be ignored. # default is 0. # "unlink_on_close" => indicates that, if possible, the OS should remove # the file as soon as it is closed. Usually indicates # use of the O_TEMPORARY flag to sysopen. # Usually irrelevant on unix # "use_exlock" => Indicates that O_EXLOCK should be used. Default is true. # Optionally a reference to a scalar can be passed into the function # On error this will be used to store the reason for the error # "ErrStr" => \$errstr # "open" and "mkdir" can not both be true # "unlink_on_close" is not used when "mkdir" is true. # The default options are equivalent to mktemp(). # Returns: # filehandle - open file handle (if called with doopen=1, else undef) # temp name - name of the temp file or directory # For example: # ($fh, $name) = _gettemp($template, "open" => 1); # for the current version, failures are associated with # stored in an error string and returned to give the reason whilst debugging # This routine is not called by any external function sub _gettemp { croak 'Usage: ($fh, $name) = _gettemp($template, OPTIONS);' unless scalar(@_) >= 1; # the internal error string - expect it to be overridden # Need this in case the caller decides not to supply us a value # need an anonymous scalar my $tempErrStr; # Default options my %options = ( "open" => 0, "mkdir" => 0, "suffixlen" => 0, "unlink_on_close" => 0, "use_exlock" => 1, "ErrStr" => \$tempErrStr, ); # Read the template my $template = shift; if (ref($template)) { # Use a warning here since we have not yet merged ErrStr carp "File::Temp::_gettemp: template must not be a reference"; return (); } # Check that the number of entries on stack are even if (scalar(@_) % 2 != 0) { # Use a warning here since we have not yet merged ErrStr carp "File::Temp::_gettemp: Must have even number of options"; return (); } # Read the options and merge with defaults %options = (%options, @_) if @_; # Make sure the error string is set to undef ${$options{ErrStr}} = undef; # Can not open the file and make a directory in a single call if ($options{"open"} && $options{"mkdir"}) { ${$options{ErrStr}} = "doopen and domkdir can not both be true\n"; return (); } # Find the start of the end of the Xs (position of last X) # Substr starts from 0 my $start = length($template) - 1 - $options{"suffixlen"}; # Check that we have at least MINX x X (e.g. 'XXXX") at the end of the string # (taking suffixlen into account). Any fewer is insecure. # Do it using substr - no reason to use a pattern match since # we know where we are looking and what we are looking for if (substr($template, $start - MINX + 1, MINX) ne 'X' x MINX) { ${$options{ErrStr}} = "The template must end with at least ". MINX . " 'X' characters\n"; return (); } # Replace all the X at the end of the substring with a # random character or just all the XX at the end of a full string. # Do it as an if, since the suffix adjusts which section to replace # and suffixlen=0 returns nothing if used in the substr directly # and generate a full path from the template my $path = _replace_XX($template, $options{"suffixlen"}); # Split the path into constituent parts - eventually we need to check # whether the directory exists # We need to know whether we are making a temp directory # or a tempfile my ($volume, $directories, $file); my $parent; # parent directory if ($options{"mkdir"}) { # There is no filename at the end ($volume, $directories, $file) = File::Spec->splitpath( $path, 1); # The parent is then $directories without the last directory # Split the directory and put it back together again my @dirs = File::Spec->splitdir($directories); # If @dirs only has one entry (i.e. the directory template) that means # we are in the current directory if ($#dirs == 0) { $parent = File::Spec->curdir; } else { if ($^O eq 'VMS') { # need volume to avoid relative dir spec $parent = File::Spec->catdir($volume, @dirs[0..$#dirs-1]); $parent = 'sys$disk:[]' if $parent eq ''; } else { # Put it back together without the last one $parent = File::Spec->catdir(@dirs[0..$#dirs-1]); # ...and attach the volume (no filename) $parent = File::Spec->catpath($volume, $parent, ''); } } } else { # Get rid of the last filename (use File::Basename for this?) ($volume, $directories, $file) = File::Spec->splitpath( $path ); # Join up without the file part $parent = File::Spec->catpath($volume,$directories,''); # If $parent is empty replace with curdir $parent = File::Spec->curdir unless $directories ne ''; } # Check that the parent directories exist # Do this even for the case where we are simply returning a name # not a file -- no point returning a name that includes a directory # that does not exist or is not writable unless (-e $parent) { ${$options{ErrStr}} = "Parent directory ($parent) does not exist"; return (); } unless (-d $parent) { ${$options{ErrStr}} = "Parent directory ($parent) is not a directory"; return (); } # Check the stickiness of the directory and chown giveaway if required # If the directory is world writable the sticky bit # must be set if (File::Temp->safe_level == MEDIUM) { my $safeerr; unless (_is_safe($parent,\$safeerr)) { ${$options{ErrStr}} = "Parent directory ($parent) is not safe ($safeerr)"; return (); } } elsif (File::Temp->safe_level == HIGH) { my $safeerr; unless (_is_verysafe($parent, \$safeerr)) { ${$options{ErrStr}} = "Parent directory ($parent) is not safe ($safeerr)"; return (); } } # Now try MAX_TRIES time to open the file for (my $i = 0; $i < MAX_TRIES; $i++) { # Try to open the file if requested if ($options{"open"}) { my $fh; # If we are running before perl5.6.0 we can not auto-vivify if ($] < 5.006) { $fh = &Symbol::gensym; } # Try to make sure this will be marked close-on-exec # XXX: Win32 doesn't respect this, nor the proper fcntl, # but may have O_NOINHERIT. This may or may not be in Fcntl. local $^F = 2; # Attempt to open the file my $open_success = undef; if ( $^O eq 'VMS' and $options{"unlink_on_close"} && !$KEEP_ALL) { # make it auto delete on close by setting FAB$V_DLT bit $fh = VMS::Stdio::vmssysopen($path, $OPENFLAGS, 0600, 'fop=dlt'); $open_success = $fh; } else { my $flags = ( ($options{"unlink_on_close"} && !$KEEP_ALL) ? $OPENTEMPFLAGS : $OPENFLAGS ); $flags |= $LOCKFLAG if (defined $LOCKFLAG && $options{use_exlock}); $open_success = sysopen($fh, $path, $flags, 0600); } if ( $open_success ) { # in case of odd umask force rw chmod(0600, $path); # Opened successfully - return file handle and name return ($fh, $path); } else { # Error opening file - abort with error # if the reason was anything but EEXIST unless ($!{EEXIST}) { ${$options{ErrStr}} = "Could not create temp file $path: $!"; return (); } # Loop round for another try } } elsif ($options{"mkdir"}) { # Open the temp directory if (mkdir( $path, 0700)) { # in case of odd umask chmod(0700, $path); return undef, $path; } else { # Abort with error if the reason for failure was anything # except EEXIST unless ($!{EEXIST}) { ${$options{ErrStr}} = "Could not create directory $path: $!"; return (); } # Loop round for another try } } else { # Return true if the file can not be found # Directory has been checked previously return (undef, $path) unless -e $path; # Try again until MAX_TRIES } # Did not successfully open the tempfile/dir # so try again with a different set of random letters # No point in trying to increment unless we have only # 1 X say and the randomness could come up with the same # file MAX_TRIES in a row. # Store current attempt - in principal this implies that the # 3rd time around the open attempt that the first temp file # name could be generated again. Probably should store each # attempt and make sure that none are repeated my $original = $path; my $counter = 0; # Stop infinite loop my $MAX_GUESS = 50; do { # Generate new name from original template $path = _replace_XX($template, $options{"suffixlen"}); $counter++; } until ($path ne $original || $counter > $MAX_GUESS); # Check for out of control looping if ($counter > $MAX_GUESS) { ${$options{ErrStr}} = "Tried to get a new temp name different to the previous value $MAX_GUESS times.\nSomething wrong with template?? ($template)"; return (); } } # If we get here, we have run out of tries ${ $options{ErrStr} } = "Have exceeded the maximum number of attempts (" . MAX_TRIES . ") to open temp file/dir"; return (); } # Internal routine to replace the XXXX... with random characters # This has to be done by _gettemp() every time it fails to # open a temp file/dir # Arguments: $template (the template with XXX), # $ignore (number of characters at end to ignore) # Returns: modified template sub _replace_XX { croak 'Usage: _replace_XX($template, $ignore)' unless scalar(@_) == 2; my ($path, $ignore) = @_; # Do it as an if, since the suffix adjusts which section to replace # and suffixlen=0 returns nothing if used in the substr directly # Alternatively, could simply set $ignore to length($path)-1 # Don't want to always use substr when not required though. my $end = ( $] >= 5.006 ? "\\z" : "\\Z" ); if ($ignore) { substr($path, 0, - $ignore) =~ s/X(?=X*$end)/$CHARS[ int( rand( @CHARS ) ) ]/ge; } else { $path =~ s/X(?=X*$end)/$CHARS[ int( rand( @CHARS ) ) ]/ge; } return $path; } # Internal routine to force a temp file to be writable after # it is created so that we can unlink it. Windows seems to occasionally # force a file to be readonly when written to certain temp locations sub _force_writable { my $file = shift; chmod 0600, $file; } # internal routine to check to see if the directory is safe # First checks to see if the directory is not owned by the # current user or root. Then checks to see if anyone else # can write to the directory and if so, checks to see if # it has the sticky bit set # Will not work on systems that do not support sticky bit #Args: directory path to check # Optionally: reference to scalar to contain error message # Returns true if the path is safe and false otherwise. # Returns undef if can not even run stat() on the path # This routine based on version written by Tom Christiansen # Presumably, by the time we actually attempt to create the # file or directory in this directory, it may not be safe # anymore... Have to run _is_safe directly after the open. sub _is_safe { my $path = shift; my $err_ref = shift; # Stat path my @info = stat($path); unless (scalar(@info)) { $$err_ref = "stat(path) returned no values"; return 0; } ; return 1 if $^O eq 'VMS'; # owner delete control at file level # Check to see whether owner is neither superuser (or a system uid) nor me # Use the effective uid from the $> variable # UID is in [4] if ($info[4] > File::Temp->top_system_uid() && $info[4] != $>) { Carp::cluck(sprintf "uid=$info[4] topuid=%s euid=$> path='$path'", File::Temp->top_system_uid()); $$err_ref = "Directory owned neither by root nor the current user" if ref($err_ref); return 0; } # check whether group or other can write file # use 066 to detect either reading or writing # use 022 to check writability # Do it with S_IWOTH and S_IWGRP for portability (maybe) # mode is in info[2] if (($info[2] & &Fcntl::S_IWGRP) || # Is group writable? ($info[2] & &Fcntl::S_IWOTH) ) { # Is world writable? # Must be a directory unless (-d $path) { $$err_ref = "Path ($path) is not a directory" if ref($err_ref); return 0; } # Must have sticky bit set unless (-k $path) { $$err_ref = "Sticky bit not set on $path when dir is group|world writable" if ref($err_ref); return 0; } } return 1; } # Internal routine to check whether a directory is safe # for temp files. Safer than _is_safe since it checks for # the possibility of chown giveaway and if that is a possibility # checks each directory in the path to see if it is safe (with _is_safe) # If _PC_CHOWN_RESTRICTED is not set, does the full test of each # directory anyway. # Takes optional second arg as scalar ref to error reason sub _is_verysafe { # Need POSIX - but only want to bother if really necessary due to overhead require POSIX; my $path = shift; print "_is_verysafe testing $path\n" if $DEBUG; return 1 if $^O eq 'VMS'; # owner delete control at file level my $err_ref = shift; # Should Get the value of _PC_CHOWN_RESTRICTED if it is defined # and If it is not there do the extensive test local($@); my $chown_restricted; $chown_restricted = &POSIX::_PC_CHOWN_RESTRICTED() if eval { &POSIX::_PC_CHOWN_RESTRICTED(); 1}; # If chown_resticted is set to some value we should test it if (defined $chown_restricted) { # Return if the current directory is safe return _is_safe($path,$err_ref) if POSIX::sysconf( $chown_restricted ); } # To reach this point either, the _PC_CHOWN_RESTRICTED symbol # was not available or the symbol was there but chown giveaway # is allowed. Either way, we now have to test the entire tree for # safety. # Convert path to an absolute directory if required unless (File::Spec->file_name_is_absolute($path)) { $path = File::Spec->rel2abs($path); } # Split directory into components - assume no file my ($volume, $directories, undef) = File::Spec->splitpath( $path, 1); # Slightly less efficient than having a function in File::Spec # to chop off the end of a directory or even a function that # can handle ../ in a directory tree # Sometimes splitdir() returns a blank at the end # so we will probably check the bottom directory twice in some cases my @dirs = File::Spec->splitdir($directories); # Concatenate one less directory each time around foreach my $pos (0.. $#dirs) { # Get a directory name my $dir = File::Spec->catpath($volume, File::Spec->catdir(@dirs[0.. $#dirs - $pos]), '' ); print "TESTING DIR $dir\n" if $DEBUG; # Check the directory return 0 unless _is_safe($dir,$err_ref); } return 1; } # internal routine to determine whether unlink works on this # platform for files that are currently open. # Returns true if we can, false otherwise. # Currently WinNT, OS/2 and VMS can not unlink an opened file # On VMS this is because the O_EXCL flag is used to open the # temporary file. Currently I do not know enough about the issues # on VMS to decide whether O_EXCL is a requirement. sub _can_unlink_opened_file { if (grep { $^O eq $_ } qw/MSWin32 os2 VMS dos MacOS haiku/) { return 0; } else { return 1; } } # internal routine to decide which security levels are allowed # see safe_level() for more information on this # Controls whether the supplied security level is allowed # $cando = _can_do_level( $level ) sub _can_do_level { # Get security level my $level = shift; # Always have to be able to do STANDARD return 1 if $level == STANDARD; # Currently, the systems that can do HIGH or MEDIUM are identical if ( $^O eq 'MSWin32' || $^O eq 'os2' || $^O eq 'cygwin' || $^O eq 'dos' || $^O eq 'MacOS' || $^O eq 'mpeix') { return 0; } else { return 1; } } # This routine sets up a deferred unlinking of a specified # filename and filehandle. It is used in the following cases: # - Called by unlink0 if an opened file can not be unlinked # - Called by tempfile() if files are to be removed on shutdown # - Called by tempdir() if directories are to be removed on shutdown # Arguments: # _deferred_unlink( $fh, $fname, $isdir ); # # - filehandle (so that it can be explicitly closed if open # - filename (the thing we want to remove) # - isdir (flag to indicate that we are being given a directory) # [and hence no filehandle] # Status is not referred to since all the magic is done with an END block { # Will set up two lexical variables to contain all the files to be # removed. One array for files, another for directories They will # only exist in this block. # This means we only have to set up a single END block to remove # all files. # in order to prevent child processes inadvertently deleting the parent # temp files we use a hash to store the temp files and directories # created by a particular process id. # %files_to_unlink contains values that are references to an array of # array references containing the filehandle and filename associated with # the temp file. my (%files_to_unlink, %dirs_to_unlink); # Set up an end block to use these arrays END { local($., $@, $!, $^E, $?); cleanup(at_exit => 1); } # Cleanup function. Always triggered on END (with at_exit => 1) but # can be invoked manually. sub cleanup { my %h = @_; my $at_exit = delete $h{at_exit}; $at_exit = 0 if not defined $at_exit; { my @k = sort keys %h; die "unrecognized parameters: @k" if @k } if (!$KEEP_ALL) { # Files my @files = (exists $files_to_unlink{$$} ? @{ $files_to_unlink{$$} } : () ); foreach my $file (@files) { # close the filehandle without checking its state # in order to make real sure that this is closed # if its already closed then I dont care about the answer # probably a better way to do this close($file->[0]); # file handle is [0] if (-f $file->[1]) { # file name is [1] _force_writable( $file->[1] ); # for windows unlink $file->[1] or warn "Error removing ".$file->[1]; } } # Dirs my @dirs = (exists $dirs_to_unlink{$$} ? @{ $dirs_to_unlink{$$} } : () ); my ($cwd, $cwd_to_remove); foreach my $dir (@dirs) { if (-d $dir) { # Some versions of rmtree will abort if you attempt to remove # the directory you are sitting in. For automatic cleanup # at program exit, we avoid this by chdir()ing out of the way # first. If not at program exit, it's best not to mess with the # current directory, so just let it fail with a warning. if ($at_exit) { $cwd = Cwd::abs_path(File::Spec->curdir) if not defined $cwd; my $abs = Cwd::abs_path($dir); if ($abs eq $cwd) { $cwd_to_remove = $dir; next; } } eval { rmtree($dir, $DEBUG, 0); }; warn $@ if ($@ && $^W); } } if (defined $cwd_to_remove) { # We do need to clean up the current directory, and everything # else is done, so get out of there and remove it. chdir $cwd_to_remove or die "cannot chdir to $cwd_to_remove: $!"; my $updir = File::Spec->updir; chdir $updir or die "cannot chdir to $updir: $!"; eval { rmtree($cwd_to_remove, $DEBUG, 0); }; warn $@ if ($@ && $^W); } # clear the arrays @{ $files_to_unlink{$$} } = () if exists $files_to_unlink{$$}; @{ $dirs_to_unlink{$$} } = () if exists $dirs_to_unlink{$$}; } } # This is the sub called to register a file for deferred unlinking # This could simply store the input parameters and defer everything # until the END block. For now we do a bit of checking at this # point in order to make sure that (1) we have a file/dir to delete # and (2) we have been called with the correct arguments. sub _deferred_unlink { croak 'Usage: _deferred_unlink($fh, $fname, $isdir)' unless scalar(@_) == 3; my ($fh, $fname, $isdir) = @_; warn "Setting up deferred removal of $fname\n" if $DEBUG; # make sure we save the absolute path for later cleanup # OK to untaint because we only ever use this internally # as a file path, never interpolating into the shell $fname = Cwd::abs_path($fname); ($fname) = $fname =~ /^(.*)$/; # If we have a directory, check that it is a directory if ($isdir) { if (-d $fname) { # Directory exists so store it # first on VMS turn []foo into [.foo] for rmtree $fname = VMS::Filespec::vmspath($fname) if $^O eq 'VMS'; $dirs_to_unlink{$$} = [] unless exists $dirs_to_unlink{$$}; push (@{ $dirs_to_unlink{$$} }, $fname); } else { carp "Request to remove directory $fname could not be completed since it does not exist!\n" if $^W; } } else { if (-f $fname) { # file exists so store handle and name for later removal $files_to_unlink{$$} = [] unless exists $files_to_unlink{$$}; push(@{ $files_to_unlink{$$} }, [$fh, $fname]); } else { carp "Request to remove file $fname could not be completed since it is not there!\n" if $^W; } } } } # normalize argument keys to upper case and do consistent handling # of leading template vs TEMPLATE sub _parse_args { my $leading_template = (scalar(@_) % 2 == 1 ? shift(@_) : '' ); my %args = @_; %args = map { uc($_), $args{$_} } keys %args; # template (store it in an array so that it will # disappear from the arg list of tempfile) my @template = ( exists $args{TEMPLATE} ? $args{TEMPLATE} : $leading_template ? $leading_template : () ); delete $args{TEMPLATE}; return( \@template, \%args ); } sub new { my $proto = shift; my $class = ref($proto) || $proto; my ($maybe_template, $args) = _parse_args(@_); # see if they are unlinking (defaulting to yes) my $unlink = (exists $args->{UNLINK} ? $args->{UNLINK} : 1 ); delete $args->{UNLINK}; # Protect OPEN delete $args->{OPEN}; # Open the file and retain file handle and file name my ($fh, $path) = tempfile( @$maybe_template, %$args ); print "Tmp: $fh - $path\n" if $DEBUG; # Store the filename in the scalar slot ${*$fh} = $path; # Cache the filename by pid so that the destructor can decide whether to remove it $FILES_CREATED_BY_OBJECT{$$}{$path} = 1; # Store unlink information in hash slot (plus other constructor info) %{*$fh} = %$args; # create the object bless $fh, $class; # final method-based configuration $fh->unlink_on_destroy( $unlink ); return $fh; } sub newdir { my $self = shift; my ($maybe_template, $args) = _parse_args(@_); # handle CLEANUP without passing CLEANUP to tempdir my $cleanup = (exists $args->{CLEANUP} ? $args->{CLEANUP} : 1 ); delete $args->{CLEANUP}; my $tempdir = tempdir( @$maybe_template, %$args); # get a safe absolute path for cleanup, just like # happens in _deferred_unlink my $real_dir = Cwd::abs_path( $tempdir ); ($real_dir) = $real_dir =~ /^(.*)$/; return bless { DIRNAME => $tempdir, REALNAME => $real_dir, CLEANUP => $cleanup, LAUNCHPID => $$, }, "File::Temp::Dir"; } sub filename { my $self = shift; return ${*$self}; } sub STRINGIFY { my $self = shift; return $self->filename; } # For reference, can't use '0+'=>\&Scalar::Util::refaddr directly because # refaddr() demands one parameter only, whereas overload.pm calls with three # even for unary operations like '0+'. sub NUMIFY { return refaddr($_[0]); } sub unlink_on_destroy { my $self = shift; if (@_) { ${*$self}{UNLINK} = shift; } return ${*$self}{UNLINK}; } sub DESTROY { local($., $@, $!, $^E, $?); my $self = shift; # Make sure we always remove the file from the global hash # on destruction. This prevents the hash from growing uncontrollably # and post-destruction there is no reason to know about the file. my $file = $self->filename; my $was_created_by_proc; if (exists $FILES_CREATED_BY_OBJECT{$$}{$file}) { $was_created_by_proc = 1; delete $FILES_CREATED_BY_OBJECT{$$}{$file}; } if (${*$self}{UNLINK} && !$KEEP_ALL) { print "# ---------> Unlinking $self\n" if $DEBUG; # only delete if this process created it return unless $was_created_by_proc; # The unlink1 may fail if the file has been closed # by the caller. This leaves us with the decision # of whether to refuse to remove the file or simply # do an unlink without test. Seems to be silly # to do this when we are trying to be careful # about security _force_writable( $file ); # for windows unlink1( $self, $file ) or unlink($file); } } sub tempfile { if ( @_ && $_[0] eq 'File::Temp' ) { croak "'tempfile' can't be called as a method"; } # Can not check for argument count since we can have any # number of args # Default options my %options = ( "DIR" => undef, # Directory prefix "SUFFIX" => '', # Template suffix "UNLINK" => 0, # Do not unlink file on exit "OPEN" => 1, # Open file "TMPDIR" => 0, # Place tempfile in tempdir if template specified "EXLOCK" => 1, # Open file with O_EXLOCK ); # Check to see whether we have an odd or even number of arguments my ($maybe_template, $args) = _parse_args(@_); my $template = @$maybe_template ? $maybe_template->[0] : undef; # Read the options and merge with defaults %options = (%options, %$args); # First decision is whether or not to open the file if (! $options{"OPEN"}) { warn "tempfile(): temporary filename requested but not opened.\nPossibly unsafe, consider using tempfile() with OPEN set to true\n" if $^W; } if ($options{"DIR"} and $^O eq 'VMS') { # on VMS turn []foo into [.foo] for concatenation $options{"DIR"} = VMS::Filespec::vmspath($options{"DIR"}); } # Construct the template # Have a choice of trying to work around the mkstemp/mktemp/tmpnam etc # functions or simply constructing a template and using _gettemp() # explicitly. Go for the latter # First generate a template if not defined and prefix the directory # If no template must prefix the temp directory if (defined $template) { # End up with current directory if neither DIR not TMPDIR are set if ($options{"DIR"}) { $template = File::Spec->catfile($options{"DIR"}, $template); } elsif ($options{TMPDIR}) { $template = File::Spec->catfile(File::Spec->tmpdir, $template ); } } else { if ($options{"DIR"}) { $template = File::Spec->catfile($options{"DIR"}, TEMPXXX); } else { $template = File::Spec->catfile(File::Spec->tmpdir, TEMPXXX); } } # Now add a suffix $template .= $options{"SUFFIX"}; # Determine whether we should tell _gettemp to unlink the file # On unix this is irrelevant and can be worked out after the file is # opened (simply by unlinking the open filehandle). On Windows or VMS # we have to indicate temporary-ness when we open the file. In general # we only want a true temporary file if we are returning just the # filehandle - if the user wants the filename they probably do not # want the file to disappear as soon as they close it (which may be # important if they want a child process to use the file) # For this reason, tie unlink_on_close to the return context regardless # of OS. my $unlink_on_close = ( wantarray ? 0 : 1); # Create the file my ($fh, $path, $errstr); croak "Error in tempfile() using template $template: $errstr" unless (($fh, $path) = _gettemp($template, "open" => $options{'OPEN'}, "mkdir"=> 0 , "unlink_on_close" => $unlink_on_close, "suffixlen" => length($options{'SUFFIX'}), "ErrStr" => \$errstr, "use_exlock" => $options{EXLOCK}, ) ); # Set up an exit handler that can do whatever is right for the # system. This removes files at exit when requested explicitly or when # system is asked to unlink_on_close but is unable to do so because # of OS limitations. # The latter should be achieved by using a tied filehandle. # Do not check return status since this is all done with END blocks. _deferred_unlink($fh, $path, 0) if $options{"UNLINK"}; # Return if (wantarray()) { if ($options{'OPEN'}) { return ($fh, $path); } else { return (undef, $path); } } else { # Unlink the file. It is up to unlink0 to decide what to do with # this (whether to unlink now or to defer until later) unlink0($fh, $path) or croak "Error unlinking file $path using unlink0"; # Return just the filehandle. return $fh; } } # ' sub tempdir { if ( @_ && $_[0] eq 'File::Temp' ) { croak "'tempdir' can't be called as a method"; } # Can not check for argument count since we can have any # number of args # Default options my %options = ( "CLEANUP" => 0, # Remove directory on exit "DIR" => '', # Root directory "TMPDIR" => 0, # Use tempdir with template ); # Check to see whether we have an odd or even number of arguments my ($maybe_template, $args) = _parse_args(@_); my $template = @$maybe_template ? $maybe_template->[0] : undef; # Read the options and merge with defaults %options = (%options, %$args); # Modify or generate the template # Deal with the DIR and TMPDIR options if (defined $template) { # Need to strip directory path if using DIR or TMPDIR if ($options{'TMPDIR'} || $options{'DIR'}) { # Strip parent directory from the filename # # There is no filename at the end $template = VMS::Filespec::vmspath($template) if $^O eq 'VMS'; my ($volume, $directories, undef) = File::Spec->splitpath( $template, 1); # Last directory is then our template $template = (File::Spec->splitdir($directories))[-1]; # Prepend the supplied directory or temp dir if ($options{"DIR"}) { $template = File::Spec->catdir($options{"DIR"}, $template); } elsif ($options{TMPDIR}) { # Prepend tmpdir $template = File::Spec->catdir(File::Spec->tmpdir, $template); } } } else { if ($options{"DIR"}) { $template = File::Spec->catdir($options{"DIR"}, TEMPXXX); } else { $template = File::Spec->catdir(File::Spec->tmpdir, TEMPXXX); } } # Create the directory my $tempdir; my $suffixlen = 0; if ($^O eq 'VMS') { # dir names can end in delimiters $template =~ m/([\.\]:>]+)$/; $suffixlen = length($1); } if ( ($^O eq 'MacOS') && (substr($template, -1) eq ':') ) { # dir name has a trailing ':' ++$suffixlen; } my $errstr; croak "Error in tempdir() using $template: $errstr" unless ((undef, $tempdir) = _gettemp($template, "open" => 0, "mkdir"=> 1 , "suffixlen" => $suffixlen, "ErrStr" => \$errstr, ) ); # Install exit handler; must be dynamic to get lexical if ( $options{'CLEANUP'} && -d $tempdir) { _deferred_unlink(undef, $tempdir, 1); } # Return the dir name return $tempdir; } sub mkstemp { croak "Usage: mkstemp(template)" if scalar(@_) != 1; my $template = shift; my ($fh, $path, $errstr); croak "Error in mkstemp using $template: $errstr" unless (($fh, $path) = _gettemp($template, "open" => 1, "mkdir"=> 0 , "suffixlen" => 0, "ErrStr" => \$errstr, ) ); if (wantarray()) { return ($fh, $path); } else { return $fh; } } sub mkstemps { croak "Usage: mkstemps(template, suffix)" if scalar(@_) != 2; my $template = shift; my $suffix = shift; $template .= $suffix; my ($fh, $path, $errstr); croak "Error in mkstemps using $template: $errstr" unless (($fh, $path) = _gettemp($template, "open" => 1, "mkdir"=> 0 , "suffixlen" => length($suffix), "ErrStr" => \$errstr, ) ); if (wantarray()) { return ($fh, $path); } else { return $fh; } } #' # for emacs sub mkdtemp { croak "Usage: mkdtemp(template)" if scalar(@_) != 1; my $template = shift; my $suffixlen = 0; if ($^O eq 'VMS') { # dir names can end in delimiters $template =~ m/([\.\]:>]+)$/; $suffixlen = length($1); } if ( ($^O eq 'MacOS') && (substr($template, -1) eq ':') ) { # dir name has a trailing ':' ++$suffixlen; } my ($junk, $tmpdir, $errstr); croak "Error creating temp directory from template $template\: $errstr" unless (($junk, $tmpdir) = _gettemp($template, "open" => 0, "mkdir"=> 1 , "suffixlen" => $suffixlen, "ErrStr" => \$errstr, ) ); return $tmpdir; } sub mktemp { croak "Usage: mktemp(template)" if scalar(@_) != 1; my $template = shift; my ($tmpname, $junk, $errstr); croak "Error getting name to temp file from template $template: $errstr" unless (($junk, $tmpname) = _gettemp($template, "open" => 0, "mkdir"=> 0 , "suffixlen" => 0, "ErrStr" => \$errstr, ) ); return $tmpname; } sub tmpnam { # Retrieve the temporary directory name my $tmpdir = File::Spec->tmpdir; croak "Error temporary directory is not writable" if $tmpdir eq ''; # Use a ten character template and append to tmpdir my $template = File::Spec->catfile($tmpdir, TEMPXXX); if (wantarray() ) { return mkstemp($template); } else { return mktemp($template); } } sub tmpfile { # Simply call tmpnam() in a list context my ($fh, $file) = tmpnam(); # Make sure file is removed when filehandle is closed # This will fail on NFS unlink0($fh, $file) or return undef; return $fh; } sub tempnam { croak 'Usage tempnam($dir, $prefix)' unless scalar(@_) == 2; my ($dir, $prefix) = @_; # Add a string to the prefix $prefix .= 'XXXXXXXX'; # Concatenate the directory to the file my $template = File::Spec->catfile($dir, $prefix); return mktemp($template); } sub unlink0 { croak 'Usage: unlink0(filehandle, filename)' unless scalar(@_) == 2; # Read args my ($fh, $path) = @_; cmpstat($fh, $path) or return 0; # attempt remove the file (does not work on some platforms) if (_can_unlink_opened_file()) { # return early (Without unlink) if we have been instructed to retain files. return 1 if $KEEP_ALL; # XXX: do *not* call this on a directory; possible race # resulting in recursive removal croak "unlink0: $path has become a directory!" if -d $path; unlink($path) or return 0; # Stat the filehandle my @fh = stat $fh; print "Link count = $fh[3] \n" if $DEBUG; # Make sure that the link count is zero # - Cygwin provides deferred unlinking, however, # on Win9x the link count remains 1 # On NFS the link count may still be 1 but we can't know that # we are on NFS. Since we can't be sure, we'll defer it return 1 if $fh[3] == 0 || $^O eq 'cygwin'; } # fall-through if we can't unlink now _deferred_unlink($fh, $path, 0); return 1; } sub cmpstat { croak 'Usage: cmpstat(filehandle, filename)' unless scalar(@_) == 2; # Read args my ($fh, $path) = @_; warn "Comparing stat\n" if $DEBUG; # Stat the filehandle - which may be closed if someone has manually # closed the file. Can not turn off warnings without using $^W # unless we upgrade to 5.006 minimum requirement my @fh; { local ($^W) = 0; @fh = stat $fh; } return unless @fh; if ($fh[3] > 1 && $^W) { carp "unlink0: fstat found too many links; SB=@fh" if $^W; } # Stat the path my @path = stat $path; unless (@path) { carp "unlink0: $path is gone already" if $^W; return; } # this is no longer a file, but may be a directory, or worse unless (-f $path) { confess "panic: $path is no longer a file: SB=@fh"; } # Do comparison of each member of the array # On WinNT dev and rdev seem to be different # depending on whether it is a file or a handle. # Cannot simply compare all members of the stat return # Select the ones we can use my @okstat = (0..$#fh); # Use all by default if ($^O eq 'MSWin32') { @okstat = (1,2,3,4,5,7,8,9,10); } elsif ($^O eq 'os2') { @okstat = (0, 2..$#fh); } elsif ($^O eq 'VMS') { # device and file ID are sufficient @okstat = (0, 1); } elsif ($^O eq 'dos') { @okstat = (0,2..7,11..$#fh); } elsif ($^O eq 'mpeix') { @okstat = (0..4,8..10); } # Now compare each entry explicitly by number for (@okstat) { print "Comparing: $_ : $fh[$_] and $path[$_]\n" if $DEBUG; # Use eq rather than == since rdev, blksize, and blocks (6, 11, # and 12) will be '' on platforms that do not support them. This # is fine since we are only comparing integers. unless ($fh[$_] eq $path[$_]) { warn "Did not match $_ element of stat\n" if $DEBUG; return 0; } } return 1; } sub unlink1 { croak 'Usage: unlink1(filehandle, filename)' unless scalar(@_) == 2; # Read args my ($fh, $path) = @_; cmpstat($fh, $path) or return 0; # Close the file close( $fh ) or return 0; # Make sure the file is writable (for windows) _force_writable( $path ); # return early (without unlink) if we have been instructed to retain files. return 1 if $KEEP_ALL; # remove the file return unlink($path); } { # protect from using the variable itself my $LEVEL = STANDARD; sub safe_level { my $self = shift; if (@_) { my $level = shift; if (($level != STANDARD) && ($level != MEDIUM) && ($level != HIGH)) { carp "safe_level: Specified level ($level) not STANDARD, MEDIUM or HIGH - ignoring\n" if $^W; } else { # Don't allow this on perl 5.005 or earlier if ($] < 5.006 && $level != STANDARD) { # Cant do MEDIUM or HIGH checks croak "Currently requires perl 5.006 or newer to do the safe checks"; } # Check that we are allowed to change level # Silently ignore if we can not. $LEVEL = $level if _can_do_level($level); } } return $LEVEL; } } { my $TopSystemUID = 10; $TopSystemUID = 197108 if $^O eq 'interix'; # "Administrator" sub top_system_uid { my $self = shift; if (@_) { my $newuid = shift; croak "top_system_uid: UIDs should be numeric" unless $newuid =~ /^\d+$/s; $TopSystemUID = $newuid; } return $TopSystemUID; } } package File::Temp::Dir; use File::Path qw/ rmtree /; use strict; use overload '""' => "STRINGIFY", '0+' => \&File::Temp::NUMIFY, fallback => 1; # private class specifically to support tempdir objects # created by File::Temp->newdir # ostensibly the same method interface as File::Temp but without # inheriting all the IO::Seekable methods and other cruft # Read-only - returns the name of the temp directory sub dirname { my $self = shift; return $self->{DIRNAME}; } sub STRINGIFY { my $self = shift; return $self->dirname; } sub unlink_on_destroy { my $self = shift; if (@_) { $self->{CLEANUP} = shift; } return $self->{CLEANUP}; } sub DESTROY { my $self = shift; local($., $@, $!, $^E, $?); if ($self->unlink_on_destroy && $$ == $self->{LAUNCHPID} && !$File::Temp::KEEP_ALL) { if (-d $self->{REALNAME}) { # Some versions of rmtree will abort if you attempt to remove # the directory you are sitting in. We protect that and turn it # into a warning. We do this because this occurs during object # destruction and so can not be caught by the user. eval { rmtree($self->{REALNAME}, $File::Temp::DEBUG, 0); }; warn $@ if ($@ && $^W); } } } 1; __END__ =pod =encoding utf-8 =head1 NAME File::Temp - return name and handle of a temporary file safely =head1 VERSION version 0.2301 =head1 SYNOPSIS use File::Temp qw/ tempfile tempdir /; $fh = tempfile(); ($fh, $filename) = tempfile(); ($fh, $filename) = tempfile( $template, DIR => $dir); ($fh, $filename) = tempfile( $template, SUFFIX => '.dat'); ($fh, $filename) = tempfile( $template, TMPDIR => 1 ); binmode( $fh, ":utf8" ); $dir = tempdir( CLEANUP => 1 ); ($fh, $filename) = tempfile( DIR => $dir ); Object interface: require File::Temp; use File::Temp (); use File::Temp qw/ :seekable /; $fh = File::Temp->new(); $fname = $fh->filename; $fh = File::Temp->new(TEMPLATE => $template); $fname = $fh->filename; $tmp = File::Temp->new( UNLINK => 0, SUFFIX => '.dat' ); print $tmp "Some data\n"; print "Filename is $tmp\n"; $tmp->seek( 0, SEEK_END ); The following interfaces are provided for compatibility with existing APIs. They should not be used in new code. MkTemp family: use File::Temp qw/ :mktemp /; ($fh, $file) = mkstemp( "tmpfileXXXXX" ); ($fh, $file) = mkstemps( "tmpfileXXXXXX", $suffix); $tmpdir = mkdtemp( $template ); $unopened_file = mktemp( $template ); POSIX functions: use File::Temp qw/ :POSIX /; $file = tmpnam(); $fh = tmpfile(); ($fh, $file) = tmpnam(); Compatibility functions: $unopened_file = File::Temp::tempnam( $dir, $pfx ); =head1 DESCRIPTION C can be used to create and open temporary files in a safe way. There is both a function interface and an object-oriented interface. The File::Temp constructor or the tempfile() function can be used to return the name and the open filehandle of a temporary file. The tempdir() function can be used to create a temporary directory. The security aspect of temporary file creation is emphasized such that a filehandle and filename are returned together. This helps guarantee that a race condition can not occur where the temporary file is created by another process between checking for the existence of the file and its opening. Additional security levels are provided to check, for example, that the sticky bit is set on world writable directories. See L<"safe_level"> for more information. For compatibility with popular C library functions, Perl implementations of the mkstemp() family of functions are provided. These are, mkstemp(), mkstemps(), mkdtemp() and mktemp(). Additionally, implementations of the standard L tmpnam() and tmpfile() functions are provided if required. Implementations of mktemp(), tmpnam(), and tempnam() are provided, but should be used with caution since they return only a filename that was valid when function was called, so cannot guarantee that the file will not exist by the time the caller opens the filename. Filehandles returned by these functions support the seekable methods. =begin __INTERNALS =head1 PORTABILITY This section is at the top in order to provide easier access to porters. It is not expected to be rendered by a standard pod formatting tool. Please skip straight to the SYNOPSIS section if you are not trying to port this module to a new platform. This module is designed to be portable across operating systems and it currently supports Unix, VMS, DOS, OS/2, Windows and Mac OS (Classic). When porting to a new OS there are generally three main issues that have to be solved: =over 4 =item * Can the OS unlink an open file? If it can not then the C<_can_unlink_opened_file> method should be modified. =item * Are the return values from C reliable? By default all the return values from C are compared when unlinking a temporary file using the filename and the handle. Operating systems other than unix do not always have valid entries in all fields. If utility function C fails then the C comparison should be modified accordingly. =item * Security. Systems that can not support a test for the sticky bit on a directory can not use the MEDIUM and HIGH security tests. The C<_can_do_level> method should be modified accordingly. =back =end __INTERNALS =head1 OBJECT-ORIENTED INTERFACE This is the primary interface for interacting with C. Using the OO interface a temporary file can be created when the object is constructed and the file can be removed when the object is no longer required. Note that there is no method to obtain the filehandle from the C object. The object itself acts as a filehandle. The object isa C and isa C so all those methods are available. Also, the object is configured such that it stringifies to the name of the temporary file and so can be compared to a filename directly. It numifies to the C the same as other handles and so can be compared to other handles with C<==>. $fh eq $filename # as a string $fh != \*STDOUT # as a number =over 4 =item B Create a temporary file object. my $tmp = File::Temp->new(); by default the object is constructed as if C was called without options, but with the additional behaviour that the temporary file is removed by the object destructor if UNLINK is set to true (the default). Supported arguments are the same as for C: UNLINK (defaulting to true), DIR, EXLOCK and SUFFIX. Additionally, the filename template is specified using the TEMPLATE option. The OPEN option is not supported (the file is always opened). $tmp = File::Temp->new( TEMPLATE => 'tempXXXXX', DIR => 'mydir', SUFFIX => '.dat'); Arguments are case insensitive. Can call croak() if an error occurs. =item B Create a temporary directory using an object oriented interface. $dir = File::Temp->newdir(); By default the directory is deleted when the object goes out of scope. Supports the same options as the C function. Note that directories created with this method default to CLEANUP => 1. $dir = File::Temp->newdir( $template, %options ); A template may be specified either with a leading template or with a TEMPLATE argument. =item B Return the name of the temporary file associated with this object (if the object was created using the "new" constructor). $filename = $tmp->filename; This method is called automatically when the object is used as a string. =item B Return the name of the temporary directory associated with this object (if the object was created using the "newdir" constructor). $dirname = $tmpdir->dirname; This method is called automatically when the object is used in string context. =item B Control whether the file is unlinked when the object goes out of scope. The file is removed if this value is true and $KEEP_ALL is not. $fh->unlink_on_destroy( 1 ); Default is for the file to be removed. =item B When the object goes out of scope, the destructor is called. This destructor will attempt to unlink the file (using L) if the constructor was called with UNLINK set to 1 (the default state if UNLINK is not specified). No error is given if the unlink fails. If the object has been passed to a child process during a fork, the file will be deleted when the object goes out of scope in the parent. For a temporary directory object the directory will be removed unless the CLEANUP argument was used in the constructor (and set to false) or C was modified after creation. Note that if a temp directory is your current directory, it cannot be removed - a warning will be given in this case. C out of the directory before letting the object go out of scope. If the global variable $KEEP_ALL is true, the file or directory will not be removed. =back =head1 FUNCTIONS This section describes the recommended interface for generating temporary files and directories. =over 4 =item B This is the basic function to generate temporary files. The behaviour of the file can be changed using various options: $fh = tempfile(); ($fh, $filename) = tempfile(); Create a temporary file in the directory specified for temporary files, as specified by the tmpdir() function in L. ($fh, $filename) = tempfile($template); Create a temporary file in the current directory using the supplied template. Trailing `X' characters are replaced with random letters to generate the filename. At least four `X' characters must be present at the end of the template. ($fh, $filename) = tempfile($template, SUFFIX => $suffix) Same as previously, except that a suffix is added to the template after the `X' translation. Useful for ensuring that a temporary filename has a particular extension when needed by other applications. But see the WARNING at the end. ($fh, $filename) = tempfile($template, DIR => $dir); Translates the template as before except that a directory name is specified. ($fh, $filename) = tempfile($template, TMPDIR => 1); Equivalent to specifying a DIR of "File::Spec->tmpdir", writing the file into the same temporary directory as would be used if no template was specified at all. ($fh, $filename) = tempfile($template, UNLINK => 1); Return the filename and filehandle as before except that the file is automatically removed when the program exits (dependent on $KEEP_ALL). Default is for the file to be removed if a file handle is requested and to be kept if the filename is requested. In a scalar context (where no filename is returned) the file is always deleted either (depending on the operating system) on exit or when it is closed (unless $KEEP_ALL is true when the temp file is created). Use the object-oriented interface if fine-grained control of when a file is removed is required. If the template is not specified, a template is always automatically generated. This temporary file is placed in tmpdir() (L) unless a directory is specified explicitly with the DIR option. $fh = tempfile( DIR => $dir ); If called in scalar context, only the filehandle is returned and the file will automatically be deleted when closed on operating systems that support this (see the description of tmpfile() elsewhere in this document). This is the preferred mode of operation, as if you only have a filehandle, you can never create a race condition by fumbling with the filename. On systems that can not unlink an open file or can not mark a file as temporary when it is opened (for example, Windows NT uses the C flag) the file is marked for deletion when the program ends (equivalent to setting UNLINK to 1). The C flag is ignored if present. (undef, $filename) = tempfile($template, OPEN => 0); This will return the filename based on the template but will not open this file. Cannot be used in conjunction with UNLINK set to true. Default is to always open the file to protect from possible race conditions. A warning is issued if warnings are turned on. Consider using the tmpnam() and mktemp() functions described elsewhere in this document if opening the file is not required. If the operating system supports it (for example BSD derived systems), the filehandle will be opened with O_EXLOCK (open with exclusive file lock). This can sometimes cause problems if the intention is to pass the filename to another system that expects to take an exclusive lock itself (such as DBD::SQLite) whilst ensuring that the tempfile is not reused. In this situation the "EXLOCK" option can be passed to tempfile. By default EXLOCK will be true (this retains compatibility with earlier releases). ($fh, $filename) = tempfile($template, EXLOCK => 0); Options can be combined as required. Will croak() if there is an error. =item B This is the recommended interface for creation of temporary directories. By default the directory will not be removed on exit (that is, it won't be temporary; this behaviour can not be changed because of issues with backwards compatibility). To enable removal either use the CLEANUP option which will trigger removal on program exit, or consider using the "newdir" method in the object interface which will allow the directory to be cleaned up when the object goes out of scope. The behaviour of the function depends on the arguments: $tempdir = tempdir(); Create a directory in tmpdir() (see L). $tempdir = tempdir( $template ); Create a directory from the supplied template. This template is similar to that described for tempfile(). `X' characters at the end of the template are replaced with random letters to construct the directory name. At least four `X' characters must be in the template. $tempdir = tempdir ( DIR => $dir ); Specifies the directory to use for the temporary directory. The temporary directory name is derived from an internal template. $tempdir = tempdir ( $template, DIR => $dir ); Prepend the supplied directory name to the template. The template should not include parent directory specifications itself. Any parent directory specifications are removed from the template before prepending the supplied directory. $tempdir = tempdir ( $template, TMPDIR => 1 ); Using the supplied template, create the temporary directory in a standard location for temporary files. Equivalent to doing $tempdir = tempdir ( $template, DIR => File::Spec->tmpdir); but shorter. Parent directory specifications are stripped from the template itself. The C option is ignored if C is set explicitly. Additionally, C is implied if neither a template nor a directory are supplied. $tempdir = tempdir( $template, CLEANUP => 1); Create a temporary directory using the supplied template, but attempt to remove it (and all files inside it) when the program exits. Note that an attempt will be made to remove all files from the directory even if they were not created by this module (otherwise why ask to clean it up?). The directory removal is made with the rmtree() function from the L module. Of course, if the template is not specified, the temporary directory will be created in tmpdir() and will also be removed at program exit. Will croak() if there is an error. =back =head1 MKTEMP FUNCTIONS The following functions are Perl implementations of the mktemp() family of temp file generation system calls. =over 4 =item B Given a template, returns a filehandle to the temporary file and the name of the file. ($fh, $name) = mkstemp( $template ); In scalar context, just the filehandle is returned. The template may be any filename with some number of X's appended to it, for example F. The trailing X's are replaced with unique alphanumeric combinations. Will croak() if there is an error. =item B Similar to mkstemp(), except that an extra argument can be supplied with a suffix to be appended to the template. ($fh, $name) = mkstemps( $template, $suffix ); For example a template of C and suffix of C<.dat> would generate a file similar to F. Returns just the filehandle alone when called in scalar context. Will croak() if there is an error. =item B Create a directory from a template. The template must end in X's that are replaced by the routine. $tmpdir_name = mkdtemp($template); Returns the name of the temporary directory created. Directory must be removed by the caller. Will croak() if there is an error. =item B Returns a valid temporary filename but does not guarantee that the file will not be opened by someone else. $unopened_file = mktemp($template); Template is the same as that required by mkstemp(). Will croak() if there is an error. =back =head1 POSIX FUNCTIONS This section describes the re-implementation of the tmpnam() and tmpfile() functions described in L using the mkstemp() from this module. Unlike the L implementations, the directory used for the temporary file is not specified in a system include file (C) but simply depends on the choice of tmpdir() returned by L. On some implementations this location can be set using the C environment variable, which may not be secure. If this is a problem, simply use mkstemp() and specify a template. =over 4 =item B When called in scalar context, returns the full name (including path) of a temporary file (uses mktemp()). The only check is that the file does not already exist, but there is no guarantee that that condition will continue to apply. $file = tmpnam(); When called in list context, a filehandle to the open file and a filename are returned. This is achieved by calling mkstemp() after constructing a suitable template. ($fh, $file) = tmpnam(); If possible, this form should be used to prevent possible race conditions. See L for information on the choice of temporary directory for a particular operating system. Will croak() if there is an error. =item B Returns the filehandle of a temporary file. $fh = tmpfile(); The file is removed when the filehandle is closed or when the program exits. No access to the filename is provided. If the temporary file can not be created undef is returned. Currently this command will probably not work when the temporary directory is on an NFS file system. Will croak() if there is an error. =back =head1 ADDITIONAL FUNCTIONS These functions are provided for backwards compatibility with common tempfile generation C library functions. They are not exported and must be addressed using the full package name. =over 4 =item B Return the name of a temporary file in the specified directory using a prefix. The file is guaranteed not to exist at the time the function was called, but such guarantees are good for one clock tick only. Always use the proper form of C with C if you must open such a filename. $filename = File::Temp::tempnam( $dir, $prefix ); Equivalent to running mktemp() with $dir/$prefixXXXXXXXX (using unix file convention as an example) Because this function uses mktemp(), it can suffer from race conditions. Will croak() if there is an error. =back =head1 UTILITY FUNCTIONS Useful functions for dealing with the filehandle and filename. =over 4 =item B Given an open filehandle and the associated filename, make a safe unlink. This is achieved by first checking that the filename and filehandle initially point to the same file and that the number of links to the file is 1 (all fields returned by stat() are compared). Then the filename is unlinked and the filehandle checked once again to verify that the number of links on that file is now 0. This is the closest you can come to making sure that the filename unlinked was the same as the file whose descriptor you hold. unlink0($fh, $path) or die "Error unlinking file $path safely"; Returns false on error but croaks() if there is a security anomaly. The filehandle is not closed since on some occasions this is not required. On some platforms, for example Windows NT, it is not possible to unlink an open file (the file must be closed first). On those platforms, the actual unlinking is deferred until the program ends and good status is returned. A check is still performed to make sure that the filehandle and filename are pointing to the same thing (but not at the time the end block is executed since the deferred removal may not have access to the filehandle). Additionally, on Windows NT not all the fields returned by stat() can be compared. For example, the C and C fields seem to be different. Also, it seems that the size of the file returned by stat() does not always agree, with C being more accurate than C, presumably because of caching issues even when using autoflush (this is usually overcome by waiting a while after writing to the tempfile before attempting to C it). Finally, on NFS file systems the link count of the file handle does not always go to zero immediately after unlinking. Currently, this command is expected to fail on NFS disks. This function is disabled if the global variable $KEEP_ALL is true and an unlink on open file is supported. If the unlink is to be deferred to the END block, the file is still registered for removal. This function should not be called if you are using the object oriented interface since the it will interfere with the object destructor deleting the file. =item B Compare C of filehandle with C of provided filename. This can be used to check that the filename and filehandle initially point to the same file and that the number of links to the file is 1 (all fields returned by stat() are compared). cmpstat($fh, $path) or die "Error comparing handle with file"; Returns false if the stat information differs or if the link count is greater than 1. Calls croak if there is a security anomaly. On certain platforms, for example Windows, not all the fields returned by stat() can be compared. For example, the C and C fields seem to be different in Windows. Also, it seems that the size of the file returned by stat() does not always agree, with C being more accurate than C, presumably because of caching issues even when using autoflush (this is usually overcome by waiting a while after writing to the tempfile before attempting to C it). Not exported by default. =item B Similar to C except after file comparison using cmpstat, the filehandle is closed prior to attempting to unlink the file. This allows the file to be removed without using an END block, but does mean that the post-unlink comparison of the filehandle state provided by C is not available. unlink1($fh, $path) or die "Error closing and unlinking file"; Usually called from the object destructor when using the OO interface. Not exported by default. This function is disabled if the global variable $KEEP_ALL is true. Can call croak() if there is a security anomaly during the stat() comparison. =item B Calling this function will cause any temp files or temp directories that are registered for removal to be removed. This happens automatically when the process exits but can be triggered manually if the caller is sure that none of the temp files are required. This method can be registered as an Apache callback. Note that if a temp directory is your current directory, it cannot be removed. C out of the directory first before calling C. (For the cleanup at program exit when the CLEANUP flag is set, this happens automatically.) On OSes where temp files are automatically removed when the temp file is closed, calling this function will have no effect other than to remove temporary directories (which may include temporary files). File::Temp::cleanup(); Not exported by default. =back =head1 PACKAGE VARIABLES These functions control the global state of the package. =over 4 =item B Controls the lengths to which the module will go to check the safety of the temporary file or directory before proceeding. Options are: =over 8 =item STANDARD Do the basic security measures to ensure the directory exists and is writable, that temporary files are opened only if they do not already exist, and that possible race conditions are avoided. Finally the L function is used to remove files safely. =item MEDIUM In addition to the STANDARD security, the output directory is checked to make sure that it is owned either by root or the user running the program. If the directory is writable by group or by other, it is then checked to make sure that the sticky bit is set. Will not work on platforms that do not support the C<-k> test for sticky bit. =item HIGH In addition to the MEDIUM security checks, also check for the possibility of ``chown() giveaway'' using the L sysconf() function. If this is a possibility, each directory in the path is checked in turn for safeness, recursively walking back to the root directory. For platforms that do not support the L C<_PC_CHOWN_RESTRICTED> symbol (for example, Windows NT) it is assumed that ``chown() giveaway'' is possible and the recursive test is performed. =back The level can be changed as follows: File::Temp->safe_level( File::Temp::HIGH ); The level constants are not exported by the module. Currently, you must be running at least perl v5.6.0 in order to run with MEDIUM or HIGH security. This is simply because the safety tests use functions from L that are not available in older versions of perl. The problem is that the version number for Fcntl is the same in perl 5.6.0 and in 5.005_03 even though they are different versions. On systems that do not support the HIGH or MEDIUM safety levels (for example Win NT or OS/2) any attempt to change the level will be ignored. The decision to ignore rather than raise an exception allows portable programs to be written with high security in mind for the systems that can support this without those programs failing on systems where the extra tests are irrelevant. If you really need to see whether the change has been accepted simply examine the return value of C. $newlevel = File::Temp->safe_level( File::Temp::HIGH ); die "Could not change to high security" if $newlevel != File::Temp::HIGH; =item TopSystemUID This is the highest UID on the current system that refers to a root UID. This is used to make sure that the temporary directory is owned by a system UID (C, C, C etc) rather than simply by root. This is required since on many unix systems C is not owned by root. Default is to assume that any UID less than or equal to 10 is a root UID. File::Temp->top_system_uid(10); my $topid = File::Temp->top_system_uid; This value can be adjusted to reduce security checking if required. The value is only relevant when C is set to MEDIUM or higher. =item B<$KEEP_ALL> Controls whether temporary files and directories should be retained regardless of any instructions in the program to remove them automatically. This is useful for debugging but should not be used in production code. $File::Temp::KEEP_ALL = 1; Default is for files to be removed as requested by the caller. In some cases, files will only be retained if this variable is true when the file is created. This means that you can not create a temporary file, set this variable and expect the temp file to still be around when the program exits. =item B<$DEBUG> Controls whether debugging messages should be enabled. $File::Temp::DEBUG = 1; Default is for debugging mode to be disabled. =back =head1 WARNING For maximum security, endeavour always to avoid ever looking at, touching, or even imputing the existence of the filename. You do not know that that filename is connected to the same file as the handle you have, and attempts to check this can only trigger more race conditions. It's far more secure to use the filehandle alone and dispense with the filename altogether. If you need to pass the handle to something that expects a filename then on a unix system you can use C<"/dev/fd/" . fileno($fh)> for arbitrary programs. Perl code that uses the 2-argument version of C<< open >> can be passed C<< "+<=&" . fileno($fh) >>. Otherwise you will need to pass the filename. You will have to clear the close-on-exec bit on that file descriptor before passing it to another process. use Fcntl qw/F_SETFD F_GETFD/; fcntl($tmpfh, F_SETFD, 0) or die "Can't clear close-on-exec flag on temp fh: $!\n"; =head2 Temporary files and NFS Some problems are associated with using temporary files that reside on NFS file systems and it is recommended that a local filesystem is used whenever possible. Some of the security tests will most probably fail when the temp file is not local. Additionally, be aware that the performance of I/O operations over NFS will not be as good as for a local disk. =head2 Forking In some cases files created by File::Temp are removed from within an END block. Since END blocks are triggered when a child process exits (unless C is used by the child) File::Temp takes care to only remove those temp files created by a particular process ID. This means that a child will not attempt to remove temp files created by the parent process. If you are forking many processes in parallel that are all creating temporary files, you may need to reset the random number seed using srand(EXPR) in each child else all the children will attempt to walk through the same set of random file names and may well cause themselves to give up if they exceed the number of retry attempts. =head2 Directory removal Note that if you have chdir'ed into the temporary directory and it is subsequently cleaned up (either in the END block or as part of object destruction), then you will get a warning from File::Path::rmtree(). =head2 Taint mode If you need to run code under taint mode, updating to the latest L is highly recommended. =head2 BINMODE The file returned by File::Temp will have been opened in binary mode if such a mode is available. If that is not correct, use the C function to change the mode of the filehandle. Note that you can modify the encoding of a file opened by File::Temp also by using C. =head1 HISTORY Originally began life in May 1999 as an XS interface to the system mkstemp() function. In March 2000, the OpenBSD mkstemp() code was translated to Perl for total control of the code's security checking, to ensure the presence of the function regardless of operating system and to help with portability. The module was shipped as a standard part of perl from v5.6.1. Thanks to Tom Christiansen for suggesting that this module should be written and providing ideas for code improvements and security enhancements. =head1 SEE ALSO L, L, L, L See L and L, L for different implementations of temporary file handling. See L for an alternative object-oriented wrapper for the C function. =for Pod::Coverage STRINGIFY NUMIFY top_system_uid # vim: ts=2 sts=2 sw=2 et: =for :stopwords cpan testmatrix url annocpan anno bugtracker rt cpants kwalitee diff irc mailto metadata placeholders metacpan =head1 SUPPORT =head2 Bugs / Feature Requests Please report any bugs or feature requests through the issue tracker at L. You will be notified automatically of any progress on your issue. =head2 Source Code This is open source software. The code repository is available for public review and contribution under the terms of the license. L git clone git://github.com/Perl-Toolchain-Gang/File-Temp.git =head1 AUTHOR Tim Jenness =head1 CONTRIBUTORS =over 4 =item * Ben Tilly =item * David Golden =item * Ed Avis =item * James E. Keenan =item * Kevin Ryde =item * Peter John Acklam =back =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Tim Jenness and the UK Particle Physics and Astronomy Research Council. 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 FILE_TEMP $fatpacked{"File/pushd.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'FILE_PUSHD'; use strict; use warnings; package File::pushd; # ABSTRACT: change directory temporarily for a limited scope our $VERSION = '1.005'; # VERSION our @EXPORT = qw( pushd tempd ); our @ISA = qw( Exporter ); use Exporter; use Carp; use Cwd qw( getcwd abs_path ); use File::Path qw( rmtree ); use File::Temp qw(); use File::Spec; use overload q{""} => sub { File::Spec->canonpath( $_[0]->{_pushd} ) }, fallback => 1; #--------------------------------------------------------------------------# # pushd() #--------------------------------------------------------------------------# sub pushd { my ($target_dir, $options) = @_; $options->{untaint_pattern} ||= qr{^([-+@\w./]+)$}; $target_dir = "." unless defined $target_dir; croak "Can't locate directory $target_dir" unless -d $target_dir; my $tainted_orig = getcwd; my $orig; if ( $tainted_orig =~ $options->{untaint_pattern} ) { $orig = $1; } else { $orig = $tainted_orig; } my $tainted_dest; eval { $tainted_dest = $target_dir ? abs_path( $target_dir ) : $orig }; croak "Can't locate absolute path for $target_dir: $@" if $@; my $dest; if ( $tainted_dest =~ $options->{untaint_pattern} ) { $dest = $1; } else { $dest = $tainted_dest; } if ($dest ne $orig) { chdir $dest or croak "Can't chdir to $dest\: $!"; } my $self = bless { _pushd => $dest, _original => $orig }, __PACKAGE__; return $self; } #--------------------------------------------------------------------------# # tempd() #--------------------------------------------------------------------------# sub tempd { my ($options) = @_; my $dir; eval { $dir = pushd( File::Temp::tempdir( CLEANUP => 0 ), $options ) }; croak $@ if $@; $dir->{_tempd} = 1; return $dir; } #--------------------------------------------------------------------------# # preserve() #--------------------------------------------------------------------------# sub preserve { my $self = shift; return 1 if ! $self->{"_tempd"}; if ( @_ == 0 ) { return $self->{_preserve} = 1; } else { return $self->{_preserve} = $_[0] ? 1 : 0; } } #--------------------------------------------------------------------------# # DESTROY() # Revert to original directory as object is destroyed and cleanup # if necessary #--------------------------------------------------------------------------# sub DESTROY { my ($self) = @_; my $orig = $self->{_original}; chdir $orig if $orig; # should always be so, but just in case... if ( $self->{_tempd} && !$self->{_preserve} ) { # don't destroy existing $@ if there is no error. my $err = do { local $@; eval { rmtree( $self->{_pushd} ) }; $@; }; carp $err if $err; } } 1; __END__ =pod =head1 NAME File::pushd - change directory temporarily for a limited scope =head1 VERSION version 1.005 =head1 SYNOPSIS use File::pushd; chdir $ENV{HOME}; # change directory again for a limited scope { my $dir = pushd( '/tmp' ); # working directory changed to /tmp } # working directory has reverted to $ENV{HOME} # tempd() is equivalent to pushd( File::Temp::tempdir ) { my $dir = tempd(); } # object stringifies naturally as an absolute path { my $dir = pushd( '/tmp' ); my $filename = File::Spec->catfile( $dir, "somefile.txt" ); # gives /tmp/somefile.txt } =head1 DESCRIPTION File::pushd does a temporary C<<< chdir >>> that is easily and automatically reverted, similar to C<<< pushd >>> in some Unix command shells. It works by creating an object that caches the original working directory. When the object is destroyed, the destructor calls C<<< chdir >>> to revert to the original working directory. By storing the object in a lexical variable with a limited scope, this happens automatically at the end of the scope. This is very handy when working with temporary directories for tasks like testing; a function is provided to streamline getting a temporary directory from L. For convenience, the object stringifies as the canonical form of the absolute pathname of the directory entered. =head1 USAGE use File::pushd; Using File::pushd automatically imports the C<<< pushd >>> and C<<< tempd >>> functions. =head2 pushd { my $dir = pushd( $target_directory ); } Caches the current working directory, calls C<<< chdir >>> to change to the target directory, and returns a File::pushd object. When the object is destroyed, the working directory reverts to the original directory. The provided target directory can be a relative or absolute path. If called with no arguments, it uses the current directory as its target and returns to the current directory when the object is destroyed. If the target directory does not exist or if the directory change fails for some reason, C<<< pushd >>> will die with an error message. Can be given a hashref as an optional second argument. The only supported option is C<<< untaint_pattern >>>, which is used to untaint file paths involved. It defaults to C<<< qr{^([-+@\w./]+)$} >>>, which is reasonably restrictive (e.g. it does not even allow spaces in the path). Change this to suit your circumstances and security needs if running under taint mode. B: you must include the parentheses in the pattern to capture the untainted portion of the path. =head2 tempd { my $dir = tempd(); } This function is like C<<< pushd >>> but automatically creates and calls C<<< chdir >>> to a temporary directory created by L. Unlike normal L cleanup which happens at the end of the program, this temporary directory is removed when the object is destroyed. (But also see C<<< preserve >>>.) A warning will be issued if the directory cannot be removed. As with C<<< pushd >>>, C<<< tempd >>> will die if C<<< chdir >>> fails. It may be given a single options hash that will be passed internally to CEpushdE. =head2 preserve { my $dir = tempd(); $dir->preserve; # mark to preserve at end of scope $dir->preserve(0); # mark to delete at end of scope } Controls whether a temporary directory will be cleaned up when the object is destroyed. With no arguments, C<<< preserve >>> sets the directory to be preserved. With an argument, the directory will be preserved if the argument is true, or marked for cleanup if the argument is false. Only C<<< tempd >>> objects may be marked for cleanup. (Target directories to C<<< pushd >>> are always preserved.) C<<< preserve >>> returns true if the directory will be preserved, and false otherwise. =head1 SEE ALSO =over =item * L =back =for :stopwords cpan testmatrix url annocpan anno bugtracker rt cpants kwalitee diff irc mailto metadata placeholders metacpan =head1 SUPPORT =head2 Bugs / Feature Requests Please report any bugs or feature requests through the issue tracker at L. You will be notified automatically of any progress on your issue. =head2 Source Code This is open source software. The code repository is available for public review and contribution under the terms of the license. L git clone git://github.com/dagolden/file-pushd.git =head1 AUTHOR David Golden =head1 CONTRIBUTOR Diab Jerius =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2013 by David A Golden. This is free software, licensed under: The Apache License, Version 2.0, January 2004 =cut FILE_PUSHD $fatpacked{"Getopt/Long.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'GETOPT_LONG'; #! perl # Getopt::Long.pm -- Universal options parsing # Author : Johan Vromans # Created On : Tue Sep 11 15:00:12 1990 # Last Modified By: Johan Vromans # Last Modified On: Mon Aug 12 17:05:46 2019 # Update Count : 1728 # Status : Released ################ Module Preamble ################ use 5.004; use strict; use warnings; package Getopt::Long; use vars qw($VERSION); $VERSION = 2.51; # For testing versions only. use vars qw($VERSION_STRING); $VERSION_STRING = "2.51"; use Exporter; use vars qw(@ISA @EXPORT @EXPORT_OK); @ISA = qw(Exporter); # Exported subroutines. sub GetOptions(@); # always sub GetOptionsFromArray(@); # on demand sub GetOptionsFromString(@); # on demand sub Configure(@); # on demand sub HelpMessage(@); # on demand sub VersionMessage(@); # in demand BEGIN { # Init immediately so their contents can be used in the 'use vars' below. @EXPORT = qw(&GetOptions $REQUIRE_ORDER $PERMUTE $RETURN_IN_ORDER); @EXPORT_OK = qw(&HelpMessage &VersionMessage &Configure &GetOptionsFromArray &GetOptionsFromString); } # User visible variables. use vars @EXPORT, @EXPORT_OK; use vars qw($error $debug $major_version $minor_version); # Deprecated visible variables. use vars qw($autoabbrev $getopt_compat $ignorecase $bundling $order $passthrough); # Official invisible variables. use vars qw($genprefix $caller $gnu_compat $auto_help $auto_version $longprefix); # Really invisible variables. my $bundling_values; # Public subroutines. sub config(@); # deprecated name # Private subroutines. sub ConfigDefaults(); sub ParseOptionSpec($$); sub OptCtl($); sub FindOption($$$$$); sub ValidValue ($$$$$); ################ Local Variables ################ # $requested_version holds the version that was mentioned in the 'use' # or 'require', if any. It can be used to enable or disable specific # features. my $requested_version = 0; ################ Resident subroutines ################ sub ConfigDefaults() { # Handle POSIX compliancy. if ( defined $ENV{"POSIXLY_CORRECT"} ) { $genprefix = "(--|-)"; $autoabbrev = 0; # no automatic abbrev of options $bundling = 0; # no bundling of single letter switches $getopt_compat = 0; # disallow '+' to start options $order = $REQUIRE_ORDER; } else { $genprefix = "(--|-|\\+)"; $autoabbrev = 1; # automatic abbrev of options $bundling = 0; # bundling off by default $getopt_compat = 1; # allow '+' to start options $order = $PERMUTE; } # Other configurable settings. $debug = 0; # for debugging $error = 0; # error tally $ignorecase = 1; # ignore case when matching options $passthrough = 0; # leave unrecognized options alone $gnu_compat = 0; # require --opt=val if value is optional $longprefix = "(--)"; # what does a long prefix look like $bundling_values = 0; # no bundling of values } # Override import. sub import { my $pkg = shift; # package my @syms = (); # symbols to import my @config = (); # configuration my $dest = \@syms; # symbols first for ( @_ ) { if ( $_ eq ':config' ) { $dest = \@config; # config next next; } push(@$dest, $_); # push } # Hide one level and call super. local $Exporter::ExportLevel = 1; push(@syms, qw(&GetOptions)) if @syms; # always export GetOptions $requested_version = 0; $pkg->SUPER::import(@syms); # And configure. Configure(@config) if @config; } ################ Initialization ################ # Values for $order. See GNU getopt.c for details. ($REQUIRE_ORDER, $PERMUTE, $RETURN_IN_ORDER) = (0..2); # Version major/minor numbers. ($major_version, $minor_version) = $VERSION =~ /^(\d+)\.(\d+)/; ConfigDefaults(); ################ OO Interface ################ package Getopt::Long::Parser; # Store a copy of the default configuration. Since ConfigDefaults has # just been called, what we get from Configure is the default. my $default_config = do { Getopt::Long::Configure () }; sub new { my $that = shift; my $class = ref($that) || $that; my %atts = @_; # Register the callers package. my $self = { caller_pkg => (caller)[0] }; bless ($self, $class); # Process config attributes. if ( defined $atts{config} ) { my $save = Getopt::Long::Configure ($default_config, @{$atts{config}}); $self->{settings} = Getopt::Long::Configure ($save); delete ($atts{config}); } # Else use default config. else { $self->{settings} = $default_config; } if ( %atts ) { # Oops die(__PACKAGE__.": unhandled attributes: ". join(" ", sort(keys(%atts)))."\n"); } $self; } sub configure { my ($self) = shift; # Restore settings, merge new settings in. my $save = Getopt::Long::Configure ($self->{settings}, @_); # Restore orig config and save the new config. $self->{settings} = Getopt::Long::Configure ($save); } sub getoptions { my ($self) = shift; return $self->getoptionsfromarray(\@ARGV, @_); } sub getoptionsfromarray { my ($self) = shift; # Restore config settings. my $save = Getopt::Long::Configure ($self->{settings}); # Call main routine. my $ret = 0; $Getopt::Long::caller = $self->{caller_pkg}; eval { # Locally set exception handler to default, otherwise it will # be called implicitly here, and again explicitly when we try # to deliver the messages. local ($SIG{__DIE__}) = 'DEFAULT'; $ret = Getopt::Long::GetOptionsFromArray (@_); }; # Restore saved settings. Getopt::Long::Configure ($save); # Handle errors and return value. die ($@) if $@; return $ret; } package Getopt::Long; ################ Back to Normal ################ # Indices in option control info. # Note that ParseOptions uses the fields directly. Search for 'hard-wired'. use constant CTL_TYPE => 0; #use constant CTL_TYPE_FLAG => ''; #use constant CTL_TYPE_NEG => '!'; #use constant CTL_TYPE_INCR => '+'; #use constant CTL_TYPE_INT => 'i'; #use constant CTL_TYPE_INTINC => 'I'; #use constant CTL_TYPE_XINT => 'o'; #use constant CTL_TYPE_FLOAT => 'f'; #use constant CTL_TYPE_STRING => 's'; use constant CTL_CNAME => 1; use constant CTL_DEFAULT => 2; use constant CTL_DEST => 3; use constant CTL_DEST_SCALAR => 0; use constant CTL_DEST_ARRAY => 1; use constant CTL_DEST_HASH => 2; use constant CTL_DEST_CODE => 3; use constant CTL_AMIN => 4; use constant CTL_AMAX => 5; # FFU. #use constant CTL_RANGE => ; #use constant CTL_REPEAT => ; # Rather liberal patterns to match numbers. use constant PAT_INT => "[-+]?_*[0-9][0-9_]*"; use constant PAT_XINT => "(?:". "[-+]?_*[1-9][0-9_]*". "|". "0x_*[0-9a-f][0-9a-f_]*". "|". "0b_*[01][01_]*". "|". "0[0-7_]*". ")"; use constant PAT_FLOAT => "[-+]?". # optional sign "(?=[0-9.])". # must start with digit or dec.point "[0-9_]*". # digits before the dec.point "(\.[0-9_]+)?". # optional fraction "([eE][-+]?[0-9_]+)?"; # optional exponent sub GetOptions(@) { # Shift in default array. unshift(@_, \@ARGV); # Try to keep caller() and Carp consistent. goto &GetOptionsFromArray; } sub GetOptionsFromString(@) { my ($string) = shift; require Text::ParseWords; my $args = [ Text::ParseWords::shellwords($string) ]; $caller ||= (caller)[0]; # current context my $ret = GetOptionsFromArray($args, @_); return ( $ret, $args ) if wantarray; if ( @$args ) { $ret = 0; warn("GetOptionsFromString: Excess data \"@$args\" in string \"$string\"\n"); } $ret; } sub GetOptionsFromArray(@) { my ($argv, @optionlist) = @_; # local copy of the option descriptions my $argend = '--'; # option list terminator my %opctl = (); # table of option specs my $pkg = $caller || (caller)[0]; # current context # Needed if linkage is omitted. my @ret = (); # accum for non-options my %linkage; # linkage my $userlinkage; # user supplied HASH my $opt; # current option my $prefix = $genprefix; # current prefix $error = ''; if ( $debug ) { # Avoid some warnings if debugging. local ($^W) = 0; print STDERR ("Getopt::Long $Getopt::Long::VERSION_STRING ", "called from package \"$pkg\".", "\n ", "argv: ", defined($argv) ? UNIVERSAL::isa( $argv, 'ARRAY' ) ? "(@$argv)" : $argv : "", "\n ", "autoabbrev=$autoabbrev,". "bundling=$bundling,", "bundling_values=$bundling_values,", "getopt_compat=$getopt_compat,", "gnu_compat=$gnu_compat,", "order=$order,", "\n ", "ignorecase=$ignorecase,", "requested_version=$requested_version,", "passthrough=$passthrough,", "genprefix=\"$genprefix\",", "longprefix=\"$longprefix\".", "\n"); } # Check for ref HASH as first argument. # First argument may be an object. It's OK to use this as long # as it is really a hash underneath. $userlinkage = undef; if ( @optionlist && ref($optionlist[0]) and UNIVERSAL::isa($optionlist[0],'HASH') ) { $userlinkage = shift (@optionlist); print STDERR ("=> user linkage: $userlinkage\n") if $debug; } # See if the first element of the optionlist contains option # starter characters. # Be careful not to interpret '<>' as option starters. if ( @optionlist && $optionlist[0] =~ /^\W+$/ && !($optionlist[0] eq '<>' && @optionlist > 0 && ref($optionlist[1])) ) { $prefix = shift (@optionlist); # Turn into regexp. Needs to be parenthesized! $prefix =~ s/(\W)/\\$1/g; $prefix = "([" . $prefix . "])"; print STDERR ("=> prefix=\"$prefix\"\n") if $debug; } # Verify correctness of optionlist. %opctl = (); while ( @optionlist ) { my $opt = shift (@optionlist); unless ( defined($opt) ) { $error .= "Undefined argument in option spec\n"; next; } # Strip leading prefix so people can specify "--foo=i" if they like. $opt = $+ if $opt =~ /^$prefix+(.*)$/s; if ( $opt eq '<>' ) { if ( (defined $userlinkage) && !(@optionlist > 0 && ref($optionlist[0])) && (exists $userlinkage->{$opt}) && ref($userlinkage->{$opt}) ) { unshift (@optionlist, $userlinkage->{$opt}); } unless ( @optionlist > 0 && ref($optionlist[0]) && ref($optionlist[0]) eq 'CODE' ) { $error .= "Option spec <> requires a reference to a subroutine\n"; # Kill the linkage (to avoid another error). shift (@optionlist) if @optionlist && ref($optionlist[0]); next; } $linkage{'<>'} = shift (@optionlist); next; } # Parse option spec. my ($name, $orig) = ParseOptionSpec ($opt, \%opctl); unless ( defined $name ) { # Failed. $orig contains the error message. Sorry for the abuse. $error .= $orig; # Kill the linkage (to avoid another error). shift (@optionlist) if @optionlist && ref($optionlist[0]); next; } # If no linkage is supplied in the @optionlist, copy it from # the userlinkage if available. if ( defined $userlinkage ) { unless ( @optionlist > 0 && ref($optionlist[0]) ) { if ( exists $userlinkage->{$orig} && ref($userlinkage->{$orig}) ) { print STDERR ("=> found userlinkage for \"$orig\": ", "$userlinkage->{$orig}\n") if $debug; unshift (@optionlist, $userlinkage->{$orig}); } else { # Do nothing. Being undefined will be handled later. next; } } } # Copy the linkage. If omitted, link to global variable. if ( @optionlist > 0 && ref($optionlist[0]) ) { print STDERR ("=> link \"$orig\" to $optionlist[0]\n") if $debug; my $rl = ref($linkage{$orig} = shift (@optionlist)); if ( $rl eq "ARRAY" ) { $opctl{$name}[CTL_DEST] = CTL_DEST_ARRAY; } elsif ( $rl eq "HASH" ) { $opctl{$name}[CTL_DEST] = CTL_DEST_HASH; } elsif ( $rl eq "SCALAR" || $rl eq "REF" ) { # if ( $opctl{$name}[CTL_DEST] == CTL_DEST_ARRAY ) { # my $t = $linkage{$orig}; # $$t = $linkage{$orig} = []; # } # elsif ( $opctl{$name}[CTL_DEST] == CTL_DEST_HASH ) { # } # else { # Ok. # } } elsif ( $rl eq "CODE" ) { # Ok. } else { $error .= "Invalid option linkage for \"$opt\"\n"; } } else { # Link to global $opt_XXX variable. # Make sure a valid perl identifier results. my $ov = $orig; $ov =~ s/\W/_/g; if ( $opctl{$name}[CTL_DEST] == CTL_DEST_ARRAY ) { print STDERR ("=> link \"$orig\" to \@$pkg","::opt_$ov\n") if $debug; eval ("\$linkage{\$orig} = \\\@".$pkg."::opt_$ov;"); } elsif ( $opctl{$name}[CTL_DEST] == CTL_DEST_HASH ) { print STDERR ("=> link \"$orig\" to \%$pkg","::opt_$ov\n") if $debug; eval ("\$linkage{\$orig} = \\\%".$pkg."::opt_$ov;"); } else { print STDERR ("=> link \"$orig\" to \$$pkg","::opt_$ov\n") if $debug; eval ("\$linkage{\$orig} = \\\$".$pkg."::opt_$ov;"); } } if ( $opctl{$name}[CTL_TYPE] eq 'I' && ( $opctl{$name}[CTL_DEST] == CTL_DEST_ARRAY || $opctl{$name}[CTL_DEST] == CTL_DEST_HASH ) ) { $error .= "Invalid option linkage for \"$opt\"\n"; } } $error .= "GetOptionsFromArray: 1st parameter is not an array reference\n" unless $argv && UNIVERSAL::isa( $argv, 'ARRAY' ); # Bail out if errors found. die ($error) if $error; $error = 0; # Supply --version and --help support, if needed and allowed. if ( defined($auto_version) ? $auto_version : ($requested_version >= 2.3203) ) { if ( !defined($opctl{version}) ) { $opctl{version} = ['','version',0,CTL_DEST_CODE,undef]; $linkage{version} = \&VersionMessage; } $auto_version = 1; } if ( defined($auto_help) ? $auto_help : ($requested_version >= 2.3203) ) { if ( !defined($opctl{help}) && !defined($opctl{'?'}) ) { $opctl{help} = $opctl{'?'} = ['','help',0,CTL_DEST_CODE,undef]; $linkage{help} = \&HelpMessage; } $auto_help = 1; } # Show the options tables if debugging. if ( $debug ) { my ($arrow, $k, $v); $arrow = "=> "; while ( ($k,$v) = each(%opctl) ) { print STDERR ($arrow, "\$opctl{$k} = $v ", OptCtl($v), "\n"); $arrow = " "; } } # Process argument list my $goon = 1; while ( $goon && @$argv > 0 ) { # Get next argument. $opt = shift (@$argv); print STDERR ("=> arg \"", $opt, "\"\n") if $debug; # Double dash is option list terminator. if ( defined($opt) && $opt eq $argend ) { push (@ret, $argend) if $passthrough; last; } # Look it up. my $tryopt = $opt; my $found; # success status my $key; # key (if hash type) my $arg; # option argument my $ctl; # the opctl entry ($found, $opt, $ctl, $arg, $key) = FindOption ($argv, $prefix, $argend, $opt, \%opctl); if ( $found ) { # FindOption undefines $opt in case of errors. next unless defined $opt; my $argcnt = 0; while ( defined $arg ) { # Get the canonical name. print STDERR ("=> cname for \"$opt\" is ") if $debug; $opt = $ctl->[CTL_CNAME]; print STDERR ("\"$ctl->[CTL_CNAME]\"\n") if $debug; if ( defined $linkage{$opt} ) { print STDERR ("=> ref(\$L{$opt}) -> ", ref($linkage{$opt}), "\n") if $debug; if ( ref($linkage{$opt}) eq 'SCALAR' || ref($linkage{$opt}) eq 'REF' ) { if ( $ctl->[CTL_TYPE] eq '+' ) { print STDERR ("=> \$\$L{$opt} += \"$arg\"\n") if $debug; if ( defined ${$linkage{$opt}} ) { ${$linkage{$opt}} += $arg; } else { ${$linkage{$opt}} = $arg; } } elsif ( $ctl->[CTL_DEST] == CTL_DEST_ARRAY ) { print STDERR ("=> ref(\$L{$opt}) auto-vivified", " to ARRAY\n") if $debug; my $t = $linkage{$opt}; $$t = $linkage{$opt} = []; print STDERR ("=> push(\@{\$L{$opt}, \"$arg\")\n") if $debug; push (@{$linkage{$opt}}, $arg); } elsif ( $ctl->[CTL_DEST] == CTL_DEST_HASH ) { print STDERR ("=> ref(\$L{$opt}) auto-vivified", " to HASH\n") if $debug; my $t = $linkage{$opt}; $$t = $linkage{$opt} = {}; print STDERR ("=> \$\$L{$opt}->{$key} = \"$arg\"\n") if $debug; $linkage{$opt}->{$key} = $arg; } else { print STDERR ("=> \$\$L{$opt} = \"$arg\"\n") if $debug; ${$linkage{$opt}} = $arg; } } elsif ( ref($linkage{$opt}) eq 'ARRAY' ) { print STDERR ("=> push(\@{\$L{$opt}, \"$arg\")\n") if $debug; push (@{$linkage{$opt}}, $arg); } elsif ( ref($linkage{$opt}) eq 'HASH' ) { print STDERR ("=> \$\$L{$opt}->{$key} = \"$arg\"\n") if $debug; $linkage{$opt}->{$key} = $arg; } elsif ( ref($linkage{$opt}) eq 'CODE' ) { print STDERR ("=> &L{$opt}(\"$opt\"", $ctl->[CTL_DEST] == CTL_DEST_HASH ? ", \"$key\"" : "", ", \"$arg\")\n") if $debug; my $eval_error = do { local $@; local $SIG{__DIE__} = 'DEFAULT'; eval { &{$linkage{$opt}} (Getopt::Long::CallBack->new (name => $opt, ctl => $ctl, opctl => \%opctl, linkage => \%linkage, prefix => $prefix, ), $ctl->[CTL_DEST] == CTL_DEST_HASH ? ($key) : (), $arg); }; $@; }; print STDERR ("=> die($eval_error)\n") if $debug && $eval_error ne ''; if ( $eval_error =~ /^!/ ) { if ( $eval_error =~ /^!FINISH\b/ ) { $goon = 0; } } elsif ( $eval_error ne '' ) { warn ($eval_error); $error++; } } else { print STDERR ("Invalid REF type \"", ref($linkage{$opt}), "\" in linkage\n"); die("Getopt::Long -- internal error!\n"); } } # No entry in linkage means entry in userlinkage. elsif ( $ctl->[CTL_DEST] == CTL_DEST_ARRAY ) { if ( defined $userlinkage->{$opt} ) { print STDERR ("=> push(\@{\$L{$opt}}, \"$arg\")\n") if $debug; push (@{$userlinkage->{$opt}}, $arg); } else { print STDERR ("=>\$L{$opt} = [\"$arg\"]\n") if $debug; $userlinkage->{$opt} = [$arg]; } } elsif ( $ctl->[CTL_DEST] == CTL_DEST_HASH ) { if ( defined $userlinkage->{$opt} ) { print STDERR ("=> \$L{$opt}->{$key} = \"$arg\"\n") if $debug; $userlinkage->{$opt}->{$key} = $arg; } else { print STDERR ("=>\$L{$opt} = {$key => \"$arg\"}\n") if $debug; $userlinkage->{$opt} = {$key => $arg}; } } else { if ( $ctl->[CTL_TYPE] eq '+' ) { print STDERR ("=> \$L{$opt} += \"$arg\"\n") if $debug; if ( defined $userlinkage->{$opt} ) { $userlinkage->{$opt} += $arg; } else { $userlinkage->{$opt} = $arg; } } else { print STDERR ("=>\$L{$opt} = \"$arg\"\n") if $debug; $userlinkage->{$opt} = $arg; } } $argcnt++; last if $argcnt >= $ctl->[CTL_AMAX] && $ctl->[CTL_AMAX] != -1; undef($arg); # Need more args? if ( $argcnt < $ctl->[CTL_AMIN] ) { if ( @$argv ) { if ( ValidValue($ctl, $argv->[0], 1, $argend, $prefix) ) { $arg = shift(@$argv); if ( $ctl->[CTL_TYPE] =~ /^[iIo]$/ ) { $arg =~ tr/_//d; $arg = $ctl->[CTL_TYPE] eq 'o' && $arg =~ /^0/ ? oct($arg) : 0+$arg } ($key,$arg) = $arg =~ /^([^=]+)=(.*)/ if $ctl->[CTL_DEST] == CTL_DEST_HASH; next; } warn("Value \"$$argv[0]\" invalid for option $opt\n"); $error++; } else { warn("Insufficient arguments for option $opt\n"); $error++; } } # Any more args? if ( @$argv && ValidValue($ctl, $argv->[0], 0, $argend, $prefix) ) { $arg = shift(@$argv); if ( $ctl->[CTL_TYPE] =~ /^[iIo]$/ ) { $arg =~ tr/_//d; $arg = $ctl->[CTL_TYPE] eq 'o' && $arg =~ /^0/ ? oct($arg) : 0+$arg } ($key,$arg) = $arg =~ /^([^=]+)=(.*)/ if $ctl->[CTL_DEST] == CTL_DEST_HASH; next; } } } # Not an option. Save it if we $PERMUTE and don't have a <>. elsif ( $order == $PERMUTE ) { # Try non-options call-back. my $cb; if ( defined ($cb = $linkage{'<>'}) ) { print STDERR ("=> &L{$tryopt}(\"$tryopt\")\n") if $debug; my $eval_error = do { local $@; local $SIG{__DIE__} = 'DEFAULT'; eval { # The arg to <> cannot be the CallBack object # since it may be passed to other modules that # get confused (e.g., Archive::Tar). Well, # it's not relevant for this callback anyway. &$cb($tryopt); }; $@; }; print STDERR ("=> die($eval_error)\n") if $debug && $eval_error ne ''; if ( $eval_error =~ /^!/ ) { if ( $eval_error =~ /^!FINISH\b/ ) { $goon = 0; } } elsif ( $eval_error ne '' ) { warn ($eval_error); $error++; } } else { print STDERR ("=> saving \"$tryopt\" ", "(not an option, may permute)\n") if $debug; push (@ret, $tryopt); } next; } # ...otherwise, terminate. else { # Push this one back and exit. unshift (@$argv, $tryopt); return ($error == 0); } } # Finish. if ( @ret && ( $order == $PERMUTE || $passthrough ) ) { # Push back accumulated arguments print STDERR ("=> restoring \"", join('" "', @ret), "\"\n") if $debug; unshift (@$argv, @ret); } return ($error == 0); } # A readable representation of what's in an optbl. sub OptCtl ($) { my ($v) = @_; my @v = map { defined($_) ? ($_) : ("") } @$v; "[". join(",", "\"$v[CTL_TYPE]\"", "\"$v[CTL_CNAME]\"", "\"$v[CTL_DEFAULT]\"", ("\$","\@","\%","\&")[$v[CTL_DEST] || 0], $v[CTL_AMIN] || '', $v[CTL_AMAX] || '', # $v[CTL_RANGE] || '', # $v[CTL_REPEAT] || '', ). "]"; } # Parse an option specification and fill the tables. sub ParseOptionSpec ($$) { my ($opt, $opctl) = @_; # Match option spec. if ( $opt !~ m;^ ( # Option name (?: \w+[-\w]* ) # Aliases (?: \| (?: . [^|!+=:]* )? )* )? ( # Either modifiers ... [!+] | # ... or a value/dest/repeat specification [=:] [ionfs] [@%]? (?: \{\d*,?\d*\} )? | # ... or an optional-with-default spec : (?: -?\d+ | \+ ) [@%]? )? $;x ) { return (undef, "Error in option spec: \"$opt\"\n"); } my ($names, $spec) = ($1, $2); $spec = '' unless defined $spec; # $orig keeps track of the primary name the user specified. # This name will be used for the internal or external linkage. # In other words, if the user specifies "FoO|BaR", it will # match any case combinations of 'foo' and 'bar', but if a global # variable needs to be set, it will be $opt_FoO in the exact case # as specified. my $orig; my @names; if ( defined $names ) { @names = split (/\|/, $names); $orig = $names[0]; } else { @names = (''); $orig = ''; } # Construct the opctl entries. my $entry; if ( $spec eq '' || $spec eq '+' || $spec eq '!' ) { # Fields are hard-wired here. $entry = [$spec,$orig,undef,CTL_DEST_SCALAR,0,0]; } elsif ( $spec =~ /^:(-?\d+|\+)([@%])?$/ ) { my $def = $1; my $dest = $2; my $type = $def eq '+' ? 'I' : 'i'; $dest ||= '$'; $dest = $dest eq '@' ? CTL_DEST_ARRAY : $dest eq '%' ? CTL_DEST_HASH : CTL_DEST_SCALAR; # Fields are hard-wired here. $entry = [$type,$orig,$def eq '+' ? undef : $def, $dest,0,1]; } else { my ($mand, $type, $dest) = $spec =~ /^([=:])([ionfs])([@%])?(\{(\d+)?(,)?(\d+)?\})?$/; return (undef, "Cannot repeat while bundling: \"$opt\"\n") if $bundling && defined($4); my ($mi, $cm, $ma) = ($5, $6, $7); return (undef, "{0} is useless in option spec: \"$opt\"\n") if defined($mi) && !$mi && !defined($ma) && !defined($cm); $type = 'i' if $type eq 'n'; $dest ||= '$'; $dest = $dest eq '@' ? CTL_DEST_ARRAY : $dest eq '%' ? CTL_DEST_HASH : CTL_DEST_SCALAR; # Default minargs to 1/0 depending on mand status. $mi = $mand eq '=' ? 1 : 0 unless defined $mi; # Adjust mand status according to minargs. $mand = $mi ? '=' : ':'; # Adjust maxargs. $ma = $mi ? $mi : 1 unless defined $ma || defined $cm; return (undef, "Max must be greater than zero in option spec: \"$opt\"\n") if defined($ma) && !$ma; return (undef, "Max less than min in option spec: \"$opt\"\n") if defined($ma) && $ma < $mi; # Fields are hard-wired here. $entry = [$type,$orig,undef,$dest,$mi,$ma||-1]; } # Process all names. First is canonical, the rest are aliases. my $dups = ''; foreach ( @names ) { $_ = lc ($_) if $ignorecase > (($bundling && length($_) == 1) ? 1 : 0); if ( exists $opctl->{$_} ) { $dups .= "Duplicate specification \"$opt\" for option \"$_\"\n"; } if ( $spec eq '!' ) { $opctl->{"no$_"} = $entry; $opctl->{"no-$_"} = $entry; $opctl->{$_} = [@$entry]; $opctl->{$_}->[CTL_TYPE] = ''; } else { $opctl->{$_} = $entry; } } if ( $dups && $^W ) { foreach ( split(/\n+/, $dups) ) { warn($_."\n"); } } ($names[0], $orig); } # Option lookup. sub FindOption ($$$$$) { # returns (1, $opt, $ctl, $arg, $key) if okay, # returns (1, undef) if option in error, # returns (0) otherwise. my ($argv, $prefix, $argend, $opt, $opctl) = @_; print STDERR ("=> find \"$opt\"\n") if $debug; return (0) unless defined($opt); return (0) unless $opt =~ /^($prefix)(.*)$/s; return (0) if $opt eq "-" && !defined $opctl->{''}; $opt = substr( $opt, length($1) ); # retain taintedness my $starter = $1; print STDERR ("=> split \"$starter\"+\"$opt\"\n") if $debug; my $optarg; # value supplied with --opt=value my $rest; # remainder from unbundling # If it is a long option, it may include the value. # With getopt_compat, only if not bundling. if ( ($starter=~/^$longprefix$/ || ($getopt_compat && ($bundling == 0 || $bundling == 2))) && (my $oppos = index($opt, '=', 1)) > 0) { my $optorg = $opt; $opt = substr($optorg, 0, $oppos); $optarg = substr($optorg, $oppos + 1); # retain tainedness print STDERR ("=> option \"", $opt, "\", optarg = \"$optarg\"\n") if $debug; } #### Look it up ### my $tryopt = $opt; # option to try if ( ( $bundling || $bundling_values ) && $starter eq '-' ) { # To try overrides, obey case ignore. $tryopt = $ignorecase ? lc($opt) : $opt; # If bundling == 2, long options can override bundles. if ( $bundling == 2 && length($tryopt) > 1 && defined ($opctl->{$tryopt}) ) { print STDERR ("=> $starter$tryopt overrides unbundling\n") if $debug; } # If bundling_values, option may be followed by the value. elsif ( $bundling_values ) { $tryopt = $opt; # Unbundle single letter option. $rest = length ($tryopt) > 0 ? substr ($tryopt, 1) : ''; $tryopt = substr ($tryopt, 0, 1); $tryopt = lc ($tryopt) if $ignorecase > 1; print STDERR ("=> $starter$tryopt unbundled from ", "$starter$tryopt$rest\n") if $debug; # Whatever remains may not be considered an option. $optarg = $rest eq '' ? undef : $rest; $rest = undef; } # Split off a single letter and leave the rest for # further processing. else { $tryopt = $opt; # Unbundle single letter option. $rest = length ($tryopt) > 0 ? substr ($tryopt, 1) : ''; $tryopt = substr ($tryopt, 0, 1); $tryopt = lc ($tryopt) if $ignorecase > 1; print STDERR ("=> $starter$tryopt unbundled from ", "$starter$tryopt$rest\n") if $debug; $rest = undef unless $rest ne ''; } } # Try auto-abbreviation. elsif ( $autoabbrev && $opt ne "" ) { # Sort the possible long option names. my @names = sort(keys (%$opctl)); # Downcase if allowed. $opt = lc ($opt) if $ignorecase; $tryopt = $opt; # Turn option name into pattern. my $pat = quotemeta ($opt); # Look up in option names. my @hits = grep (/^$pat/, @names); print STDERR ("=> ", scalar(@hits), " hits (@hits) with \"$pat\" ", "out of ", scalar(@names), "\n") if $debug; # Check for ambiguous results. unless ( (@hits <= 1) || (grep ($_ eq $opt, @hits) == 1) ) { # See if all matches are for the same option. my %hit; foreach ( @hits ) { my $hit = $opctl->{$_}->[CTL_CNAME] if defined $opctl->{$_}->[CTL_CNAME]; $hit = "no" . $hit if $opctl->{$_}->[CTL_TYPE] eq '!'; $hit{$hit} = 1; } # Remove auto-supplied options (version, help). if ( keys(%hit) == 2 ) { if ( $auto_version && exists($hit{version}) ) { delete $hit{version}; } elsif ( $auto_help && exists($hit{help}) ) { delete $hit{help}; } } # Now see if it really is ambiguous. unless ( keys(%hit) == 1 ) { return (0) if $passthrough; warn ("Option ", $opt, " is ambiguous (", join(", ", @hits), ")\n"); $error++; return (1, undef); } @hits = keys(%hit); } # Complete the option name, if appropriate. if ( @hits == 1 && $hits[0] ne $opt ) { $tryopt = $hits[0]; $tryopt = lc ($tryopt) if $ignorecase > (($bundling && length($tryopt) == 1) ? 1 : 0); print STDERR ("=> option \"$opt\" -> \"$tryopt\"\n") if $debug; } } # Map to all lowercase if ignoring case. elsif ( $ignorecase ) { $tryopt = lc ($opt); } # Check validity by fetching the info. my $ctl = $opctl->{$tryopt}; unless ( defined $ctl ) { return (0) if $passthrough; # Pretend one char when bundling. if ( $bundling == 1 && length($starter) == 1 ) { $opt = substr($opt,0,1); unshift (@$argv, $starter.$rest) if defined $rest; } if ( $opt eq "" ) { warn ("Missing option after ", $starter, "\n"); } else { warn ("Unknown option: ", $opt, "\n"); } $error++; return (1, undef); } # Apparently valid. $opt = $tryopt; print STDERR ("=> found ", OptCtl($ctl), " for \"", $opt, "\"\n") if $debug; #### Determine argument status #### # If it is an option w/o argument, we're almost finished with it. my $type = $ctl->[CTL_TYPE]; my $arg; if ( $type eq '' || $type eq '!' || $type eq '+' ) { if ( defined $optarg ) { return (0) if $passthrough; warn ("Option ", $opt, " does not take an argument\n"); $error++; undef $opt; undef $optarg if $bundling_values; } elsif ( $type eq '' || $type eq '+' ) { # Supply explicit value. $arg = 1; } else { $opt =~ s/^no-?//i; # strip NO prefix $arg = 0; # supply explicit value } unshift (@$argv, $starter.$rest) if defined $rest; return (1, $opt, $ctl, $arg); } # Get mandatory status and type info. my $mand = $ctl->[CTL_AMIN]; # Check if there is an option argument available. if ( $gnu_compat ) { my $optargtype = 0; # none, 1 = empty, 2 = nonempty, 3 = aux if ( defined($optarg) ) { $optargtype = (length($optarg) == 0) ? 1 : 2; } elsif ( defined $rest || @$argv > 0 ) { # GNU getopt_long() does not accept the (optional) # argument to be passed to the option without = sign. # We do, since not doing so breaks existing scripts. $optargtype = 3; } if(($optargtype == 0) && !$mand) { if ( $type eq 'I' ) { # Fake incremental type. my @c = @$ctl; $c[CTL_TYPE] = '+'; return (1, $opt, \@c, 1); } my $val = defined($ctl->[CTL_DEFAULT]) ? $ctl->[CTL_DEFAULT] : $type eq 's' ? '' : 0; return (1, $opt, $ctl, $val); } return (1, $opt, $ctl, $type eq 's' ? '' : 0) if $optargtype == 1; # --foo= -> return nothing } # Check if there is an option argument available. if ( defined $optarg ? ($optarg eq '') : !(defined $rest || @$argv > 0) ) { # Complain if this option needs an argument. # if ( $mand && !($type eq 's' ? defined($optarg) : 0) ) { if ( $mand ) { return (0) if $passthrough; warn ("Option ", $opt, " requires an argument\n"); $error++; return (1, undef); } if ( $type eq 'I' ) { # Fake incremental type. my @c = @$ctl; $c[CTL_TYPE] = '+'; return (1, $opt, \@c, 1); } return (1, $opt, $ctl, defined($ctl->[CTL_DEFAULT]) ? $ctl->[CTL_DEFAULT] : $type eq 's' ? '' : 0); } # Get (possibly optional) argument. $arg = (defined $rest ? $rest : (defined $optarg ? $optarg : shift (@$argv))); # Get key if this is a "name=value" pair for a hash option. my $key; if ($ctl->[CTL_DEST] == CTL_DEST_HASH && defined $arg) { ($key, $arg) = ($arg =~ /^([^=]*)=(.*)$/s) ? ($1, $2) : ($arg, defined($ctl->[CTL_DEFAULT]) ? $ctl->[CTL_DEFAULT] : ($mand ? undef : ($type eq 's' ? "" : 1))); if (! defined $arg) { warn ("Option $opt, key \"$key\", requires a value\n"); $error++; # Push back. unshift (@$argv, $starter.$rest) if defined $rest; return (1, undef); } } #### Check if the argument is valid for this option #### my $key_valid = $ctl->[CTL_DEST] == CTL_DEST_HASH ? "[^=]+=" : ""; if ( $type eq 's' ) { # string # A mandatory string takes anything. return (1, $opt, $ctl, $arg, $key) if $mand; # Same for optional string as a hash value return (1, $opt, $ctl, $arg, $key) if $ctl->[CTL_DEST] == CTL_DEST_HASH; # An optional string takes almost anything. return (1, $opt, $ctl, $arg, $key) if defined $optarg || defined $rest; return (1, $opt, $ctl, $arg, $key) if $arg eq "-"; # ?? # Check for option or option list terminator. if ($arg eq $argend || $arg =~ /^$prefix.+/) { # Push back. unshift (@$argv, $arg); # Supply empty value. $arg = ''; } } elsif ( $type eq 'i' # numeric/integer || $type eq 'I' # numeric/integer w/ incr default || $type eq 'o' ) { # dec/oct/hex/bin value my $o_valid = $type eq 'o' ? PAT_XINT : PAT_INT; if ( $bundling && defined $rest && $rest =~ /^($key_valid)($o_valid)(.*)$/si ) { ($key, $arg, $rest) = ($1, $2, $+); chop($key) if $key; $arg = ($type eq 'o' && $arg =~ /^0/) ? oct($arg) : 0+$arg; unshift (@$argv, $starter.$rest) if defined $rest && $rest ne ''; } elsif ( $arg =~ /^$o_valid$/si ) { $arg =~ tr/_//d; $arg = ($type eq 'o' && $arg =~ /^0/) ? oct($arg) : 0+$arg; } else { if ( defined $optarg || $mand ) { if ( $passthrough ) { unshift (@$argv, defined $rest ? $starter.$rest : $arg) unless defined $optarg; return (0); } warn ("Value \"", $arg, "\" invalid for option ", $opt, " (", $type eq 'o' ? "extended " : '', "number expected)\n"); $error++; # Push back. unshift (@$argv, $starter.$rest) if defined $rest; return (1, undef); } else { # Push back. unshift (@$argv, defined $rest ? $starter.$rest : $arg); if ( $type eq 'I' ) { # Fake incremental type. my @c = @$ctl; $c[CTL_TYPE] = '+'; return (1, $opt, \@c, 1); } # Supply default value. $arg = defined($ctl->[CTL_DEFAULT]) ? $ctl->[CTL_DEFAULT] : 0; } } } elsif ( $type eq 'f' ) { # real number, int is also ok my $o_valid = PAT_FLOAT; if ( $bundling && defined $rest && $rest =~ /^($key_valid)($o_valid)(.*)$/s ) { $arg =~ tr/_//d; ($key, $arg, $rest) = ($1, $2, $+); chop($key) if $key; unshift (@$argv, $starter.$rest) if defined $rest && $rest ne ''; } elsif ( $arg =~ /^$o_valid$/ ) { $arg =~ tr/_//d; } else { if ( defined $optarg || $mand ) { if ( $passthrough ) { unshift (@$argv, defined $rest ? $starter.$rest : $arg) unless defined $optarg; return (0); } warn ("Value \"", $arg, "\" invalid for option ", $opt, " (real number expected)\n"); $error++; # Push back. unshift (@$argv, $starter.$rest) if defined $rest; return (1, undef); } else { # Push back. unshift (@$argv, defined $rest ? $starter.$rest : $arg); # Supply default value. $arg = 0.0; } } } else { die("Getopt::Long internal error (Can't happen)\n"); } return (1, $opt, $ctl, $arg, $key); } sub ValidValue ($$$$$) { my ($ctl, $arg, $mand, $argend, $prefix) = @_; if ( $ctl->[CTL_DEST] == CTL_DEST_HASH ) { return 0 unless $arg =~ /[^=]+=(.*)/; $arg = $1; } my $type = $ctl->[CTL_TYPE]; if ( $type eq 's' ) { # string # A mandatory string takes anything. return (1) if $mand; return (1) if $arg eq "-"; # Check for option or option list terminator. return 0 if $arg eq $argend || $arg =~ /^$prefix.+/; return 1; } elsif ( $type eq 'i' # numeric/integer || $type eq 'I' # numeric/integer w/ incr default || $type eq 'o' ) { # dec/oct/hex/bin value my $o_valid = $type eq 'o' ? PAT_XINT : PAT_INT; return $arg =~ /^$o_valid$/si; } elsif ( $type eq 'f' ) { # real number, int is also ok my $o_valid = PAT_FLOAT; return $arg =~ /^$o_valid$/; } die("ValidValue: Cannot happen\n"); } # Getopt::Long Configuration. sub Configure (@) { my (@options) = @_; my $prevconfig = [ $error, $debug, $major_version, $minor_version, $caller, $autoabbrev, $getopt_compat, $ignorecase, $bundling, $order, $gnu_compat, $passthrough, $genprefix, $auto_version, $auto_help, $longprefix, $bundling_values ]; if ( ref($options[0]) eq 'ARRAY' ) { ( $error, $debug, $major_version, $minor_version, $caller, $autoabbrev, $getopt_compat, $ignorecase, $bundling, $order, $gnu_compat, $passthrough, $genprefix, $auto_version, $auto_help, $longprefix, $bundling_values ) = @{shift(@options)}; } my $opt; foreach $opt ( @options ) { my $try = lc ($opt); my $action = 1; if ( $try =~ /^no_?(.*)$/s ) { $action = 0; $try = $+; } if ( ($try eq 'default' or $try eq 'defaults') && $action ) { ConfigDefaults (); } elsif ( ($try eq 'posix_default' or $try eq 'posix_defaults') ) { local $ENV{POSIXLY_CORRECT}; $ENV{POSIXLY_CORRECT} = 1 if $action; ConfigDefaults (); } elsif ( $try eq 'auto_abbrev' or $try eq 'autoabbrev' ) { $autoabbrev = $action; } elsif ( $try eq 'getopt_compat' ) { $getopt_compat = $action; $genprefix = $action ? "(--|-|\\+)" : "(--|-)"; } elsif ( $try eq 'gnu_getopt' ) { if ( $action ) { $gnu_compat = 1; $bundling = 1; $getopt_compat = 0; $genprefix = "(--|-)"; $order = $PERMUTE; $bundling_values = 0; } } elsif ( $try eq 'gnu_compat' ) { $gnu_compat = $action; $bundling = 0; $bundling_values = 1; } elsif ( $try =~ /^(auto_?)?version$/ ) { $auto_version = $action; } elsif ( $try =~ /^(auto_?)?help$/ ) { $auto_help = $action; } elsif ( $try eq 'ignorecase' or $try eq 'ignore_case' ) { $ignorecase = $action; } elsif ( $try eq 'ignorecase_always' or $try eq 'ignore_case_always' ) { $ignorecase = $action ? 2 : 0; } elsif ( $try eq 'bundling' ) { $bundling = $action; $bundling_values = 0 if $action; } elsif ( $try eq 'bundling_override' ) { $bundling = $action ? 2 : 0; $bundling_values = 0 if $action; } elsif ( $try eq 'bundling_values' ) { $bundling_values = $action; $bundling = 0 if $action; } elsif ( $try eq 'require_order' ) { $order = $action ? $REQUIRE_ORDER : $PERMUTE; } elsif ( $try eq 'permute' ) { $order = $action ? $PERMUTE : $REQUIRE_ORDER; } elsif ( $try eq 'pass_through' or $try eq 'passthrough' ) { $passthrough = $action; } elsif ( $try =~ /^prefix=(.+)$/ && $action ) { $genprefix = $1; # Turn into regexp. Needs to be parenthesized! $genprefix = "(" . quotemeta($genprefix) . ")"; eval { '' =~ /$genprefix/; }; die("Getopt::Long: invalid pattern \"$genprefix\"\n") if $@; } elsif ( $try =~ /^prefix_pattern=(.+)$/ && $action ) { $genprefix = $1; # Parenthesize if needed. $genprefix = "(" . $genprefix . ")" unless $genprefix =~ /^\(.*\)$/; eval { '' =~ m"$genprefix"; }; die("Getopt::Long: invalid pattern \"$genprefix\"\n") if $@; } elsif ( $try =~ /^long_prefix_pattern=(.+)$/ && $action ) { $longprefix = $1; # Parenthesize if needed. $longprefix = "(" . $longprefix . ")" unless $longprefix =~ /^\(.*\)$/; eval { '' =~ m"$longprefix"; }; die("Getopt::Long: invalid long prefix pattern \"$longprefix\"\n") if $@; } elsif ( $try eq 'debug' ) { $debug = $action; } else { die("Getopt::Long: unknown or erroneous config parameter \"$opt\"\n") } } $prevconfig; } # Deprecated name. sub config (@) { Configure (@_); } # Issue a standard message for --version. # # The arguments are mostly the same as for Pod::Usage::pod2usage: # # - a number (exit value) # - a string (lead in message) # - a hash with options. See Pod::Usage for details. # sub VersionMessage(@) { # Massage args. my $pa = setup_pa_args("version", @_); my $v = $main::VERSION; my $fh = $pa->{-output} || ( ($pa->{-exitval} eq "NOEXIT" || $pa->{-exitval} < 2) ? \*STDOUT : \*STDERR ); print $fh (defined($pa->{-message}) ? $pa->{-message} : (), $0, defined $v ? " version $v" : (), "\n", "(", __PACKAGE__, "::", "GetOptions", " version ", defined($Getopt::Long::VERSION_STRING) ? $Getopt::Long::VERSION_STRING : $VERSION, ";", " Perl version ", $] >= 5.006 ? sprintf("%vd", $^V) : $], ")\n"); exit($pa->{-exitval}) unless $pa->{-exitval} eq "NOEXIT"; } # Issue a standard message for --help. # # The arguments are the same as for Pod::Usage::pod2usage: # # - a number (exit value) # - a string (lead in message) # - a hash with options. See Pod::Usage for details. # sub HelpMessage(@) { eval { require Pod::Usage; import Pod::Usage; 1; } || die("Cannot provide help: cannot load Pod::Usage\n"); # Note that pod2usage will issue a warning if -exitval => NOEXIT. pod2usage(setup_pa_args("help", @_)); } # Helper routine to set up a normalized hash ref to be used as # argument to pod2usage. sub setup_pa_args($@) { my $tag = shift; # who's calling # If called by direct binding to an option, it will get the option # name and value as arguments. Remove these, if so. @_ = () if @_ == 2 && $_[0] eq $tag; my $pa; if ( @_ > 1 ) { $pa = { @_ }; } else { $pa = shift || {}; } # At this point, $pa can be a number (exit value), string # (message) or hash with options. if ( UNIVERSAL::isa($pa, 'HASH') ) { # Get rid of -msg vs. -message ambiguity. $pa->{-message} = $pa->{-msg}; delete($pa->{-msg}); } elsif ( $pa =~ /^-?\d+$/ ) { $pa = { -exitval => $pa }; } else { $pa = { -message => $pa }; } # These are _our_ defaults. $pa->{-verbose} = 0 unless exists($pa->{-verbose}); $pa->{-exitval} = 0 unless exists($pa->{-exitval}); $pa; } # Sneak way to know what version the user requested. sub VERSION { $requested_version = $_[1] if @_ > 1; shift->SUPER::VERSION(@_); } package Getopt::Long::CallBack; sub new { my ($pkg, %atts) = @_; bless { %atts }, $pkg; } sub name { my $self = shift; ''.$self->{name}; } use overload # Treat this object as an ordinary string for legacy API. '""' => \&name, fallback => 1; 1; ################ Documentation ################ =head1 NAME Getopt::Long - Extended processing of command line options =head1 SYNOPSIS use Getopt::Long; my $data = "file.dat"; my $length = 24; my $verbose; GetOptions ("length=i" => \$length, # numeric "file=s" => \$data, # string "verbose" => \$verbose) # flag or die("Error in command line arguments\n"); =head1 DESCRIPTION The Getopt::Long module implements an extended getopt function called GetOptions(). It parses the command line from C<@ARGV>, recognizing and removing specified options and their possible values. This function adheres to the POSIX syntax for command line options, with GNU extensions. In general, this means that options have long names instead of single letters, and are introduced with a double dash "--". Support for bundling of command line options, as was the case with the more traditional single-letter approach, is provided but not enabled by default. =head1 Command Line Options, an Introduction Command line operated programs traditionally take their arguments from the command line, for example filenames or other information that the program needs to know. Besides arguments, these programs often take command line I as well. Options are not necessary for the program to work, hence the name 'option', but are used to modify its default behaviour. For example, a program could do its job quietly, but with a suitable option it could provide verbose information about what it did. Command line options come in several flavours. Historically, they are preceded by a single dash C<->, and consist of a single letter. -l -a -c Usually, these single-character options can be bundled: -lac Options can have values, the value is placed after the option character. Sometimes with whitespace in between, sometimes not: -s 24 -s24 Due to the very cryptic nature of these options, another style was developed that used long names. So instead of a cryptic C<-l> one could use the more descriptive C<--long>. To distinguish between a bundle of single-character options and a long one, two dashes are used to precede the option name. Early implementations of long options used a plus C<+> instead. Also, option values could be specified either like --size=24 or --size 24 The C<+> form is now obsolete and strongly deprecated. =head1 Getting Started with Getopt::Long Getopt::Long is the Perl5 successor of C. This was the first Perl module that provided support for handling the new style of command line options, in particular long option names, hence the Perl5 name Getopt::Long. This module also supports single-character options and bundling. To use Getopt::Long from a Perl program, you must include the following line in your Perl program: use Getopt::Long; This will load the core of the Getopt::Long module and prepare your program for using it. Most of the actual Getopt::Long code is not loaded until you really call one of its functions. In the default configuration, options names may be abbreviated to uniqueness, case does not matter, and a single dash is sufficient, even for long option names. Also, options may be placed between non-option arguments. See L for more details on how to configure Getopt::Long. =head2 Simple options The most simple options are the ones that take no values. Their mere presence on the command line enables the option. Popular examples are: --all --verbose --quiet --debug Handling simple options is straightforward: my $verbose = ''; # option variable with default value (false) my $all = ''; # option variable with default value (false) GetOptions ('verbose' => \$verbose, 'all' => \$all); The call to GetOptions() parses the command line arguments that are present in C<@ARGV> and sets the option variable to the value C<1> if the option did occur on the command line. Otherwise, the option variable is not touched. Setting the option value to true is often called I the option. The option name as specified to the GetOptions() function is called the option I. Later we'll see that this specification can contain more than just the option name. The reference to the variable is called the option I. GetOptions() will return a true value if the command line could be processed successfully. Otherwise, it will write error messages using die() and warn(), and return a false result. =head2 A little bit less simple options Getopt::Long supports two useful variants of simple options: I options and I options. A negatable option is specified with an exclamation mark C after the option name: my $verbose = ''; # option variable with default value (false) GetOptions ('verbose!' => \$verbose); Now, using C<--verbose> on the command line will enable C<$verbose>, as expected. But it is also allowed to use C<--noverbose>, which will disable C<$verbose> by setting its value to C<0>. Using a suitable default value, the program can find out whether C<$verbose> is false by default, or disabled by using C<--noverbose>. An incremental option is specified with a plus C<+> after the option name: my $verbose = ''; # option variable with default value (false) GetOptions ('verbose+' => \$verbose); Using C<--verbose> on the command line will increment the value of C<$verbose>. This way the program can keep track of how many times the option occurred on the command line. For example, each occurrence of C<--verbose> could increase the verbosity level of the program. =head2 Mixing command line option with other arguments Usually programs take command line options as well as other arguments, for example, file names. It is good practice to always specify the options first, and the other arguments last. Getopt::Long will, however, allow the options and arguments to be mixed and 'filter out' all the options before passing the rest of the arguments to the program. To stop Getopt::Long from processing further arguments, insert a double dash C<--> on the command line: --size 24 -- --all In this example, C<--all> will I be treated as an option, but passed to the program unharmed, in C<@ARGV>. =head2 Options with values For options that take values it must be specified whether the option value is required or not, and what kind of value the option expects. Three kinds of values are supported: integer numbers, floating point numbers, and strings. If the option value is required, Getopt::Long will take the command line argument that follows the option and assign this to the option variable. If, however, the option value is specified as optional, this will only be done if that value does not look like a valid command line option itself. my $tag = ''; # option variable with default value GetOptions ('tag=s' => \$tag); In the option specification, the option name is followed by an equals sign C<=> and the letter C. The equals sign indicates that this option requires a value. The letter C indicates that this value is an arbitrary string. Other possible value types are C for integer values, and C for floating point values. Using a colon C<:> instead of the equals sign indicates that the option value is optional. In this case, if no suitable value is supplied, string valued options get an empty string C<''> assigned, while numeric options are set to C<0>. =head2 Options with multiple values Options sometimes take several values. For example, a program could use multiple directories to search for library files: --library lib/stdlib --library lib/extlib To accomplish this behaviour, simply specify an array reference as the destination for the option: GetOptions ("library=s" => \@libfiles); Alternatively, you can specify that the option can have multiple values by adding a "@", and pass a reference to a scalar as the destination: GetOptions ("library=s@" => \$libfiles); Used with the example above, C<@libfiles> c.q. C<@$libfiles> would contain two strings upon completion: C<"lib/stdlib"> and C<"lib/extlib">, in that order. It is also possible to specify that only integer or floating point numbers are acceptable values. Often it is useful to allow comma-separated lists of values as well as multiple occurrences of the options. This is easy using Perl's split() and join() operators: GetOptions ("library=s" => \@libfiles); @libfiles = split(/,/,join(',',@libfiles)); Of course, it is important to choose the right separator string for each purpose. Warning: What follows is an experimental feature. Options can take multiple values at once, for example --coordinates 52.2 16.4 --rgbcolor 255 255 149 This can be accomplished by adding a repeat specifier to the option specification. Repeat specifiers are very similar to the C<{...}> repeat specifiers that can be used with regular expression patterns. For example, the above command line would be handled as follows: GetOptions('coordinates=f{2}' => \@coor, 'rgbcolor=i{3}' => \@color); The destination for the option must be an array or array reference. It is also possible to specify the minimal and maximal number of arguments an option takes. C indicates an option that takes at least two and at most 4 arguments. C indicates one or more values; C indicates zero or more option values. =head2 Options with hash values If the option destination is a reference to a hash, the option will take, as value, strings of the form IC<=>I. The value will be stored with the specified key in the hash. GetOptions ("define=s" => \%defines); Alternatively you can use: GetOptions ("define=s%" => \$defines); When used with command line options: --define os=linux --define vendor=redhat the hash C<%defines> (or C<%$defines>) will contain two keys, C<"os"> with value C<"linux"> and C<"vendor"> with value C<"redhat">. It is also possible to specify that only integer or floating point numbers are acceptable values. The keys are always taken to be strings. =head2 User-defined subroutines to handle options Ultimate control over what should be done when (actually: each time) an option is encountered on the command line can be achieved by designating a reference to a subroutine (or an anonymous subroutine) as the option destination. When GetOptions() encounters the option, it will call the subroutine with two or three arguments. The first argument is the name of the option. (Actually, it is an object that stringifies to the name of the option.) For a scalar or array destination, the second argument is the value to be stored. For a hash destination, the second argument is the key to the hash, and the third argument the value to be stored. It is up to the subroutine to store the value, or do whatever it thinks is appropriate. A trivial application of this mechanism is to implement options that are related to each other. For example: my $verbose = ''; # option variable with default value (false) GetOptions ('verbose' => \$verbose, 'quiet' => sub { $verbose = 0 }); Here C<--verbose> and C<--quiet> control the same variable C<$verbose>, but with opposite values. If the subroutine needs to signal an error, it should call die() with the desired error message as its argument. GetOptions() will catch the die(), issue the error message, and record that an error result must be returned upon completion. If the text of the error message starts with an exclamation mark C it is interpreted specially by GetOptions(). There is currently one special command implemented: C will cause GetOptions() to stop processing options, as if it encountered a double dash C<-->. In version 2.37 the first argument to the callback function was changed from string to object. This was done to make room for extensions and more detailed control. The object stringifies to the option name so this change should not introduce compatibility problems. Here is an example of how to access the option name and value from within a subroutine: GetOptions ('opt=i' => \&handler); sub handler { my ($opt_name, $opt_value) = @_; print("Option name is $opt_name and value is $opt_value\n"); } =head2 Options with multiple names Often it is user friendly to supply alternate mnemonic names for options. For example C<--height> could be an alternate name for C<--length>. Alternate names can be included in the option specification, separated by vertical bar C<|> characters. To implement the above example: GetOptions ('length|height=f' => \$length); The first name is called the I name, the other names are called I. When using a hash to store options, the key will always be the primary name. Multiple alternate names are possible. =head2 Case and abbreviations Without additional configuration, GetOptions() will ignore the case of option names, and allow the options to be abbreviated to uniqueness. GetOptions ('length|height=f' => \$length, "head" => \$head); This call will allow C<--l> and C<--L> for the length option, but requires a least C<--hea> and C<--hei> for the head and height options. =head2 Summary of Option Specifications Each option specifier consists of two parts: the name specification and the argument specification. The name specification contains the name of the option, optionally followed by a list of alternative names separated by vertical bar characters. length option name is "length" length|size|l name is "length", aliases are "size" and "l" The argument specification is optional. If omitted, the option is considered boolean, a value of 1 will be assigned when the option is used on the command line. The argument specification can be =over 4 =item ! The option does not take an argument and may be negated by prefixing it with "no" or "no-". E.g. C<"foo!"> will allow C<--foo> (a value of 1 will be assigned) as well as C<--nofoo> and C<--no-foo> (a value of 0 will be assigned). If the option has aliases, this applies to the aliases as well. Using negation on a single letter option when bundling is in effect is pointless and will result in a warning. =item + The option does not take an argument and will be incremented by 1 every time it appears on the command line. E.g. C<"more+">, when used with C<--more --more --more>, will increment the value three times, resulting in a value of 3 (provided it was 0 or undefined at first). The C<+> specifier is ignored if the option destination is not a scalar. =item = I [ I ] [ I ] The option requires an argument of the given type. Supported types are: =over 4 =item s String. An arbitrary sequence of characters. It is valid for the argument to start with C<-> or C<-->. =item i Integer. An optional leading plus or minus sign, followed by a sequence of digits. =item o Extended integer, Perl style. This can be either an optional leading plus or minus sign, followed by a sequence of digits, or an octal string (a zero, optionally followed by '0', '1', .. '7'), or a hexadecimal string (C<0x> followed by '0' .. '9', 'a' .. 'f', case insensitive), or a binary string (C<0b> followed by a series of '0' and '1'). =item f Real number. For example C<3.14>, C<-6.23E24> and so on. =back The I can be C<@> or C<%> to specify that the option is list or a hash valued. This is only needed when the destination for the option value is not otherwise specified. It should be omitted when not needed. The I specifies the number of values this option takes per occurrence on the command line. It has the format C<{> [ I ] [ C<,> [ I ] ] C<}>. I denotes the minimal number of arguments. It defaults to 1 for options with C<=> and to 0 for options with C<:>, see below. Note that I overrules the C<=> / C<:> semantics. I denotes the maximum number of arguments. It must be at least I. If I is omitted, I, there is no upper bound to the number of argument values taken. =item : I [ I ] Like C<=>, but designates the argument as optional. If omitted, an empty string will be assigned to string values options, and the value zero to numeric options. Note that if a string argument starts with C<-> or C<-->, it will be considered an option on itself. =item : I [ I ] Like C<:i>, but if the value is omitted, the I will be assigned. =item : + [ I ] Like C<:i>, but if the value is omitted, the current value for the option will be incremented. =back =head1 Advanced Possibilities =head2 Object oriented interface Getopt::Long can be used in an object oriented way as well: use Getopt::Long; $p = Getopt::Long::Parser->new; $p->configure(...configuration options...); if ($p->getoptions(...options descriptions...)) ... if ($p->getoptionsfromarray( \@array, ...options descriptions...)) ... Configuration options can be passed to the constructor: $p = new Getopt::Long::Parser config => [...configuration options...]; =head2 Thread Safety Getopt::Long is thread safe when using ithreads as of Perl 5.8. It is I thread safe when using the older (experimental and now obsolete) threads implementation that was added to Perl 5.005. =head2 Documentation and help texts Getopt::Long encourages the use of Pod::Usage to produce help messages. For example: use Getopt::Long; use Pod::Usage; my $man = 0; my $help = 0; GetOptions('help|?' => \$help, man => \$man) or pod2usage(2); pod2usage(1) if $help; pod2usage(-exitval => 0, -verbose => 2) if $man; __END__ =head1 NAME sample - Using Getopt::Long and Pod::Usage =head1 SYNOPSIS sample [options] [file ...] Options: -help brief help message -man full documentation =head1 OPTIONS =over 8 =item B<-help> Print a brief help message and exits. =item B<-man> Prints the manual page and exits. =back =head1 DESCRIPTION B will read the given input file(s) and do something useful with the contents thereof. =cut See L for details. =head2 Parsing options from an arbitrary array By default, GetOptions parses the options that are present in the global array C<@ARGV>. A special entry C can be used to parse options from an arbitrary array. use Getopt::Long qw(GetOptionsFromArray); $ret = GetOptionsFromArray(\@myopts, ...); When used like this, options and their possible values are removed from C<@myopts>, the global C<@ARGV> is not touched at all. The following two calls behave identically: $ret = GetOptions( ... ); $ret = GetOptionsFromArray(\@ARGV, ... ); This also means that a first argument hash reference now becomes the second argument: $ret = GetOptions(\%opts, ... ); $ret = GetOptionsFromArray(\@ARGV, \%opts, ... ); =head2 Parsing options from an arbitrary string A special entry C can be used to parse options from an arbitrary string. use Getopt::Long qw(GetOptionsFromString); $ret = GetOptionsFromString($string, ...); The contents of the string are split into arguments using a call to C. As with C, the global C<@ARGV> is not touched. It is possible that, upon completion, not all arguments in the string have been processed. C will, when called in list context, return both the return status and an array reference to any remaining arguments: ($ret, $args) = GetOptionsFromString($string, ... ); If any arguments remain, and C was not called in list context, a message will be given and C will return failure. As with GetOptionsFromArray, a first argument hash reference now becomes the second argument. =head2 Storing options values in a hash Sometimes, for example when there are a lot of options, having a separate variable for each of them can be cumbersome. GetOptions() supports, as an alternative mechanism, storing options values in a hash. To obtain this, a reference to a hash must be passed I to GetOptions(). For each option that is specified on the command line, the option value will be stored in the hash with the option name as key. Options that are not actually used on the command line will not be put in the hash, on other words, C (or defined()) can be used to test if an option was used. The drawback is that warnings will be issued if the program runs under C and uses C<$h{option}> without testing with exists() or defined() first. my %h = (); GetOptions (\%h, 'length=i'); # will store in $h{length} For options that take list or hash values, it is necessary to indicate this by appending an C<@> or C<%> sign after the type: GetOptions (\%h, 'colours=s@'); # will push to @{$h{colours}} To make things more complicated, the hash may contain references to the actual destinations, for example: my $len = 0; my %h = ('length' => \$len); GetOptions (\%h, 'length=i'); # will store in $len This example is fully equivalent with: my $len = 0; GetOptions ('length=i' => \$len); # will store in $len Any mixture is possible. For example, the most frequently used options could be stored in variables while all other options get stored in the hash: my $verbose = 0; # frequently referred my $debug = 0; # frequently referred my %h = ('verbose' => \$verbose, 'debug' => \$debug); GetOptions (\%h, 'verbose', 'debug', 'filter', 'size=i'); if ( $verbose ) { ... } if ( exists $h{filter} ) { ... option 'filter' was specified ... } =head2 Bundling With bundling it is possible to set several single-character options at once. For example if C, C and C are all valid options, -vax will set all three. Getopt::Long supports three styles of bundling. To enable bundling, a call to Getopt::Long::Configure is required. The simplest style of bundling can be enabled with: Getopt::Long::Configure ("bundling"); Configured this way, single-character options can be bundled but long options B always start with a double dash C<--> to avoid ambiguity. For example, when C, C, C and C are all valid options, -vax will set C, C and C, but --vax will set C. The second style of bundling lifts this restriction. It can be enabled with: Getopt::Long::Configure ("bundling_override"); Now, C<-vax> will set the option C. In all of the above cases, option values may be inserted in the bundle. For example: -h24w80 is equivalent to -h 24 -w 80 A third style of bundling allows only values to be bundled with options. It can be enabled with: Getopt::Long::Configure ("bundling_values"); Now, C<-h24> will set the option C to C<24>, but option bundles like C<-vxa> and C<-h24w80> are flagged as errors. Enabling C will disable the other two styles of bundling. When configured for bundling, single-character options are matched case sensitive while long options are matched case insensitive. To have the single-character options matched case insensitive as well, use: Getopt::Long::Configure ("bundling", "ignorecase_always"); It goes without saying that bundling can be quite confusing. =head2 The lonesome dash Normally, a lone dash C<-> on the command line will not be considered an option. Option processing will terminate (unless "permute" is configured) and the dash will be left in C<@ARGV>. It is possible to get special treatment for a lone dash. This can be achieved by adding an option specification with an empty name, for example: GetOptions ('' => \$stdio); A lone dash on the command line will now be a legal option, and using it will set variable C<$stdio>. =head2 Argument callback A special option 'name' C<< <> >> can be used to designate a subroutine to handle non-option arguments. When GetOptions() encounters an argument that does not look like an option, it will immediately call this subroutine and passes it one parameter: the argument name. For example: my $width = 80; sub process { ... } GetOptions ('width=i' => \$width, '<>' => \&process); When applied to the following command line: arg1 --width=72 arg2 --width=60 arg3 This will call C while C<$width> is C<80>, C while C<$width> is C<72>, and C while C<$width> is C<60>. This feature requires configuration option B, see section L. =head1 Configuring Getopt::Long Getopt::Long can be configured by calling subroutine Getopt::Long::Configure(). This subroutine takes a list of quoted strings, each specifying a configuration option to be enabled, e.g. C, or disabled, e.g. C. Case does not matter. Multiple calls to Configure() are possible. Alternatively, as of version 2.24, the configuration options may be passed together with the C statement: use Getopt::Long qw(:config no_ignore_case bundling); The following options are available: =over 12 =item default This option causes all configuration options to be reset to their default values. =item posix_default This option causes all configuration options to be reset to their default values as if the environment variable POSIXLY_CORRECT had been set. =item auto_abbrev Allow option names to be abbreviated to uniqueness. Default is enabled unless environment variable POSIXLY_CORRECT has been set, in which case C is disabled. =item getopt_compat Allow C<+> to start options. Default is enabled unless environment variable POSIXLY_CORRECT has been set, in which case C is disabled. =item gnu_compat C controls whether C<--opt=> is allowed, and what it should do. Without C, C<--opt=> gives an error. With C, C<--opt=> will give option C and empty value. This is the way GNU getopt_long() does it. Note that C<--opt value> is still accepted, even though GNU getopt_long() doesn't. =item gnu_getopt This is a short way of setting C C C C. With C, command line handling should be reasonably compatible with GNU getopt_long(). =item require_order Whether command line arguments are allowed to be mixed with options. Default is disabled unless environment variable POSIXLY_CORRECT has been set, in which case C is enabled. See also C, which is the opposite of C. =item permute Whether command line arguments are allowed to be mixed with options. Default is enabled unless environment variable POSIXLY_CORRECT has been set, in which case C is disabled. Note that C is the opposite of C. If C is enabled, this means that --foo arg1 --bar arg2 arg3 is equivalent to --foo --bar arg1 arg2 arg3 If an argument callback routine is specified, C<@ARGV> will always be empty upon successful return of GetOptions() since all options have been processed. The only exception is when C<--> is used: --foo arg1 --bar arg2 -- arg3 This will call the callback routine for arg1 and arg2, and then terminate GetOptions() leaving C<"arg3"> in C<@ARGV>. If C is enabled, options processing terminates when the first non-option is encountered. --foo arg1 --bar arg2 arg3 is equivalent to --foo -- arg1 --bar arg2 arg3 If C is also enabled, options processing will terminate at the first unrecognized option, or non-option, whichever comes first. =item bundling (default: disabled) Enabling this option will allow single-character options to be bundled. To distinguish bundles from long option names, long options I be introduced with C<--> and bundles with C<->. Note that, if you have options C, C and C, and auto_abbrev enabled, possible arguments and option settings are: using argument sets option(s) ------------------------------------------ -a, --a a -l, --l l -al, -la, -ala, -all,... a, l --al, --all all The surprising part is that C<--a> sets option C (due to auto completion), not C. Note: disabling C also disables C. =item bundling_override (default: disabled) If C is enabled, bundling is enabled as with C but now long option names override option bundles. Note: disabling C also disables C. B Using option bundling can easily lead to unexpected results, especially when mixing long options and bundles. Caveat emptor. =item ignore_case (default: enabled) If enabled, case is ignored when matching option names. If, however, bundling is enabled as well, single character options will be treated case-sensitive. With C, option specifications for options that only differ in case, e.g., C<"foo"> and C<"Foo">, will be flagged as duplicates. Note: disabling C also disables C. =item ignore_case_always (default: disabled) When bundling is in effect, case is ignored on single-character options also. Note: disabling C also disables C. =item auto_version (default:disabled) Automatically provide support for the B<--version> option if the application did not specify a handler for this option itself. Getopt::Long will provide a standard version message that includes the program name, its version (if $main::VERSION is defined), and the versions of Getopt::Long and Perl. The message will be written to standard output and processing will terminate. C will be enabled if the calling program explicitly specified a version number higher than 2.32 in the C or C statement. =item auto_help (default:disabled) Automatically provide support for the B<--help> and B<-?> options if the application did not specify a handler for this option itself. Getopt::Long will provide a help message using module L. The message, derived from the SYNOPSIS POD section, will be written to standard output and processing will terminate. C will be enabled if the calling program explicitly specified a version number higher than 2.32 in the C or C statement. =item pass_through (default: disabled) With C anything that is unknown, ambiguous or supplied with an invalid option will not be flagged as an error. Instead the unknown option(s) will be passed to the catchall C<< <> >> if present, otherwise through to C<@ARGV>. This makes it possible to write wrapper scripts that process only part of the user supplied command line arguments, and pass the remaining options to some other program. If C is enabled, options processing will terminate at the first unrecognized option, or non-option, whichever comes first and all remaining arguments are passed to C<@ARGV> instead of the catchall C<< <> >> if present. However, if C is enabled instead, results can become confusing. Note that the options terminator (default C<-->), if present, will also be passed through in C<@ARGV>. =item prefix The string that starts options. If a constant string is not sufficient, see C. =item prefix_pattern A Perl pattern that identifies the strings that introduce options. Default is C<--|-|\+> unless environment variable POSIXLY_CORRECT has been set, in which case it is C<--|->. =item long_prefix_pattern A Perl pattern that allows the disambiguation of long and short prefixes. Default is C<-->. Typically you only need to set this if you are using nonstandard prefixes and want some or all of them to have the same semantics as '--' does under normal circumstances. For example, setting prefix_pattern to C<--|-|\+|\/> and long_prefix_pattern to C<--|\/> would add Win32 style argument handling. =item debug (default: disabled) Enable debugging output. =back =head1 Exportable Methods =over =item VersionMessage This subroutine provides a standard version message. Its argument can be: =over 4 =item * A string containing the text of a message to print I printing the standard message. =item * A numeric value corresponding to the desired exit status. =item * A reference to a hash. =back If more than one argument is given then the entire argument list is assumed to be a hash. If a hash is supplied (either as a reference or as a list) it should contain one or more elements with the following keys: =over 4 =item C<-message> =item C<-msg> The text of a message to print immediately prior to printing the program's usage message. =item C<-exitval> The desired exit status to pass to the B function. This should be an integer, or else the string "NOEXIT" to indicate that control should simply be returned without terminating the invoking process. =item C<-output> A reference to a filehandle, or the pathname of a file to which the usage message should be written. The default is C<\*STDERR> unless the exit value is less than 2 (in which case the default is C<\*STDOUT>). =back You cannot tie this routine directly to an option, e.g.: GetOptions("version" => \&VersionMessage); Use this instead: GetOptions("version" => sub { VersionMessage() }); =item HelpMessage This subroutine produces a standard help message, derived from the program's POD section SYNOPSIS using L. It takes the same arguments as VersionMessage(). In particular, you cannot tie it directly to an option, e.g.: GetOptions("help" => \&HelpMessage); Use this instead: GetOptions("help" => sub { HelpMessage() }); =back =head1 Return values and Errors Configuration errors and errors in the option definitions are signalled using die() and will terminate the calling program unless the call to Getopt::Long::GetOptions() was embedded in C, or die() was trapped using C<$SIG{__DIE__}>. GetOptions returns true to indicate success. It returns false when the function detected one or more errors during option parsing. These errors are signalled using warn() and can be trapped with C<$SIG{__WARN__}>. =head1 Legacy The earliest development of C started in 1990, with Perl version 4. As a result, its development, and the development of Getopt::Long, has gone through several stages. Since backward compatibility has always been extremely important, the current version of Getopt::Long still supports a lot of constructs that nowadays are no longer necessary or otherwise unwanted. This section describes briefly some of these 'features'. =head2 Default destinations When no destination is specified for an option, GetOptions will store the resultant value in a global variable named CI, where I is the primary name of this option. When a program executes under C (recommended), these variables must be pre-declared with our() or C. our $opt_length = 0; GetOptions ('length=i'); # will store in $opt_length To yield a usable Perl variable, characters that are not part of the syntax for variables are translated to underscores. For example, C<--fpp-struct-return> will set the variable C<$opt_fpp_struct_return>. Note that this variable resides in the namespace of the calling program, not necessarily C
. For example: GetOptions ("size=i", "sizes=i@"); with command line "-size 10 -sizes 24 -sizes 48" will perform the equivalent of the assignments $opt_size = 10; @opt_sizes = (24, 48); =head2 Alternative option starters A string of alternative option starter characters may be passed as the first argument (or the first argument after a leading hash reference argument). my $len = 0; GetOptions ('/', 'length=i' => $len); Now the command line may look like: /length 24 -- arg Note that to terminate options processing still requires a double dash C<-->. GetOptions() will not interpret a leading C<< "<>" >> as option starters if the next argument is a reference. To force C<< "<" >> and C<< ">" >> as option starters, use C<< "><" >>. Confusing? Well, B anyway. =head2 Configuration variables Previous versions of Getopt::Long used variables for the purpose of configuring. Although manipulating these variables still work, it is strongly encouraged to use the C routine that was introduced in version 2.17. Besides, it is much easier. =head1 Tips and Techniques =head2 Pushing multiple values in a hash option Sometimes you want to combine the best of hashes and arrays. For example, the command line: --list add=first --list add=second --list add=third where each successive 'list add' option will push the value of add into array ref $list->{'add'}. The result would be like $list->{add} = [qw(first second third)]; This can be accomplished with a destination routine: GetOptions('list=s%' => sub { push(@{$list{$_[1]}}, $_[2]) }); =head1 Troubleshooting =head2 GetOptions does not return a false result when an option is not supplied That's why they're called 'options'. =head2 GetOptions does not split the command line correctly The command line is not split by GetOptions, but by the command line interpreter (CLI). On Unix, this is the shell. On Windows, it is COMMAND.COM or CMD.EXE. Other operating systems have other CLIs. It is important to know that these CLIs may behave different when the command line contains special characters, in particular quotes or backslashes. For example, with Unix shells you can use single quotes (C<'>) and double quotes (C<">) to group words together. The following alternatives are equivalent on Unix: "two words" 'two words' two\ words In case of doubt, insert the following statement in front of your Perl program: print STDERR (join("|",@ARGV),"\n"); to verify how your CLI passes the arguments to the program. =head2 Undefined subroutine &main::GetOptions called Are you running Windows, and did you write use GetOpt::Long; (note the capital 'O')? =head2 How do I put a "-?" option into a Getopt::Long? You can only obtain this using an alias, and Getopt::Long of at least version 2.13. use Getopt::Long; GetOptions ("help|?"); # -help and -? will both set $opt_help Other characters that can't appear in Perl identifiers are also supported in aliases with Getopt::Long of at version 2.39. Note that the characters C, C<|>, C<+>, C<=>, and C<:> can only appear as the first (or only) character of an alias. As of version 2.32 Getopt::Long provides auto-help, a quick and easy way to add the options --help and -? to your program, and handle them. See C in section L. =head1 AUTHOR Johan Vromans =head1 COPYRIGHT AND DISCLAIMER This program is Copyright 1990,2015 by Johan Vromans. This program is free software; you can redistribute it and/or modify it under the terms of the Perl Artistic License or the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. If you do not have a copy of the GNU General Public License write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. =cut GETOPT_LONG $fatpacked{"Module/Pluggable.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MODULE_PLUGGABLE'; package Module::Pluggable; use strict; use vars qw($VERSION $FORCE_SEARCH_ALL_PATHS); use Module::Pluggable::Object; use if $] > 5.017, 'deprecate'; # ObQuote: # Bob Porter: Looks like you've been missing a lot of work lately. # Peter Gibbons: I wouldn't say I've been missing it, Bob! $VERSION = '4.8'; $FORCE_SEARCH_ALL_PATHS = 0; sub import { my $class = shift; my %opts = @_; my ($pkg, $file) = caller; # the default name for the method is 'plugins' my $sub = $opts{'sub_name'} || 'plugins'; # get our package my ($package) = $opts{'package'} || $pkg; $opts{filename} = $file; $opts{package} = $package; $opts{force_search_all_paths} = $FORCE_SEARCH_ALL_PATHS unless exists $opts{force_search_all_paths}; my $finder = Module::Pluggable::Object->new(%opts); my $subroutine = sub { my $self = shift; return $finder->plugins(@_) }; my $searchsub = sub { my $self = shift; my ($action,@paths) = @_; $finder->{'search_path'} = ["${package}::Plugin"] if ($action eq 'add' and not $finder->{'search_path'} ); push @{$finder->{'search_path'}}, @paths if ($action eq 'add'); $finder->{'search_path'} = \@paths if ($action eq 'new'); return $finder->{'search_path'}; }; my $onlysub = sub { my ($self, $only) = @_; if (defined $only) { $finder->{'only'} = $only; }; return $finder->{'only'}; }; my $exceptsub = sub { my ($self, $except) = @_; if (defined $except) { $finder->{'except'} = $except; }; return $finder->{'except'}; }; no strict 'refs'; no warnings qw(redefine prototype); *{"$package\::$sub"} = $subroutine; *{"$package\::search_path"} = $searchsub; *{"$package\::only"} = $onlysub; *{"$package\::except"} = $exceptsub; } 1; =pod =head1 NAME Module::Pluggable - automatically give your module the ability to have plugins =head1 SYNOPSIS Simple use Module::Pluggable - package MyClass; use Module::Pluggable; and then later ... use MyClass; my $mc = MyClass->new(); # returns the names of all plugins installed under MyClass::Plugin::* my @plugins = $mc->plugins(); =head1 EXAMPLE Why would you want to do this? Say you have something that wants to pass an object to a number of different plugins in turn. For example you may want to extract meta-data from every email you get sent and do something with it. Plugins make sense here because then you can keep adding new meta data parsers and all the logic and docs for each one will be self contained and new handlers are easy to add without changing the core code. For that, you might do something like ... package Email::Examiner; use strict; use Email::Simple; use Module::Pluggable require => 1; sub handle_email { my $self = shift; my $email = shift; foreach my $plugin ($self->plugins) { $plugin->examine($email); } return 1; } .. and all the plugins will get a chance in turn to look at it. This can be trivially extended so that plugins could save the email somewhere and then no other plugin should try and do that. Simply have it so that the C method returns C<1> if it has saved the email somewhere. You might also want to be paranoid and check to see if the plugin has an C method. foreach my $plugin ($self->plugins) { next unless $plugin->can('examine'); last if $plugin->examine($email); } And so on. The sky's the limit. =head1 DESCRIPTION Provides a simple but, hopefully, extensible way of having 'plugins' for your module. Obviously this isn't going to be the be all and end all of solutions but it works for me. Essentially all it does is export a method into your namespace that looks through a search path for .pm files and turn those into class names. Optionally it instantiates those classes for you. =head1 ADVANCED USAGE Alternatively, if you don't want to use 'plugins' as the method ... package MyClass; use Module::Pluggable sub_name => 'foo'; and then later ... my @plugins = $mc->foo(); Or if you want to look in another namespace package MyClass; use Module::Pluggable search_path => ['Acme::MyClass::Plugin', 'MyClass::Extend']; or directory use Module::Pluggable search_dirs => ['mylibs/Foo']; Or if you want to instantiate each plugin rather than just return the name package MyClass; use Module::Pluggable instantiate => 'new'; and then # whatever is passed to 'plugins' will be passed # to 'new' for each plugin my @plugins = $mc->plugins(@options); alternatively you can just require the module without instantiating it package MyClass; use Module::Pluggable require => 1; since requiring automatically searches inner packages, which may not be desirable, you can turn this off package MyClass; use Module::Pluggable require => 1, inner => 0; You can limit the plugins loaded using the except option, either as a string, array ref or regex package MyClass; use Module::Pluggable except => 'MyClass::Plugin::Foo'; or package MyClass; use Module::Pluggable except => ['MyClass::Plugin::Foo', 'MyClass::Plugin::Bar']; or package MyClass; use Module::Pluggable except => qr/^MyClass::Plugin::(Foo|Bar)$/; and similarly for only which will only load plugins which match. Remember you can use the module more than once package MyClass; use Module::Pluggable search_path => 'MyClass::Filters' sub_name => 'filters'; use Module::Pluggable search_path => 'MyClass::Plugins' sub_name => 'plugins'; and then later ... my @filters = $self->filters; my @plugins = $self->plugins; =head1 PLUGIN SEARCHING Every time you call 'plugins' the whole search path is walked again. This allows for dynamically loading plugins even at run time. However this can get expensive and so if you don't expect to want to add new plugins at run time you could do package Foo; use strict; use Module::Pluggable sub_name => '_plugins'; our @PLUGINS; sub plugins { @PLUGINS ||= shift->_plugins } 1; =head1 INNER PACKAGES If you have, for example, a file B that contains package definitions for both C and C then as long as you either have either the B or B option set then we'll also find C. Nifty! =head1 OPTIONS You can pass a hash of options when importing this module. The options can be ... =head2 sub_name The name of the subroutine to create in your namespace. By default this is 'plugins' =head2 search_path An array ref of namespaces to look in. =head2 search_dirs An array ref of directories to look in before @INC. =head2 instantiate Call this method on the class. In general this will probably be 'new' but it can be whatever you want. Whatever arguments are passed to 'plugins' will be passed to the method. The default is 'undef' i.e just return the class name. =head2 require Just require the class, don't instantiate (overrides 'instantiate'); =head2 inner If set to 0 will B search inner packages. If set to 1 will override C. =head2 only Takes a string, array ref or regex describing the names of the only plugins to return. Whilst this may seem perverse ... well, it is. But it also makes sense. Trust me. =head2 except Similar to C it takes a description of plugins to exclude from returning. This is slightly less perverse. =head2 package This is for use by extension modules which build on C: passing a C option allows you to place the plugin method in a different package other than your own. =head2 file_regex By default C only looks for I<.pm> files. By supplying a new C then you can change this behaviour e.g file_regex => qr/\.plugin$/ =head2 include_editor_junk By default C ignores files that look like they were left behind by editors. Currently this means files ending in F<~> (~), the extensions F<.swp> or F<.swo>, or files beginning with F<.#>. Setting C changes C so it does not ignore any files it finds. =head2 follow_symlinks Whether, when searching directories, to follow symlinks. Defaults to 1 i.e do follow symlinks. =head2 min_depth, max_depth This will allow you to set what 'depth' of plugin will be allowed. So, for example, C will have a depth of 3 and C will have a depth of 4 so to only get the former (i.e C) do package MyClass; use Module::Pluggable max_depth => 3; and to only get the latter (i.e C) package MyClass; use Module::Pluggable min_depth => 4; =head1 TRIGGERS Various triggers can also be passed in to the options. If any of these triggers return 0 then the plugin will not be returned. =head2 before_require Gets passed the plugin name. If 0 is returned then this plugin will not be required either. =head2 on_require_error Gets called when there's an error on requiring the plugin. Gets passed the plugin name and the error. The default on_require_error handler is to C the error and return 0. =head2 on_instantiate_error Gets called when there's an error on instantiating the plugin. Gets passed the plugin name and the error. The default on_instantiate_error handler is to C the error and return 0. =head2 after_require Gets passed the plugin name. If 0 is returned then this plugin will be required but not returned as a plugin. =head1 METHODs =head2 search_path The method C is exported into you namespace as well. You can call that at any time to change or replace the search_path. $self->search_path( add => "New::Path" ); # add $self->search_path( new => "New::Path" ); # replace =head1 BEHAVIOUR UNDER TEST ENVIRONMENT In order to make testing reliable we exclude anything not from blib if blib.pm is in %INC. However if the module being tested used another module that itself used C then the second module would fail. This was fixed by checking to see if the caller had (^|/)blib/ in their filename. There's an argument that this is the wrong behaviour and that modules should explicitly trigger this behaviour but that particular code has been around for 7 years now and I'm reluctant to change the default behaviour. You can now (as of version 4.1) force Module::Pluggable to look outside blib in a test environment by doing either require Module::Pluggable; $Module::Pluggable::FORCE_SEARCH_ALL_PATHS = 1; import Module::Pluggable; or use Module::Pluggable force_search_all_paths => 1; =head1 FUTURE PLANS This does everything I need and I can't really think of any other features I want to add. Famous last words of course Recently tried fixed to find inner packages and to make it 'just work' with PAR but there are still some issues. However suggestions (and patches) are welcome. =head1 DEVELOPMENT The master repo for this module is at https://github.com/simonwistow/Module-Pluggable =head1 AUTHOR Simon Wistow =head1 COPYING Copyright, 2006 Simon Wistow Distributed under the same terms as Perl itself. =head1 BUGS None known. =head1 SEE ALSO L, L, L, L, L =cut MODULE_PLUGGABLE $fatpacked{"Module/Pluggable/Object.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MODULE_PLUGGABLE_OBJECT'; package Module::Pluggable::Object; use strict; use File::Find (); use File::Basename; use File::Spec::Functions qw(splitdir catdir curdir catfile abs2rel); use Carp qw(croak carp confess); use Devel::InnerPackage; use vars qw($VERSION); use if $] > 5.017, 'deprecate'; $VERSION = '4.8'; sub new { my $class = shift; my %opts = @_; return bless \%opts, $class; } ### Eugggh, this code smells ### This is what happens when you keep adding patches ### *sigh* sub plugins { my $self = shift; my @args = @_; # override 'require' $self->{'require'} = 1 if $self->{'inner'}; my $filename = $self->{'filename'}; my $pkg = $self->{'package'}; # Get the exception params instantiated $self->_setup_exceptions; # automatically turn a scalar search path or namespace into a arrayref for (qw(search_path search_dirs)) { $self->{$_} = [ $self->{$_} ] if exists $self->{$_} && !ref($self->{$_}); } # default search path is '::::Plugin' $self->{'search_path'} ||= ["${pkg}::Plugin"]; # default error handler $self->{'on_require_error'} ||= sub { my ($plugin, $err) = @_; carp "Couldn't require $plugin : $err"; return 0 }; $self->{'on_instantiate_error'} ||= sub { my ($plugin, $err) = @_; carp "Couldn't instantiate $plugin: $err"; return 0 }; # default whether to follow symlinks $self->{'follow_symlinks'} = 1 unless exists $self->{'follow_symlinks'}; # check to see if we're running under test my @SEARCHDIR = exists $INC{"blib.pm"} && defined $filename && $filename =~ m!(^|/)blib/! && !$self->{'force_search_all_paths'} ? grep {/blib/} @INC : @INC; # add any search_dir params unshift @SEARCHDIR, @{$self->{'search_dirs'}} if defined $self->{'search_dirs'}; # set our @INC up to include and prefer our search_dirs if necessary my @tmp = @INC; unshift @tmp, @{$self->{'search_dirs'} || []}; local @INC = @tmp if defined $self->{'search_dirs'}; my @plugins = $self->search_directories(@SEARCHDIR); push(@plugins, $self->handle_innerpackages($_)) for @{$self->{'search_path'}}; # return blank unless we've found anything return () unless @plugins; # remove duplicates # probably not necessary but hey ho my %plugins; for(@plugins) { next unless $self->_is_legit($_); $plugins{$_} = 1; } # are we instantiating or requiring? if (defined $self->{'instantiate'}) { my $method = $self->{'instantiate'}; my @objs = (); foreach my $package (sort keys %plugins) { next unless $package->can($method); my $obj = eval { $package->$method(@_) }; $self->{'on_instantiate_error'}->($package, $@) if $@; push @objs, $obj if $obj; } return @objs; } else { # no? just return the names my @objs= sort keys %plugins; return @objs; } } sub _setup_exceptions { my $self = shift; my %only; my %except; my $only; my $except; if (defined $self->{'only'}) { if (ref($self->{'only'}) eq 'ARRAY') { %only = map { $_ => 1 } @{$self->{'only'}}; } elsif (ref($self->{'only'}) eq 'Regexp') { $only = $self->{'only'} } elsif (ref($self->{'only'}) eq '') { $only{$self->{'only'}} = 1; } } if (defined $self->{'except'}) { if (ref($self->{'except'}) eq 'ARRAY') { %except = map { $_ => 1 } @{$self->{'except'}}; } elsif (ref($self->{'except'}) eq 'Regexp') { $except = $self->{'except'} } elsif (ref($self->{'except'}) eq '') { $except{$self->{'except'}} = 1; } } $self->{_exceptions}->{only_hash} = \%only; $self->{_exceptions}->{only} = $only; $self->{_exceptions}->{except_hash} = \%except; $self->{_exceptions}->{except} = $except; } sub _is_legit { my $self = shift; my $plugin = shift; my %only = %{$self->{_exceptions}->{only_hash}||{}}; my %except = %{$self->{_exceptions}->{except_hash}||{}}; my $only = $self->{_exceptions}->{only}; my $except = $self->{_exceptions}->{except}; my $depth = () = split '::', $plugin, -1; return 0 if (keys %only && !$only{$plugin} ); return 0 unless (!defined $only || $plugin =~ m!$only! ); return 0 if (keys %except && $except{$plugin} ); return 0 if (defined $except && $plugin =~ m!$except! ); return 0 if defined $self->{max_depth} && $depth>$self->{max_depth}; return 0 if defined $self->{min_depth} && $depth<$self->{min_depth}; return 1; } sub search_directories { my $self = shift; my @SEARCHDIR = @_; my @plugins; # go through our @INC foreach my $dir (@SEARCHDIR) { push @plugins, $self->search_paths($dir); } return @plugins; } sub search_paths { my $self = shift; my $dir = shift; my @plugins; my $file_regex = $self->{'file_regex'} || qr/\.pm$/; # and each directory in our search path foreach my $searchpath (@{$self->{'search_path'}}) { # create the search directory in a cross platform goodness way my $sp = catdir($dir, (split /::/, $searchpath)); # if it doesn't exist or it's not a dir then skip it next unless ( -e $sp && -d _ ); # Use the cached stat the second time my @files = $self->find_files($sp); # foreach one we've found foreach my $file (@files) { # untaint the file; accept .pm only next unless ($file) = ($file =~ /(.*$file_regex)$/); # parse the file to get the name my ($name, $directory, $suffix) = fileparse($file, $file_regex); next if (!$self->{include_editor_junk} && $self->_is_editor_junk($name)); $directory = abs2rel($directory, $sp); # If we have a mixed-case package name, assume case has been preserved # correctly. Otherwise, root through the file to locate the case-preserved # version of the package name. my @pkg_dirs = (); if ( $name eq lc($name) || $name eq uc($name) ) { my $pkg_file = catfile($sp, $directory, "$name$suffix"); open PKGFILE, "<$pkg_file" or die "search_paths: Can't open $pkg_file: $!"; my $in_pod = 0; while ( my $line = ) { $in_pod = 1 if $line =~ m/^=\w/; $in_pod = 0 if $line =~ /^=cut/; next if ($in_pod || $line =~ /^=cut/); # skip pod text next if $line =~ /^\s*#/; # and comments if ( $line =~ m/^\s*package\s+(.*::)?($name)\s*;/i ) { @pkg_dirs = split /::/, $1 if defined $1;; $name = $2; last; } } close PKGFILE; } # then create the class name in a cross platform way $directory =~ s/^[a-z]://i if($^O =~ /MSWin32|dos/); # remove volume my @dirs = (); if ($directory) { ($directory) = ($directory =~ /(.*)/); @dirs = grep(length($_), splitdir($directory)) unless $directory eq curdir(); for my $d (reverse @dirs) { my $pkg_dir = pop @pkg_dirs; last unless defined $pkg_dir; $d =~ s/\Q$pkg_dir\E/$pkg_dir/i; # Correct case } } else { $directory = ""; } my $plugin = join '::', $searchpath, @dirs, $name; next unless $plugin =~ m!(?:[a-z\d]+)[a-z\d]!i; $self->handle_finding_plugin($plugin, \@plugins) } # now add stuff that may have been in package # NOTE we should probably use all the stuff we've been given already # but then we can't unload it :( push @plugins, $self->handle_innerpackages($searchpath); } # foreach $searchpath return @plugins; } sub _is_editor_junk { my $self = shift; my $name = shift; # Emacs (and other Unix-y editors) leave temp files ending in a # tilde as a backup. return 1 if $name =~ /~$/; # Emacs makes these files while a buffer is edited but not yet # saved. return 1 if $name =~ /^\.#/; # Vim can leave these files behind if it crashes. return 1 if $name =~ /\.sw[po]$/; return 0; } sub handle_finding_plugin { my $self = shift; my $plugin = shift; my $plugins = shift; my $no_req = shift || 0; return unless $self->_is_legit($plugin); unless (defined $self->{'instantiate'} || $self->{'require'}) { push @$plugins, $plugin; return; } $self->{before_require}->($plugin) || return if defined $self->{before_require}; unless ($no_req) { my $tmp = $@; my $res = eval { $self->_require($plugin) }; my $err = $@; $@ = $tmp; if ($err) { if (defined $self->{on_require_error}) { $self->{on_require_error}->($plugin, $err) || return; } else { return; } } } $self->{after_require}->($plugin) || return if defined $self->{after_require}; push @$plugins, $plugin; } sub find_files { my $self = shift; my $search_path = shift; my $file_regex = $self->{'file_regex'} || qr/\.pm$/; # find all the .pm files in it # this isn't perfect and won't find multiple plugins per file #my $cwd = Cwd::getcwd; my @files = (); { # for the benefit of perl 5.6.1's Find, localize topic local $_; File::Find::find( { no_chdir => 1, follow => $self->{'follow_symlinks'}, wanted => sub { # Inlined from File::Find::Rule C< name => '*.pm' > return unless $File::Find::name =~ /$file_regex/; (my $path = $File::Find::name) =~ s#^\\./##; push @files, $path; } }, $search_path ); } #chdir $cwd; return @files; } sub handle_innerpackages { my $self = shift; return () if (exists $self->{inner} && !$self->{inner}); my $path = shift; my @plugins; foreach my $plugin (Devel::InnerPackage::list_packages($path)) { $self->handle_finding_plugin($plugin, \@plugins, 1); } return @plugins; } sub _require { my $self = shift; my $pack = shift; eval "CORE::require $pack"; die ($@) if $@; return 1; } 1; =pod =head1 NAME Module::Pluggable::Object - automatically give your module the ability to have plugins =head1 SYNOPSIS Simple use Module::Pluggable - package MyClass; use Module::Pluggable::Object; my $finder = Module::Pluggable::Object->new(%opts); print "My plugins are: ".join(", ", $finder->plugins)."\n"; =head1 DESCRIPTION Provides a simple but, hopefully, extensible way of having 'plugins' for your module. Obviously this isn't going to be the be all and end all of solutions but it works for me. Essentially all it does is export a method into your namespace that looks through a search path for .pm files and turn those into class names. Optionally it instantiates those classes for you. This object is wrapped by C. If you want to do something odd or add non-general special features you're probably best to wrap this and produce your own subclass. =head1 OPTIONS See the C docs. =head1 AUTHOR Simon Wistow =head1 COPYING Copyright, 2006 Simon Wistow Distributed under the same terms as Perl itself. =head1 BUGS None known. =head1 SEE ALSO L =cut MODULE_PLUGGABLE_OBJECT $fatpacked{"i686-linux/Cwd.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'I686-LINUX_CWD'; package Cwd; =head1 NAME Cwd - get pathname of current working directory =head1 SYNOPSIS use Cwd; my $dir = getcwd; use Cwd 'abs_path'; my $abs_path = abs_path($file); =head1 DESCRIPTION This module provides functions for determining the pathname of the current working directory. It is recommended that getcwd (or another *cwd() function) be used in I code to ensure portability. By default, it exports the functions cwd(), getcwd(), fastcwd(), and fastgetcwd() (and, on Win32, getdcwd()) into the caller's namespace. =head2 getcwd and friends Each of these functions are called without arguments and return the absolute path of the current working directory. =over 4 =item getcwd my $cwd = getcwd(); Returns the current working directory. Exposes the POSIX function getcwd(3) or re-implements it if it's not available. =item cwd my $cwd = cwd(); The cwd() is the most natural form for the current architecture. For most systems it is identical to `pwd` (but without the trailing line terminator). =item fastcwd my $cwd = fastcwd(); A more dangerous version of getcwd(), but potentially faster. It might conceivably chdir() you out of a directory that it can't chdir() you back into. If fastcwd encounters a problem it will return undef but will probably leave you in a different directory. For a measure of extra security, if everything appears to have worked, the fastcwd() function will check that it leaves you in the same directory that it started in. If it has changed it will C with the message "Unstable directory path, current directory changed unexpectedly". That should never happen. =item fastgetcwd my $cwd = fastgetcwd(); The fastgetcwd() function is provided as a synonym for cwd(). =item getdcwd my $cwd = getdcwd(); my $cwd = getdcwd('C:'); The getdcwd() function is also provided on Win32 to get the current working directory on the specified drive, since Windows maintains a separate current working directory for each drive. If no drive is specified then the current drive is assumed. This function simply calls the Microsoft C library _getdcwd() function. =back =head2 abs_path and friends These functions are exported only on request. They each take a single argument and return the absolute pathname for it. If no argument is given they'll use the current working directory. =over 4 =item abs_path my $abs_path = abs_path($file); Uses the same algorithm as getcwd(). Symbolic links and relative-path components ("." and "..") are resolved to return the canonical pathname, just like realpath(3). =item realpath my $abs_path = realpath($file); A synonym for abs_path(). =item fast_abs_path my $abs_path = fast_abs_path($file); A more dangerous, but potentially faster version of abs_path. =back =head2 $ENV{PWD} If you ask to override your chdir() built-in function, use Cwd qw(chdir); then your PWD environment variable will be kept up to date. Note that it will only be kept up to date if all packages which use chdir import it from Cwd. =head1 NOTES =over 4 =item * Since the path separators are different on some operating systems ('/' on Unix, ':' on MacPerl, etc...) we recommend you use the File::Spec modules wherever portability is a concern. =item * Actually, on Mac OS, the C, C and C functions are all aliases for the C function, which, on Mac OS, calls `pwd`. Likewise, the C function is an alias for C. =back =head1 AUTHOR Originally by the perl5-porters. Maintained by Ken Williams =head1 COPYRIGHT Copyright (c) 2004 by the Perl 5 Porters. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Portions of the C code in this library are copyright (c) 1994 by the Regents of the University of California. All rights reserved. The license on this code is compatible with the licensing of the rest of the distribution - please see the source code in F for the details. =head1 SEE ALSO L =cut use strict; use Exporter; use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION); $VERSION = '3.40'; my $xs_version = $VERSION; $VERSION =~ tr/_//; @ISA = qw/ Exporter /; @EXPORT = qw(cwd getcwd fastcwd fastgetcwd); push @EXPORT, qw(getdcwd) if $^O eq 'MSWin32'; @EXPORT_OK = qw(chdir abs_path fast_abs_path realpath fast_realpath); # sys_cwd may keep the builtin command # All the functionality of this module may provided by builtins, # there is no sense to process the rest of the file. # The best choice may be to have this in BEGIN, but how to return from BEGIN? if ($^O eq 'os2') { local $^W = 0; *cwd = defined &sys_cwd ? \&sys_cwd : \&_os2_cwd; *getcwd = \&cwd; *fastgetcwd = \&cwd; *fastcwd = \&cwd; *fast_abs_path = \&sys_abspath if defined &sys_abspath; *abs_path = \&fast_abs_path; *realpath = \&fast_abs_path; *fast_realpath = \&fast_abs_path; return 1; } # Need to look up the feature settings on VMS. The preferred way is to use the # VMS::Feature module, but that may not be available to dual life modules. my $use_vms_feature; BEGIN { if ($^O eq 'VMS') { if (eval { local $SIG{__DIE__}; require VMS::Feature; }) { $use_vms_feature = 1; } } } # Need to look up the UNIX report mode. This may become a dynamic mode # in the future. sub _vms_unix_rpt { my $unix_rpt; if ($use_vms_feature) { $unix_rpt = VMS::Feature::current("filename_unix_report"); } else { my $env_unix_rpt = $ENV{'DECC$FILENAME_UNIX_REPORT'} || ''; $unix_rpt = $env_unix_rpt =~ /^[ET1]/i; } return $unix_rpt; } # Need to look up the EFS character set mode. This may become a dynamic # mode in the future. sub _vms_efs { my $efs; if ($use_vms_feature) { $efs = VMS::Feature::current("efs_charset"); } else { my $env_efs = $ENV{'DECC$EFS_CHARSET'} || ''; $efs = $env_efs =~ /^[ET1]/i; } return $efs; } # If loading the XS stuff doesn't work, we can fall back to pure perl eval { if ( $] >= 5.006 ) { require XSLoader; XSLoader::load( __PACKAGE__, $xs_version); } else { require DynaLoader; push @ISA, 'DynaLoader'; __PACKAGE__->bootstrap( $xs_version ); } }; # Big nasty table of function aliases my %METHOD_MAP = ( VMS => { cwd => '_vms_cwd', getcwd => '_vms_cwd', fastcwd => '_vms_cwd', fastgetcwd => '_vms_cwd', abs_path => '_vms_abs_path', fast_abs_path => '_vms_abs_path', }, MSWin32 => { # We assume that &_NT_cwd is defined as an XSUB or in the core. cwd => '_NT_cwd', getcwd => '_NT_cwd', fastcwd => '_NT_cwd', fastgetcwd => '_NT_cwd', abs_path => 'fast_abs_path', realpath => 'fast_abs_path', }, dos => { cwd => '_dos_cwd', getcwd => '_dos_cwd', fastgetcwd => '_dos_cwd', fastcwd => '_dos_cwd', abs_path => 'fast_abs_path', }, # QNX4. QNX6 has a $os of 'nto'. qnx => { cwd => '_qnx_cwd', getcwd => '_qnx_cwd', fastgetcwd => '_qnx_cwd', fastcwd => '_qnx_cwd', abs_path => '_qnx_abs_path', fast_abs_path => '_qnx_abs_path', }, cygwin => { getcwd => 'cwd', fastgetcwd => 'cwd', fastcwd => 'cwd', abs_path => 'fast_abs_path', realpath => 'fast_abs_path', }, epoc => { cwd => '_epoc_cwd', getcwd => '_epoc_cwd', fastgetcwd => '_epoc_cwd', fastcwd => '_epoc_cwd', abs_path => 'fast_abs_path', }, MacOS => { getcwd => 'cwd', fastgetcwd => 'cwd', fastcwd => 'cwd', abs_path => 'fast_abs_path', }, ); $METHOD_MAP{NT} = $METHOD_MAP{MSWin32}; # Find the pwd command in the expected locations. We assume these # are safe. This prevents _backtick_pwd() consulting $ENV{PATH} # so everything works under taint mode. my $pwd_cmd; foreach my $try ('/bin/pwd', '/usr/bin/pwd', '/QOpenSys/bin/pwd', # OS/400 PASE. ) { if( -x $try ) { $pwd_cmd = $try; last; } } my $found_pwd_cmd = defined($pwd_cmd); unless ($pwd_cmd) { # Isn't this wrong? _backtick_pwd() will fail if somenone has # pwd in their path but it is not /bin/pwd or /usr/bin/pwd? # See [perl #16774]. --jhi $pwd_cmd = 'pwd'; } # Lazy-load Carp sub _carp { require Carp; Carp::carp(@_) } sub _croak { require Carp; Carp::croak(@_) } # The 'natural and safe form' for UNIX (pwd may be setuid root) sub _backtick_pwd { # Localize %ENV entries in a way that won't create new hash keys my @localize = grep exists $ENV{$_}, qw(PATH IFS CDPATH ENV BASH_ENV); local @ENV{@localize}; my $cwd = `$pwd_cmd`; # Belt-and-suspenders in case someone said "undef $/". local $/ = "\n"; # `pwd` may fail e.g. if the disk is full chomp($cwd) if defined $cwd; $cwd; } # Since some ports may predefine cwd internally (e.g., NT) # we take care not to override an existing definition for cwd(). unless ($METHOD_MAP{$^O}{cwd} or defined &cwd) { # The pwd command is not available in some chroot(2)'ed environments my $sep = $Config::Config{path_sep} || ':'; my $os = $^O; # Protect $^O from tainting # Try again to find a pwd, this time searching the whole PATH. if (defined $ENV{PATH} and $os ne 'MSWin32') { # no pwd on Windows my @candidates = split($sep, $ENV{PATH}); while (!$found_pwd_cmd and @candidates) { my $candidate = shift @candidates; $found_pwd_cmd = 1 if -x "$candidate/pwd"; } } # MacOS has some special magic to make `pwd` work. if( $os eq 'MacOS' || $found_pwd_cmd ) { *cwd = \&_backtick_pwd; } else { *cwd = \&getcwd; } } if ($^O eq 'cygwin') { # We need to make sure cwd() is called with no args, because it's # got an arg-less prototype and will die if args are present. local $^W = 0; my $orig_cwd = \&cwd; *cwd = sub { &$orig_cwd() } } # set a reasonable (and very safe) default for fastgetcwd, in case it # isn't redefined later (20001212 rspier) *fastgetcwd = \&cwd; # A non-XS version of getcwd() - also used to bootstrap the perl build # process, when miniperl is running and no XS loading happens. sub _perl_getcwd { abs_path('.'); } # By John Bazik # # Usage: $cwd = &fastcwd; # # This is a faster version of getcwd. It's also more dangerous because # you might chdir out of a directory that you can't chdir back into. sub fastcwd_ { my($odev, $oino, $cdev, $cino, $tdev, $tino); my(@path, $path); local(*DIR); my($orig_cdev, $orig_cino) = stat('.'); ($cdev, $cino) = ($orig_cdev, $orig_cino); for (;;) { my $direntry; ($odev, $oino) = ($cdev, $cino); CORE::chdir('..') || return undef; ($cdev, $cino) = stat('.'); last if $odev == $cdev && $oino == $cino; opendir(DIR, '.') || return undef; for (;;) { $direntry = readdir(DIR); last unless defined $direntry; next if $direntry eq '.'; next if $direntry eq '..'; ($tdev, $tino) = lstat($direntry); last unless $tdev != $odev || $tino != $oino; } closedir(DIR); return undef unless defined $direntry; # should never happen unshift(@path, $direntry); } $path = '/' . join('/', @path); if ($^O eq 'apollo') { $path = "/".$path; } # At this point $path may be tainted (if tainting) and chdir would fail. # Untaint it then check that we landed where we started. $path =~ /^(.*)\z/s # untaint && CORE::chdir($1) or return undef; ($cdev, $cino) = stat('.'); die "Unstable directory path, current directory changed unexpectedly" if $cdev != $orig_cdev || $cino != $orig_cino; $path; } if (not defined &fastcwd) { *fastcwd = \&fastcwd_ } # Keeps track of current working directory in PWD environment var # Usage: # use Cwd 'chdir'; # chdir $newdir; my $chdir_init = 0; sub chdir_init { if ($ENV{'PWD'} and $^O ne 'os2' and $^O ne 'dos' and $^O ne 'MSWin32') { my($dd,$di) = stat('.'); my($pd,$pi) = stat($ENV{'PWD'}); if (!defined $dd or !defined $pd or $di != $pi or $dd != $pd) { $ENV{'PWD'} = cwd(); } } else { my $wd = cwd(); $wd = Win32::GetFullPathName($wd) if $^O eq 'MSWin32'; $ENV{'PWD'} = $wd; } # Strip an automounter prefix (where /tmp_mnt/foo/bar == /foo/bar) if ($^O ne 'MSWin32' and $ENV{'PWD'} =~ m|(/[^/]+(/[^/]+/[^/]+))(.*)|s) { my($pd,$pi) = stat($2); my($dd,$di) = stat($1); if (defined $pd and defined $dd and $di == $pi and $dd == $pd) { $ENV{'PWD'}="$2$3"; } } $chdir_init = 1; } sub chdir { my $newdir = @_ ? shift : ''; # allow for no arg (chdir to HOME dir) $newdir =~ s|///*|/|g unless $^O eq 'MSWin32'; chdir_init() unless $chdir_init; my $newpwd; if ($^O eq 'MSWin32') { # get the full path name *before* the chdir() $newpwd = Win32::GetFullPathName($newdir); } return 0 unless CORE::chdir $newdir; if ($^O eq 'VMS') { return $ENV{'PWD'} = $ENV{'DEFAULT'} } elsif ($^O eq 'MacOS') { return $ENV{'PWD'} = cwd(); } elsif ($^O eq 'MSWin32') { $ENV{'PWD'} = $newpwd; return 1; } if (ref $newdir eq 'GLOB') { # in case a file/dir handle is passed in $ENV{'PWD'} = cwd(); } elsif ($newdir =~ m#^/#s) { $ENV{'PWD'} = $newdir; } else { my @curdir = split(m#/#,$ENV{'PWD'}); @curdir = ('') unless @curdir; my $component; foreach $component (split(m#/#, $newdir)) { next if $component eq '.'; pop(@curdir),next if $component eq '..'; push(@curdir,$component); } $ENV{'PWD'} = join('/',@curdir) || '/'; } 1; } sub _perl_abs_path { my $start = @_ ? shift : '.'; my($dotdots, $cwd, @pst, @cst, $dir, @tst); unless (@cst = stat( $start )) { _carp("stat($start): $!"); return ''; } unless (-d _) { # Make sure we can be invoked on plain files, not just directories. # NOTE that this routine assumes that '/' is the only directory separator. my ($dir, $file) = $start =~ m{^(.*)/(.+)$} or return cwd() . '/' . $start; # Can't use "-l _" here, because the previous stat was a stat(), not an lstat(). if (-l $start) { my $link_target = readlink($start); die "Can't resolve link $start: $!" unless defined $link_target; require File::Spec; $link_target = $dir . '/' . $link_target unless File::Spec->file_name_is_absolute($link_target); return abs_path($link_target); } return $dir ? abs_path($dir) . "/$file" : "/$file"; } $cwd = ''; $dotdots = $start; do { $dotdots .= '/..'; @pst = @cst; local *PARENT; unless (opendir(PARENT, $dotdots)) { # probably a permissions issue. Try the native command. require File::Spec; return File::Spec->rel2abs( $start, _backtick_pwd() ); } unless (@cst = stat($dotdots)) { _carp("stat($dotdots): $!"); closedir(PARENT); return ''; } if ($pst[0] == $cst[0] && $pst[1] == $cst[1]) { $dir = undef; } else { do { unless (defined ($dir = readdir(PARENT))) { _carp("readdir($dotdots): $!"); closedir(PARENT); return ''; } $tst[0] = $pst[0]+1 unless (@tst = lstat("$dotdots/$dir")) } while ($dir eq '.' || $dir eq '..' || $tst[0] != $pst[0] || $tst[1] != $pst[1]); } $cwd = (defined $dir ? "$dir" : "" ) . "/$cwd" ; closedir(PARENT); } while (defined $dir); chop($cwd) unless $cwd eq '/'; # drop the trailing / $cwd; } my $Curdir; sub fast_abs_path { local $ENV{PWD} = $ENV{PWD} || ''; # Guard against clobberage my $cwd = getcwd(); require File::Spec; my $path = @_ ? shift : ($Curdir ||= File::Spec->curdir); # Detaint else we'll explode in taint mode. This is safe because # we're not doing anything dangerous with it. ($path) = $path =~ /(.*)/s; ($cwd) = $cwd =~ /(.*)/s; unless (-e $path) { _croak("$path: No such file or directory"); } unless (-d _) { # Make sure we can be invoked on plain files, not just directories. my ($vol, $dir, $file) = File::Spec->splitpath($path); return File::Spec->catfile($cwd, $path) unless length $dir; if (-l $path) { my $link_target = readlink($path); die "Can't resolve link $path: $!" unless defined $link_target; $link_target = File::Spec->catpath($vol, $dir, $link_target) unless File::Spec->file_name_is_absolute($link_target); return fast_abs_path($link_target); } return $dir eq File::Spec->rootdir ? File::Spec->catpath($vol, $dir, $file) : fast_abs_path(File::Spec->catpath($vol, $dir, '')) . '/' . $file; } if (!CORE::chdir($path)) { _croak("Cannot chdir to $path: $!"); } my $realpath = getcwd(); if (! ((-d $cwd) && (CORE::chdir($cwd)))) { _croak("Cannot chdir back to $cwd: $!"); } $realpath; } # added function alias to follow principle of least surprise # based on previous aliasing. --tchrist 27-Jan-00 *fast_realpath = \&fast_abs_path; # --- PORTING SECTION --- # VMS: $ENV{'DEFAULT'} points to default directory at all times # 06-Mar-1996 Charles Bailey bailey@newman.upenn.edu # Note: Use of Cwd::chdir() causes the logical name PWD to be defined # in the process logical name table as the default device and directory # seen by Perl. This may not be the same as the default device # and directory seen by DCL after Perl exits, since the effects # the CRTL chdir() function persist only until Perl exits. sub _vms_cwd { return $ENV{'DEFAULT'}; } sub _vms_abs_path { return $ENV{'DEFAULT'} unless @_; my $path = shift; my $efs = _vms_efs; my $unix_rpt = _vms_unix_rpt; if (defined &VMS::Filespec::vmsrealpath) { my $path_unix = 0; my $path_vms = 0; $path_unix = 1 if ($path =~ m#(?<=\^)/#); $path_unix = 1 if ($path =~ /^\.\.?$/); $path_vms = 1 if ($path =~ m#[\[<\]]#); $path_vms = 1 if ($path =~ /^--?$/); my $unix_mode = $path_unix; if ($efs) { # In case of a tie, the Unix report mode decides. if ($path_vms == $path_unix) { $unix_mode = $unix_rpt; } else { $unix_mode = 0 if $path_vms; } } if ($unix_mode) { # Unix format return VMS::Filespec::unixrealpath($path); } # VMS format my $new_path = VMS::Filespec::vmsrealpath($path); # Perl expects directories to be in directory format $new_path = VMS::Filespec::pathify($new_path) if -d $path; return $new_path; } # Fallback to older algorithm if correct ones are not # available. if (-l $path) { my $link_target = readlink($path); die "Can't resolve link $path: $!" unless defined $link_target; return _vms_abs_path($link_target); } # may need to turn foo.dir into [.foo] my $pathified = VMS::Filespec::pathify($path); $path = $pathified if defined $pathified; return VMS::Filespec::rmsexpand($path); } sub _os2_cwd { $ENV{'PWD'} = `cmd /c cd`; chomp $ENV{'PWD'}; $ENV{'PWD'} =~ s:\\:/:g ; return $ENV{'PWD'}; } sub _win32_cwd_simple { $ENV{'PWD'} = `cd`; chomp $ENV{'PWD'}; $ENV{'PWD'} =~ s:\\:/:g ; return $ENV{'PWD'}; } sub _win32_cwd { # Need to avoid taking any sort of reference to the typeglob or the code in # the optree, so that this tests the runtime state of things, as the # ExtUtils::MakeMaker tests for "miniperl" need to be able to fake things at # runtime by deleting the subroutine. *foo{THING} syntax on a symbol table # lookup avoids needing a string eval, which has been reported to cause # problems (for reasons that we haven't been able to get to the bottom of - # rt.cpan.org #56225) if (*{$DynaLoader::{boot_DynaLoader}}{CODE}) { $ENV{'PWD'} = Win32::GetCwd(); } else { # miniperl chomp($ENV{'PWD'} = `cd`); } $ENV{'PWD'} =~ s:\\:/:g ; return $ENV{'PWD'}; } *_NT_cwd = defined &Win32::GetCwd ? \&_win32_cwd : \&_win32_cwd_simple; sub _dos_cwd { if (!defined &Dos::GetCwd) { $ENV{'PWD'} = `command /c cd`; chomp $ENV{'PWD'}; $ENV{'PWD'} =~ s:\\:/:g ; } else { $ENV{'PWD'} = Dos::GetCwd(); } return $ENV{'PWD'}; } sub _qnx_cwd { local $ENV{PATH} = ''; local $ENV{CDPATH} = ''; local $ENV{ENV} = ''; $ENV{'PWD'} = `/usr/bin/fullpath -t`; chomp $ENV{'PWD'}; return $ENV{'PWD'}; } sub _qnx_abs_path { local $ENV{PATH} = ''; local $ENV{CDPATH} = ''; local $ENV{ENV} = ''; my $path = @_ ? shift : '.'; local *REALPATH; defined( open(REALPATH, '-|') || exec '/usr/bin/fullpath', '-t', $path ) or die "Can't open /usr/bin/fullpath: $!"; my $realpath = ; close REALPATH; chomp $realpath; return $realpath; } sub _epoc_cwd { $ENV{'PWD'} = EPOC::getcwd(); return $ENV{'PWD'}; } # Now that all the base-level functions are set up, alias the # user-level functions to the right places if (exists $METHOD_MAP{$^O}) { my $map = $METHOD_MAP{$^O}; foreach my $name (keys %$map) { local $^W = 0; # assignments trigger 'subroutine redefined' warning no strict 'refs'; *{$name} = \&{$map->{$name}}; } } # In case the XS version doesn't load. *abs_path = \&_perl_abs_path unless defined &abs_path; *getcwd = \&_perl_getcwd unless defined &getcwd; # added function alias for those of us more # used to the libc function. --tchrist 27-Jan-00 *realpath = \&abs_path; 1; I686-LINUX_CWD $fatpacked{"i686-linux/File/Spec.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'I686-LINUX_FILE_SPEC'; package File::Spec; use strict; use vars qw(@ISA $VERSION); $VERSION = '3.40'; $VERSION =~ tr/_//; my %module = (MacOS => 'Mac', MSWin32 => 'Win32', os2 => 'OS2', VMS => 'VMS', epoc => 'Epoc', NetWare => 'Win32', # Yes, File::Spec::Win32 works on NetWare. symbian => 'Win32', # Yes, File::Spec::Win32 works on symbian. dos => 'OS2', # Yes, File::Spec::OS2 works on DJGPP. cygwin => 'Cygwin'); my $module = $module{$^O} || 'Unix'; require "File/Spec/$module.pm"; @ISA = ("File::Spec::$module"); 1; __END__ =head1 NAME File::Spec - portably perform operations on file names =head1 SYNOPSIS use File::Spec; $x=File::Spec->catfile('a', 'b', 'c'); which returns 'a/b/c' under Unix. Or: use File::Spec::Functions; $x = catfile('a', 'b', 'c'); =head1 DESCRIPTION This module is designed to support operations commonly performed on file specifications (usually called "file names", but not to be confused with the contents of a file, or Perl's file handles), such as concatenating several directory and file names into a single path, or determining whether a path is rooted. It is based on code directly taken from MakeMaker 5.17, code written by Andreas KEnig, Andy Dougherty, Charles Bailey, Ilya Zakharevich, Paul Schinder, and others. Since these functions are different for most operating systems, each set of OS specific routines is available in a separate module, including: File::Spec::Unix File::Spec::Mac File::Spec::OS2 File::Spec::Win32 File::Spec::VMS The module appropriate for the current OS is automatically loaded by File::Spec. Since some modules (like VMS) make use of facilities available only under that OS, it may not be possible to load all modules under all operating systems. Since File::Spec is object oriented, subroutines should not be called directly, as in: File::Spec::catfile('a','b'); but rather as class methods: File::Spec->catfile('a','b'); For simple uses, L provides convenient functional forms of these methods. =head1 METHODS =over 2 =item canonpath X No physical check on the filesystem, but a logical cleanup of a path. $cpath = File::Spec->canonpath( $path ) ; Note that this does *not* collapse F sections into F. This is by design. If F on your system is a symlink to F, then F is actually F, not F as a naive F<../>-removal would give you. If you want to do this kind of processing, you probably want C's C function to actually traverse the filesystem cleaning up paths like this. =item catdir X Concatenate two or more directory names to form a complete path ending with a directory. But remove the trailing slash from the resulting string, because it doesn't look good, isn't necessary and confuses OS/2. Of course, if this is the root directory, don't cut off the trailing slash :-) $path = File::Spec->catdir( @directories ); =item catfile X Concatenate one or more directory names and a filename to form a complete path ending with a filename $path = File::Spec->catfile( @directories, $filename ); =item curdir X Returns a string representation of the current directory. $curdir = File::Spec->curdir(); =item devnull X Returns a string representation of the null device. $devnull = File::Spec->devnull(); =item rootdir X Returns a string representation of the root directory. $rootdir = File::Spec->rootdir(); =item tmpdir X Returns a string representation of the first writable directory from a list of possible temporary directories. Returns the current directory if no writable temporary directories are found. The list of directories checked depends on the platform; e.g. File::Spec::Unix checks C<$ENV{TMPDIR}> (unless taint is on) and F. $tmpdir = File::Spec->tmpdir(); =item updir X Returns a string representation of the parent directory. $updir = File::Spec->updir(); =item no_upwards Given a list of file names, strip out those that refer to a parent directory. (Does not strip symlinks, only '.', '..', and equivalents.) @paths = File::Spec->no_upwards( @paths ); =item case_tolerant Returns a true or false value indicating, respectively, that alphabetic case is not or is significant when comparing file specifications. Cygwin and Win32 accept an optional drive argument. $is_case_tolerant = File::Spec->case_tolerant(); =item file_name_is_absolute Takes as its argument a path, and returns true if it is an absolute path. $is_absolute = File::Spec->file_name_is_absolute( $path ); This does not consult the local filesystem on Unix, Win32, OS/2, or Mac OS (Classic). It does consult the working environment for VMS (see L). =item path X Takes no argument. Returns the environment variable C (or the local platform's equivalent) as a list. @PATH = File::Spec->path(); =item join X join is the same as catfile. =item splitpath X X Splits a path in to volume, directory, and filename portions. On systems with no concept of volume, returns '' for volume. ($volume,$directories,$file) = File::Spec->splitpath( $path ); ($volume,$directories,$file) = File::Spec->splitpath( $path, $no_file ); For systems with no syntax differentiating filenames from directories, assumes that the last file is a path unless C<$no_file> is true or a trailing separator or F or F is present. On Unix, this means that C<$no_file> true makes this return ( '', $path, '' ). The directory portion may or may not be returned with a trailing '/'. The results can be passed to L to get back a path equivalent to (usually identical to) the original path. =item splitdir X X The opposite of L. @dirs = File::Spec->splitdir( $directories ); C<$directories> must be only the directory portion of the path on systems that have the concept of a volume or that have path syntax that differentiates files from directories. Unlike just splitting the directories on the separator, empty directory names (C<''>) can be returned, because these are significant on some OSes. =item catpath() Takes volume, directory and file portions and returns an entire path. Under Unix, C<$volume> is ignored, and directory and file are concatenated. A '/' is inserted if need be. On other OSes, C<$volume> is significant. $full_path = File::Spec->catpath( $volume, $directory, $file ); =item abs2rel X X X Takes a destination path and an optional base path returns a relative path from the base path to the destination path: $rel_path = File::Spec->abs2rel( $path ) ; $rel_path = File::Spec->abs2rel( $path, $base ) ; If C<$base> is not present or '', then L is used. If C<$base> is relative, then it is converted to absolute form using L. This means that it is taken to be relative to L. On systems with the concept of volume, if C<$path> and C<$base> appear to be on two different volumes, we will not attempt to resolve the two paths, and we will instead simply return C<$path>. Note that previous versions of this module ignored the volume of C<$base>, which resulted in garbage results part of the time. On systems that have a grammar that indicates filenames, this ignores the C<$base> filename as well. Otherwise all path components are assumed to be directories. If C<$path> is relative, it is converted to absolute form using L. This means that it is taken to be relative to L. No checks against the filesystem are made. On VMS, there is interaction with the working environment, as logicals and macros are expanded. Based on code written by Shigio Yamaguchi. =item rel2abs() X X X Converts a relative path to an absolute path. $abs_path = File::Spec->rel2abs( $path ) ; $abs_path = File::Spec->rel2abs( $path, $base ) ; If C<$base> is not present or '', then L is used. If C<$base> is relative, then it is converted to absolute form using L. This means that it is taken to be relative to L. On systems with the concept of volume, if C<$path> and C<$base> appear to be on two different volumes, we will not attempt to resolve the two paths, and we will instead simply return C<$path>. Note that previous versions of this module ignored the volume of C<$base>, which resulted in garbage results part of the time. On systems that have a grammar that indicates filenames, this ignores the C<$base> filename as well. Otherwise all path components are assumed to be directories. If C<$path> is absolute, it is cleaned up and returned using L. No checks against the filesystem are made. On VMS, there is interaction with the working environment, as logicals and macros are expanded. Based on code written by Shigio Yamaguchi. =back For further information, please see L, L, L, L, or L. =head1 SEE ALSO L, L, L, L, L, L, L =head1 AUTHOR Currently maintained by Ken Williams C<< >>. The vast majority of the code was written by Kenneth Albanowski C<< >>, Andy Dougherty C<< >>, Andreas KEnig C<< >>, Tim Bunce C<< >>. VMS support by Charles Bailey C<< >>. OS/2 support by Ilya Zakharevich C<< >>. Mac support by Paul Schinder C<< >>, and Thomas Wegner C<< >>. abs2rel() and rel2abs() written by Shigio Yamaguchi C<< >>, modified by Barrie Slaymaker C<< >>. splitpath(), splitdir(), catpath() and catdir() by Barrie Slaymaker. =head1 COPYRIGHT Copyright (c) 2004-2013 by the Perl 5 Porters. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut I686-LINUX_FILE_SPEC $fatpacked{"i686-linux/File/Spec/Cygwin.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'I686-LINUX_FILE_SPEC_CYGWIN'; package File::Spec::Cygwin; use strict; use vars qw(@ISA $VERSION); require File::Spec::Unix; $VERSION = '3.40'; $VERSION =~ tr/_//; @ISA = qw(File::Spec::Unix); =head1 NAME File::Spec::Cygwin - methods for Cygwin file specs =head1 SYNOPSIS require File::Spec::Cygwin; # Done internally by File::Spec if needed =head1 DESCRIPTION See L and L. This package overrides the implementation of these methods, not the semantics. This module is still in beta. Cygwin-knowledgeable folks are invited to offer patches and suggestions. =cut =pod =over 4 =item canonpath Any C<\> (backslashes) are converted to C (forward slashes), and then File::Spec::Unix canonpath() is called on the result. =cut sub canonpath { my($self,$path) = @_; return unless defined $path; $path =~ s|\\|/|g; # Handle network path names beginning with double slash my $node = ''; if ( $path =~ s@^(//[^/]+)(?:/|\z)@/@s ) { $node = $1; } return $node . $self->SUPER::canonpath($path); } sub catdir { my $self = shift; return unless @_; # Don't create something that looks like a //network/path if ($_[0] and ($_[0] eq '/' or $_[0] eq '\\')) { shift; return $self->SUPER::catdir('', @_); } $self->SUPER::catdir(@_); } =pod =item file_name_is_absolute True is returned if the file name begins with C, and if not, File::Spec::Unix file_name_is_absolute() is called. =cut sub file_name_is_absolute { my ($self,$file) = @_; return 1 if $file =~ m{^([a-z]:)?[\\/]}is; # C:/test return $self->SUPER::file_name_is_absolute($file); } =item tmpdir (override) Returns a string representation of the first existing directory from the following list: $ENV{TMPDIR} /tmp $ENV{'TMP'} $ENV{'TEMP'} C:/temp Since Perl 5.8.0, if running under taint mode, and if the environment variables are tainted, they are not used. =cut my $tmpdir; sub tmpdir { return $tmpdir if defined $tmpdir; $tmpdir = $_[0]->_tmpdir( $ENV{TMPDIR}, "/tmp", $ENV{'TMP'}, $ENV{'TEMP'}, 'C:/temp' ); } =item case_tolerant Override Unix. Cygwin case-tolerance depends on managed mount settings and as with MsWin32 on GetVolumeInformation() $ouFsFlags == FS_CASE_SENSITIVE, indicating the case significance when comparing file specifications. Default: 1 =cut sub case_tolerant { return 1 unless $^O eq 'cygwin' and defined &Cygwin::mount_flags; my $drive = shift; if (! $drive) { my @flags = split(/,/, Cygwin::mount_flags('/cygwin')); my $prefix = pop(@flags); if (! $prefix || $prefix eq 'cygdrive') { $drive = '/cygdrive/c'; } elsif ($prefix eq '/') { $drive = '/c'; } else { $drive = "$prefix/c"; } } my $mntopts = Cygwin::mount_flags($drive); if ($mntopts and ($mntopts =~ /,managed/)) { return 0; } eval { require Win32API::File; } or return 1; my $osFsType = "\0"x256; my $osVolName = "\0"x256; my $ouFsFlags = 0; Win32API::File::GetVolumeInformation($drive, $osVolName, 256, [], [], $ouFsFlags, $osFsType, 256 ); if ($ouFsFlags & Win32API::File::FS_CASE_SENSITIVE()) { return 0; } else { return 1; } } =back =head1 COPYRIGHT Copyright (c) 2004,2007 by the Perl 5 Porters. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut 1; I686-LINUX_FILE_SPEC_CYGWIN $fatpacked{"i686-linux/File/Spec/Epoc.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'I686-LINUX_FILE_SPEC_EPOC'; package File::Spec::Epoc; use strict; use vars qw($VERSION @ISA); $VERSION = '3.40'; $VERSION =~ tr/_//; require File::Spec::Unix; @ISA = qw(File::Spec::Unix); =head1 NAME File::Spec::Epoc - methods for Epoc file specs =head1 SYNOPSIS require File::Spec::Epoc; # Done internally by File::Spec if needed =head1 DESCRIPTION See File::Spec::Unix for a documentation of the methods provided there. This package overrides the implementation of these methods, not the semantics. This package is still work in progress ;-) =cut sub case_tolerant { return 1; } =pod =over 4 =item canonpath() No physical check on the filesystem, but a logical cleanup of a path. On UNIX eliminated successive slashes and successive "/.". =back =cut sub canonpath { my ($self,$path) = @_; return unless defined $path; $path =~ s|/+|/|g; # xx////xx -> xx/xx $path =~ s|(/\.)+/|/|g; # xx/././xx -> xx/xx $path =~ s|^(\./)+||s unless $path eq "./"; # ./xx -> xx $path =~ s|^/(\.\./)+|/|s; # /../../xx -> xx $path =~ s|/\Z(?!\n)|| unless $path eq "/"; # xx/ -> xx return $path; } =pod =head1 AUTHOR o.flebbe@gmx.de =head1 COPYRIGHT Copyright (c) 2004 by the Perl 5 Porters. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO See L and L. This package overrides the implementation of these methods, not the semantics. =cut 1; I686-LINUX_FILE_SPEC_EPOC $fatpacked{"i686-linux/File/Spec/Functions.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'I686-LINUX_FILE_SPEC_FUNCTIONS'; package File::Spec::Functions; use File::Spec; use strict; use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION); $VERSION = '3.40'; $VERSION =~ tr/_//; require Exporter; @ISA = qw(Exporter); @EXPORT = qw( canonpath catdir catfile curdir rootdir updir no_upwards file_name_is_absolute path ); @EXPORT_OK = qw( devnull tmpdir splitpath splitdir catpath abs2rel rel2abs case_tolerant ); %EXPORT_TAGS = ( ALL => [ @EXPORT_OK, @EXPORT ] ); foreach my $meth (@EXPORT, @EXPORT_OK) { my $sub = File::Spec->can($meth); no strict 'refs'; *{$meth} = sub {&$sub('File::Spec', @_)}; } 1; __END__ =head1 NAME File::Spec::Functions - portably perform operations on file names =head1 SYNOPSIS use File::Spec::Functions; $x = catfile('a','b'); =head1 DESCRIPTION This module exports convenience functions for all of the class methods provided by File::Spec. For a reference of available functions, please consult L, which contains the entire set, and which is inherited by the modules for other platforms. For further information, please see L, L, L, or L. =head2 Exports The following functions are exported by default. canonpath catdir catfile curdir rootdir updir no_upwards file_name_is_absolute path The following functions are exported only by request. devnull tmpdir splitpath splitdir catpath abs2rel rel2abs case_tolerant All the functions may be imported using the C<:ALL> tag. =head1 COPYRIGHT Copyright (c) 2004 by the Perl 5 Porters. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO File::Spec, File::Spec::Unix, File::Spec::Mac, File::Spec::OS2, File::Spec::Win32, File::Spec::VMS, ExtUtils::MakeMaker =cut I686-LINUX_FILE_SPEC_FUNCTIONS $fatpacked{"i686-linux/File/Spec/Mac.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'I686-LINUX_FILE_SPEC_MAC'; package File::Spec::Mac; use strict; use vars qw(@ISA $VERSION); require File::Spec::Unix; $VERSION = '3.40'; $VERSION =~ tr/_//; @ISA = qw(File::Spec::Unix); my $macfiles; if ($^O eq 'MacOS') { $macfiles = eval { require Mac::Files }; } sub case_tolerant { 1 } =head1 NAME File::Spec::Mac - File::Spec for Mac OS (Classic) =head1 SYNOPSIS require File::Spec::Mac; # Done internally by File::Spec if needed =head1 DESCRIPTION Methods for manipulating file specifications. =head1 METHODS =over 2 =item canonpath On Mac OS, there's nothing to be done. Returns what it's given. =cut sub canonpath { my ($self,$path) = @_; return $path; } =item catdir() Concatenate two or more directory names to form a path separated by colons (":") ending with a directory. Resulting paths are B by default, but can be forced to be absolute (but avoid this, see below). Automatically puts a trailing ":" on the end of the complete path, because that's what's done in MacPerl's environment and helps to distinguish a file path from a directory path. B Beginning with version 1.3 of this module, the resulting path is relative by default and I absolute. This decision was made due to portability reasons. Since Ccatdir()> returns relative paths on all other operating systems, it will now also follow this convention on Mac OS. Note that this may break some existing scripts. The intended purpose of this routine is to concatenate I. But because of the nature of Macintosh paths, some additional possibilities are allowed to make using this routine give reasonable results for some common situations. In other words, you are also allowed to concatenate I instead of directory names (strictly speaking, a string like ":a" is a path, but not a name, since it contains a punctuation character ":"). So, beside calls like catdir("a") = ":a:" catdir("a","b") = ":a:b:" catdir() = "" (special case) calls like the following catdir(":a:") = ":a:" catdir(":a","b") = ":a:b:" catdir(":a:","b") = ":a:b:" catdir(":a:",":b:") = ":a:b:" catdir(":") = ":" are allowed. Here are the rules that are used in C; note that we try to be as compatible as possible to Unix: =over 2 =item 1. The resulting path is relative by default, i.e. the resulting path will have a leading colon. =item 2. A trailing colon is added automatically to the resulting path, to denote a directory. =item 3. Generally, each argument has one leading ":" and one trailing ":" removed (if any). They are then joined together by a ":". Special treatment applies for arguments denoting updir paths like "::lib:", see (4), or arguments consisting solely of colons ("colon paths"), see (5). =item 4. When an updir path like ":::lib::" is passed as argument, the number of directories to climb up is handled correctly, not removing leading or trailing colons when necessary. E.g. catdir(":::a","::b","c") = ":::a::b:c:" catdir(":::a::","::b","c") = ":::a:::b:c:" =item 5. Adding a colon ":" or empty string "" to a path at I position doesn't alter the path, i.e. these arguments are ignored. (When a "" is passed as the first argument, it has a special meaning, see (6)). This way, a colon ":" is handled like a "." (curdir) on Unix, while an empty string "" is generally ignored (see Ccanonpath()> ). Likewise, a "::" is handled like a ".." (updir), and a ":::" is handled like a "../.." etc. E.g. catdir("a",":",":","b") = ":a:b:" catdir("a",":","::",":b") = ":a::b:" =item 6. If the first argument is an empty string "" or is a volume name, i.e. matches the pattern /^[^:]+:/, the resulting path is B. =item 7. Passing an empty string "" as the first argument to C is like passingCrootdir()> as the first argument, i.e. catdir("","a","b") is the same as catdir(rootdir(),"a","b"). This is true on Unix, where C yields "/a/b" and C is "/". Note that C on Mac OS is the startup volume, which is the closest in concept to Unix' "/". This should help to run existing scripts originally written for Unix. =item 8. For absolute paths, some cleanup is done, to ensure that the volume name isn't immediately followed by updirs. This is invalid, because this would go beyond "root". Generally, these cases are handled like their Unix counterparts: Unix: Unix->catdir("","") = "/" Unix->catdir("",".") = "/" Unix->catdir("","..") = "/" # can't go # beyond root Unix->catdir("",".","..","..","a") = "/a" Mac: Mac->catdir("","") = rootdir() # (e.g. "HD:") Mac->catdir("",":") = rootdir() Mac->catdir("","::") = rootdir() # can't go # beyond root Mac->catdir("",":","::","::","a") = rootdir() . "a:" # (e.g. "HD:a:") However, this approach is limited to the first arguments following "root" (again, see Ccanonpath()> ). If there are more arguments that move up the directory tree, an invalid path going beyond root can be created. =back As you've seen, you can force C to create an absolute path by passing either an empty string or a path that begins with a volume name as the first argument. However, you are strongly encouraged not to do so, since this is done only for backward compatibility. Newer versions of File::Spec come with a method called C (see below), that is designed to offer a portable solution for the creation of absolute paths. It takes volume, directory and file portions and returns an entire path. While C is still suitable for the concatenation of I, you are encouraged to use C to concatenate I and I. E.g. $dir = File::Spec->catdir("tmp","sources"); $abs_path = File::Spec->catpath("MacintoshHD:", $dir,""); yields "MacintoshHD:tmp:sources:" . =cut sub catdir { my $self = shift; return '' unless @_; my @args = @_; my $first_arg; my $relative; # take care of the first argument if ($args[0] eq '') { # absolute path, rootdir shift @args; $relative = 0; $first_arg = $self->rootdir; } elsif ($args[0] =~ /^[^:]+:/) { # absolute path, volume name $relative = 0; $first_arg = shift @args; # add a trailing ':' if need be (may be it's a path like HD:dir) $first_arg = "$first_arg:" unless ($first_arg =~ /:\Z(?!\n)/); } else { # relative path $relative = 1; if ( $args[0] =~ /^::+\Z(?!\n)/ ) { # updir colon path ('::', ':::' etc.), don't shift $first_arg = ':'; } elsif ($args[0] eq ':') { $first_arg = shift @args; } else { # add a trailing ':' if need be $first_arg = shift @args; $first_arg = "$first_arg:" unless ($first_arg =~ /:\Z(?!\n)/); } } # For all other arguments, # (a) ignore arguments that equal ':' or '', # (b) handle updir paths specially: # '::' -> concatenate '::' # '::' . '::' -> concatenate ':::' etc. # (c) add a trailing ':' if need be my $result = $first_arg; while (@args) { my $arg = shift @args; unless (($arg eq '') || ($arg eq ':')) { if ($arg =~ /^::+\Z(?!\n)/ ) { # updir colon path like ':::' my $updir_count = length($arg) - 1; while ((@args) && ($args[0] =~ /^::+\Z(?!\n)/) ) { # while updir colon path $arg = shift @args; $updir_count += (length($arg) - 1); } $arg = (':' x $updir_count); } else { $arg =~ s/^://s; # remove a leading ':' if any $arg = "$arg:" unless ($arg =~ /:\Z(?!\n)/); # ensure trailing ':' } $result .= $arg; }#unless } if ( ($relative) && ($result !~ /^:/) ) { # add a leading colon if need be $result = ":$result"; } unless ($relative) { # remove updirs immediately following the volume name $result =~ s/([^:]+:)(:*)(.*)\Z(?!\n)/$1$3/; } return $result; } =item catfile Concatenate one or more directory names and a filename to form a complete path ending with a filename. Resulting paths are B by default, but can be forced to be absolute (but avoid this). B Beginning with version 1.3 of this module, the resulting path is relative by default and I absolute. This decision was made due to portability reasons. Since Ccatfile()> returns relative paths on all other operating systems, it will now also follow this convention on Mac OS. Note that this may break some existing scripts. The last argument is always considered to be the file portion. Since C uses C (see above) for the concatenation of the directory portions (if any), the following with regard to relative and absolute paths is true: catfile("") = "" catfile("file") = "file" but catfile("","") = rootdir() # (e.g. "HD:") catfile("","file") = rootdir() . file # (e.g. "HD:file") catfile("HD:","file") = "HD:file" This means that C is called only when there are two or more arguments, as one might expect. Note that the leading ":" is removed from the filename, so that catfile("a","b","file") = ":a:b:file" and catfile("a","b",":file") = ":a:b:file" give the same answer. To concatenate I, I and I, you are encouraged to use C (see below). =cut sub catfile { my $self = shift; return '' unless @_; my $file = pop @_; return $file unless @_; my $dir = $self->catdir(@_); $file =~ s/^://s; return $dir.$file; } =item curdir Returns a string representing the current directory. On Mac OS, this is ":". =cut sub curdir { return ":"; } =item devnull Returns a string representing the null device. On Mac OS, this is "Dev:Null". =cut sub devnull { return "Dev:Null"; } =item rootdir Returns a string representing the root directory. Under MacPerl, returns the name of the startup volume, since that's the closest in concept, although other volumes aren't rooted there. The name has a trailing ":", because that's the correct specification for a volume name on Mac OS. If Mac::Files could not be loaded, the empty string is returned. =cut sub rootdir { # # There's no real root directory on Mac OS. The name of the startup # volume is returned, since that's the closest in concept. # return '' unless $macfiles; my $system = Mac::Files::FindFolder(&Mac::Files::kOnSystemDisk, &Mac::Files::kSystemFolderType); $system =~ s/:.*\Z(?!\n)/:/s; return $system; } =item tmpdir Returns the contents of $ENV{TMPDIR}, if that directory exits or the current working directory otherwise. Under MacPerl, $ENV{TMPDIR} will contain a path like "MacintoshHD:Temporary Items:", which is a hidden directory on your startup volume. =cut my $tmpdir; sub tmpdir { return $tmpdir if defined $tmpdir; $tmpdir = $_[0]->_tmpdir( $ENV{TMPDIR} ); } =item updir Returns a string representing the parent directory. On Mac OS, this is "::". =cut sub updir { return "::"; } =item file_name_is_absolute Takes as argument a path and returns true, if it is an absolute path. If the path has a leading ":", it's a relative path. Otherwise, it's an absolute path, unless the path doesn't contain any colons, i.e. it's a name like "a". In this particular case, the path is considered to be relative (i.e. it is considered to be a filename). Use ":" in the appropriate place in the path if you want to distinguish unambiguously. As a special case, the filename '' is always considered to be absolute. Note that with version 1.2 of File::Spec::Mac, this does no longer consult the local filesystem. E.g. File::Spec->file_name_is_absolute("a"); # false (relative) File::Spec->file_name_is_absolute(":a:b:"); # false (relative) File::Spec->file_name_is_absolute("MacintoshHD:"); # true (absolute) File::Spec->file_name_is_absolute(""); # true (absolute) =cut sub file_name_is_absolute { my ($self,$file) = @_; if ($file =~ /:/) { return (! ($file =~ m/^:/s) ); } elsif ( $file eq '' ) { return 1 ; } else { return 0; # i.e. a file like "a" } } =item path Returns the null list for the MacPerl application, since the concept is usually meaningless under Mac OS. But if you're using the MacPerl tool under MPW, it gives back $ENV{Commands} suitably split, as is done in :lib:ExtUtils:MM_Mac.pm. =cut sub path { # # The concept is meaningless under the MacPerl application. # Under MPW, it has a meaning. # return unless exists $ENV{Commands}; return split(/,/, $ENV{Commands}); } =item splitpath ($volume,$directories,$file) = File::Spec->splitpath( $path ); ($volume,$directories,$file) = File::Spec->splitpath( $path, $no_file ); Splits a path into volume, directory, and filename portions. On Mac OS, assumes that the last part of the path is a filename unless $no_file is true or a trailing separator ":" is present. The volume portion is always returned with a trailing ":". The directory portion is always returned with a leading (to denote a relative path) and a trailing ":" (to denote a directory). The file portion is always returned I a leading ":". Empty portions are returned as empty string ''. The results can be passed to C to get back a path equivalent to (usually identical to) the original path. =cut sub splitpath { my ($self,$path, $nofile) = @_; my ($volume,$directory,$file); if ( $nofile ) { ( $volume, $directory ) = $path =~ m|^((?:[^:]+:)?)(.*)|s; } else { $path =~ m|^( (?: [^:]+: )? ) ( (?: .*: )? ) ( .* ) |xs; $volume = $1; $directory = $2; $file = $3; } $volume = '' unless defined($volume); $directory = ":$directory" if ( $volume && $directory ); # take care of "HD::dir" if ($directory) { # Make sure non-empty directories begin and end in ':' $directory .= ':' unless (substr($directory,-1) eq ':'); $directory = ":$directory" unless (substr($directory,0,1) eq ':'); } else { $directory = ''; } $file = '' unless defined($file); return ($volume,$directory,$file); } =item splitdir The opposite of C. @dirs = File::Spec->splitdir( $directories ); $directories should be only the directory portion of the path on systems that have the concept of a volume or that have path syntax that differentiates files from directories. Consider using C otherwise. Unlike just splitting the directories on the separator, empty directory names (C<"">) can be returned. Since C on Mac OS always appends a trailing colon to distinguish a directory path from a file path, a single trailing colon will be ignored, i.e. there's no empty directory name after it. Hence, on Mac OS, both File::Spec->splitdir( ":a:b::c:" ); and File::Spec->splitdir( ":a:b::c" ); yield: ( "a", "b", "::", "c") while File::Spec->splitdir( ":a:b::c::" ); yields: ( "a", "b", "::", "c", "::") =cut sub splitdir { my ($self, $path) = @_; my @result = (); my ($head, $sep, $tail, $volume, $directories); return @result if ( (!defined($path)) || ($path eq '') ); return (':') if ($path eq ':'); ( $volume, $sep, $directories ) = $path =~ m|^((?:[^:]+:)?)(:*)(.*)|s; # deprecated, but handle it correctly if ($volume) { push (@result, $volume); $sep .= ':'; } while ($sep || $directories) { if (length($sep) > 1) { my $updir_count = length($sep) - 1; for (my $i=0; $i<$updir_count; $i++) { # push '::' updir_count times; # simulate Unix '..' updirs push (@result, '::'); } } $sep = ''; if ($directories) { ( $head, $sep, $tail ) = $directories =~ m|^((?:[^:]+)?)(:*)(.*)|s; push (@result, $head); $directories = $tail; } } return @result; } =item catpath $path = File::Spec->catpath($volume,$directory,$file); Takes volume, directory and file portions and returns an entire path. On Mac OS, $volume, $directory and $file are concatenated. A ':' is inserted if need be. You may pass an empty string for each portion. If all portions are empty, the empty string is returned. If $volume is empty, the result will be a relative path, beginning with a ':'. If $volume and $directory are empty, a leading ":" (if any) is removed form $file and the remainder is returned. If $file is empty, the resulting path will have a trailing ':'. =cut sub catpath { my ($self,$volume,$directory,$file) = @_; if ( (! $volume) && (! $directory) ) { $file =~ s/^:// if $file; return $file ; } # We look for a volume in $volume, then in $directory, but not both my ($dir_volume, $dir_dirs) = $self->splitpath($directory, 1); $volume = $dir_volume unless length $volume; my $path = $volume; # may be '' $path .= ':' unless (substr($path, -1) eq ':'); # ensure trailing ':' if ($directory) { $directory = $dir_dirs if $volume; $directory =~ s/^://; # remove leading ':' if any $path .= $directory; $path .= ':' unless (substr($path, -1) eq ':'); # ensure trailing ':' } if ($file) { $file =~ s/^://; # remove leading ':' if any $path .= $file; } return $path; } =item abs2rel Takes a destination path and an optional base path and returns a relative path from the base path to the destination path: $rel_path = File::Spec->abs2rel( $path ) ; $rel_path = File::Spec->abs2rel( $path, $base ) ; Note that both paths are assumed to have a notation that distinguishes a directory path (with trailing ':') from a file path (without trailing ':'). If $base is not present or '', then the current working directory is used. If $base is relative, then it is converted to absolute form using C. This means that it is taken to be relative to the current working directory. If $path and $base appear to be on two different volumes, we will not attempt to resolve the two paths, and we will instead simply return $path. Note that previous versions of this module ignored the volume of $base, which resulted in garbage results part of the time. If $base doesn't have a trailing colon, the last element of $base is assumed to be a filename. This filename is ignored. Otherwise all path components are assumed to be directories. If $path is relative, it is converted to absolute form using C. This means that it is taken to be relative to the current working directory. Based on code written by Shigio Yamaguchi. =cut # maybe this should be done in canonpath() ? sub _resolve_updirs { my $path = shift @_; my $proceed; # resolve any updirs, e.g. "HD:tmp::file" -> "HD:file" do { $proceed = ($path =~ s/^(.*):[^:]+::(.*?)\z/$1:$2/); } while ($proceed); return $path; } sub abs2rel { my($self,$path,$base) = @_; # Clean up $path if ( ! $self->file_name_is_absolute( $path ) ) { $path = $self->rel2abs( $path ) ; } # Figure out the effective $base and clean it up. if ( !defined( $base ) || $base eq '' ) { $base = $self->_cwd(); } elsif ( ! $self->file_name_is_absolute( $base ) ) { $base = $self->rel2abs( $base ) ; $base = _resolve_updirs( $base ); # resolve updirs in $base } else { $base = _resolve_updirs( $base ); } # Split up paths - ignore $base's file my ( $path_vol, $path_dirs, $path_file ) = $self->splitpath( $path ); my ( $base_vol, $base_dirs ) = $self->splitpath( $base ); return $path unless lc( $path_vol ) eq lc( $base_vol ); # Now, remove all leading components that are the same my @pathchunks = $self->splitdir( $path_dirs ); my @basechunks = $self->splitdir( $base_dirs ); while ( @pathchunks && @basechunks && lc( $pathchunks[0] ) eq lc( $basechunks[0] ) ) { shift @pathchunks ; shift @basechunks ; } # @pathchunks now has the directories to descend in to. # ensure relative path, even if @pathchunks is empty $path_dirs = $self->catdir( ':', @pathchunks ); # @basechunks now contains the number of directories to climb out of. $base_dirs = (':' x @basechunks) . ':' ; return $self->catpath( '', $self->catdir( $base_dirs, $path_dirs ), $path_file ) ; } =item rel2abs Converts a relative path to an absolute path: $abs_path = File::Spec->rel2abs( $path ) ; $abs_path = File::Spec->rel2abs( $path, $base ) ; Note that both paths are assumed to have a notation that distinguishes a directory path (with trailing ':') from a file path (without trailing ':'). If $base is not present or '', then $base is set to the current working directory. If $base is relative, then it is converted to absolute form using C. This means that it is taken to be relative to the current working directory. If $base doesn't have a trailing colon, the last element of $base is assumed to be a filename. This filename is ignored. Otherwise all path components are assumed to be directories. If $path is already absolute, it is returned and $base is ignored. Based on code written by Shigio Yamaguchi. =cut sub rel2abs { my ($self,$path,$base) = @_; if ( ! $self->file_name_is_absolute($path) ) { # Figure out the effective $base and clean it up. if ( !defined( $base ) || $base eq '' ) { $base = $self->_cwd(); } elsif ( ! $self->file_name_is_absolute($base) ) { $base = $self->rel2abs($base) ; } # Split up paths # ignore $path's volume my ( $path_dirs, $path_file ) = ($self->splitpath($path))[1,2] ; # ignore $base's file part my ( $base_vol, $base_dirs ) = $self->splitpath($base) ; # Glom them together $path_dirs = ':' if ($path_dirs eq ''); $base_dirs =~ s/:$//; # remove trailing ':', if any $base_dirs = $base_dirs . $path_dirs; $path = $self->catpath( $base_vol, $base_dirs, $path_file ); } return $path; } =back =head1 AUTHORS See the authors list in I. Mac OS support by Paul Schinder and Thomas Wegner . =head1 COPYRIGHT Copyright (c) 2004 by the Perl 5 Porters. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO See L and L. This package overrides the implementation of these methods, not the semantics. =cut 1; I686-LINUX_FILE_SPEC_MAC $fatpacked{"i686-linux/File/Spec/OS2.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'I686-LINUX_FILE_SPEC_OS2'; package File::Spec::OS2; use strict; use vars qw(@ISA $VERSION); require File::Spec::Unix; $VERSION = '3.40'; $VERSION =~ tr/_//; @ISA = qw(File::Spec::Unix); sub devnull { return "/dev/nul"; } sub case_tolerant { return 1; } sub file_name_is_absolute { my ($self,$file) = @_; return scalar($file =~ m{^([a-z]:)?[\\/]}is); } sub path { my $path = $ENV{PATH}; $path =~ s:\\:/:g; my @path = split(';',$path); foreach (@path) { $_ = '.' if $_ eq '' } return @path; } sub _cwd { # In OS/2 the "require Cwd" is unnecessary bloat. return Cwd::sys_cwd(); } my $tmpdir; sub tmpdir { return $tmpdir if defined $tmpdir; my @d = @ENV{qw(TMPDIR TEMP TMP)}; # function call could autovivivy $tmpdir = $_[0]->_tmpdir( @d, '/tmp', '/' ); } sub catdir { my $self = shift; my @args = @_; foreach (@args) { tr[\\][/]; # append a backslash to each argument unless it has one there $_ .= "/" unless m{/$}; } return $self->canonpath(join('', @args)); } sub canonpath { my ($self,$path) = @_; return unless defined $path; $path =~ s/^([a-z]:)/\l$1/s; $path =~ s|\\|/|g; $path =~ s|([^/])/+|$1/|g; # xx////xx -> xx/xx $path =~ s|(/\.)+/|/|g; # xx/././xx -> xx/xx $path =~ s|^(\./)+(?=[^/])||s; # ./xx -> xx $path =~ s|/\Z(?!\n)|| unless $path =~ m#^([a-z]:)?/\Z(?!\n)#si;# xx/ -> xx $path =~ s{^/\.\.$}{/}; # /.. -> / 1 while $path =~ s{^/\.\.}{}; # /../xx -> /xx return $path; } sub splitpath { my ($self,$path, $nofile) = @_; my ($volume,$directory,$file) = ('','',''); if ( $nofile ) { $path =~ m{^( (?:[a-zA-Z]:|(?:\\\\|//)[^\\/]+[\\/][^\\/]+)? ) (.*) }xs; $volume = $1; $directory = $2; } else { $path =~ m{^ ( (?: [a-zA-Z]: | (?:\\\\|//)[^\\/]+[\\/][^\\/]+ )? ) ( (?:.*[\\\\/](?:\.\.?\Z(?!\n))?)? ) (.*) }xs; $volume = $1; $directory = $2; $file = $3; } return ($volume,$directory,$file); } sub splitdir { my ($self,$directories) = @_ ; split m|[\\/]|, $directories, -1; } sub catpath { my ($self,$volume,$directory,$file) = @_; # If it's UNC, make sure the glue separator is there, reusing # whatever separator is first in the $volume $volume .= $1 if ( $volume =~ m@^([\\/])[\\/][^\\/]+[\\/][^\\/]+\Z(?!\n)@s && $directory =~ m@^[^\\/]@s ) ; $volume .= $directory ; # If the volume is not just A:, make sure the glue separator is # there, reusing whatever separator is first in the $volume if possible. if ( $volume !~ m@^[a-zA-Z]:\Z(?!\n)@s && $volume =~ m@[^\\/]\Z(?!\n)@ && $file =~ m@[^\\/]@ ) { $volume =~ m@([\\/])@ ; my $sep = $1 ? $1 : '/' ; $volume .= $sep ; } $volume .= $file ; return $volume ; } sub abs2rel { my($self,$path,$base) = @_; # Clean up $path if ( ! $self->file_name_is_absolute( $path ) ) { $path = $self->rel2abs( $path ) ; } else { $path = $self->canonpath( $path ) ; } # Figure out the effective $base and clean it up. if ( !defined( $base ) || $base eq '' ) { $base = $self->_cwd(); } elsif ( ! $self->file_name_is_absolute( $base ) ) { $base = $self->rel2abs( $base ) ; } else { $base = $self->canonpath( $base ) ; } # Split up paths my ( $path_volume, $path_directories, $path_file ) = $self->splitpath( $path, 1 ) ; my ( $base_volume, $base_directories ) = $self->splitpath( $base, 1 ) ; return $path unless $path_volume eq $base_volume; # Now, remove all leading components that are the same my @pathchunks = $self->splitdir( $path_directories ); my @basechunks = $self->splitdir( $base_directories ); while ( @pathchunks && @basechunks && lc( $pathchunks[0] ) eq lc( $basechunks[0] ) ) { shift @pathchunks ; shift @basechunks ; } # No need to catdir, we know these are well formed. $path_directories = CORE::join( '/', @pathchunks ); $base_directories = CORE::join( '/', @basechunks ); # $base_directories now contains the directories the resulting relative # path must ascend out of before it can descend to $path_directory. So, # replace all names with $parentDir #FA Need to replace between backslashes... $base_directories =~ s|[^\\/]+|..|g ; # Glue the two together, using a separator if necessary, and preventing an # empty result. #FA Must check that new directories are not empty. if ( $path_directories ne '' && $base_directories ne '' ) { $path_directories = "$base_directories/$path_directories" ; } else { $path_directories = "$base_directories$path_directories" ; } return $self->canonpath( $self->catpath( "", $path_directories, $path_file ) ) ; } sub rel2abs { my ($self,$path,$base ) = @_; if ( ! $self->file_name_is_absolute( $path ) ) { if ( !defined( $base ) || $base eq '' ) { $base = $self->_cwd(); } elsif ( ! $self->file_name_is_absolute( $base ) ) { $base = $self->rel2abs( $base ) ; } else { $base = $self->canonpath( $base ) ; } my ( $path_directories, $path_file ) = ($self->splitpath( $path, 1 ))[1,2] ; my ( $base_volume, $base_directories ) = $self->splitpath( $base, 1 ) ; $path = $self->catpath( $base_volume, $self->catdir( $base_directories, $path_directories ), $path_file ) ; } return $self->canonpath( $path ) ; } 1; __END__ =head1 NAME File::Spec::OS2 - methods for OS/2 file specs =head1 SYNOPSIS require File::Spec::OS2; # Done internally by File::Spec if needed =head1 DESCRIPTION See L and L. This package overrides the implementation of these methods, not the semantics. Amongst the changes made for OS/2 are... =over 4 =item tmpdir Modifies the list of places temp directory information is looked for. $ENV{TMPDIR} $ENV{TEMP} $ENV{TMP} /tmp / =item splitpath Volumes can be drive letters or UNC sharenames (\\server\share). =back =head1 COPYRIGHT Copyright (c) 2004 by the Perl 5 Porters. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut I686-LINUX_FILE_SPEC_OS2 $fatpacked{"i686-linux/File/Spec/Unix.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'I686-LINUX_FILE_SPEC_UNIX'; package File::Spec::Unix; use strict; use vars qw($VERSION); $VERSION = '3.40'; $VERSION =~ tr/_//; =head1 NAME File::Spec::Unix - File::Spec for Unix, base for other File::Spec modules =head1 SYNOPSIS require File::Spec::Unix; # Done automatically by File::Spec =head1 DESCRIPTION Methods for manipulating file specifications. Other File::Spec modules, such as File::Spec::Mac, inherit from File::Spec::Unix and override specific methods. =head1 METHODS =over 2 =item canonpath() No physical check on the filesystem, but a logical cleanup of a path. On UNIX eliminates successive slashes and successive "/.". $cpath = File::Spec->canonpath( $path ) ; Note that this does *not* collapse F sections into F. This is by design. If F on your system is a symlink to F, then F is actually F, not F as a naive F<../>-removal would give you. If you want to do this kind of processing, you probably want C's C function to actually traverse the filesystem cleaning up paths like this. =cut sub canonpath { my ($self,$path) = @_; return unless defined $path; # Handle POSIX-style node names beginning with double slash (qnx, nto) # (POSIX says: "a pathname that begins with two successive slashes # may be interpreted in an implementation-defined manner, although # more than two leading slashes shall be treated as a single slash.") my $node = ''; my $double_slashes_special = $^O eq 'qnx' || $^O eq 'nto'; if ( $double_slashes_special && ( $path =~ s{^(//[^/]+)/?\z}{}s || $path =~ s{^(//[^/]+)/}{/}s ) ) { $node = $1; } # This used to be # $path =~ s|/+|/|g unless ($^O eq 'cygwin'); # but that made tests 29, 30, 35, 46, and 213 (as of #13272) to fail # (Mainly because trailing "" directories didn't get stripped). # Why would cygwin avoid collapsing multiple slashes into one? --jhi $path =~ s|/{2,}|/|g; # xx////xx -> xx/xx $path =~ s{(?:/\.)+(?:/|\z)}{/}g; # xx/././xx -> xx/xx $path =~ s|^(?:\./)+||s unless $path eq "./"; # ./xx -> xx $path =~ s|^/(?:\.\./)+|/|; # /../../xx -> xx $path =~ s|^/\.\.$|/|; # /.. -> / $path =~ s|/\z|| unless $path eq "/"; # xx/ -> xx return "$node$path"; } =item catdir() Concatenate two or more directory names to form a complete path ending with a directory. But remove the trailing slash from the resulting string, because it doesn't look good, isn't necessary and confuses OS2. Of course, if this is the root directory, don't cut off the trailing slash :-) =cut sub catdir { my $self = shift; $self->canonpath(join('/', @_, '')); # '' because need a trailing '/' } =item catfile Concatenate one or more directory names and a filename to form a complete path ending with a filename =cut sub catfile { my $self = shift; my $file = $self->canonpath(pop @_); return $file unless @_; my $dir = $self->catdir(@_); $dir .= "/" unless substr($dir,-1) eq "/"; return $dir.$file; } =item curdir Returns a string representation of the current directory. "." on UNIX. =cut sub curdir { '.' } =item devnull Returns a string representation of the null device. "/dev/null" on UNIX. =cut sub devnull { '/dev/null' } =item rootdir Returns a string representation of the root directory. "/" on UNIX. =cut sub rootdir { '/' } =item tmpdir Returns a string representation of the first writable directory from the following list or the current directory if none from the list are writable: $ENV{TMPDIR} /tmp If running under taint mode, and if $ENV{TMPDIR} is tainted, it is not used. =cut my $tmpdir; sub _tmpdir { return $tmpdir if defined $tmpdir; my $self = shift; my @dirlist = @_; { no strict 'refs'; if (${"\cTAINT"}) { # Check for taint mode on perl >= 5.8.0 require Scalar::Util; @dirlist = grep { ! Scalar::Util::tainted($_) } @dirlist; } elsif ($] < 5.007) { # No ${^TAINT} before 5.8 @dirlist = grep { eval { eval('1'.substr $_,0,0) } } @dirlist; } } foreach (@dirlist) { next unless defined && -d && -w _; $tmpdir = $_; last; } $tmpdir = $self->curdir unless defined $tmpdir; $tmpdir = defined $tmpdir && $self->canonpath($tmpdir); return $tmpdir; } sub tmpdir { return $tmpdir if defined $tmpdir; $tmpdir = $_[0]->_tmpdir( $ENV{TMPDIR}, "/tmp" ); } =item updir Returns a string representation of the parent directory. ".." on UNIX. =cut sub updir { '..' } =item no_upwards Given a list of file names, strip out those that refer to a parent directory. (Does not strip symlinks, only '.', '..', and equivalents.) =cut sub no_upwards { my $self = shift; return grep(!/^\.{1,2}\z/s, @_); } =item case_tolerant Returns a true or false value indicating, respectively, that alphabetic is not or is significant when comparing file specifications. =cut sub case_tolerant { 0 } =item file_name_is_absolute Takes as argument a path and returns true if it is an absolute path. This does not consult the local filesystem on Unix, Win32, OS/2 or Mac OS (Classic). It does consult the working environment for VMS (see L). =cut sub file_name_is_absolute { my ($self,$file) = @_; return scalar($file =~ m:^/:s); } =item path Takes no argument, returns the environment variable PATH as an array. =cut sub path { return () unless exists $ENV{PATH}; my @path = split(':', $ENV{PATH}); foreach (@path) { $_ = '.' if $_ eq '' } return @path; } =item join join is the same as catfile. =cut sub join { my $self = shift; return $self->catfile(@_); } =item splitpath ($volume,$directories,$file) = File::Spec->splitpath( $path ); ($volume,$directories,$file) = File::Spec->splitpath( $path, $no_file ); Splits a path into volume, directory, and filename portions. On systems with no concept of volume, returns '' for volume. For systems with no syntax differentiating filenames from directories, assumes that the last file is a path unless $no_file is true or a trailing separator or /. or /.. is present. On Unix this means that $no_file true makes this return ( '', $path, '' ). The directory portion may or may not be returned with a trailing '/'. The results can be passed to L to get back a path equivalent to (usually identical to) the original path. =cut sub splitpath { my ($self,$path, $nofile) = @_; my ($volume,$directory,$file) = ('','',''); if ( $nofile ) { $directory = $path; } else { $path =~ m|^ ( (?: .* / (?: \.\.?\z )? )? ) ([^/]*) |xs; $directory = $1; $file = $2; } return ($volume,$directory,$file); } =item splitdir The opposite of L. @dirs = File::Spec->splitdir( $directories ); $directories must be only the directory portion of the path on systems that have the concept of a volume or that have path syntax that differentiates files from directories. Unlike just splitting the directories on the separator, empty directory names (C<''>) can be returned, because these are significant on some OSs. On Unix, File::Spec->splitdir( "/a/b//c/" ); Yields: ( '', 'a', 'b', '', 'c', '' ) =cut sub splitdir { return split m|/|, $_[1], -1; # Preserve trailing fields } =item catpath() Takes volume, directory and file portions and returns an entire path. Under Unix, $volume is ignored, and directory and file are concatenated. A '/' is inserted if needed (though if the directory portion doesn't start with '/' it is not added). On other OSs, $volume is significant. =cut sub catpath { my ($self,$volume,$directory,$file) = @_; if ( $directory ne '' && $file ne '' && substr( $directory, -1 ) ne '/' && substr( $file, 0, 1 ) ne '/' ) { $directory .= "/$file" ; } else { $directory .= $file ; } return $directory ; } =item abs2rel Takes a destination path and an optional base path returns a relative path from the base path to the destination path: $rel_path = File::Spec->abs2rel( $path ) ; $rel_path = File::Spec->abs2rel( $path, $base ) ; If $base is not present or '', then L is used. If $base is relative, then it is converted to absolute form using L. This means that it is taken to be relative to L. On systems that have a grammar that indicates filenames, this ignores the $base filename. Otherwise all path components are assumed to be directories. If $path is relative, it is converted to absolute form using L. This means that it is taken to be relative to L. No checks against the filesystem are made, so the result may not be correct if C<$base> contains symbolic links. (Apply L beforehand if that is a concern.) On VMS, there is interaction with the working environment, as logicals and macros are expanded. Based on code written by Shigio Yamaguchi. =cut sub abs2rel { my($self,$path,$base) = @_; $base = $self->_cwd() unless defined $base and length $base; ($path, $base) = map $self->canonpath($_), $path, $base; my $path_directories; my $base_directories; if (grep $self->file_name_is_absolute($_), $path, $base) { ($path, $base) = map $self->rel2abs($_), $path, $base; my ($path_volume) = $self->splitpath($path, 1); my ($base_volume) = $self->splitpath($base, 1); # Can't relativize across volumes return $path unless $path_volume eq $base_volume; $path_directories = ($self->splitpath($path, 1))[1]; $base_directories = ($self->splitpath($base, 1))[1]; # For UNC paths, the user might give a volume like //foo/bar that # strictly speaking has no directory portion. Treat it as if it # had the root directory for that volume. if (!length($base_directories) and $self->file_name_is_absolute($base)) { $base_directories = $self->rootdir; } } else { my $wd= ($self->splitpath($self->_cwd(), 1))[1]; $path_directories = $self->catdir($wd, $path); $base_directories = $self->catdir($wd, $base); } # Now, remove all leading components that are the same my @pathchunks = $self->splitdir( $path_directories ); my @basechunks = $self->splitdir( $base_directories ); if ($base_directories eq $self->rootdir) { return $self->curdir if $path_directories eq $self->rootdir; shift @pathchunks; return $self->canonpath( $self->catpath('', $self->catdir( @pathchunks ), '') ); } my @common; while (@pathchunks && @basechunks && $self->_same($pathchunks[0], $basechunks[0])) { push @common, shift @pathchunks ; shift @basechunks ; } return $self->curdir unless @pathchunks || @basechunks; # @basechunks now contains the directories the resulting relative path # must ascend out of before it can descend to $path_directory. If there # are updir components, we must descend into the corresponding directories # (this only works if they are no symlinks). my @reverse_base; while( defined(my $dir= shift @basechunks) ) { if( $dir ne $self->updir ) { unshift @reverse_base, $self->updir; push @common, $dir; } elsif( @common ) { if( @reverse_base && $reverse_base[0] eq $self->updir ) { shift @reverse_base; pop @common; } else { unshift @reverse_base, pop @common; } } } my $result_dirs = $self->catdir( @reverse_base, @pathchunks ); return $self->canonpath( $self->catpath('', $result_dirs, '') ); } sub _same { $_[1] eq $_[2]; } =item rel2abs() Converts a relative path to an absolute path. $abs_path = File::Spec->rel2abs( $path ) ; $abs_path = File::Spec->rel2abs( $path, $base ) ; If $base is not present or '', then L is used. If $base is relative, then it is converted to absolute form using L. This means that it is taken to be relative to L. On systems that have a grammar that indicates filenames, this ignores the $base filename. Otherwise all path components are assumed to be directories. If $path is absolute, it is cleaned up and returned using L. No checks against the filesystem are made. On VMS, there is interaction with the working environment, as logicals and macros are expanded. Based on code written by Shigio Yamaguchi. =cut sub rel2abs { my ($self,$path,$base ) = @_; # Clean up $path if ( ! $self->file_name_is_absolute( $path ) ) { # Figure out the effective $base and clean it up. if ( !defined( $base ) || $base eq '' ) { $base = $self->_cwd(); } elsif ( ! $self->file_name_is_absolute( $base ) ) { $base = $self->rel2abs( $base ) ; } else { $base = $self->canonpath( $base ) ; } # Glom them together $path = $self->catdir( $base, $path ) ; } return $self->canonpath( $path ) ; } =back =head1 COPYRIGHT Copyright (c) 2004 by the Perl 5 Porters. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Please submit bug reports and patches to perlbug@perl.org. =head1 SEE ALSO L =cut # Internal routine to File::Spec, no point in making this public since # it is the standard Cwd interface. Most of the platform-specific # File::Spec subclasses use this. sub _cwd { require Cwd; Cwd::getcwd(); } # Internal method to reduce xx\..\yy -> yy sub _collapse { my($fs, $path) = @_; my $updir = $fs->updir; my $curdir = $fs->curdir; my($vol, $dirs, $file) = $fs->splitpath($path); my @dirs = $fs->splitdir($dirs); pop @dirs if @dirs && $dirs[-1] eq ''; my @collapsed; foreach my $dir (@dirs) { if( $dir eq $updir and # if we have an updir @collapsed and # and something to collapse length $collapsed[-1] and # and its not the rootdir $collapsed[-1] ne $updir and # nor another updir $collapsed[-1] ne $curdir # nor the curdir ) { # then pop @collapsed; # collapse } else { # else push @collapsed, $dir; # just hang onto it } } return $fs->catpath($vol, $fs->catdir(@collapsed), $file ); } 1; I686-LINUX_FILE_SPEC_UNIX $fatpacked{"i686-linux/File/Spec/VMS.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'I686-LINUX_FILE_SPEC_VMS'; package File::Spec::VMS; use strict; use vars qw(@ISA $VERSION); require File::Spec::Unix; $VERSION = '3.40'; $VERSION =~ tr/_//; @ISA = qw(File::Spec::Unix); use File::Basename; use VMS::Filespec; =head1 NAME File::Spec::VMS - methods for VMS file specs =head1 SYNOPSIS require File::Spec::VMS; # Done internally by File::Spec if needed =head1 DESCRIPTION See File::Spec::Unix for a documentation of the methods provided there. This package overrides the implementation of these methods, not the semantics. The default behavior is to allow either VMS or Unix syntax on input and to return VMS syntax on output unless Unix syntax has been explicity requested via the C CRTL feature. =over 4 =cut # Need to look up the feature settings. The preferred way is to use the # VMS::Feature module, but that may not be available to dual life modules. my $use_feature; BEGIN { if (eval { local $SIG{__DIE__}; require VMS::Feature; }) { $use_feature = 1; } } # Need to look up the UNIX report mode. This may become a dynamic mode # in the future. sub _unix_rpt { my $unix_rpt; if ($use_feature) { $unix_rpt = VMS::Feature::current("filename_unix_report"); } else { my $env_unix_rpt = $ENV{'DECC$FILENAME_UNIX_REPORT'} || ''; $unix_rpt = $env_unix_rpt =~ /^[ET1]/i; } return $unix_rpt; } =item canonpath (override) Removes redundant portions of file specifications and returns results in native syntax unless Unix filename reporting has been enabled. =cut sub canonpath { my($self,$path) = @_; return undef unless defined $path; my $unix_rpt = $self->_unix_rpt; if ($path =~ m|/|) { my $pathify = $path =~ m|/\Z(?!\n)|; $path = $self->SUPER::canonpath($path); return $path if $unix_rpt; $path = $pathify ? vmspath($path) : vmsify($path); } $path =~ s/(? ==> [ and ] $path =~ s/(?/]/; $path =~ s/(? .][ $path =~ s/(? [ $path =~ s/(? [ $path =~ s/(? ] $path =~ s/(? foo.bar 1 while ($path =~ s/(? .--. # [-.-. ==> [--. # .-.-] ==> .--] # [-.-] ==> [--] 1 while ($path =~ s/(? .-. # .foo.--] ==> .-] # [foo.--. ==> [-. # [foo.--] ==> [-] # # And then, the remaining cases $path =~ s/(? [- $path =~ s/(? . $path =~ s/(? [ $path =~ s/(? ] # [foo.-] ==> [000000] $path =~ s/(? $path =~ s/(?_unix_rpt; my @dirs = grep {defined() && length()} @_; my $rslt; if (@dirs) { my $path = (@dirs == 1 ? $dirs[0] : $self->catdir(@dirs)); my ($spath,$sdir) = ($path,$dir); $spath =~ s/\.dir\Z(?!\n)//i; $sdir =~ s/\.dir\Z(?!\n)//i; if ($unix_rpt) { $spath = unixify($spath) unless $spath =~ m#/#; $sdir= unixify($sdir) unless $sdir =~ m#/#; return $self->SUPER::catdir($spath, $sdir) } $sdir = $self->eliminate_macros($sdir) unless $sdir =~ /^[\w\-]+\Z(?!\n)/s; $rslt = $self->fixpath($self->eliminate_macros($spath)."/$sdir",1); # Special case for VMS absolute directory specs: these will have # had device prepended during trip through Unix syntax in # eliminate_macros(), since Unix syntax has no way to express # "absolute from the top of this device's directory tree". if ($spath =~ /^[\[<][^.\-]/s) { $rslt =~ s/^[^\[<]+//s; } } else { # Single directory. Return an empty string on null input; otherwise # just return a canonical path. if (not defined $dir or not length $dir) { $rslt = ''; } else { $rslt = $unix_rpt ? $dir : vmspath($dir); } } return $self->canonpath($rslt); } =item catfile (override) Concatenates a list of directory specifications with a filename specification to build a path. =cut sub catfile { my $self = shift; my $tfile = pop(); my $file = $self->canonpath($tfile); my @files = grep {defined() && length()} @_; my $unix_rpt = $self->_unix_rpt; my $rslt; if (@files) { my $path = (@files == 1 ? $files[0] : $self->catdir(@files)); my $spath = $path; # Something building a VMS path in pieces may try to pass a # directory name in filename format, so normalize it. $spath =~ s/\.dir\Z(?!\n)//i; # If the spath ends with a directory delimiter and the file is bare, # then just concatenate them. if ($spath =~ /^(?]+\)\Z(?!\n)/s && basename($file) eq $file) { $rslt = "$spath$file"; } else { $rslt = $self->eliminate_macros($spath); $rslt .= (defined($rslt) && length($rslt) ? '/' : '') . unixify($file); $rslt = vmsify($rslt) unless $unix_rpt; } } else { # Only passed a single file? my $xfile = (defined($file) && length($file)) ? $file : ''; $rslt = $unix_rpt ? $file : vmsify($file); } return $self->canonpath($rslt) unless $unix_rpt; # In Unix report mode, do not strip off redundant path information. return $rslt; } =item curdir (override) Returns a string representation of the current directory: '[]' or '.' =cut sub curdir { my $self = shift @_; return '.' if ($self->_unix_rpt); return '[]'; } =item devnull (override) Returns a string representation of the null device: '_NLA0:' or '/dev/null' =cut sub devnull { my $self = shift @_; return '/dev/null' if ($self->_unix_rpt); return "_NLA0:"; } =item rootdir (override) Returns a string representation of the root directory: 'SYS$DISK:[000000]' or '/' =cut sub rootdir { my $self = shift @_; if ($self->_unix_rpt) { # Root may exist, try it first. my $try = '/'; my ($dev1, $ino1) = stat('/'); my ($dev2, $ino2) = stat('.'); # Perl falls back to '.' if it can not determine '/' if (($dev1 != $dev2) || ($ino1 != $ino2)) { return $try; } # Fall back to UNIX format sys$disk. return '/sys$disk/'; } return 'SYS$DISK:[000000]'; } =item tmpdir (override) Returns a string representation of the first writable directory from the following list or '' if none are writable: /tmp if C is enabled. sys$scratch: $ENV{TMPDIR} Since perl 5.8.0, if running under taint mode, and if $ENV{TMPDIR} is tainted, it is not used. =cut my $tmpdir; sub tmpdir { my $self = shift @_; return $tmpdir if defined $tmpdir; if ($self->_unix_rpt) { $tmpdir = $self->_tmpdir('/tmp', '/sys$scratch', $ENV{TMPDIR}); return $tmpdir; } $tmpdir = $self->_tmpdir( 'sys$scratch:', $ENV{TMPDIR} ); } =item updir (override) Returns a string representation of the parent directory: '[-]' or '..' =cut sub updir { my $self = shift @_; return '..' if ($self->_unix_rpt); return '[-]'; } =item case_tolerant (override) VMS file specification syntax is case-tolerant. =cut sub case_tolerant { return 1; } =item path (override) Translate logical name DCL$PATH as a searchlist, rather than trying to C string value of C<$ENV{'PATH'}>. =cut sub path { my (@dirs,$dir,$i); while ($dir = $ENV{'DCL$PATH;' . $i++}) { push(@dirs,$dir); } return @dirs; } =item file_name_is_absolute (override) Checks for VMS directory spec as well as Unix separators. =cut sub file_name_is_absolute { my ($self,$file) = @_; # If it's a logical name, expand it. $file = $ENV{$file} while $file =~ /^[\w\$\-]+\Z(?!\n)/s && $ENV{$file}; return scalar($file =~ m!^/!s || $file =~ m![<\[][^.\-\]>]! || $file =~ /:[^<\[]/); } =item splitpath (override) ($volume,$directories,$file) = File::Spec->splitpath( $path ); ($volume,$directories,$file) = File::Spec->splitpath( $path, $no_file ); Passing a true value for C<$no_file> indicates that the path being split only contains directory components, even on systems where you can usually (when not supporting a foreign syntax) tell the difference between directories and files at a glance. =cut sub splitpath { my($self,$path, $nofile) = @_; my($dev,$dir,$file) = ('','',''); my $vmsify_path = vmsify($path); if ( $nofile ) { #vmsify('d1/d2/d3') returns '[.d1.d2]d3' #vmsify('/d1/d2/d3') returns 'd1:[d2]d3' if( $vmsify_path =~ /(.*)\](.+)/ ){ $vmsify_path = $1.'.'.$2.']'; } $vmsify_path =~ /(.+:)?(.*)/s; $dir = defined $2 ? $2 : ''; # dir can be '0' return ($1 || '',$dir,$file); } else { $vmsify_path =~ /(.+:)?([\[<].*[\]>])?(.*)/s; return ($1 || '',$2 || '',$3); } } =item splitdir (override) Split a directory specification into the components. =cut sub splitdir { my($self,$dirspec) = @_; my @dirs = (); return @dirs if ( (!defined $dirspec) || ('' eq $dirspec) ); $dirspec =~ s/(? ==> [ and ] $dirspec =~ s/(?/]/; $dirspec =~ s/(? .][ $dirspec =~ s/(? [ $dirspec =~ s/(? [ $dirspec =~ s/(? ] $dirspec =~ s/(? foo.bar while ($dirspec =~ s/(^|[\[\<\.])\-(\-+)($|[\]\>\.])/$1-.$2$3/g) {} # That loop does the following # with any amount of dashes: # .--. ==> .-.-. # [--. ==> [-.-. # .--] ==> .-.-] # [--] ==> [-.-] $dirspec = "[$dirspec]" unless $dirspec =~ /(?]\Z(?!\n)//s; @dirs; } =item catpath (override) Construct a complete filespec. =cut sub catpath { my($self,$dev,$dir,$file) = @_; # We look for a volume in $dev, then in $dir, but not both my ($dir_volume, $dir_dir, $dir_file) = $self->splitpath($dir); $dev = $dir_volume unless length $dev; $dir = length $dir_file ? $self->catfile($dir_dir, $dir_file) : $dir_dir; if ($dev =~ m|^(?'); "$dev$dir$file"; } =item abs2rel (override) Attempt to convert an absolute file specification to a relative specification. =cut sub abs2rel { my $self = shift; return vmspath(File::Spec::Unix::abs2rel( $self, @_ )) if grep m{/}, @_; my($path,$base) = @_; $base = $self->_cwd() unless defined $base and length $base; for ($path, $base) { $_ = $self->canonpath($_) } # Are we even starting $path on the same (node::)device as $base? Note that # logical paths or nodename differences may be on the "same device" # but the comparison that ignores device differences so as to concatenate # [---] up directory specs is not even a good idea in cases where there is # a logical path difference between $path and $base nodename and/or device. # Hence we fall back to returning the absolute $path spec # if there is a case blind device (or node) difference of any sort # and we do not even try to call $parse() or consult %ENV for $trnlnm() # (this module needs to run on non VMS platforms after all). my ($path_volume, $path_directories, $path_file) = $self->splitpath($path); my ($base_volume, $base_directories, $base_file) = $self->splitpath($base); return $path unless lc($path_volume) eq lc($base_volume); for ($path, $base) { $_ = $self->rel2abs($_) } # Now, remove all leading components that are the same my @pathchunks = $self->splitdir( $path_directories ); my $pathchunks = @pathchunks; unshift(@pathchunks,'000000') unless $pathchunks[0] eq '000000'; my @basechunks = $self->splitdir( $base_directories ); my $basechunks = @basechunks; unshift(@basechunks,'000000') unless $basechunks[0] eq '000000'; while ( @pathchunks && @basechunks && lc( $pathchunks[0] ) eq lc( $basechunks[0] ) ) { shift @pathchunks ; shift @basechunks ; } # @basechunks now contains the directories to climb out of, # @pathchunks now has the directories to descend in to. if ((@basechunks > 0) || ($basechunks != $pathchunks)) { $path_directories = join '.', ('-' x @basechunks, @pathchunks) ; } else { $path_directories = join '.', @pathchunks; } $path_directories = '['.$path_directories.']'; return $self->canonpath( $self->catpath( '', $path_directories, $path_file ) ) ; } =item rel2abs (override) Return an absolute file specification from a relative one. =cut sub rel2abs { my $self = shift ; my ($path,$base ) = @_; return undef unless defined $path; if ($path =~ m/\//) { $path = ( -d $path || $path =~ m/\/\z/ # educated guessing about ? vmspath($path) # whether it's a directory : vmsify($path) ); } $base = vmspath($base) if defined $base && $base =~ m/\//; # Clean up and split up $path if ( ! $self->file_name_is_absolute( $path ) ) { # Figure out the effective $base and clean it up. if ( !defined( $base ) || $base eq '' ) { $base = $self->_cwd; } elsif ( ! $self->file_name_is_absolute( $base ) ) { $base = $self->rel2abs( $base ) ; } else { $base = $self->canonpath( $base ) ; } # Split up paths my ( $path_directories, $path_file ) = ($self->splitpath( $path ))[1,2] ; my ( $base_volume, $base_directories ) = $self->splitpath( $base ) ; $path_directories = '' if $path_directories eq '[]' || $path_directories eq '<>'; my $sep = '' ; $sep = '.' if ( $base_directories =~ m{[^.\]>]\Z(?!\n)} && $path_directories =~ m{^[^.\[<]}s ) ; $base_directories = "$base_directories$sep$path_directories"; $base_directories =~ s{\.?[\]>][\[<]\.?}{.}; $path = $self->catpath( $base_volume, $base_directories, $path_file ); } return $self->canonpath( $path ) ; } # eliminate_macros() and fixpath() are MakeMaker-specific methods # which are used inside catfile() and catdir(). MakeMaker has its own # copies as of 6.06_03 which are the canonical ones. We leave these # here, in peace, so that File::Spec continues to work with MakeMakers # prior to 6.06_03. # # Please consider these two methods deprecated. Do not patch them, # patch the ones in ExtUtils::MM_VMS instead. # # Update: MakeMaker 6.48 is still using these routines on VMS. # so they need to be kept up to date with ExtUtils::MM_VMS. sub eliminate_macros { my($self,$path) = @_; return '' unless (defined $path) && ($path ne ''); $self = {} unless ref $self; if ($path =~ /\s/) { return join ' ', map { $self->eliminate_macros($_) } split /\s+/, $path; } my $npath = unixify($path); # sometimes unixify will return a string with an off-by-one trailing null $npath =~ s{\0$}{}; my($complex) = 0; my($head,$macro,$tail); # perform m##g in scalar context so it acts as an iterator while ($npath =~ m#(.*?)\$\((\S+?)\)(.*)#gs) { if (defined $self->{$2}) { ($head,$macro,$tail) = ($1,$2,$3); if (ref $self->{$macro}) { if (ref $self->{$macro} eq 'ARRAY') { $macro = join ' ', @{$self->{$macro}}; } else { print "Note: can't expand macro \$($macro) containing ",ref($self->{$macro}), "\n\t(using MMK-specific deferred substitutuon; MMS will break)\n"; $macro = "\cB$macro\cB"; $complex = 1; } } else { ($macro = unixify($self->{$macro})) =~ s#/\Z(?!\n)##; } $npath = "$head$macro$tail"; } } if ($complex) { $npath =~ s#\cB(.*?)\cB#\${$1}#gs; } $npath; } # Deprecated. See the note above for eliminate_macros(). # Catchall routine to clean up problem MM[SK]/Make macros. Expands macros # in any directory specification, in order to avoid juxtaposing two # VMS-syntax directories when MM[SK] is run. Also expands expressions which # are all macro, so that we can tell how long the expansion is, and avoid # overrunning DCL's command buffer when MM[KS] is running. # fixpath() checks to see whether the result matches the name of a # directory in the current default directory and returns a directory or # file specification accordingly. C<$is_dir> can be set to true to # force fixpath() to consider the path to be a directory or false to force # it to be a file. sub fixpath { my($self,$path,$force_path) = @_; return '' unless $path; $self = bless {}, $self unless ref $self; my($fixedpath,$prefix,$name); if ($path =~ /\s/) { return join ' ', map { $self->fixpath($_,$force_path) } split /\s+/, $path; } if ($path =~ m#^\$\([^\)]+\)\Z(?!\n)#s || $path =~ m#[/:>\]]#) { if ($force_path or $path =~ /(?:DIR\)|\])\Z(?!\n)/) { $fixedpath = vmspath($self->eliminate_macros($path)); } else { $fixedpath = vmsify($self->eliminate_macros($path)); } } elsif ((($prefix,$name) = ($path =~ m#^\$\(([^\)]+)\)(.+)#s)) && $self->{$prefix}) { my($vmspre) = $self->eliminate_macros("\$($prefix)"); # is it a dir or just a name? $vmspre = ($vmspre =~ m|/| or $prefix =~ /DIR\Z(?!\n)/) ? vmspath($vmspre) : ''; $fixedpath = ($vmspre ? $vmspre : $self->{$prefix}) . $name; $fixedpath = vmspath($fixedpath) if $force_path; } else { $fixedpath = $path; $fixedpath = vmspath($fixedpath) if $force_path; } # No hints, so we try to guess if (!defined($force_path) and $fixedpath !~ /[:>(.\]]/) { $fixedpath = vmspath($fixedpath) if -d $fixedpath; } # Trim off root dirname if it's had other dirs inserted in front of it. $fixedpath =~ s/\.000000([\]>])/$1/; # Special case for VMS absolute directory specs: these will have had device # prepended during trip through Unix syntax in eliminate_macros(), since # Unix syntax has no way to express "absolute from the top of this device's # directory tree". if ($path =~ /^[\[>][^.\-]/) { $fixedpath =~ s/^[^\[<]+//; } $fixedpath; } =back =head1 COPYRIGHT Copyright (c) 2004 by the Perl 5 Porters. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO See L and L. This package overrides the implementation of these methods, not the semantics. An explanation of VMS file specs can be found at L. =cut 1; I686-LINUX_FILE_SPEC_VMS $fatpacked{"i686-linux/File/Spec/Win32.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'I686-LINUX_FILE_SPEC_WIN32'; package File::Spec::Win32; use strict; use vars qw(@ISA $VERSION); require File::Spec::Unix; $VERSION = '3.40'; $VERSION =~ tr/_//; @ISA = qw(File::Spec::Unix); # Some regexes we use for path splitting my $DRIVE_RX = '[a-zA-Z]:'; my $UNC_RX = '(?:\\\\\\\\|//)[^\\\\/]+[\\\\/][^\\\\/]+'; my $VOL_RX = "(?:$DRIVE_RX|$UNC_RX)"; =head1 NAME File::Spec::Win32 - methods for Win32 file specs =head1 SYNOPSIS require File::Spec::Win32; # Done internally by File::Spec if needed =head1 DESCRIPTION See File::Spec::Unix for a documentation of the methods provided there. This package overrides the implementation of these methods, not the semantics. =over 4 =item devnull Returns a string representation of the null device. =cut sub devnull { return "nul"; } sub rootdir { '\\' } =item tmpdir Returns a string representation of the first existing directory from the following list: $ENV{TMPDIR} $ENV{TEMP} $ENV{TMP} SYS:/temp C:\system\temp C:/temp /tmp / The SYS:/temp is preferred in Novell NetWare and the C:\system\temp for Symbian (the File::Spec::Win32 is used also for those platforms). Since Perl 5.8.0, if running under taint mode, and if the environment variables are tainted, they are not used. =cut my $tmpdir; sub tmpdir { return $tmpdir if defined $tmpdir; $tmpdir = $_[0]->_tmpdir( map( $ENV{$_}, qw(TMPDIR TEMP TMP) ), 'SYS:/temp', 'C:\system\temp', 'C:/temp', '/tmp', '/' ); } =item case_tolerant MSWin32 case-tolerance depends on GetVolumeInformation() $ouFsFlags == FS_CASE_SENSITIVE, indicating the case significance when comparing file specifications. Since XP FS_CASE_SENSITIVE is effectively disabled for the NT subsubsystem. See http://cygwin.com/ml/cygwin/2007-07/msg00891.html Default: 1 =cut sub case_tolerant { eval { require Win32API::File; } or return 1; my $drive = shift || "C:"; my $osFsType = "\0"x256; my $osVolName = "\0"x256; my $ouFsFlags = 0; Win32API::File::GetVolumeInformation($drive, $osVolName, 256, [], [], $ouFsFlags, $osFsType, 256 ); if ($ouFsFlags & Win32API::File::FS_CASE_SENSITIVE()) { return 0; } else { return 1; } } =item file_name_is_absolute As of right now, this returns 2 if the path is absolute with a volume, 1 if it's absolute with no volume, 0 otherwise. =cut sub file_name_is_absolute { my ($self,$file) = @_; if ($file =~ m{^($VOL_RX)}o) { my $vol = $1; return ($vol =~ m{^$UNC_RX}o ? 2 : $file =~ m{^$DRIVE_RX[\\/]}o ? 2 : 0); } return $file =~ m{^[\\/]} ? 1 : 0; } =item catfile Concatenate one or more directory names and a filename to form a complete path ending with a filename =cut sub catfile { shift; # Legacy / compatibility support # shift, return _canon_cat( "/", @_ ) if $_[0] eq ""; # Compatibility with File::Spec <= 3.26: # catfile('A:', 'foo') should return 'A:\foo'. return _canon_cat( ($_[0].'\\'), @_[1..$#_] ) if $_[0] =~ m{^$DRIVE_RX\z}o; return _canon_cat( @_ ); } sub catdir { shift; # Legacy / compatibility support # return "" unless @_; shift, return _canon_cat( "/", @_ ) if $_[0] eq ""; # Compatibility with File::Spec <= 3.26: # catdir('A:', 'foo') should return 'A:\foo'. return _canon_cat( ($_[0].'\\'), @_[1..$#_] ) if $_[0] =~ m{^$DRIVE_RX\z}o; return _canon_cat( @_ ); } sub path { my @path = split(';', $ENV{PATH}); s/"//g for @path; @path = grep length, @path; unshift(@path, "."); return @path; } =item canonpath No physical check on the filesystem, but a logical cleanup of a path. On UNIX eliminated successive slashes and successive "/.". On Win32 makes dir1\dir2\dir3\..\..\dir4 -> \dir\dir4 and even dir1\dir2\dir3\...\dir4 -> \dir\dir4 =cut sub canonpath { # Legacy / compatibility support # return $_[1] if !defined($_[1]) or $_[1] eq ''; return _canon_cat( $_[1] ); } =item splitpath ($volume,$directories,$file) = File::Spec->splitpath( $path ); ($volume,$directories,$file) = File::Spec->splitpath( $path, $no_file ); Splits a path into volume, directory, and filename portions. Assumes that the last file is a path unless the path ends in '\\', '\\.', '\\..' or $no_file is true. On Win32 this means that $no_file true makes this return ( $volume, $path, '' ). Separators accepted are \ and /. Volumes can be drive letters or UNC sharenames (\\server\share). The results can be passed to L to get back a path equivalent to (usually identical to) the original path. =cut sub splitpath { my ($self,$path, $nofile) = @_; my ($volume,$directory,$file) = ('','',''); if ( $nofile ) { $path =~ m{^ ( $VOL_RX ? ) (.*) }sox; $volume = $1; $directory = $2; } else { $path =~ m{^ ( $VOL_RX ? ) ( (?:.*[\\/](?:\.\.?\Z(?!\n))?)? ) (.*) }sox; $volume = $1; $directory = $2; $file = $3; } return ($volume,$directory,$file); } =item splitdir The opposite of L. @dirs = File::Spec->splitdir( $directories ); $directories must be only the directory portion of the path on systems that have the concept of a volume or that have path syntax that differentiates files from directories. Unlike just splitting the directories on the separator, leading empty and trailing directory entries can be returned, because these are significant on some OSs. So, File::Spec->splitdir( "/a/b/c" ); Yields: ( '', 'a', 'b', '', 'c', '' ) =cut sub splitdir { my ($self,$directories) = @_ ; # # split() likes to forget about trailing null fields, so here we # check to be sure that there will not be any before handling the # simple case. # if ( $directories !~ m|[\\/]\Z(?!\n)| ) { return split( m|[\\/]|, $directories ); } else { # # since there was a trailing separator, add a file name to the end, # then do the split, then replace it with ''. # my( @directories )= split( m|[\\/]|, "${directories}dummy" ) ; $directories[ $#directories ]= '' ; return @directories ; } } =item catpath Takes volume, directory and file portions and returns an entire path. Under Unix, $volume is ignored, and this is just like catfile(). On other OSs, the $volume become significant. =cut sub catpath { my ($self,$volume,$directory,$file) = @_; # If it's UNC, make sure the glue separator is there, reusing # whatever separator is first in the $volume my $v; $volume .= $v if ( (($v) = $volume =~ m@^([\\/])[\\/][^\\/]+[\\/][^\\/]+\Z(?!\n)@s) && $directory =~ m@^[^\\/]@s ) ; $volume .= $directory ; # If the volume is not just A:, make sure the glue separator is # there, reusing whatever separator is first in the $volume if possible. if ( $volume !~ m@^[a-zA-Z]:\Z(?!\n)@s && $volume =~ m@[^\\/]\Z(?!\n)@ && $file =~ m@[^\\/]@ ) { $volume =~ m@([\\/])@ ; my $sep = $1 ? $1 : '\\' ; $volume .= $sep ; } $volume .= $file ; return $volume ; } sub _same { lc($_[1]) eq lc($_[2]); } sub rel2abs { my ($self,$path,$base ) = @_; my $is_abs = $self->file_name_is_absolute($path); # Check for volume (should probably document the '2' thing...) return $self->canonpath( $path ) if $is_abs == 2; if ($is_abs) { # It's missing a volume, add one my $vol = ($self->splitpath( $self->_cwd() ))[0]; return $self->canonpath( $vol . $path ); } if ( !defined( $base ) || $base eq '' ) { require Cwd ; $base = Cwd::getdcwd( ($self->splitpath( $path ))[0] ) if defined &Cwd::getdcwd ; $base = $self->_cwd() unless defined $base ; } elsif ( ! $self->file_name_is_absolute( $base ) ) { $base = $self->rel2abs( $base ) ; } else { $base = $self->canonpath( $base ) ; } my ( $path_directories, $path_file ) = ($self->splitpath( $path, 1 ))[1,2] ; my ( $base_volume, $base_directories ) = $self->splitpath( $base, 1 ) ; $path = $self->catpath( $base_volume, $self->catdir( $base_directories, $path_directories ), $path_file ) ; return $self->canonpath( $path ) ; } =back =head2 Note For File::Spec::Win32 Maintainers Novell NetWare inherits its File::Spec behaviour from File::Spec::Win32. =head1 COPYRIGHT Copyright (c) 2004,2007 by the Perl 5 Porters. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO See L and L. This package overrides the implementation of these methods, not the semantics. =cut sub _canon_cat # @path -> path { my ($first, @rest) = @_; my $volume = $first =~ s{ \A ([A-Za-z]:) ([\\/]?) }{}x # drive letter ? ucfirst( $1 ).( $2 ? "\\" : "" ) : $first =~ s{ \A (?:\\\\|//) ([^\\/]+) (?: [\\/] ([^\\/]+) )? [\\/]? }{}xs # UNC volume ? "\\\\$1".( defined $2 ? "\\$2" : "" )."\\" : $first =~ s{ \A [\\/] }{}x # root dir ? "\\" : ""; my $path = join "\\", $first, @rest; $path =~ tr#\\/#\\\\#s; # xx/yy --> xx\yy & xx\\yy --> xx\yy # xx/././yy --> xx/yy $path =~ s{(?: (?:\A|\\) # at begin or after a slash \. (?:\\\.)* # and more (?:\\|\z) # at end or followed by slash )+ # performance boost -- I do not know why }{\\}gx; # XXX I do not know whether more dots are supported by the OS supporting # this ... annotation (NetWare or symbian but not MSWin32). # Then .... could easily become ../../.. etc: # Replace \.\.\. by (\.\.\.+) and substitute with # { $1 . ".." . "\\.." x (length($2)-2) }gex # ... --> ../.. $path =~ s{ (\A|\\) # at begin or after a slash \.\.\. (?=\\|\z) # at end or followed by slash }{$1..\\..}gx; # xx\yy\..\zz --> xx\zz while ( $path =~ s{(?: (?:\A|\\) # at begin or after a slash [^\\]+ # rip this 'yy' off \\\.\. (? xx NOTE: this is *not* root $path =~ s#\\\z##; # xx\ --> xx if ( $volume =~ m#\\\z# ) { # \.. --> \ $path =~ s{ \A # at begin \.\. (?:\\\.\.)* # and more (?:\\|\z) # at end or followed by slash }{}x; return $1 # \\HOST\SHARE\ --> \\HOST\SHARE if $path eq "" and $volume =~ m#\A(\\\\.*)\\\z#s; } return $path ne "" || $volume ? $volume.$path : "."; } 1; I686-LINUX_FILE_SPEC_WIN32 $fatpacked{"i686-linux/version.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'I686-LINUX_VERSION'; #!perl -w package version; use 5.005_04; use strict; use vars qw(@ISA $VERSION $CLASS $STRICT $LAX *declare *qv); $VERSION = 0.9902; $CLASS = 'version'; #--------------------------------------------------------------------------# # Version regexp components #--------------------------------------------------------------------------# # Fraction part of a decimal version number. This is a common part of # both strict and lax decimal versions my $FRACTION_PART = qr/\.[0-9]+/; # First part of either decimal or dotted-decimal strict version number. # Unsigned integer with no leading zeroes (except for zero itself) to # avoid confusion with octal. my $STRICT_INTEGER_PART = qr/0|[1-9][0-9]*/; # First part of either decimal or dotted-decimal lax version number. # Unsigned integer, but allowing leading zeros. Always interpreted # as decimal. However, some forms of the resulting syntax give odd # results if used as ordinary Perl expressions, due to how perl treats # octals. E.g. # version->new("010" ) == 10 # version->new( 010 ) == 8 # version->new( 010.2) == 82 # "8" . "2" my $LAX_INTEGER_PART = qr/[0-9]+/; # Second and subsequent part of a strict dotted-decimal version number. # Leading zeroes are permitted, and the number is always decimal. # Limited to three digits to avoid overflow when converting to decimal # form and also avoid problematic style with excessive leading zeroes. my $STRICT_DOTTED_DECIMAL_PART = qr/\.[0-9]{1,3}/; # Second and subsequent part of a lax dotted-decimal version number. # Leading zeroes are permitted, and the number is always decimal. No # limit on the numerical value or number of digits, so there is the # possibility of overflow when converting to decimal form. my $LAX_DOTTED_DECIMAL_PART = qr/\.[0-9]+/; # Alpha suffix part of lax version number syntax. Acts like a # dotted-decimal part. my $LAX_ALPHA_PART = qr/_[0-9]+/; #--------------------------------------------------------------------------# # Strict version regexp definitions #--------------------------------------------------------------------------# # Strict decimal version number. my $STRICT_DECIMAL_VERSION = qr/ $STRICT_INTEGER_PART $FRACTION_PART? /x; # Strict dotted-decimal version number. Must have both leading "v" and # at least three parts, to avoid confusion with decimal syntax. my $STRICT_DOTTED_DECIMAL_VERSION = qr/ v $STRICT_INTEGER_PART $STRICT_DOTTED_DECIMAL_PART{2,} /x; # Complete strict version number syntax -- should generally be used # anchored: qr/ \A $STRICT \z /x $STRICT = qr/ $STRICT_DECIMAL_VERSION | $STRICT_DOTTED_DECIMAL_VERSION /x; #--------------------------------------------------------------------------# # Lax version regexp definitions #--------------------------------------------------------------------------# # Lax decimal version number. Just like the strict one except for # allowing an alpha suffix or allowing a leading or trailing # decimal-point my $LAX_DECIMAL_VERSION = qr/ $LAX_INTEGER_PART (?: \. | $FRACTION_PART $LAX_ALPHA_PART? )? | $FRACTION_PART $LAX_ALPHA_PART? /x; # Lax dotted-decimal version number. Distinguished by having either # leading "v" or at least three non-alpha parts. Alpha part is only # permitted if there are at least two non-alpha parts. Strangely # enough, without the leading "v", Perl takes .1.2 to mean v0.1.2, # so when there is no "v", the leading part is optional my $LAX_DOTTED_DECIMAL_VERSION = qr/ v $LAX_INTEGER_PART (?: $LAX_DOTTED_DECIMAL_PART+ $LAX_ALPHA_PART? )? | $LAX_INTEGER_PART? $LAX_DOTTED_DECIMAL_PART{2,} $LAX_ALPHA_PART? /x; # Complete lax version number syntax -- should generally be used # anchored: qr/ \A $LAX \z /x # # The string 'undef' is a special case to make for easier handling # of return values from ExtUtils::MM->parse_version $LAX = qr/ undef | $LAX_DECIMAL_VERSION | $LAX_DOTTED_DECIMAL_VERSION /x; #--------------------------------------------------------------------------# { local $SIG{'__DIE__'}; eval "use version::vxs $VERSION"; if ( $@ ) { # don't have the XS version installed eval "use version::vpp $VERSION"; # don't tempt fate die "$@" if ( $@ ); push @ISA, "version::vpp"; local $^W; *version::qv = \&version::vpp::qv; *version::declare = \&version::vpp::declare; *version::_VERSION = \&version::vpp::_VERSION; *version::vcmp = \&version::vpp::vcmp; *version::new = \&version::vpp::new; if ($] >= 5.009000) { no strict 'refs'; *version::stringify = \&version::vpp::stringify; *{'version::(""'} = \&version::vpp::stringify; *{'version::(<=>'} = \&version::vpp::vcmp; *version::parse = \&version::vpp::parse; } } else { # use XS module push @ISA, "version::vxs"; local $^W; *version::declare = \&version::vxs::declare; *version::qv = \&version::vxs::qv; *version::_VERSION = \&version::vxs::_VERSION; *version::vcmp = \&version::vxs::VCMP; *version::new = \&version::vxs::new; if ($] >= 5.009000) { no strict 'refs'; *version::stringify = \&version::vxs::stringify; *{'version::(""'} = \&version::vxs::stringify; *{'version::(<=>'} = \&version::vxs::VCMP; *version::parse = \&version::vxs::parse; } } } # Preloaded methods go here. sub import { no strict 'refs'; my ($class) = shift; # Set up any derived class unless ($class eq 'version') { local $^W; *{$class.'::declare'} = \&version::declare; *{$class.'::qv'} = \&version::qv; } my %args; if (@_) { # any remaining terms are arguments map { $args{$_} = 1 } @_ } else { # no parameters at all on use line %args = ( qv => 1, 'UNIVERSAL::VERSION' => 1, ); } my $callpkg = caller(); if (exists($args{declare})) { *{$callpkg.'::declare'} = sub {return $class->declare(shift) } unless defined(&{$callpkg.'::declare'}); } if (exists($args{qv})) { *{$callpkg.'::qv'} = sub {return $class->qv(shift) } unless defined(&{$callpkg.'::qv'}); } if (exists($args{'UNIVERSAL::VERSION'})) { local $^W; *UNIVERSAL::VERSION = \&version::_VERSION; } if (exists($args{'VERSION'})) { *{$callpkg.'::VERSION'} = \&version::_VERSION; } if (exists($args{'is_strict'})) { *{$callpkg.'::is_strict'} = \&version::is_strict unless defined(&{$callpkg.'::is_strict'}); } if (exists($args{'is_lax'})) { *{$callpkg.'::is_lax'} = \&version::is_lax unless defined(&{$callpkg.'::is_lax'}); } } sub is_strict { defined $_[0] && $_[0] =~ qr/ \A $STRICT \z /x } sub is_lax { defined $_[0] && $_[0] =~ qr/ \A $LAX \z /x } 1; I686-LINUX_VERSION $fatpacked{"i686-linux/version/vxs.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'I686-LINUX_VERSION_VXS'; #!perl -w package version::vxs; use 5.005_03; use strict; use vars qw(@ISA $VERSION $CLASS ); $VERSION = 0.9902; $CLASS = 'version::vxs'; eval { require XSLoader; local $^W; # shut up the 'redefined' warning for UNIVERSAL::VERSION XSLoader::load('version::vxs', $VERSION); 1; } or do { require DynaLoader; push @ISA, 'DynaLoader'; local $^W; # shut up the 'redefined' warning for UNIVERSAL::VERSION bootstrap version::vxs $VERSION; }; # Preloaded methods go here. 1; I686-LINUX_VERSION_VXS $fatpacked{"version.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'VERSION'; #!perl -w package version; use 5.006002; use strict; use warnings::register; if ($] >= 5.015) { warnings::register_categories(qw/version/); } our $VERSION = 0.9924; our $CLASS = 'version'; our (@ISA, $STRICT, $LAX); # !!!!Delete this next block completely when adding to Perl core!!!! { local $SIG{'__DIE__'}; eval "use version::vxs $VERSION"; if ( $@ ) { # don't have the XS version installed eval "use version::vpp $VERSION"; # don't tempt fate die "$@" if ( $@ ); push @ISA, "version::vpp"; local $^W; *version::qv = \&version::vpp::qv; *version::declare = \&version::vpp::declare; *version::_VERSION = \&version::vpp::_VERSION; *version::vcmp = \&version::vpp::vcmp; *version::new = \&version::vpp::new; *version::numify = \&version::vpp::numify; *version::normal = \&version::vpp::normal; if ($] >= 5.009000) { no strict 'refs'; *version::stringify = \&version::vpp::stringify; *{'version::(""'} = \&version::vpp::stringify; *{'version::(<=>'} = \&version::vpp::vcmp; *{'version::(cmp'} = \&version::vpp::vcmp; *version::parse = \&version::vpp::parse; } } else { # use XS module push @ISA, "version::vxs"; local $^W; *version::declare = \&version::vxs::declare; *version::qv = \&version::vxs::qv; *version::_VERSION = \&version::vxs::_VERSION; *version::vcmp = \&version::vxs::VCMP; *version::new = \&version::vxs::new; *version::numify = \&version::vxs::numify; *version::normal = \&version::vxs::normal; if ($] >= 5.009000) { no strict 'refs'; *version::stringify = \&version::vxs::stringify; *{'version::(""'} = \&version::vxs::stringify; *{'version::(<=>'} = \&version::vxs::VCMP; *{'version::(cmp'} = \&version::vxs::VCMP; *version::parse = \&version::vxs::parse; } } } # avoid using Exporter require version::regex; *version::is_lax = \&version::regex::is_lax; *version::is_strict = \&version::regex::is_strict; *LAX = \$version::regex::LAX; *LAX_DECIMAL_VERSION = \$version::regex::LAX_DECIMAL_VERSION; *LAX_DOTTED_DECIMAL_VERSION = \$version::regex::LAX_DOTTED_DECIMAL_VERSION; *STRICT = \$version::regex::STRICT; *STRICT_DECIMAL_VERSION = \$version::regex::STRICT_DECIMAL_VERSION; *STRICT_DOTTED_DECIMAL_VERSION = \$version::regex::STRICT_DOTTED_DECIMAL_VERSION; sub import { no strict 'refs'; my ($class) = shift; # Set up any derived class unless ($class eq $CLASS) { local $^W; *{$class.'::declare'} = \&{$CLASS.'::declare'}; *{$class.'::qv'} = \&{$CLASS.'::qv'}; } my %args; if (@_) { # any remaining terms are arguments map { $args{$_} = 1 } @_ } else { # no parameters at all on use line %args = ( qv => 1, 'UNIVERSAL::VERSION' => 1, ); } my $callpkg = caller(); if (exists($args{declare})) { *{$callpkg.'::declare'} = sub {return $class->declare(shift) } unless defined(&{$callpkg.'::declare'}); } if (exists($args{qv})) { *{$callpkg.'::qv'} = sub {return $class->qv(shift) } unless defined(&{$callpkg.'::qv'}); } if (exists($args{'UNIVERSAL::VERSION'})) { local $^W; *UNIVERSAL::VERSION = \&{$CLASS.'::_VERSION'}; } if (exists($args{'VERSION'})) { *{$callpkg.'::VERSION'} = \&{$CLASS.'::_VERSION'}; } if (exists($args{'is_strict'})) { *{$callpkg.'::is_strict'} = \&{$CLASS.'::is_strict'} unless defined(&{$callpkg.'::is_strict'}); } if (exists($args{'is_lax'})) { *{$callpkg.'::is_lax'} = \&{$CLASS.'::is_lax'} unless defined(&{$callpkg.'::is_lax'}); } } 1; VERSION $fatpacked{"version/regex.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'VERSION_REGEX'; package version::regex; use strict; our $VERSION = 0.9924; #--------------------------------------------------------------------------# # Version regexp components #--------------------------------------------------------------------------# # Fraction part of a decimal version number. This is a common part of # both strict and lax decimal versions my $FRACTION_PART = qr/\.[0-9]+/; # First part of either decimal or dotted-decimal strict version number. # Unsigned integer with no leading zeroes (except for zero itself) to # avoid confusion with octal. my $STRICT_INTEGER_PART = qr/0|[1-9][0-9]*/; # First part of either decimal or dotted-decimal lax version number. # Unsigned integer, but allowing leading zeros. Always interpreted # as decimal. However, some forms of the resulting syntax give odd # results if used as ordinary Perl expressions, due to how perl treats # octals. E.g. # version->new("010" ) == 10 # version->new( 010 ) == 8 # version->new( 010.2) == 82 # "8" . "2" my $LAX_INTEGER_PART = qr/[0-9]+/; # Second and subsequent part of a strict dotted-decimal version number. # Leading zeroes are permitted, and the number is always decimal. # Limited to three digits to avoid overflow when converting to decimal # form and also avoid problematic style with excessive leading zeroes. my $STRICT_DOTTED_DECIMAL_PART = qr/\.[0-9]{1,3}/; # Second and subsequent part of a lax dotted-decimal version number. # Leading zeroes are permitted, and the number is always decimal. No # limit on the numerical value or number of digits, so there is the # possibility of overflow when converting to decimal form. my $LAX_DOTTED_DECIMAL_PART = qr/\.[0-9]+/; # Alpha suffix part of lax version number syntax. Acts like a # dotted-decimal part. my $LAX_ALPHA_PART = qr/_[0-9]+/; #--------------------------------------------------------------------------# # Strict version regexp definitions #--------------------------------------------------------------------------# # Strict decimal version number. our $STRICT_DECIMAL_VERSION = qr/ $STRICT_INTEGER_PART $FRACTION_PART? /x; # Strict dotted-decimal version number. Must have both leading "v" and # at least three parts, to avoid confusion with decimal syntax. our $STRICT_DOTTED_DECIMAL_VERSION = qr/ v $STRICT_INTEGER_PART $STRICT_DOTTED_DECIMAL_PART{2,} /x; # Complete strict version number syntax -- should generally be used # anchored: qr/ \A $STRICT \z /x our $STRICT = qr/ $STRICT_DECIMAL_VERSION | $STRICT_DOTTED_DECIMAL_VERSION /x; #--------------------------------------------------------------------------# # Lax version regexp definitions #--------------------------------------------------------------------------# # Lax decimal version number. Just like the strict one except for # allowing an alpha suffix or allowing a leading or trailing # decimal-point our $LAX_DECIMAL_VERSION = qr/ $LAX_INTEGER_PART (?: $FRACTION_PART | \. )? $LAX_ALPHA_PART? | $FRACTION_PART $LAX_ALPHA_PART? /x; # Lax dotted-decimal version number. Distinguished by having either # leading "v" or at least three non-alpha parts. Alpha part is only # permitted if there are at least two non-alpha parts. Strangely # enough, without the leading "v", Perl takes .1.2 to mean v0.1.2, # so when there is no "v", the leading part is optional our $LAX_DOTTED_DECIMAL_VERSION = qr/ v $LAX_INTEGER_PART (?: $LAX_DOTTED_DECIMAL_PART+ $LAX_ALPHA_PART? )? | $LAX_INTEGER_PART? $LAX_DOTTED_DECIMAL_PART{2,} $LAX_ALPHA_PART? /x; # Complete lax version number syntax -- should generally be used # anchored: qr/ \A $LAX \z /x # # The string 'undef' is a special case to make for easier handling # of return values from ExtUtils::MM->parse_version our $LAX = qr/ undef | $LAX_DOTTED_DECIMAL_VERSION | $LAX_DECIMAL_VERSION /x; #--------------------------------------------------------------------------# # Preloaded methods go here. sub is_strict { defined $_[0] && $_[0] =~ qr/ \A $STRICT \z /x } sub is_lax { defined $_[0] && $_[0] =~ qr/ \A $LAX \z /x } 1; VERSION_REGEX $fatpacked{"version/vpp.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'VERSION_VPP'; package charstar; # a little helper class to emulate C char* semantics in Perl # so that prescan_version can use the same code as in C use overload ( '""' => \&thischar, '0+' => \&thischar, '++' => \&increment, '--' => \&decrement, '+' => \&plus, '-' => \&minus, '*' => \&multiply, 'cmp' => \&cmp, '<=>' => \&spaceship, 'bool' => \&thischar, '=' => \&clone, ); sub new { my ($self, $string) = @_; my $class = ref($self) || $self; my $obj = { string => [split(//,$string)], current => 0, }; return bless $obj, $class; } sub thischar { my ($self) = @_; my $last = $#{$self->{string}}; my $curr = $self->{current}; if ($curr >= 0 && $curr <= $last) { return $self->{string}->[$curr]; } else { return ''; } } sub increment { my ($self) = @_; $self->{current}++; } sub decrement { my ($self) = @_; $self->{current}--; } sub plus { my ($self, $offset) = @_; my $rself = $self->clone; $rself->{current} += $offset; return $rself; } sub minus { my ($self, $offset) = @_; my $rself = $self->clone; $rself->{current} -= $offset; return $rself; } sub multiply { my ($left, $right, $swapped) = @_; my $char = $left->thischar(); return $char * $right; } sub spaceship { my ($left, $right, $swapped) = @_; unless (ref($right)) { # not an object already $right = $left->new($right); } return $left->{current} <=> $right->{current}; } sub cmp { my ($left, $right, $swapped) = @_; unless (ref($right)) { # not an object already if (length($right) == 1) { # comparing single character only return $left->thischar cmp $right; } $right = $left->new($right); } return $left->currstr cmp $right->currstr; } sub bool { my ($self) = @_; my $char = $self->thischar; return ($char ne ''); } sub clone { my ($left, $right, $swapped) = @_; $right = { string => [@{$left->{string}}], current => $left->{current}, }; return bless $right, ref($left); } sub currstr { my ($self, $s) = @_; my $curr = $self->{current}; my $last = $#{$self->{string}}; if (defined($s) && $s->{current} < $last) { $last = $s->{current}; } my $string = join('', @{$self->{string}}[$curr..$last]); return $string; } package version::vpp; use 5.006002; use strict; use warnings::register; use Config; our $VERSION = 0.9924; our $CLASS = 'version::vpp'; our ($LAX, $STRICT, $WARN_CATEGORY); if ($] > 5.015) { warnings::register_categories(qw/version/); $WARN_CATEGORY = 'version'; } else { $WARN_CATEGORY = 'numeric'; } require version::regex; *version::vpp::is_strict = \&version::regex::is_strict; *version::vpp::is_lax = \&version::regex::is_lax; *LAX = \$version::regex::LAX; *STRICT = \$version::regex::STRICT; use overload ( '""' => \&stringify, '0+' => \&numify, 'cmp' => \&vcmp, '<=>' => \&vcmp, 'bool' => \&vbool, '+' => \&vnoop, '-' => \&vnoop, '*' => \&vnoop, '/' => \&vnoop, '+=' => \&vnoop, '-=' => \&vnoop, '*=' => \&vnoop, '/=' => \&vnoop, 'abs' => \&vnoop, ); sub import { no strict 'refs'; my ($class) = shift; # Set up any derived class unless ($class eq $CLASS) { local $^W; *{$class.'::declare'} = \&{$CLASS.'::declare'}; *{$class.'::qv'} = \&{$CLASS.'::qv'}; } my %args; if (@_) { # any remaining terms are arguments map { $args{$_} = 1 } @_ } else { # no parameters at all on use line %args = ( qv => 1, 'UNIVERSAL::VERSION' => 1, ); } my $callpkg = caller(); if (exists($args{declare})) { *{$callpkg.'::declare'} = sub {return $class->declare(shift) } unless defined(&{$callpkg.'::declare'}); } if (exists($args{qv})) { *{$callpkg.'::qv'} = sub {return $class->qv(shift) } unless defined(&{$callpkg.'::qv'}); } if (exists($args{'UNIVERSAL::VERSION'})) { no warnings qw/redefine/; *UNIVERSAL::VERSION = \&{$CLASS.'::_VERSION'}; } if (exists($args{'VERSION'})) { *{$callpkg.'::VERSION'} = \&{$CLASS.'::_VERSION'}; } if (exists($args{'is_strict'})) { *{$callpkg.'::is_strict'} = \&{$CLASS.'::is_strict'} unless defined(&{$callpkg.'::is_strict'}); } if (exists($args{'is_lax'})) { *{$callpkg.'::is_lax'} = \&{$CLASS.'::is_lax'} unless defined(&{$callpkg.'::is_lax'}); } } my $VERSION_MAX = 0x7FFFFFFF; # implement prescan_version as closely to the C version as possible use constant TRUE => 1; use constant FALSE => 0; sub isDIGIT { my ($char) = shift->thischar(); return ($char =~ /\d/); } sub isALPHA { my ($char) = shift->thischar(); return ($char =~ /[a-zA-Z]/); } sub isSPACE { my ($char) = shift->thischar(); return ($char =~ /\s/); } sub BADVERSION { my ($s, $errstr, $error) = @_; if ($errstr) { $$errstr = $error; } return $s; } sub prescan_version { my ($s, $strict, $errstr, $sqv, $ssaw_decimal, $swidth, $salpha) = @_; my $qv = defined $sqv ? $$sqv : FALSE; my $saw_decimal = defined $ssaw_decimal ? $$ssaw_decimal : 0; my $width = defined $swidth ? $$swidth : 3; my $alpha = defined $salpha ? $$salpha : FALSE; my $d = $s; if ($qv && isDIGIT($d)) { goto dotted_decimal_version; } if ($d eq 'v') { # explicit v-string $d++; if (isDIGIT($d)) { $qv = TRUE; } else { # degenerate v-string # requires v1.2.3 return BADVERSION($s,$errstr,"Invalid version format (dotted-decimal versions require at least three parts)"); } dotted_decimal_version: if ($strict && $d eq '0' && isDIGIT($d+1)) { # no leading zeros allowed return BADVERSION($s,$errstr,"Invalid version format (no leading zeros)"); } while (isDIGIT($d)) { # integer part $d++; } if ($d eq '.') { $saw_decimal++; $d++; # decimal point } else { if ($strict) { # require v1.2.3 return BADVERSION($s,$errstr,"Invalid version format (dotted-decimal versions require at least three parts)"); } else { goto version_prescan_finish; } } { my $i = 0; my $j = 0; while (isDIGIT($d)) { # just keep reading $i++; while (isDIGIT($d)) { $d++; $j++; # maximum 3 digits between decimal if ($strict && $j > 3) { return BADVERSION($s,$errstr,"Invalid version format (maximum 3 digits between decimals)"); } } if ($d eq '_') { if ($strict) { return BADVERSION($s,$errstr,"Invalid version format (no underscores)"); } if ( $alpha ) { return BADVERSION($s,$errstr,"Invalid version format (multiple underscores)"); } $d++; $alpha = TRUE; } elsif ($d eq '.') { if ($alpha) { return BADVERSION($s,$errstr,"Invalid version format (underscores before decimal)"); } $saw_decimal++; $d++; } elsif (!isDIGIT($d)) { last; } $j = 0; } if ($strict && $i < 2) { # requires v1.2.3 return BADVERSION($s,$errstr,"Invalid version format (dotted-decimal versions require at least three parts)"); } } } # end if dotted-decimal else { # decimal versions my $j = 0; # special $strict case for leading '.' or '0' if ($strict) { if ($d eq '.') { return BADVERSION($s,$errstr,"Invalid version format (0 before decimal required)"); } if ($d eq '0' && isDIGIT($d+1)) { return BADVERSION($s,$errstr,"Invalid version format (no leading zeros)"); } } # and we never support negative version numbers if ($d eq '-') { return BADVERSION($s,$errstr,"Invalid version format (negative version number)"); } # consume all of the integer part while (isDIGIT($d)) { $d++; } # look for a fractional part if ($d eq '.') { # we found it, so consume it $saw_decimal++; $d++; } elsif (!$d || $d eq ';' || isSPACE($d) || $d eq '}') { if ( $d == $s ) { # found nothing return BADVERSION($s,$errstr,"Invalid version format (version required)"); } # found just an integer goto version_prescan_finish; } elsif ( $d == $s ) { # didn't find either integer or period return BADVERSION($s,$errstr,"Invalid version format (non-numeric data)"); } elsif ($d eq '_') { # underscore can't come after integer part if ($strict) { return BADVERSION($s,$errstr,"Invalid version format (no underscores)"); } elsif (isDIGIT($d+1)) { return BADVERSION($s,$errstr,"Invalid version format (alpha without decimal)"); } else { return BADVERSION($s,$errstr,"Invalid version format (misplaced underscore)"); } } elsif ($d) { # anything else after integer part is just invalid data return BADVERSION($s,$errstr,"Invalid version format (non-numeric data)"); } # scan the fractional part after the decimal point if ($d && !isDIGIT($d) && ($strict || ! ($d eq ';' || isSPACE($d) || $d eq '}') )) { # $strict or lax-but-not-the-end return BADVERSION($s,$errstr,"Invalid version format (fractional part required)"); } while (isDIGIT($d)) { $d++; $j++; if ($d eq '.' && isDIGIT($d-1)) { if ($alpha) { return BADVERSION($s,$errstr,"Invalid version format (underscores before decimal)"); } if ($strict) { return BADVERSION($s,$errstr,"Invalid version format (dotted-decimal versions must begin with 'v')"); } $d = $s; # start all over again $qv = TRUE; goto dotted_decimal_version; } if ($d eq '_') { if ($strict) { return BADVERSION($s,$errstr,"Invalid version format (no underscores)"); } if ( $alpha ) { return BADVERSION($s,$errstr,"Invalid version format (multiple underscores)"); } if ( ! isDIGIT($d+1) ) { return BADVERSION($s,$errstr,"Invalid version format (misplaced underscore)"); } $width = $j; $d++; $alpha = TRUE; } } } version_prescan_finish: while (isSPACE($d)) { $d++; } if ($d && !isDIGIT($d) && (! ($d eq ';' || $d eq '}') )) { # trailing non-numeric data return BADVERSION($s,$errstr,"Invalid version format (non-numeric data)"); } if ($saw_decimal > 1 && ($d-1) eq '.') { # no trailing period allowed return BADVERSION($s,$errstr,"Invalid version format (trailing decimal)"); } if (defined $sqv) { $$sqv = $qv; } if (defined $swidth) { $$swidth = $width; } if (defined $ssaw_decimal) { $$ssaw_decimal = $saw_decimal; } if (defined $salpha) { $$salpha = $alpha; } return $d; } sub scan_version { my ($s, $rv, $qv) = @_; my $start; my $pos; my $last; my $errstr; my $saw_decimal = 0; my $width = 3; my $alpha = FALSE; my $vinf = FALSE; my @av; $s = new charstar $s; while (isSPACE($s)) { # leading whitespace is OK $s++; } $last = prescan_version($s, FALSE, \$errstr, \$qv, \$saw_decimal, \$width, \$alpha); if ($errstr) { # 'undef' is a special case and not an error if ( $s ne 'undef') { require Carp; Carp::croak($errstr); } } $start = $s; if ($s eq 'v') { $s++; } $pos = $s; if ( $qv ) { $$rv->{qv} = $qv; } if ( $alpha ) { $$rv->{alpha} = $alpha; } if ( !$qv && $width < 3 ) { $$rv->{width} = $width; } while (isDIGIT($pos) || $pos eq '_') { $pos++; } if (!isALPHA($pos)) { my $rev; for (;;) { $rev = 0; { # this is atoi() that delimits on underscores my $end = $pos; my $mult = 1; my $orev; # the following if() will only be true after the decimal # point of a version originally created with a bare # floating point number, i.e. not quoted in any way # if ( !$qv && $s > $start && $saw_decimal == 1 ) { $mult *= 100; while ( $s < $end ) { next if $s eq '_'; $orev = $rev; $rev += $s * $mult; $mult /= 10; if ( (abs($orev) > abs($rev)) || (abs($rev) > $VERSION_MAX )) { warn("Integer overflow in version %d", $VERSION_MAX); $s = $end - 1; $rev = $VERSION_MAX; $vinf = 1; } $s++; if ( $s eq '_' ) { $s++; } } } else { while (--$end >= $s) { next if $end eq '_'; $orev = $rev; $rev += $end * $mult; $mult *= 10; if ( (abs($orev) > abs($rev)) || (abs($rev) > $VERSION_MAX )) { warn("Integer overflow in version"); $end = $s - 1; $rev = $VERSION_MAX; $vinf = 1; } } } } # Append revision push @av, $rev; if ( $vinf ) { $s = $last; last; } elsif ( $pos eq '.' ) { $s = ++$pos; } elsif ( $pos eq '_' && isDIGIT($pos+1) ) { $s = ++$pos; } elsif ( $pos eq ',' && isDIGIT($pos+1) ) { $s = ++$pos; } elsif ( isDIGIT($pos) ) { $s = $pos; } else { $s = $pos; last; } if ( $qv ) { while ( isDIGIT($pos) || $pos eq '_') { $pos++; } } else { my $digits = 0; while ( ( isDIGIT($pos) || $pos eq '_' ) && $digits < 3 ) { if ( $pos ne '_' ) { $digits++; } $pos++; } } } } if ( $qv ) { # quoted versions always get at least three terms my $len = $#av; # This for loop appears to trigger a compiler bug on OS X, as it # loops infinitely. Yes, len is negative. No, it makes no sense. # Compiler in question is: # gcc version 3.3 20030304 (Apple Computer, Inc. build 1640) # for ( len = 2 - len; len > 0; len-- ) # av_push(MUTABLE_AV(sv), newSViv(0)); # $len = 2 - $len; while ($len-- > 0) { push @av, 0; } } # need to save off the current version string for later if ( $vinf ) { $$rv->{original} = "v.Inf"; $$rv->{vinf} = 1; } elsif ( $s > $start ) { $$rv->{original} = $start->currstr($s); if ( $qv && $saw_decimal == 1 && $start ne 'v' ) { # need to insert a v to be consistent $$rv->{original} = 'v' . $$rv->{original}; } } else { $$rv->{original} = '0'; push(@av, 0); } # And finally, store the AV in the hash $$rv->{version} = \@av; # fix RT#19517 - special case 'undef' as string if ($s eq 'undef') { $s += 5; } return $s; } sub new { my $class = shift; unless (defined $class or $#_ > 1) { require Carp; Carp::croak('Usage: version::new(class, version)'); } my $self = bless ({}, ref ($class) || $class); my $qv = FALSE; if ( $#_ == 1 ) { # must be CVS-style $qv = TRUE; } my $value = pop; # always going to be the last element if ( ref($value) && eval('$value->isa("version")') ) { # Can copy the elements directly $self->{version} = [ @{$value->{version} } ]; $self->{qv} = 1 if $value->{qv}; $self->{alpha} = 1 if $value->{alpha}; $self->{original} = ''.$value->{original}; return $self; } if ( not defined $value or $value =~ /^undef$/ ) { # RT #19517 - special case for undef comparison # or someone forgot to pass a value push @{$self->{version}}, 0; $self->{original} = "0"; return ($self); } if (ref($value) =~ m/ARRAY|HASH/) { require Carp; Carp::croak("Invalid version format (non-numeric data)"); } $value = _un_vstring($value); if ($Config{d_setlocale}) { use POSIX qw/locale_h/; use if $Config{d_setlocale}, 'locale'; my $currlocale = setlocale(LC_ALL); # if the current locale uses commas for decimal points, we # just replace commas with decimal places, rather than changing # locales if ( localeconv()->{decimal_point} eq ',' ) { $value =~ tr/,/./; } } # exponential notation if ( $value =~ /\d+.?\d*e[-+]?\d+/ ) { $value = sprintf("%.9f",$value); $value =~ s/(0+)$//; # trim trailing zeros } my $s = scan_version($value, \$self, $qv); if ($s) { # must be something left over warn(sprintf "Version string '%s' contains invalid data; " ."ignoring: '%s'", $value, $s); } return ($self); } *parse = \&new; sub numify { my ($self) = @_; unless (_verify($self)) { require Carp; Carp::croak("Invalid version object"); } my $alpha = $self->{alpha} || ""; my $len = $#{$self->{version}}; my $digit = $self->{version}[0]; my $string = sprintf("%d.", $digit ); if ($alpha and warnings::enabled()) { warnings::warn($WARN_CATEGORY, 'alpha->numify() is lossy'); } for ( my $i = 1 ; $i <= $len ; $i++ ) { $digit = $self->{version}[$i]; $string .= sprintf("%03d", $digit); } if ( $len == 0 ) { $string .= sprintf("000"); } return $string; } sub normal { my ($self) = @_; unless (_verify($self)) { require Carp; Carp::croak("Invalid version object"); } my $len = $#{$self->{version}}; my $digit = $self->{version}[0]; my $string = sprintf("v%d", $digit ); for ( my $i = 1 ; $i <= $len ; $i++ ) { $digit = $self->{version}[$i]; $string .= sprintf(".%d", $digit); } if ( $len <= 2 ) { for ( $len = 2 - $len; $len != 0; $len-- ) { $string .= sprintf(".%0d", 0); } } return $string; } sub stringify { my ($self) = @_; unless (_verify($self)) { require Carp; Carp::croak("Invalid version object"); } return exists $self->{original} ? $self->{original} : exists $self->{qv} ? $self->normal : $self->numify; } sub vcmp { my ($left,$right,$swap) = @_; my $class = ref($left); unless ( UNIVERSAL::isa($right, $class) ) { $right = $class->new($right); } if ( $swap ) { ($left, $right) = ($right, $left); } unless (_verify($left)) { require Carp; Carp::croak("Invalid version object"); } unless (_verify($right)) { require Carp; Carp::croak("Invalid version format"); } my $l = $#{$left->{version}}; my $r = $#{$right->{version}}; my $m = $l < $r ? $l : $r; my $lalpha = $left->is_alpha; my $ralpha = $right->is_alpha; my $retval = 0; my $i = 0; while ( $i <= $m && $retval == 0 ) { $retval = $left->{version}[$i] <=> $right->{version}[$i]; $i++; } # possible match except for trailing 0's if ( $retval == 0 && $l != $r ) { if ( $l < $r ) { while ( $i <= $r && $retval == 0 ) { if ( $right->{version}[$i] != 0 ) { $retval = -1; # not a match after all } $i++; } } else { while ( $i <= $l && $retval == 0 ) { if ( $left->{version}[$i] != 0 ) { $retval = +1; # not a match after all } $i++; } } } return $retval; } sub vbool { my ($self) = @_; return vcmp($self,$self->new("0"),1); } sub vnoop { require Carp; Carp::croak("operation not supported with version object"); } sub is_alpha { my ($self) = @_; return (exists $self->{alpha}); } sub qv { my $value = shift; my $class = $CLASS; if (@_) { $class = ref($value) || $value; $value = shift; } $value = _un_vstring($value); $value = 'v'.$value unless $value =~ /(^v|\d+\.\d+\.\d)/; my $obj = $CLASS->new($value); return bless $obj, $class; } *declare = \&qv; sub is_qv { my ($self) = @_; return (exists $self->{qv}); } sub _verify { my ($self) = @_; if ( ref($self) && eval { exists $self->{version} } && ref($self->{version}) eq 'ARRAY' ) { return 1; } else { return 0; } } sub _is_non_alphanumeric { my $s = shift; $s = new charstar $s; while ($s) { return 0 if isSPACE($s); # early out return 1 unless (isALPHA($s) || isDIGIT($s) || $s =~ /[.-]/); $s++; } return 0; } sub _un_vstring { my $value = shift; # may be a v-string if ( length($value) >= 1 && $value !~ /[,._]/ && _is_non_alphanumeric($value)) { my $tvalue; if ( $] >= 5.008_001 ) { $tvalue = _find_magic_vstring($value); $value = $tvalue if length $tvalue; } elsif ( $] >= 5.006_000 ) { $tvalue = sprintf("v%vd",$value); if ( $tvalue =~ /^v\d+(\.\d+)*$/ ) { # must be a v-string $value = $tvalue; } } } return $value; } sub _find_magic_vstring { my $value = shift; my $tvalue = ''; require B; my $sv = B::svref_2object(\$value); my $magic = ref($sv) eq 'B::PVMG' ? $sv->MAGIC : undef; while ( $magic ) { if ( $magic->TYPE eq 'V' ) { $tvalue = $magic->PTR; $tvalue =~ s/^v?(.+)$/v$1/; last; } else { $magic = $magic->MOREMAGIC; } } $tvalue =~ tr/_//d; return $tvalue; } sub _VERSION { my ($obj, $req) = @_; my $class = ref($obj) || $obj; no strict 'refs'; if ( exists $INC{"$class.pm"} and not %{"$class\::"} and $] >= 5.008) { # file but no package require Carp; Carp::croak( "$class defines neither package nor VERSION" ."--version check failed"); } my $version = eval "\$$class\::VERSION"; if ( defined $version ) { local $^W if $] <= 5.008; $version = version::vpp->new($version); } if ( defined $req ) { unless ( defined $version ) { require Carp; my $msg = $] < 5.006 ? "$class version $req required--this is only version " : "$class does not define \$$class\::VERSION" ."--version check failed"; if ( $ENV{VERSION_DEBUG} ) { Carp::confess($msg); } else { Carp::croak($msg); } } $req = version::vpp->new($req); if ( $req > $version ) { require Carp; if ( $req->is_qv ) { Carp::croak( sprintf ("%s version %s required--". "this is only version %s", $class, $req->normal, $version->normal) ); } else { Carp::croak( sprintf ("%s version %s required--". "this is only version %s", $class, $req->stringify, $version->stringify) ); } } } return defined $version ? $version->stringify : undef; } 1; #this line is important and will help the module return a true value VERSION_VPP s/^ //mg for values %fatpacked; my $class = 'FatPacked::'.(0+\%fatpacked); no strict 'refs'; *{"${class}::files"} = sub { keys %{$_[0]} }; if ($] < 5.008) { *{"${class}::INC"} = sub { if (my $fat = $_[0]{$_[1]}) { my $pos = 0; my $last = length $fat; return (sub { return 0 if $pos == $last; my $next = (1 + index $fat, "\n", $pos) || $last; $_ .= substr $fat, $pos, $next - $pos; $pos = $next; return 1; }); } }; } else { *{"${class}::INC"} = sub { if (my $fat = $_[0]{$_[1]}) { open my $fh, '<', \$fat or die "FatPacker error loading $_[1] (could be a perl installation issue?)"; return $fh; } return; }; } unshift @INC, bless \%fatpacked, $class; } # END OF FATPACK CODE #!/apps/perlbrew/perls/perl-5.8.8/bin/perl package patchperl; # ABSTRACT: patch a perl source tree use strict; use warnings; use Devel::PatchPerl; use Getopt::Long; my $version = ''; my $patchlevel = ''; GetOptions( version => \$version, patchlevel => \$patchlevel, ) or die("Error in command line arguments\n"); if ( $version ) { my $vers = Devel::PatchPerl->_patchperl_version(); print "Devel::PatchPerl $vers\n"; } else { local $ENV{PERL5_PATCHPERL_PATCHLEVEL} = $patchlevel; Devel::PatchPerl->patch_source($ARGV[1], $ARGV[0]); } __END__ =pod =encoding UTF-8 =head1 NAME patchperl - patch a perl source tree =head1 VERSION version 2.08 =head1 SYNOPSIS patchperl =head1 COMMAND LINE SWITCHES =over =item C<--version> Prints the version of L to STDOUT and exits =item C<--patchlevel> Devel::PatchPerl will normally update the C file in the perl source tree to indicate that it has applied local patches. This behaviour is negated if it is detected that it is operating in a git repository. To override this and update C when in a Git repository use this switch. =back =head1 AUTHOR Chris Williams =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2021 by Chris Williams and Marcus Holland-Moritz. 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