lib/TWiki/Configure/Checkers/WorkingDir.pm
changeset 0 414e01d06fd5
equal deleted inserted replaced
-1:000000000000 0:414e01d06fd5
       
     1 #
       
     2 # TWiki Enterprise Collaboration Platform, http://TWiki.org/
       
     3 #
       
     4 # Copyright (C) 2000-2006 TWiki Contributors.
       
     5 #
       
     6 # This program is free software; you can redistribute it and/or
       
     7 # modify it under the terms of the GNU General Public License
       
     8 # as published by the Free Software Foundation; either version 2
       
     9 # of the License, or (at your option) any later version. For
       
    10 # more details read LICENSE in the root of this distribution.
       
    11 #
       
    12 # This program is distributed in the hope that it will be useful,
       
    13 # but WITHOUT ANY WARRANTY; without even the implied warranty of
       
    14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
       
    15 #
       
    16 # As per the GPL, removal of this notice is prohibited.
       
    17 package TWiki::Configure::Checkers::WorkingDir;
       
    18 use base 'TWiki::Configure::Checker';
       
    19 
       
    20 use strict;
       
    21 
       
    22 sub check {
       
    23     my $this = shift;
       
    24 
       
    25     my $mess = $this->guessMajorDir('WorkingDir', 'working', 1);
       
    26     $TWiki::cfg{WorkingDir} =~ s#[/\\]+$##;
       
    27 
       
    28     unless (-d "$TWiki::cfg{WorkingDir}") {
       
    29         mkdir("$TWiki::cfg{WorkingDir}") ||
       
    30           return $this->ERROR("$TWiki::cfg{WorkingDir} does not exist, and I can't create it: $!");
       
    31         $mess .= $this->NOTE("Created $TWiki::cfg{WorkingDir}");
       
    32     }
       
    33 
       
    34     unless (-d "$TWiki::cfg{WorkingDir}/tmp") {
       
    35         if (-e "$TWiki::cfg{WorkingDir}/tmp") {
       
    36             $mess .= $this->ERROR("$TWiki::cfg{WorkingDir}/tmp already exists, but is not a directory");
       
    37         } elsif (!mkdir("$TWiki::cfg{WorkingDir}/tmp", '1777')) {
       
    38             $mess .= $this->ERROR("Could not create $TWiki::cfg{WorkingDir}/tmp");
       
    39         } else {
       
    40             $mess .= $this->NOTE("Created $TWiki::cfg{WorkingDir}/tmp");
       
    41         }
       
    42     }
       
    43 
       
    44     unless (-d "$TWiki::cfg{WorkingDir}/work_areas") {
       
    45         if (-e "$TWiki::cfg{WorkingDir}/work_areas") {
       
    46             $mess .= $this->ERROR("$TWiki::cfg{WorkingDir}/work_areas already exists, but is not a directory");
       
    47         } elsif (!mkdir("$TWiki::cfg{WorkingDir}/work_areas")) {
       
    48             $mess .= $this->ERROR("Could not create $TWiki::cfg{WorkingDir}/work_areas");
       
    49         } else {
       
    50             $mess .= $this->NOTE("Created $TWiki::cfg{WorkingDir}/work_areas");
       
    51         }
       
    52     }
       
    53 
       
    54     # Automatic upgrade of work_areas
       
    55     my $existing = $TWiki::cfg{RCS}{WorkAreaDir} || '';
       
    56     $existing =~ s/\$TWiki::cfg({\w+})+/eval "$TWiki::cfg$1"/ge;
       
    57     if ($existing && -d $existing) {
       
    58         # Try and move the contents of the old workarea
       
    59         my $e = $this->copytree(
       
    60             $existing, "$TWiki::cfg{WorkingDir}/work_areas");
       
    61         if ($e) {
       
    62             $mess .= $this->ERROR($e);
       
    63         } else {
       
    64             $mess .= $this->WARN("
       
    65 You have an existing {RCS}{WorkAreaDir} ($TWiki::cfg{RCS}{WorkAreaDir}),
       
    66 so I have copied the contents of that directory into the new
       
    67 $TWiki::cfg{WorkingDir}/work_areas. You should delete the old
       
    68 $TWiki::cfg{RCS}{WorkAreaDir} when you are happy with
       
    69 the upgrade.");
       
    70             delete( $TWiki::cfg{RCS}{WorkAreaDir} );
       
    71         }
       
    72     }
       
    73 
       
    74     unless (-d "$TWiki::cfg{WorkingDir}/registration_approvals") {
       
    75         if (-e "$TWiki::cfg{WorkingDir}/registration_approvals") {
       
    76             $mess .= $this->ERROR("$TWiki::cfg{WorkingDir}/registration_approvals already exists, but is not a directory");
       
    77         } elsif (!mkdir("$TWiki::cfg{WorkingDir}/registration_approvals")) {
       
    78               $mess .= $this->ERROR("Could not create $TWiki::cfg{WorkingDir}/registration_approvals");
       
    79         }
       
    80     }
       
    81 
       
    82     my $e = $this->checkTreePerms( $TWiki::cfg{WorkingDir}, 'rw' );
       
    83     $mess .= $this->ERROR($e) if $e;
       
    84 
       
    85     return $mess;
       
    86 }
       
    87 
       
    88 1;