← Back to branch summary

~kosova/+junk/tuxfamily-twiki

« back to all changes in this revision

Viewing changes to foswiki/lib/Foswiki/Configure/UIs/EXTENSIONS.pm

  • Committer: James Michael DuPont
  • Date: 2009-07-18 19:58:49 UTC
  • Revision ID: jamesmikedupont@gmail.com-20090718195849-vgbmaht2ys791uo2
added foswiki

Show diffs side-by-side

added added

removed removed

Lines of Context:
foswiki/lib/Foswiki/Configure/UIs/EXTENSIONS.pm
 
1
# See bottom of file for license and copyright information
 
2
package Foswiki::Configure::UIs::EXTENSIONS;
 
3
use base 'Foswiki::Configure::UI';
 
4
 
 
5
use strict;
 
6
use Foswiki::Configure::Type;
 
7
 
 
8
# THE FOLLOWING MUST BE MAINTAINED CONSISTENT WITH Extensions.FastReport
 
9
# They describe the format of an extension topic.
 
10
my @tableHeads =
 
11
  qw( topic classification description version installedVersion compatibility install );
 
12
my $VERSION_LINE = qr/\n\|[\s\w-]*\s[Vv]ersion:\s*\|([^|]+)\|/;
 
13
 
 
14
my %headNames = (
 
15
    topic            => 'Extension',
 
16
    classification   => 'Classification',
 
17
    description      => 'Description',
 
18
    version          => 'Most Recent Version',
 
19
    installedVersion => 'Installed Version',
 
20
    compatibility    => 'Compatible with',
 
21
    install          => 'Action',
 
22
);
 
23
 
 
24
my @MNAMES  = qw(jan feb mar apr may jun jul aug sep oct nov dec);
 
25
my $mnamess = join( '|', @MNAMES );
 
26
my $MNAME   = qr/$mnamess/i;
 
27
my %N2M;
 
28
foreach ( 0 .. $#MNAMES ) { $N2M{ $MNAMES[$_] } = $_; }
 
29
 
 
30
# Convert a date in the formats dd mm yyyy or dd Mmm yyyy to a unique integer
 
31
sub d2n {
 
32
    my ( $d, $m, $y ) = @_;
 
33
    return ( $y * 12 + $m ) * 31 + $d;
 
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
            next unless defined $place->{data};
 
48
            $place->{data} =~ s#/*$#/#;
 
49
            print CGI::div("Consulting $place->{name}...");
 
50
            my $url      = $place->{data} . 'FastReport?skin=text';
 
51
            my $response = $this->getUrl($url);
 
52
            if ( !$response->is_error() ) {
 
53
                my $page = $response->content();
 
54
                if (defined $page) {
 
55
                    $page =~ s/{(.*?)}/$this->_parseRow($1, $place)/ges;
 
56
                } else {
 
57
                    push(
 
58
                        @{ $this->{errors} },
 
59
                        "Error accessing $place->{name}: no content"
 
60
                       );
 
61
                }
 
62
            }
 
63
            else {
 
64
                push(
 
65
                    @{ $this->{errors} },
 
66
                    "Error accessing $place->{name}: " . $response->message()
 
67
                );
 
68
 
 
69
                #see if its because LWP isn't installed..
 
70
                eval "require LWP";
 
71
                if ($@) {
 
72
                    push(
 
73
                        @{ $this->{errors} },
 
74
"This may be because the LWP CPAN module isn't installed."
 
75
                    );
 
76
                }
 
77
            }
 
78
        }
 
79
    }
 
80
    return $this->{list};
 
81
}
 
