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