view release on metacpan or  search on metacpan

lib/B/C.pm  view on Meta::CPAN

      return 1 if ( $u =~ /^$p\:\:/ ) && $include_package{$package};
    }
  }
  # Needed since 5.12.2: Check already if deleted
  my $incpack = inc_packname($package);
  if ( $] > 5.015001 and exists $all_bc_deps{$package}
       and !exists $curINC{$incpack} and $savINC{$incpack} ) {
    $include_package{$package} = 0;
    warn "Cached $package not in \%INC, already deleted (early)\n" if $debug{pkg};
    return 0;
  }
  # issue348: only drop B::C packages, not any from user code.
  if (($package =~ /^DynaLoader|XSLoader$/ and $use_xsloader)
      or (!exists $all_bc_deps{$package})) {
    $include_package{$package} = 1;
  }
  # If this package is in the same file as main:: or our source, save it. (72, 73)
  if ($mainfile) {
    # Find the first cv in this package for CV->FILE
    no strict 'refs';
    for my $sym (sort keys %{$package.'::'}) {
      if (defined &{$package.'::'.$sym}) {
	# compare cv->FILE to $mainfile
	my $cv = svref_2object(\&{$package.'::'.$sym});
	if ($cv and $cv->can('FILE') and $cv->FILE) {
	  $include_package{$package} = 1 if $mainfile eq $cv->FILE;
	  last;
	}
      }
    }
  }
  if ($module and $package ne $module) {
    $include_package{$package} = 0;
    warn "Skip $package not in $mainfile\n" if $debug{pkg};
    return 0;
  }
  # add overloaded but otherwise empty packages (#172)
  if ($savINC{'overload.pm'} and exists ${$package.'::'}{OVERLOAD} and exists ${$package.'::'}{'()'}) {
    mark_package($package, 1);
    mark_package('overload', 1);
    return 1;
  }
  # Omit the packages which we use (and which cause grief
  # because of fancy "goto &$AUTOLOAD" stuff).
  # XXX Surely there must be a nicer way to do this.
  if ( exists $include_package{$package} ) {
    if (! exists $all_bc_deps{$package}) {
      $include_package{$package} = 1;
      $curINC{$incpack} = $savINC{$incpack};
      warn "Cached new $package is kept\n" if $debug{pkg};
    }
    elsif (!$include_package{$package}) {
      delete_unsaved_hashINC($package) if can_delete($package);
      warn "Cached $package is already deleted\n" if $debug{pkg};
    } else {
      warn "Cached $package is cached\n" if $debug{pkg};
    }
    return $include_package{$package};
  }

  # Now see if current package looks like an OO class. This is probably too strong.
  if (!$all_bc_deps{$package}) {
    foreach my $m (qw(new DESTROY TIESCALAR TIEARRAY TIEHASH TIEHANDLE)) {
      # 5.10 introduced version and Regexp::DESTROY, which we dont want automatically.
      # XXX TODO This logic here is wrong and unstable. Fixes lead to more failures.
      # The walker deserves a rewrite.
      if ( UNIVERSAL::can( $package, $m ) and $package !~ /^(B::C|version|Regexp|utf8|SelectSaver)$/ ) {
        next if $package eq 'utf8' and $m eq 'DESTROY'; # utf8::DESTROY is empty
        # we load Errno by ourself to avoid double Config warnings [perl #]
        # and we have special logic to detect and include it
        next if $package =~ /^(Errno|Tie::Hash::NamedCapture)$/ and $m eq 'TIEHASH';
        # XXX Config and FileHandle should not just return. If unneeded skip em.
        return 0 if $package eq 'Config' and $m =~ /DESTROY|TIEHASH/; # Config detected in GV
        # IO::File|IO::Handle added for B::CC only
        return 0 if $package =~ /^(FileHandle|IO::File|IO::Handle)/ and $m eq 'new';
        warn "$package has method $m: saving package\n" if $debug{pkg};
        return mark_package($package);
      }
    }
  }
  if ($package !~ /^PerlIO/ and can_delete($package)) {
    delete_unsaved_hashINC($package);
  }
  if (can_delete($package)) {
    warn "Delete $package\n" if $debug{pkg};
    return $include_package{$package} = 0;
  } elsif (! exists $all_bc_deps{$package}) { # and not in @deps
    warn "Keep $package\n" if $debug{pkg};
    return $include_package{$package} = 1;
  } else { # in @deps
    # warn "Ignore $package\n" if $debug{pkg};
    return;
  }
}

sub inc_packname {
  my $package = shift;
  # See below at the reverse packname_inc: utf8 => utf8.pm + utf8_heavy.pl
  $package =~ s/\:\:/\//g;
  $package .= '.pm';
  return $package;
}

sub packname_inc {
  my $package = shift;
  $package =~ s/\//::/g;
  if ($package =~ /^(Config_git\.pl|Config_heavy.pl)$/) {
    return 'Config';
  }
  if ($package eq 'utf8_heavy.pl') {
    return 'utf8';
  }
  $package =~ s/\.p[lm]$//;
  return $package;
}

sub delete_unsaved_hashINC {
  my $package = shift;
  my $incpack = inc_packname($package);
  # Not already saved package, so it is not loaded again at run-time.
  return if $dumped_package{$package};