82
 
 
83
sub _parseRow {
 
84
    my ( $this, $row, $place ) = @_;
 
85
    my %data;
 
86
    return '' unless defined $row;
 
87
    return '' unless $row =~ s/^ *(\w+): *(.*?) *$/$data{$1} = $2;''/gem;
 
88
    ( $data{installedVersion}, $data{namespace} ) =
 
89
      $this->_getInstalledVersion( $data{topic} );
 
90
    $data{repository} = $place->{name};
 
91
    $data{data}       = $place->{data};
 
92
    $data{pub}        = $place->{pub};
 
93
    die "$row: " . Data::Dumper->Dump( [ \%data ] ) unless $data{topic};
 
94
    $this->{list}->{ $data{topic} } = \%data;
 
95
    return '';
 
96
}
 
97
 
 
98
sub ui {
 
99
    my $this  = shift;
 
100
    my $table = '';
 
101
 
 
102
    my $rows      = 0;
 
103
    my $installed = 0;
 
104
    my $exts      = $this->_getListOfExtensions();
 
105
    foreach my $error ( @{ $this->{errors} } ) {
 
106
        $table .= CGI::Tr( { class => 'foswikiAlert' },
 
107
            CGI::td( { colspan => "7" }, $error ) );
 
108
    }
 
109
 
 
110
    $table .= CGI::Tr(
 
111
        join( '',
 
112
            map { CGI::th( { valign => 'bottom' }, $headNames{$_} ) }
 
113
              @tableHeads )
 
114
    );
 
115
    foreach my $key ( sort keys %$exts ) {
 
116
        my $ext = $exts->{$key};
 
117
        my $row = '';
 
118
 
 
119
        foreach my $f (@tableHeads) {
 
120
            my $text;
 
121
            if ( $f eq 'install' ) {
 
122
                my @script     = File::Spec->splitdir( $ENV{SCRIPT_NAME} );
 
123
                my $scriptName = pop(@script);
 
124
                $scriptName =~ s/.*[\/\\]//;    # Fix for Item3511, on Win XP
 
125
 
 
126
                my $link =
 
127
                    $scriptName
 
128
                  . '?action=InstallExtension'
 
129
                  . ';repository='
 
130
                  . $ext->{repository}
 
131
                  . ';extension='
 
132
                  . $ext->{topic};
 
133
                $text = 'Install';
 
134
                if ( $ext->{installedVersion} ) {
 
135
                    if ( $ext->{installedVersion} eq 'HEAD' ) {
 
136
 
 
137
                        # Unexpanded, assume pseudo-installed
 
138
                        $link = '';
 
139
                        $text = 'pseudo-installed';
 
140
                        $ext->{cssclass} = 'pseudoinstalled';
 
141
                    }
 
142
                    elsif ( $ext->{installedVersion} =~
 
143
                        /^\s*v?(\d+)\.(\d+)(?:\.(\d+))/ )
 
144
                    {
 
145
 
 
146
                        # X.Y, X.Y.Z, vX.Y, vX.Y.Z
 
147
                        # Combine into one number; allows up to 1000
 
148
                        # revs in each field
 
149
                        my $irev = ( $1 * 1000 + $2 ) * 1000 + $3;
 
150
                        $text = 'Re-install';
 
151
                        $ext->{cssclass} = 'reinstall';
 
152
                        if ( $ext->{version} =~
 
153
                               /^\s*v?(\d+)\.(\d+)(?:\.(\d+))?/ ) {
 
154
 
 
155
                            # Compatible version number
 
156
                            my $arev = ( $1 * 1000 + $2 ) * 1000 + ($3 || 0);
 
157
                            if ( $arev > $irev ) {
 
158
                                $text = 'Upgrade';
 
159
                                $ext->{cssclass} = 'upgrade';
 
160
                            }
 
161
                        }
 
162
                    }
 
163
                    elsif ( $ext->{installedVersion} =~ /^\s*(\d+)\s/ ) {
 
164
 
 
165
                        # SVN rev number
 
166
                        my $gotrev = $1;
 
167
                        $text = 'Re-install';
 
168
                        $ext->{cssclass} = 'reinstall';
 
169
                        if ( defined $ext->{version} &&
 
170
                               $ext->{version} =~ /^\s*(\d+)\s/ ) {
 
171
                            my $availrev = $1;
 
172
                            if ( $availrev > $gotrev ) {
 
173
                                $text = 'Upgrade';
 
174
                                $ext->{cssclass} = 'upgrade';
 
175
                            }
 
176
                        }
 
177
                    }
 
178
                    elsif ( $ext->{installedVersion} =~
 
179
                        /(\d{4})-(\d\d)-(\d\d)/ ) {
 
180
                        # ISO date
 
181
                        my $idate = d2n( $3, $2, $1 );
 
182
                        $text = 'Re-install';
 
183
                        $ext->{cssclass} = 'reinstall';
 
184
                        if ( defined $ext->{version} &&
 
185
                               $ext->{version} =~  /(\d{4})-(\d\d)-(\d\d)/ ) {
 
186
                            my $adate = d2n( $3, $2, $1 );
 
187
                            if ( $adate > $idate ) {
 
188
                                $text = 'Upgrade';
 
189
                                $ext->{cssclass} = 'upgrade';
 
190
                            }
 
191
                        }
 
192
                    }
 
193
                    elsif ( $ext->{installedVersion} =~
 
194
                        /(\d{1,2}) ($MNAME) (\d{4})/ ) {
 
195
 
 
196
                        # dd Mmm yyyy date
 
197
                        my $idate = d2n( $1, $N2M{lc($2)}, $3 );
 
198
                        $text = 'Re-install';
 
199
                        $ext->{cssclass} = 'reinstall';
 
200
                        if ( defined $ext->{version} &&
 
201
                               $ext->{version} =~
 
202
                                 /(\d{1,2}) ($MNAME) (\d{4})/ ) {
 
203
                            my $adate = d2n( $1, $N2M{lc($2)}, $3 );
 
204
                            if ( $adate > $idate ) {
 
205
                                $text = 'Upgrade';
 
206
                                $ext->{cssclass} = 'upgrade';
 
207
                            }
 
208
                        }
 
209
                    }
 
210
                    $installed++;
 
211
                }
 
212
                if ($link) {
 
213
                    $text = CGI::a( { href => $link }, $text );
 
214
                }
 
215
            }
 
216
            else {
 
217
                $text = $ext->{$f} || '-';
 
218
                $text =~ s/!(\w+)/$1/go; # remove ! escape syntax from text
 
219
                if ( $f eq 'topic' ) {
 
220
                    my $link = $ext->{data} . $ext->{topic};
 
221
                    $text = CGI::a( { href => $link }, $text );
 
222
                }
 
223
=pod
 
224
                elsif ($f eq 'image'
 
225
                    && $ext->{namespace}
 
226
                    && $ext->{namespace} ne 'Foswiki' )
 
227
                {
 
228
                    $text = "$text ($ext->{namespace})";
 
229
                }
 
230
=cut
 
231
            }
 
232
            my %opts = ( valign => 'top' );
 
233
            if ( $ext->{namespace} && $ext->{namespace} ne 'Foswiki' ) {
 
234
                $opts{class} = 'alienExtension';
 
235
            }
 
236
            $row .= CGI::td( \%opts, $text );
 
237
        }
 
238
        my @classes = ( $rows % 2 ? 'odd' : 'even' );
 
239
        if ( $ext->{installedVersion} ) {
 
240
            push @classes, 'installed';
 
241
            push( @classes, $ext->{cssclass} ) if ($ext->{cssclass}); 
 
242
            push @classes, 'twikiExtension'
 
243
              if $ext->{installedVersion} =~ /\(TWiki\)/;
 
244
        }
 
245
        $table .= CGI::Tr( { class => join( ' ', @classes ) }, $row );
 
246
        $rows++;
 
247
    }
 
248
    $table .= CGI::Tr(
 
249
        { class => 'patternAccessKeyInfo' },
 
250
        CGI::td(
 
251
            { colspan => "7" },
 
252
            $installed
 
253
              . ' extension'
 
254
              . ( $installed == 1 ? '' : 's' )
 
255
              . ' out of '
 
256
              . $rows
 
257
              . ' already installed'
 
258
        )
 
259
    );
 
260
    my $page = <<INTRO;
 
261
<div class="foswikiHelp">Note that the webserver user has to be able to
 
262
write files everywhere in your Foswiki installation. Otherwise you may see
 
263
'No permission to write' errors during extension installation.</div>
 
264
INTRO
 
265
    $page .= CGI::table( { class => 'foswikiTable extensionsTable' }, $table );
 
266
    return $page;
 
267
}
 
