lib/TWiki/Configure/UIs/EXTENSIONS.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::UIs::EXTENSIONS;
colas@0
    18
use base 'TWiki::Configure::UI';
colas@0
    19
colas@0
    20
use strict;
colas@0
    21
use TWiki::Configure::Type;
colas@0
    22
colas@0
    23
my @tableHeads =
colas@0
    24
  qw(image topic description version installedVersion testedOn install );
colas@0
    25
my %headNames = (
colas@0
    26
    image => '',
colas@0
    27
    topic => 'Extension',
colas@0
    28
    description => 'Description',
colas@0
    29
    version => 'Most Recent Version',
colas@0
    30
    installedVersion => 'Installed Version',
colas@0
    31
    testedOn => 'Tested On TWiki',
colas@0
    32
    testedOnOS => 'Tested On OS',
colas@0
    33
    install => 'Action',
colas@0
    34
   );
colas@0
    35
colas@0
    36
# Download the report page from the repository, and extract a hash of
colas@0
    37
# available extensions
colas@0
    38
sub _getListOfExtensions {
colas@0
    39
    my $this = shift;
colas@0
    40
colas@0
    41
    $this->findRepositories();
colas@0
    42
colas@0
    43
    if (!$this->{list}) {
colas@0
    44
        $this->{list} = {};
colas@0
    45
        $this->{errors} = [];
colas@0
    46
        foreach my $place ( @{$this->{repositories}} ) {
colas@0
    47
            $place->{data} =~ s#/*$#/#;
colas@0
    48
            print CGI::div("Consulting $place->{name}...");
colas@0
    49
            my $url = $place->{data}.
colas@0
    50
                  'FastReport?skin=text&contenttype=text/plain';
colas@0
    51
            my $response = $this->getUrl($url);
colas@0
    52
            if (!$response->is_error()) {
colas@0
    53
                my $page = $response->content();
colas@0
    54
                $page =~ s/{(.*?)}/$this->_parseRow($1, $place)/ges;
colas@0
    55
            } else {
colas@0
    56
                push(@{$this->{errors}},
colas@0
    57
                     "Error accessing $place->{name}: ".$response->message());
colas@0
    58
            }
colas@0
    59
        }
colas@0
    60
    }
colas@0
    61
    return $this->{list};
colas@0
    62
}
colas@0
    63
colas@0
    64
sub _parseRow {
colas@0
    65
    my ($this, $row, $place) = @_;
colas@0
    66
    my %data;
colas@0
    67
    return '' unless $row =~ s/^ *(\w+): *(.*?) *$/$data{$1} = $2;''/gem;
colas@0
    68
    $data{installedVersion} = $this->_getInstalledVersion($data{topic});
colas@0
    69
    $data{repository} = $place->{name};
colas@0
    70
    $data{data} = $place->{data};
colas@0
    71
    $data{pub} = $place->{pub};
colas@0
    72
    die "$row: ".Data::Dumper->Dump([\%data]) unless $data{topic};
colas@0
    73
    $this->{list}->{$data{topic}} = \%data;
colas@0
    74
    return '';
colas@0
    75
}
colas@0
    76
colas@0
    77
