Move XSSymSet.pm to lib/ExtUtils/, but only install it on VMS.

This reduces the number of places with special-casing logic.

2 files changed, 2 insertions, 245 deletions

diff --git a/vms/descrip_mms.template b/vms/descrip_mms.template
index bb4e00e240..a2f2067d66 100644
--- a/vms/descrip_mms.template
+++ b/vms/descrip_mms.template
@@ -352,7 +352,7 @@ CRTLOPTS =,$(CRTL)/Options
 unidatadirs = lib/unicore/To lib/unicore/lib
 
 # Modules which must be installed before we can build extensions
-LIBPREREQ = $(ARCHDIR)Config.pm $(ARCHDIR)Config_heavy.pl [.lib.VMS]Filespec.pm [.lib]DynaLoader.pm [.lib]XSLoader.pm [.lib]lib.pm [.lib.ExtUtils]XSSymSet.pm $(ARCHDIR)vmspipe.com [.lib]re.pm unidatafiles.ts
+LIBPREREQ = $(ARCHDIR)Config.pm $(ARCHDIR)Config_heavy.pl [.lib.VMS]Filespec.pm [.lib]DynaLoader.pm [.lib]XSLoader.pm [.lib]lib.pm $(ARCHDIR)vmspipe.com [.lib]re.pm unidatafiles.ts
 
 utils1 = [.lib.pods]perldoc.com [.lib.ExtUtils]Miniperl.pm [.utils]c2ph.com [.utils]h2ph.com 
 utils2 = [.utils]h2xs.com [.utils]libnetcfg.com [.lib]perlbug.com [.utils]dprofpp.com 
@@ -541,7 +541,7 @@ unidatafiles.ts : $(MINIPERL_EXE) [.lib]Config.pm [.lib.unicore]mktables
 	@ If F$Search("$(MMS$TARGET)").nes."" Then Delete/NoLog/NoConfirm $(MMS$TARGET);*
 	@ Copy/NoConfirm _NLA0: $(MMS$TARGET)
  
-[.ext.DynaLoader]dl_vms.c : [.ext.DynaLoader]dl_vms.xs $(ARCHDIR)Config.pm [.lib.ExtUtils]XSSymSet.pm $(MINIPERL_EXE) [.lib.VMS]Filespec.pm 
+[.ext.DynaLoader]dl_vms.c : [.ext.DynaLoader]dl_vms.xs $(ARCHDIR)Config.pm $(MINIPERL_EXE) [.lib.VMS]Filespec.pm 
 	$(XSUBPP) $(MMS$SOURCE) >$(MMS$TARGET)
 
 [.ext.DynaLoader]dl_vms$(O) : [.ext.DynaLoader]dl_vms.c
@@ -575,10 +575,6 @@ dynext : $(LIBPREREQ) $(DBG)perlshr$(E) preplibrary makeppport
 	@ If F$Search("[.lib]VMS.Dir").eqs."" Then Create/Directory [.lib.VMS]
 	Copy/NoConfirm/Log $(MMS$SOURCE) [.lib.VMS]
 
-[.lib.ExtUtils]XSSymSet.pm : [.vms.ext]XSSymSet.pm
-	@ If F$Search("[.lib]ExtUtils.Dir").eqs."" Then Create/Directory [.lib.ExtUtils]
-	Copy/NoConfirm/Log $(MMS$SOURCE) [.lib.ExtUtils]
-
 [.lib.pods]perldoc.com : [.utils]perldoc.PL $(ARCHDIR)Config.pm
 	@ If F$Search("[.lib]pods.dir").eqs."" Then Create/Directory [.lib.pods]
 	$(MINIPERL) -"I[-.lib]" $(MMS$SOURCE)
@@ -1830,7 +1826,6 @@ tidy : cleanlis
 	- If F$Search("[.lib]Config_heavy.pl;-1").nes."" Then Purge/NoConfirm/Log [.lib]Config_heavy.pl
 	- If F$Search("$(ARCHDIR)Config_heavy.pl;-1").nes."" Then Purge/NoConfirm/Log $(ARCHDIR)Config_heavy.pl
 	- If F$Search("[.lib.ExtUtils]Miniperl.pm").nes."" Then Purge/NoConfirm/Log [.lib.ExtUtils]Miniperl.pm
-	- If F$Search("[.lib.ExtUtils]XSSymSet.pm").nes."" Then Purge/NoConfirm/Log [.lib.ExtUtils]XSSymSet.pm
 	- If F$Search("[.lib.VMS]*.*;-1").nes."" Then Purge/NoConfirm/Log [.lib.VMS]*.*
 	- If F$Search("[.lib.pods]*.Pod;-1").nes."" Then Purge/NoConfirm/Log [.lib.pods]*.Pod
 	- If F$Search("$(ARCHCORE)*.*").nes."" Then Purge/NoConfirm/Log $(ARCHCORE)*.*
