home *** CD-ROM | disk | FTP | other *** search
/ Acorn User 10 / AU_CD10.iso / Updates / Perl / RPC / !Perl / scripts / swapext < prev    next >
Encoding:
Text File  |  1998-07-14  |  1.3 KB  |  64 lines
  1. #! perl -w
  2. use RISCOS;
  3. use File::Copy;
  4.  
  5. # Swap the files in the perl library from Name/pm to pm.Name
  6.  
  7. die "$0 <from> <to>" unless( @ARGV == 2 );
  8.  
  9. $from = shift;
  10. $to = shift;
  11.  
  12. sub ensuredir ($) {
  13.     my ($path);
  14.     foreach (split /\./, $_[0])
  15.     {
  16.     if( defined $path )
  17.     {
  18.         $path .= ".$_";
  19.     }
  20.     else
  21.     {
  22.         $path = $_
  23.     }
  24.     mkdir $path, 0777 or warn $! unless -d $path;
  25.     }
  26. }
  27.  
  28. @ext = qw(pm pl al ix);
  29.  
  30. # Sort makes sure we do things in the right order, moving file *.pm out of the
  31. # way before creating directory *.pm
  32. foreach $file ( sort { $b cmp $a } ( <$from..*> ) )
  33. {
  34.     $dest = $file;
  35.     $dest =~ s/^\Q$from\E/$to/;
  36.  
  37.     unless( -d $file )
  38.     {
  39.     foreach $ext (@ext)
  40.     {
  41.         ($base, $leaf) = $dest =~ m|^(.*)\.(.*)/$ext$|;
  42.         ($base, $leaf) = $dest =~ m|^(.*)\.(.*)\.$ext$|
  43.            unless defined $leaf;
  44.            # See autosplit - this is a UnixLib bug workaround
  45.  
  46.         if( defined $leaf )
  47.         {
  48.           $dir = "$base.$ext";
  49.           $dest = "$base.$ext.$leaf";
  50.  
  51.           last;
  52.         }
  53.     }
  54.     ($dir) = $dest =~ /(.*)\./ unless defined $leaf;
  55.     warn "No suffix on '$file'\n" unless defined $leaf;
  56.     
  57.     ensuredir( $dir );
  58.     printf "%s -ยป %s\n", $file, $dest;
  59. #        printf "%s -> %s\n", RISCOS::Filespec::riscosify($file),
  60. #                RISCOS::Filespec::riscosify ($dest);
  61.     copy $file, "$dest" or warn $!;
  62.     }
  63. }
  64.