268
 
 
269
sub _getInstalledVersion {
 
270
    my ( $this, $module ) = @_;
 
271
    my $lib;
 
272
 
 
273
    return undef unless $module;
 
274
 
 
275
    if ( $module =~ /Plugin$/ ) {
 
276
        $lib = 'Plugins';
 
277
    }
 
278
    else {
 
279
        $lib = 'Contrib';
 
280
    }
 
281
 
 
282
    # See if we have a compileable module
 
283
    my $compileable = 0;
 
284
    my $from;
 
285
    foreach $from qw(Foswiki TWiki) {
 
286
        my $path = $from . '::' . $lib . '::' . $module;
 
287
        eval "require $path";
 
288
        unless ($@) {
 
289
            $compileable = 1;    # found the module
 
290
            last;
 
291
        }
 
292
    }
 
293
 
 
294
    # Now scrape the version information from the .txt
 
295
    my $release = '';
 
296
    if ($compileable) {
 
297
        foreach
 
298
          my $web ( split( /[, ]+/, $Foswiki::cfg{Plugins}{WebSearchPath} ) )
 
299
        {
 
300
 
 
301
            # SMELL: can't use Foswiki store to do this lookup; relying on
 
302
            # directories. Not a problem right now, but in the future.....
 
303
            my $path = "$Foswiki::cfg{DataDir}/$web/$module.txt";
 
304
            my $fh;
 
305
            local $/;
 
306
            if ( -e $path && open( $fh, '<', $path ) ) {
 
307
                my $text = <$fh>;
 
308
                if ( defined $ text && $text =~ /$VERSION_LINE/s ) {
 
309
                    $release = $+;
 
310
                    $release = 'HEAD' if $release =~ /%\$VERSION%/;
 
311
                }
 
312
                close($fh);
 
313
            }
 
314
            last;
 
315
        }
 
316
    }
 
317
 
 
318
    return ( $release, $from );
 
319
}
 