@@ -1894,7 +1889,6 @@ realclean : clean
 	- If F$Search("$(ARCHDIR)Config.pm").nes."" Then Delete/NoConfirm/Log $(ARCHDIR)Config.pm;*
 	- If F$Search("$(ARCHDIR)Config_heavy.pl").nes."" Then Delete/NoConfirm/Log $(ARCHDIR)Config_heavy.pl;*
 	- If F$Search("[.lib.ExtUtils]Miniperl.pm").nes."" Then Delete/NoConfirm/Log [.lib.ExtUtils]Miniperl.pm;*
-	- If F$Search("[.lib.ExtUtils]XSSymSet.pm").nes."" Then Delete/NoConfirm/Log [.lib.ExtUtils]XSSymSet.pm;*
 	- If F$Search("[.lib.pods]*.pod").nes."" Then Delete/NoConfirm/Log [.lib.pods]*.pod;*
 	- If F$Search("[.lib.pods]perldoc.com").nes."" Then Delete/NoConfirm/Log [.lib.pods]perldoc.com;*
 	- If F$Search("[.utils]perlivp.com").nes."" Then Delete/NoConfirm/Log [.utils]perlivp.com;*
diff --git a/vms/ext/XSSymSet.pm b/vms/ext/XSSymSet.pm
deleted file mode 100644
index 548c7ea553..0000000000
--- a/vms/ext/XSSymSet.pm
+++ /dev/null
@@ -1,237 +0,0 @@
-package ExtUtils::XSSymSet;
-
-use strict;
-use vars qw( $VERSION );
-$VERSION = '1.1';
-
-
-sub new { 
-  my($pkg,$maxlen,$silent) = @_;
-  $maxlen ||= 31;
-  $silent ||= 0;
-  my($obj) = { '__M@xLen' => $maxlen, '__S!lent' => $silent };
-  bless $obj, $pkg;
-}
-
-
-sub trimsym {
-  my($self,$name,$maxlen,$silent) = @_;
-
-  unless (defined $maxlen) {
-    if (ref $self) { $maxlen ||= $self->{'__M@xLen'}; }
-    $maxlen ||= 31;
-  }
-  unless (defined $silent) {
-    if (ref $self) { $silent ||= $self->{'__S!lent'}; }
-    $silent ||= 0;
-  }
-  return $name if (length $name <= $maxlen);
-
-  my $trimmed = $name;
-  # First, just try to remove duplicated delimiters
-  $trimmed =~ s/__/_/g;
-  if (length $trimmed > $maxlen) {
-    # Next, all duplicated chars
-    $trimmed =~ s/(.)\1+/$1/g;
-    if (length $trimmed > $maxlen) {
-      my $squeezed = $trimmed;
-      my($xs,$prefix,$func) = $trimmed =~ /^(XS_)?(.*)_([^_]*)$/;
-      $xs ||= '';
-      my $frac = 3; # replaces broken length-based calculations but w/same result
-      my $pat = '([^_])';
-      if (length $func <= 12) {  # Try to preserve short function names
-        if ($frac > 1) { $pat .= '[^A-Z_]{' . ($frac - 1) . '}'; }
-        $prefix =~ s/$pat/$1/g;
-        $squeezed = "$xs$prefix" . "_$func";
-        if (length $squeezed > $maxlen) {
-          $pat =~ s/A-Z//;
-          $prefix =~ s/$pat/$1/g;
-          $squeezed = "$xs$prefix" . "_$func";
-        }
-      }
-      else { 
-        if ($frac > 1) { $pat .= '[^A-Z_]{' . ($frac - 1) . '}'; }
-        $squeezed = "$prefix$func";
-        $squeezed =~ s/$pat/$1/g;
-        if (length "$xs$squeezed" > $maxlen) {
-          $pat =~ s/A-Z//;
-          $squeezed =~ s/$pat/$1/g;
-        }
-        $squeezed = "$xs$squeezed";
-      }
-      if (length $squeezed <= $maxlen) { $trimmed = $squeezed; }
-      else {
-        my $frac = int((length $trimmed - $maxlen) / length $trimmed + 0.5);
-        my $pat = '(.).{$frac}';
-        $trimmed =~ s/$pat/$1/g;
-      }
-    }
-  }
-  warn "Warning: long symbol $name\n\ttrimmed to $trimmed\n\t" unless $silent;
-  return $trimmed;
-}
-
-
-sub addsym {
-  my($self,$sym,$maxlen,$silent) = @_;
-  my $trimmed = $self->get_trimmed($sym);
-
-  return $trimmed if defined $trimmed;
-
-  $maxlen ||= $self->{'__M@xLen'} || 31;
-  $silent ||= $self->{'__S!lent'} || 0;    
-  $trimmed = $self->trimsym($sym,$maxlen,1);
-  if (exists $self->{$trimmed}) {
-    my($i) = "00";
-    $trimmed = $self->trimsym($sym,$maxlen-3,$silent);
-    while (exists $self->{"${trimmed}_$i"}) { $i++; }
-    warn "Warning: duplicate symbol $trimmed\n\tchanged to ${trimmed}_$i\n\t(original was $sym)\n\t"
-      unless $silent;
-    $trimmed .= "_$i";
-  }
-  elsif (not $silent and $trimmed ne $sym) {
-    warn "Warning: long symbol $sym\n\ttrimmed to $trimmed\n\t";
-  }
-  $self->{$trimmed} = $sym;
-  $self->{'__N+Map'}->{$sym} = $trimmed;
-  $trimmed;
-}
-
-
-sub delsym {
-  my($self,$sym) = @_;
-  my $trimmed = $self->{'__N+Map'}->{$sym};
-  if (defined $trimmed) {
-    delete $self->{'__N+Map'}->{$sym};
-    delete $self->{$trimmed};
-  }
-  $trimmed;
-}
-
-
-sub get_trimmed {
-  my($self,$sym) = @_;
-  $self->{'__N+Map'}->{$sym};
-}
-
-
-sub get_orig {
-  my($self,$trimmed) = @_;
-  $self->{$trimmed};
-}
-
-
-sub all_orig { (keys %{$_[0]->{'__N+Map'}}); }
-sub all_trimmed { (grep { /^\w+$/ } keys %{$_[0]}); }
-
-__END__
-
-=head1 NAME
-
-ExtUtils::XSSymSet - keep sets of symbol names palatable to the VMS linker
-
-=head1 SYNOPSIS
-
-  use ExtUtils::XSSymSet;
-
-  $set = new ExtUtils::XSSymSet;
-  while ($sym = make_symbol()) { $set->addsym($sym); }
-  foreach $safesym ($set->all_trimmed) {
-    print "Processing $safesym (derived from ",$self->get_orig($safesym),")\n";
-    do_stuff($safesym);
-  }
-
-  $safesym = ExtUtils::XSSymSet->trimsym($onesym);
-
-=head1 DESCRIPTION
-
-Since the VMS linker distinguishes symbols based only on the first 31
-characters of their names, it is occasionally necessary to shorten
-symbol names in order to avoid collisions.  (This is especially true of
-names generated by xsubpp, since prefixes generated by nested package
-names can become quite long.)  C<ExtUtils::XSSymSet> provides functions to
-shorten names in a consistent fashion, and to track a set of names to
-insure that each is unique.  While designed with F<xsubpp> in mind, it
-may be used with any set of strings.  
-
-This package supplies the following functions, all of which should be
-called as methods.
-
-=over 4
-
-=item new([$maxlen[,$silent]])
-
-Creates an empty C<ExtUtils::XSSymset> set of symbols.  This function may be
-called as a static method or via an existing object.  If C<$maxlen> or
-C<$silent> are specified, they are used as the defaults for maximum
-name length and warning behavior in future calls to addsym() or
-trimsym() via this object.
-
-=item addsym($name[,$maxlen[,$silent]])
-
-Creates a symbol name from C<$name>, using the methods described
-under trimsym(), which is unique in this set of symbols, and returns
-the new name.  C<$name> and its resultant are added to the set, and
-any future calls to addsym() specifying the same C<$name> will return
-the same result, regardless of the value of C<$maxlen> specified.
-Unless C<$silent> is true, warnings are output if C<$name> had to be
-trimmed or changed in order to avoid collision with an existing symbol
-name.  C<$maxlen> and C<$silent> default to the values specified when
-this set of symbols was created.  This method must be called via an
-existing object.
-
-=item trimsym($name[,$maxlen[,$silent]])
-
-Creates a symbol name C<$maxlen> or fewer characters long from
-C<$name> and returns it. If C<$name> is too long, it first tries to
-shorten it by removing duplicate characters, then by periodically
-removing non-underscore characters, and finally, if necessary, by
-periodically removing characters of any type.  C<$maxlen> defaults
-to 31.  Unless C<$silent> is true, a warning is output if C<$name>
-is altered in any way.  This function may be called either as a
-static method or via an existing object, but in the latter case no
-check is made to insure that the resulting name is unique in the
-set of symbols.
-
-=item delsym($name)
-
-Removes C<$name> from the set of symbols, where C<$name> is the
-original symbol name passed previously to addsym().  If C<$name>
-existed in the set of symbols, returns its "trimmed" equivalent,
-otherwise returns C<undef>.  This method must be called via an
-existing object.
-
-=item get_orig($trimmed)
-
-Returns the original name which was trimmed to C<$trimmed> by a
-previous call to addsym(), or C<undef> if C<$trimmed> does not
-correspond to a member of this set of symbols.  This method must be
-called via an existing object.
-
-=item get_trimmed($name)
-
-Returns the trimmed name which was generated from C<$name> by a
-previous call to addsym(), or C<undef> if C<$name> is not a member
-of this set of symbols.  This method must be called via an
-existing object.
-
-=item all_orig()
-
-Returns a list containing all of the original symbol names
-from this set.
-
-=item all_trimmed()
-
-Returns a list containing all of the trimmed symbol names
-from this set.
-
-=back
-
-=head1 AUTHOR
-
-Charles Bailey  E<lt>I<bailey@newman.upenn.edu>E<gt>
-
-=head1 REVISION
-
-Last revised 14-Feb-1997, for Perl 5.004.
-