sub ui {
colas@0
    78
    my $this = shift;
colas@0
    79
    my $table = '';
colas@0
    80
colas@0
    81
    my $rows = 0;
colas@0
    82
    my $installed = 0;
colas@0
    83
    my $exts = $this->_getListOfExtensions();
colas@0
    84
    foreach my $error (@{$this->{errors}}) {
colas@0
    85
        $table .= CGI::Tr({class=>'twikiAlert'},CGI::td(
colas@0
    86
            {colspan => 7},
colas@0
    87
            $error));
colas@0
    88
    }
colas@0
    89
colas@0
    90
    $table .=
colas@0
    91
      CGI::Tr(join('', map { CGI::th({valign=>'bottom' },
colas@0
    92
                                     $headNames{$_}) } @tableHeads));
colas@0
    93
    foreach my $key (sort keys %$exts) {
colas@0
    94
        my $ext = $exts->{$key};
colas@0
    95
        my $row = '';
colas@0
    96
        foreach my $f (@tableHeads) {
colas@0
    97
            my $text;
colas@0
    98
            if ($f eq 'install') {
colas@0
    99
                my @script = File::Spec->splitdir($ENV{SCRIPT_NAME});
colas@0
   100
                my $scriptName = pop(@script);
colas@0
   101
                $scriptName =~ s/.*[\/\\]//;  # Fix for Item3511, on Win XP
colas@0
   102
colas@0
   103
                my $link = $scriptName.
colas@0
   104
                  '?action=InstallExtension'.
colas@0
   105
                    ';repository='.$ext->{repository}.
colas@0
   106
                    ';extension='.$ext->{topic};
colas@0
   107
                $text = 'Install';
colas@0
   108
                if ($ext->{installedVersion}) {
colas@0
   109
                    $text = 'Upgrade';
colas@0
   110
                    $installed++;
colas@0
   111
                }
colas@0
   112
                $text = CGI::a({ href => $link }, $text);
colas@0
   113
            } else {
colas@0
   114
                $text = $ext->{$f}||'-';
colas@0
   115
                if ($f eq 'topic') {
colas@0
   116
                    my $link = $ext->{data}.$ext->{topic};
colas@0
   117
                    $text = CGI::a({ href => $link }, $text);
colas@0
   118
                }
colas@0
   119
            }
colas@0
   120
            $row .= CGI::td({valign=>'top'}, $text);
colas@0
   121
        }
colas@0
   122
        if ($ext->{installedVersion}) {
colas@0
   123
            $table .= CGI::Tr({class=>'patternAccessKeyInfo'}, $row);
colas@0
   124
        } else {
colas@0
   125
            $table .= CGI::Tr($row);
colas@0
   126
        }
colas@0
   127
        $rows++;
colas@0
   128
    }
colas@0
   129
    $table .= CGI::Tr({class=>'patternAccessKeyInfo'},CGI::td(
colas@0
   130
        {colspan => 7},
colas@0
   131
        $installed . ' extension'.
colas@0
   132
          ($installed==1?'':'s').' out of '.$rows.' already installed'));
colas@0
   133
    my $page = <<INTRO;
colas@0
   134
To install an extension from this page, click on the link in the 'Action' column.<p />Note that the webserver user has to be able to
colas@0
   135
write files everywhere in your TWiki installation. Otherwise you may see
colas@0
   136
'No permission to write' errors during extension installation.
colas@0
   137
INTRO
colas@0
   138
    $page .= CGI::table({class=>'twikiForm'},$table);
colas@0
   139
    return $page;
colas@0
   140
}
colas@0
   141
colas@0
   142
sub _getInstalledVersion {
colas@0
   143
    my ($this, $module) = @_;
colas@0
   144
    my $lib;
colas@0
   145
colas@0
   146
    return undef unless $module;
colas@0
   147
colas@0
   148
    if ($module =~ /Plugin$/) {
colas@0
   149
        $lib = 'Plugins';
colas@0
   150
    } else {
colas@0
   151
        $lib = 'Contrib';
colas@0
   152
    }
colas@0
   153
colas@0
   154
    my $path = 'TWiki::'.$lib.'::'.$module;
colas@0
   155
    my $version;
colas@0
   156
    my $check = 'use '.$path.'; $version = $'.$path.'::VERSION;';
colas@0
   157
    eval $check;
colas@0
   158
    #print STDERR $@ if $@ && DEBUG;
colas@0
   159
    if ($version) {
colas@0
   160
        $version =~ s/^\s*\$Rev:\s*(.*?)\s*\$$/$1/;
colas@0
   161
    }
colas@0
   162
    return $version;
colas@0
   163
}
colas@0
   164
colas@0
   165
1;