#

# TWiki Enterprise Collaboration Platform, http://TWiki.org/

#

# Copyright (C) 2000-2006 TWiki Contributors.

#

# This program is free software; you can redistribute it and/or

# modify it under the terms of the GNU General Public License

# as published by the Free Software Foundation; either version 2

# of the License, or (at your option) any later version. For

# more details read LICENSE in the root of this distribution.

#

# This program is distributed in the hope that it will be useful,

# but WITHOUT ANY WARRANTY; without even the implied warranty of

# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

#

# As per the GPL, removal of this notice is prohibited.

package TWiki::Configure::UIs::EXTENSIONS;

use base 'TWiki::Configure::UI';

use strict;

use TWiki::Configure::Type;

my @tableHeads =

  qw(image topic description version installedVersion testedOn install );

my %headNames = (

    image => '',

    topic => 'Extension',

    description => 'Description',

    version => 'Most Recent Version',

    installedVersion => 'Installed Version',

    testedOn => 'Tested On TWiki',

    testedOnOS => 'Tested On OS',

    install => 'Action',

   );

# Download the report page from the repository, and extract a hash of

# available extensions

sub _getListOfExtensions {

    my $this = shift;

    $this->findRepositories();

    if (!$this->{list}) {

        $this->{list} = {};

        $this->{errors} = [];

        foreach my $place ( @{$this->{repositories}} ) {

            $place->{data} =~ s#/*$#/#;

            print CGI::div("Consulting $place->{name}...");

            my $url = $place->{data}.

                  'FastReport?skin=text&contenttype=text/plain';

            my $response = $this->getUrl($url);

            if (!$response->is_error()) {

                my $page = $response->content();

                $page =~ s/{(.*?)}/$this->_parseRow($1, $place)/ges;

            } else {

                push(@{$this->{errors}},

                     "Error accessing $place->{name}: ".$response->message());

            }

        }

    }

    return $this->{list};

}

sub _parseRow {

    my ($this, $row, $place) = @_;

    my %data;

    return '' unless $row =~ s/^ *(\w+): *(.*?) *$/$data{$1} = $2;''/gem;

    $data{installedVersion} = $this->_getInstalledVersion($data{topic});

    $data{repository} = $place->{name};

    $data{data} = $place->{data};

    $data{pub} = $place->{pub};

    die "$row: ".Data::Dumper->Dump([\%data]) unless $data{topic};

    $this->{list}->{$data{topic}} = \%data;

    return '';

}

sub ui {

    my $this = shift;

    my $table = '';

    my $rows = 0;

    my $installed = 0;

    my $exts = $this->_getListOfExtensions();

    foreach my $error (@{$this->{errors}}) {

        $table .= CGI::Tr({class=>'twikiAlert'},CGI::td(

            {colspan => 7},

            $error));

    }

    $table .=

      CGI::Tr(join('', map { CGI::th({valign=>'bottom' },

                                     $headNames{$_}) } @tableHeads));

    foreach my $key (sort keys %$exts) {

        my $ext = $exts->{$key};

        my $row = '';

        foreach my $f (@tableHeads) {

            my $text;

            if ($f eq 'install') {

                my @script = File::Spec->splitdir($ENV{SCRIPT_NAME});

                my $scriptName = pop(@script);

                $scriptName =~ s/.*[\/\\]//;  # Fix for Item3511, on Win XP

                my $link = $scriptName.

                  '?action=InstallExtension'.

                    ';repository='.$ext->{repository}.

                    ';extension='.$ext->{topic};

                $text = 'Install';

                if ($ext->{installedVersion}) {

                    $text = 'Upgrade';

                    $installed++;

                }

                $text = CGI::a({ href => $link }, $text);

            } else {

                $text = $ext->{$f}||'-';

                if ($f eq 'topic') {

                    my $link = $ext->{data}.$ext->{topic};

                    $text = CGI::a({ href => $link }, $text);

                }

            }

            $row .= CGI::td({valign=>'top'}, $text);

        }

        if ($ext->{installedVersion}) {

            $table .= CGI::Tr({class=>'patternAccessKeyInfo'}, $row);

        } else {

            $table .= CGI::Tr($row);

        }

        $rows++;

    }

    $table .= CGI::Tr({class=>'patternAccessKeyInfo'},CGI::td(

        {colspan => 7},

        $installed . ' extension'.

          ($installed==1?'':'s').' out of '.$rows.' already installed'));

    my $page = <<INTRO;

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

write files everywhere in your TWiki installation. Otherwise you may see

'No permission to write' errors during extension installation.

INTRO

    $page .= CGI::table({class=>'twikiForm'},$table);

    return $page;

}

sub _getInstalledVersion {

    my ($this, $module) = @_;

    my $lib;

    return undef unless $module;

    if ($module =~ /Plugin$/) {

        $lib = 'Plugins';

    } else {

        $lib = 'Contrib';

    }

    my $path = 'TWiki::'.$lib.'::'.$module;

    my $version;

    my $check = 'use '.$path.'; $version = $'.$path.'::VERSION;';

    eval $check;

    #print STDERR $@ if $@ && DEBUG;

    if ($version) {

        $version =~ s/^\s*\$Rev:\s*(.*?)\s*\$$/$1/;

    }

    return $version;

}

1;