home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / tsw / TSW_3.4.0.exe / Apache2 / perl / Test5005compat.pm < prev    next >
Encoding:
Perl POD Document  |  2003-04-29  |  1.3 KB  |  71 lines
  1. package Apache::Test5005compat;
  2.  
  3. use strict;
  4. use Symbol ();
  5. use File::Basename;
  6. use File::Path;
  7.  
  8. $Apache::Test5005compat::VERSION = '0.01';
  9.  
  10. my %compat_files = (
  11.      'lib/warnings.pm' => \&warnings_pm,
  12. );
  13.  
  14. sub import {
  15.     if ($] >= 5.006) {
  16.         #make sure old compat stubs dont wipe out installed versions
  17.         unlink for keys %compat_files;
  18.         return;
  19.     }
  20.  
  21.     eval { require File::Spec::Functions; } or
  22.       die "this is only Perl $], you need to install File-Spec from CPAN";
  23.  
  24.     my $min_version = 0.82;
  25.     unless ($File::Spec::VERSION >= $min_version) {
  26.         die "you need to install File-Spec-$min_version or higher from CPAN";
  27.     }
  28.  
  29.     while (my($file, $sub) = each %compat_files) {
  30.         $sub->($file);
  31.     }
  32. }
  33.  
  34. sub open_file {
  35.     my $file = shift;
  36.  
  37.     unless (-d 'lib') {
  38.         $file = "Apache-Test/$file";
  39.     }
  40.  
  41.     my $dir = dirname $file;
  42.  
  43.     unless (-d $dir) {
  44.         mkpath([$dir], 0, 0755);
  45.     }
  46.  
  47.     my $fh = Symbol::gensym();
  48.     print "creating $file\n";
  49.     open $fh, ">$file" or die "open $file: $!";
  50.  
  51.     return $fh;
  52. }
  53.  
  54. sub warnings_pm {
  55.     return if eval { require warnings };
  56.  
  57.     my $fh = open_file(shift);
  58.  
  59.     print $fh <<'EOF';
  60. package warnings;
  61.  
  62. sub import {}
  63.  
  64. 1;
  65. EOF
  66.  
  67.     close $fh;
  68. }
  69.  
  70. 1;
  71.