lib/TWiki/Configure/UIs/EXTENSIONS.pm
changeset 0 414e01d06fd5
     1.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2 +++ b/lib/TWiki/Configure/UIs/EXTENSIONS.pm	Sat Jan 26 15:50:53 2008 +0100
     1.3 @@ -0,0 +1,165 @@
     1.4 +#
     1.5 +# TWiki Enterprise Collaboration Platform, http://TWiki.org/
     1.6 +#
     1.7 +# Copyright (C) 2000-2006 TWiki Contributors.
     1.8 +#
     1.9 +# This program is free software; you can redistribute it and/or
    1.10 +# modify it under the terms of the GNU General Public License
    1.11 +# as published by the Free Software Foundation; either version 2
    1.12 +# of the License, or (at your option) any later version. For
    1.13 +# more details read LICENSE in the root of this distribution.
    1.14 +#
    1.15 +# This program is distributed in the hope that it will be useful,
    1.16 +# but WITHOUT ANY WARRANTY; without even the implied warranty of
    1.17 +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
    1.18 +#
    1.19 +# As per the GPL, removal of this notice is prohibited.
    1.20 +package TWiki::Configure::UIs::EXTENSIONS;
    1.21 +use base 'TWiki::Configure::UI';
    1.22 +
    1.23 +use strict;
    1.24 +use TWiki::Configure::Type;
    1.25 +
    1.26 +my @tableHeads =
    1.27 +  qw(image topic description version installedVersion testedOn install );
    1.28 +my %headNames = (
    1.29 +    image => '',
    1.30 +    topic => 'Extension',
    1.31 +    description => 'Description',
    1.32 +    version => 'Most Recent Version',
    1.33 +    installedVersion => 'Installed Version',
    1.34 +    testedOn => 'Tested On TWiki',
    1.35 +    testedOnOS => 'Tested On OS',
    1.36 +    install => 'Action',
    1.37 +   );
    1.38 +
    1.39 +# Download the report page from the repository, and extract a hash of
    1.40 +# available extensions
    1.41 +sub _getListOfExtensions {
    1.42 +    my $this = shift;
    1.43 +
    1.44 +    $this->findRepositories();
    1.45 +
    1.46 +    if (!$this->{list}) {
    1.47 +        $this->{list} = {};
    1.48 +        $this->{errors} = [];
    1.49 +        foreach my $place ( @{$this->{repositories}} ) {
    1.50 +            $place->{data} =~ s#/*$#/#;
    1.51 +            print CGI::div("Consulting $place->{name}...");
    1.52 +            my $url = $place->{data}.
    1.53 +                  'FastReport?skin=text&contenttype=text/plain';
    1.54 +            my $response = $this->getUrl($url);
    1.55 +            if (!$response->is_error()) {
    1.56 +                my $page = $response->content();
    1.57 +                $page =~ s/{(.*?)}/$this->_parseRow($1, $place)/ges;
    1.58 +            } else {
    1.59 +                push(@{$this->{errors}},
    1.60 +                     "Error accessing $place->{name}: ".$response->message());
    1.61 +            }
    1.62 +        }
    1.63 +    }
    1.64 +    return $this->{list};
    1.65 +}
    1.66 +
    1.67 +sub _parseRow {
    1.68 +    my ($this, $row, $place) = @_;
    1.69 +    my %data;
    1.70 +    return '' unless $row =~ s/^ *(\w+): *(.*?) *$/$data{$1} = $2;''/gem;
    1.71 +    $data{installedVersion} = $this->_getInstalledVersion($data{topic});
    1.72 +    $data{repository} = $place->{name};
    1.73 +    $data{data} = $place->{data};
    1.74 +    $data{pub} = $place->{pub};
    1.75 +    die "$row: ".Data::Dumper->Dump([\%data]) unless $data{topic};
    1.76 +    $this->{list}->{$data{topic}} = \%data;
    1.77 +    return '';
    1.78 +}
    1.79 +
    1.80 +sub ui {
    1.81 +    my $this = shift;
    1.82 +    my $table = '';
    1.83 +
    1.84 +    my $rows = 0;
    1.85 +    my $installed = 0;
    1.86 +    my $exts = $this->_getListOfExtensions();
    1.87 +    foreach my $error (@{$this->{errors}}) {
    1.88 +        $table .= CGI::Tr({class=>'twikiAlert'},CGI::td(
    1.89 +            {colspan => 7},
    1.90 +            $error));
    1.91 +    }
    1.92 +
    1.93 +    $table .=
    1.94 +      CGI::Tr(join('', map { CGI::th({valign=>'bottom' },
    1.95 +                                     $headNames{$_}) } @tableHeads));
    1.96 +    foreach my $key (sort keys %$exts) {
    1.97 +        my $ext = $exts->{$key};
    1.98 +        my $row = '';
    1.99 +        foreach my $f (@tableHeads) {
   1.100 +            my $text;
   1.101 +            if ($f eq 'install') {
   1.102 +                my @script = File::Spec->splitdir($ENV{SCRIPT_NAME});
   1.103 +                my $scriptName = pop(@script);
   1.104 +                $scriptName =~ s/.*[\/\\]//;  # Fix for Item3511, on Win XP
   1.105 +
   1.106 +                my $link = $scriptName.
   1.107 +                  '?action=InstallExtension'.
   1.108 +                    ';repository='.$ext->{repository}.
   1.109 +                    ';extension='.$ext->{topic};
   1.110 +                $text = 'Install';
   1.111 +                if ($ext->{installedVersion}) {
   1.112 +                    $text = 'Upgrade';
   1.113 +                    $installed++;
   1.114 +                }
   1.115 +                $text = CGI::a({ href => $link }, $text);
   1.116 +            } else {
   1.117 +                $text = $ext->{$f}||'-';
   1.118 +                if ($f eq 'topic') {
   1.119 +                    my $link = $ext->{data}.$ext->{topic};
   1.120 +                    $text = CGI::a({ href => $link }, $text);
   1.121 +                }
   1.122 +            }
   1.123 +            $row .= CGI::td({valign=>'top'}, $text);
   1.124 +        }
   1.125 +        if ($ext->{installedVersion}) {
   1.126 +            $table .= CGI::Tr({class=>'patternAccessKeyInfo'}, $row);
   1.127 +        } else {
   1.128 +            $table .= CGI::Tr($row);
   1.129 +        }
   1.130 +        $rows++;
   1.131 +    }
   1.132 +    $table .= CGI::Tr({class=>'patternAccessKeyInfo'},CGI::td(
   1.133 +        {colspan => 7},
   1.134 +        $installed . ' extension'.
   1.135 +          ($installed==1?'':'s').' out of '.$rows.' already installed'));
   1.136 +    my $page = <<INTRO;
   1.137 +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
   1.138 +write files everywhere in your TWiki installation. Otherwise you may see
   1.139 +'No permission to write' errors during extension installation.
   1.140 +INTRO
   1.141 +    $page .= CGI::table({class=>'twikiForm'},$table);
   1.142 +    return $page;
   1.143 +}
   1.144 +
   1.145 +sub _getInstalledVersion {
   1.146 +    my ($this, $module) = @_;
   1.147 +    my $lib;
   1.148 +
   1.149 +    return undef unless $module;
   1.150 +
   1.151 +    if ($module =~ /Plugin$/) {
   1.152 +        $lib = 'Plugins';
   1.153 +    } else {
   1.154 +        $lib = 'Contrib';
   1.155 +    }
   1.156 +
   1.157 +    my $path = 'TWiki::'.$lib.'::'.$module;
   1.158 +    my $version;
   1.159 +    my $check = 'use '.$path.'; $version = $'.$path.'::VERSION;';
   1.160 +    eval $check;
   1.161 +    #print STDERR $@ if $@ && DEBUG;
   1.162 +    if ($version) {
   1.163 +        $version =~ s/^\s*\$Rev:\s*(.*?)\s*\$$/$1/;
   1.164 +    }
   1.165 +    return $version;
   1.166 +}
   1.167 +
   1.168 +1;