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