1# See bottom of file for license and copyright information
2package Foswiki;
3
4# Detailed core and plugin dependency report - see
5# System.VarPERLDEPENDENCYREPORT and System.PerlDependencyReport
6
7use strict;
8use warnings;
9
10use Foswiki::Configure::Dependency ();
11use Foswiki::Configure::FileUtil   ();
12use Foswiki::Configure::Auth       ();
13
14sub PERLDEPENDENCYREPORT {
15    my ( $this, $params ) = @_;
16    my $session = $Foswiki::Plugins::SESSION;
17
18    Foswiki::Configure::Auth::checkAccess($session);
19
20    my $inc = 'missing';
21
22    $inc = 'all'
23      if ( defined $params->{include} && $params->{include} eq 'all' );
24
25    if ( defined $params->{_DEFAULT}
26        && $params->{_DEFAULT} eq 'extensions' )
27    {
28        return _analyzeExtensions($inc);
29    }
30    else {
31        return _analyzeFoswiki($inc);
32    }
33
34}
35
36sub cliDependencyReport {
37    my $inc = shift || 'missing';
38
39    my $msg = '';
40    $msg = '\t\t**POSSIBLE MISSING DEPENDENCY**' if ( $inc eq 'all' );
41
42    my $content;
43
44    $content = _analyzeFoswiki($inc);
45    $content =~ s/^\|/\n/g;
46    $content =~ s/\|/\t/g;
47    $content =~ s#<br ?/>#\n\t\t#g;
48    $content =~ s/CPAN://g;
49    $content =~
50s#\s*<span class="foswikiAlert">%X% Possible missing dependency!</span>#$msg#g;
51
52    $content .= "\n\n";
53
54    $content .= _analyzeExtensions($inc);
55    $content =~ s/^\|/\n/g;
56    $content =~ s/\|/\t/g;
57    $content =~ s#<br ?/>#\n\t\t#g;
58    $content =~ s/CPAN://g;
59    $content =~
60s#\s*<span class="foswikiAlert">%X% Possible missing dependency!</span>#$msg#g;
61
62    $content =~ s/<.*?>//g;
63    $content =~ s/[\[\]]//g;
64
65    return $content;
66
67}
68
69sub _analyzeFoswiki {
70    my $include = shift;
71
72    my $content;
73
74    $content = "   * *Perl version:* $]\n";
75
76    # Check that each of the required Perl modules can be found
77    # and read, and  print its version number.  Keep this section last
78    # so it does not hide shorter and more frequently accessed information.
79
80    # File DEPENDENCIES is in the lib dir (Item3478)
81    my $from = Foswiki::Configure::FileUtil::findFileOnPath('Foswiki.spec');
82    my @dir  = File::Spec->splitdir($from);
83    pop(@dir);    # Cutting off trailing Foswiki.spec gives us lib dir
84    $from =
85      File::Spec->catfile( @dir, 'Foswiki', 'Contrib', 'core', 'DEPENDENCIES' );
86
87    my %seen;
88    my $perlModules = _loadDEPENDENCIES( $from, 'core', \%seen );
89    $content .= _showDEPENDENCIES( 'core', $perlModules, 0, $include );
90
91    return $content;
92}
93
94sub _analyzeExtensions {
95    my $include = shift;
96
97    my $content;
98
99    # File DEPENDENCIES is in the lib dir (Item3478)
100
101    my $from = Foswiki::Configure::FileUtil::findFileOnPath('Foswiki.spec');
102    my @dir  = File::Spec->splitdir($from);
103    pop(@dir);    # Cutting off trailing Foswiki.spec gives us lib dir
104    $from =
105      File::Spec->catfile( @dir, 'Foswiki', 'Contrib', 'core', 'DEPENDENCIES' );
106
107    my %seen;
108    my @mods;
109    my $perlModules = \@mods;
110
111    foreach my $info ( values %seen ) {
112        if ( $info->{usage} ) {
113            $info->{usage} =~ s,^\s?<br />,<br /><strong>Foswiki: </strong>,;
114        }
115    }
116    my %extns = (
117        $from => 1,
118        File::Spec->catfile( @dir, 'Foswiki', 'Plugins', 'EmptyPlugin' ) => 1,
119        File::Spec->catfile( @dir, 'TWiki',   'Plugins', 'EmptyPlugin' ) => 1,
120    );
121    foreach my $dir (@INC) {
122        _findDependencies( $dir, '/Foswiki/Plugins', \%extns,
123            $perlModules, \%seen );
124        _findDependencies( $dir, '/Foswiki/Contrib', \%extns,
125            $perlModules, \%seen );
126        _findDependencies( $dir, '/TWiki/Plugins', \%extns,
127            $perlModules, \%seen );
128        _findDependencies( $dir, '/TWiki/Contrib', \%extns,
129            $perlModules, \%seen );
130    }
131
132    $content .= _showDEPENDENCIES( 'Extensions', $perlModules, 1, $include );
133
134    return $content;
135}
136
137sub _findDependencies {
138    my ( $dir, $path, $extns, $perlModules, $seen ) = @_;
139
140    my $dh;
141    my $dpath = File::Spec->catdir( $dir, $path );
142
143    return unless ( opendir( $dh, $dpath ) );
144
145    foreach my $extn ( grep !/^\./, readdir $dh ) {
146        $extn =~ m/^(.*)$/;
147        $extn = $1;
148        my $dfile = File::Spec->catfile( $dpath, $extn, 'DEPENDENCIES' );
149        next if ( $extns->{$dfile} || !-e $dfile );
150        push @$perlModules, @{ _loadDEPENDENCIES( $dfile, $extn, $seen ) };
151        $extns->{$dfile} = 1;
152    }
153    closedir($dh);
154}
155
156sub _showDEPENDENCIES {
157    my $who         = shift;
158    my $perlModules = shift;
159    my $users       = shift;
160    my $inc         = shift;
161
162 # I suppose this needs a word of explanation:
163 # The primary sort is by module name (multi-level split by ::)
164 # If $users is false, we are processing the core, which the UI calls 'Foswiki'.
165 # No user information is necessary, as only core data is present.
166 # Otherwise, we have both the core and extensions dependencies.  We
167 # skip modules used only by the core, but have merged core and all extensions.
168 # So a module used by extensions and the core is also displayed with the
169 # extensions, as either may have the highest version constraint.  The highest
170 # version constraint is underlined (unless there's only one user)
171
172    my $set;
173    my @list = map {
174        my $mvu = $_->[0]{minVersionUser};
175        $mvu = 'Foswiki' if ( $mvu eq 'core' );
176        my $mu = @{ $_->[0]{users} } > 1;
177        $_->[0]{usage} .= ' <br><b>Used by:</b> '
178          . join( ', ',
179            map { $_ eq $mvu && $mu ? "<u>[[$_]]</u>" : "[[$_]]" }
180              sort map { $_ eq 'core' ? '%WIKITOOLNAME%' : $_ }
181              @{ $_->[0]{users} } )
182          if ($users);
183        $_->[0]
184      } sort {
185        my @a = @{ $a->[1] };
186        my @b = @{ $b->[1] };
187        while ( @a && @b ) {
188            my $na = shift @a;
189            my $nb = shift @b;
190            my $c  = $na cmp $nb;
191            return $c if ($c);
192        }
193        return @a <=> @b;
194      } map {
195        ( $users && @{ $_->{users} } == 1 && $_->{users}[0] eq 'core' )
196          ? ()
197          : [ $_, [ split( /::/, $_->{name} ) ] ]
198      } @$perlModules;
199
200    Foswiki::Configure::Dependency::checkPerlModules(@list);
201
202    foreach (@list) {
203
204        my $linkname =
205          ( $_->{name} =~ m/^Foswiki::/ )
206          ? "$_->{name}"
207          : "CPAN:$_->{name}";
208        if ( $linkname =~ m/^Foswiki::(?:[^:]+)::(.*)$/ ) {
209            $linkname = "[[http://foswiki.org/Extensions/$1][$1]]";
210        }
211
212     #SMELL: Something is inserting newlines, breaking the table. This fixes it.
213        $_->{check_result} =~
214          s/(?>\x0D\x0A?|[\x0A-\x0C\x85\x{2028}\x{2029}])//sg;
215        my $ok = '<br/>';
216        $ok .=
217          ( $_->{ok} )
218          ? "Location: $_->{location}"
219          : '<span class="foswikiAlert">%X% Possible missing dependency!</span>';
220        $set .= "| $linkname | $_->{check_result}$ok |\n"
221          unless ( $inc ne 'all' && $_->{ok} );
222    }
223
224    if ( $who eq 'core' ) {
225        return "Perl modules used by Foswiki:\n" . $set;
226    }
227    else {
228        return "Extensions and Perl modules used by installed Extensions:\n"
229          . $set;
230    }
231}
232
233# Extract a list of the perl modules that are required by a DEPENDENCIES file.
234# We also keep track of who uses each module, and the maximum version
235# constraint.  Multiple user notes are labeled and merged.
236
237sub _loadDEPENDENCIES {
238    my $from = shift;
239    my $who  = shift;
240    my $seen = shift;
241    my $trig = 1;
242
243    my $dwho = $who;
244    $dwho = 'Foswiki' if ( $who eq 'core' );
245    $dwho = "<strong>$dwho</strong>";
246
247    my $d;
248    open( $d, '<', $from ) || return "Failed to load $from: $!";
249    my @perlModules;
250
251    foreach my $line (<$d>) {
252        next unless $line;
253
254        if ( $line =~ /^ONLYIF\s+(.+)$/ ) {
255            $trig = $1;
256            next;
257        }
258
259        my $required = eval($trig);
260        if ($@) {
261            print STDERR
262"**ERROR** -- ONLYIF \"$trig\" condition failed to compile: contact developer -- $@\n";
263            next;
264        }
265        $trig = 1;
266        next unless $required;    # Skip the module - trigger was false
267
268        my @row = split( /,\s*/, $line, 4 );
269        next
270          unless ( scalar(@row) == 4
271            && ( $row[2] eq 'cpan' || $row[2] eq 'perl' ) );
272        my ( $cond, $ver ) = $row[1] =~ m/^([=<>!]*)(.*)$/;
273        $cond ||= '>=';
274        $row[0] =~ m/([\w:]+)/;    # check and untaint
275        my $modname = $1;
276
277        my ( $dispo, $usage ) = $row[3] =~ m/^\s*(\w+)(?:[.,]\s*)?(.*)$/;
278
279        # There's weird stuff in DEPENDENCIES...
280        # required => ERROR; recommended => WARN; default is NOTE
281        #
282        # If not one of the expected keywords, make it a WARN so the
283        # file can be corrected without instilling too much fear.
284        # Also, it's probably part of the usage sentence, so re-combine it.
285
286        if ( $dispo !~ m/^(required|optional|recommended)$/i ) {
287            $dispo = 'recommended';
288            $usage = $row[3];
289        }
290        $usage ||= '';
291
292        # Activate links found in DEPENDENCIES notes.
293
294        my $dlink =
295          '<a class="configureDependenciesLink" target="_blank" href=';
296        $usage =~
297s,\[\[(https?://[^\]]+)\]\[([^\]]+)\](?:\[[^\]]*\])?\],$dlink"$1">$2</a>,gms;
298        $usage =~ s,\[\[(https?://[^\]]+)\]\],$dlink"$1">$1</a>,gms;
299        $usage =~ s,(^|[^"])(https?://.*?)(\s|$),$1$dlink"$2">$2</a>$3,gms;
300
301        if ( ( my $info = $seen->{$modname} ) ) {
302            push @{ $info->{users} }, $who;
303            my $prevVer = $info->{minimumVersion};
304            $prevVer =~ s/(\d+(\.\d*)?).*/$1/;
305            $ver     =~ s/(\d+(\.\d*)?).*/$1/;
306            $ver     ||= 0;
307            $prevVer ||= 0;
308            if ( $ver > $prevVer ) {
309                $info->{minimumVersion} = $ver;
310                $info->{minVersionUser} = $who;
311            }
312            $info->{usage} .= " <br />$dwho: $usage" if ($usage);
313            next;
314        }
315        if ($usage) {
316            if ( $who eq 'core' ) {
317                $usage = " <br />" . ucfirst( lc($dispo) ) . " $usage";
318            }
319            else {
320                $usage = "<br />$dwho: " . ucfirst( lc($dispo) ) . " $usage";
321            }
322        }
323        push(
324            @perlModules,
325            {
326                name           => $modname,
327                usage          => $usage,
328                minimumVersion => $ver || 0,
329                minVersionUser => $who,
330                condition      => $cond,
331                disposition    => lc($dispo),
332                users          => [$who],
333            }
334        );
335        $seen->{$modname} = $perlModules[-1];
336    }
337    close($d);
338    return \@perlModules;
339}
340
3411;
342__END__
343Foswiki - The Free and Open Source Wiki, http://foswiki.org/
344
345Copyright (C) 2014 Foswiki Contributors. Foswiki Contributors
346are listed in the AUTHORS file in the root of this distribution.
347NOTE: Please extend that file, not this notice.
348
349This program is free software; you can redistribute it and/or
350modify it under the terms of the GNU General Public License
351as published by the Free Software Foundation; either version 2
352of the License, or (at your option) any later version. For
353more details read LICENSE in the root of this distribution.
354
355This program is distributed in the hope that it will be useful,
356but WITHOUT ANY WARRANTY; without even the implied warranty of
357MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
358
359As per the GPL, removal of this notice is prohibited.
360