320
 
 
321
1;
 
322
__DATA__
 
323
#
 
324
# Foswiki - The Free and Open Source Wiki, http://foswiki.org/
 
325
#
 
326
# Copyright (C) 2008 Foswiki Contributors. All Rights Reserved.
 
327
# Foswiki Contributors are listed in the AUTHORS file in the root
 
328
# of this distribution. NOTE: Please extend that file, not this notice.
 
329
#
 
330
# Additional copyrights apply to some or all of the code in this
 
331
# file as follows:
 
332
#
 
333
# Copyright (C) 2000-2006 TWiki Contributors. All Rights Reserved.
 
334
# TWiki Contributors are listed in the AUTHORS file in the root
 
335
# of this distribution. NOTE: Please extend that file, not this notice.
 
336
#
 
337
# This program is free software; you can redistribute it and/or
 
338
# modify it under the terms of the GNU General Public License
 
339
# as published by the Free Software Foundation; either version 2
 
340
# of the License, or (at your option) any later version. For
 
341
# more details read LICENSE in the root of this distribution.
 
342
#
 
343
# This program is distributed in the hope that it will be useful,
 
344
# but WITHOUT ANY WARRANTY; without even the implied warranty of
 
345
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
346
#
 
347
# As per the GPL, removal of this notice is prohibited.