home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / xampp / xampp-perl-addon-1.4.9-installer.exe / Test5005compat.pm < prev    next >
Encoding:
Perl POD Document  |  2004-03-04  |  1.8 KB  |  85 lines
  1. # Copyright 2001-2004 The Apache Software Foundation
  2. #
  3. # Licensed under the Apache License, Version 2.0 (the "License");
  4. # you may not use this file except in compliance with the License.
  5. # You may obtain a copy of the License at
  6. #
  7. #     http://www.apache.org/licenses/LICENSE-2.0
  8. #
  9. # Unless required by applicable law or agreed to in writing, software
  10. # distributed under the License is distributed on an "AS IS" BASIS,
  11. # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
  12. # See the License for the specific language governing permissions and
  13. # limitations under the License.
  14. #
  15. package Apache::Test5005compat;
  16.  
  17. use strict;
  18. use Symbol ();
  19. use File::Basename;
  20. use File::Path;
  21.  
  22. $Apache::Test5005compat::VERSION = '0.01';
  23.  
  24. my %compat_files = (
  25.      'lib/warnings.pm' => \&warnings_pm,
  26. );
  27.  
  28. sub import {
  29.     if ($] >= 5.006) {
  30.         #make sure old compat stubs dont wipe out installed versions
  31.         unlink for keys %compat_files;
  32.         return;
  33.     }
  34.  
  35.     eval { require File::Spec::Functions; } or
  36.       die "this is only Perl $], you need to install File-Spec from CPAN";
  37.  
  38.     my $min_version = 0.82;
  39.     unless ($File::Spec::VERSION >= $min_version) {
  40.         die "you need to install File-Spec-$min_version or higher from CPAN";
  41.     }
  42.  
  43.     while (my($file, $sub) = each %compat_files) {
  44.         $sub->($file);
  45.     }
  46. }
  47.  
  48. sub open_file {
  49.     my $file = shift;
  50.  
  51.     unless (-d 'lib') {
  52.         $file = "Apache-Test/$file";
  53.     }
  54.  
  55.     my $dir = dirname $file;
  56.  
  57.     unless (-d $dir) {
  58.         mkpath([$dir], 0, 0755);
  59.     }
  60.  
  61.     my $fh = Symbol::gensym();
  62.     print "creating $file\n";
  63.     open $fh, ">$file" or die "open $file: $!";
  64.  
  65.     return $fh;
  66. }
  67.  
  68. sub warnings_pm {
  69.     return if eval { require warnings };
  70.  
  71.     my $fh = open_file(shift);
  72.  
  73.     print $fh <<'EOF';
  74. package warnings;
  75.  
  76. sub import {}
  77.  
  78. 1;
  79. EOF
  80.  
  81.     close $fh;
  82. }
  83.  
  84. 1;
  85.