~kosova/+junk/tuxfamily-twiki

« back to all changes in this revision

Viewing changes to foswiki/lib/Foswiki/Configure/Types/SELECTCLASS.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:
 
1
# See bottom of file for license and copyright information
 
2
 
 
3
package Foswiki::Configure::Types::SELECTCLASS;
 
4
 
 
5
use strict;
 
6
 
 
7
use Foswiki::Configure::Types::SELECT;
 
8
 
 
9
use base 'Foswiki::Configure::Types::SELECT';
 
10
 
 
11
# generate an input field for SELECTCLASS types
 
12
# Takes a comma-separated list of options
 
13
# Each option must be either 'none' or a wildcard expression that matches classes e.g.
 
14
# Foswiki::Plugins::*Plugin
 
15
# * is the only wildcard supported
 
16
# Finds all classes that match in @INC
 
17
sub prompt {
 
18
    my ( $this, $id, $opts, $value ) = @_;
 
19
    my @ropts;
 
20
    $opts =~ s/\s.*$//;    # remove e.g. EXPERT
 
21
    foreach my $opt ( split( /,/, $opts ) ) {
 
22
        if ( $opt eq 'none' ) {
 
23
            push( @ropts, 'none' );
 
24
        }
 
25
        else {
 
26
            push( @ropts, @{ $this->findClasses($opt) } );
 
27
        }
 
28
    }
 
29
    return $this->SUPER::prompt( $id, join( ',', @ropts ), $value );
 
30
}
 
31
 
 
32
# $pattern is a wildcard expression that matches classes e.g.
 
33
# Foswiki::Plugins::*Plugin
 
34
# * is the only wildcard supported
 
35
# Finds all classes that match in @INC
 
36
sub findClasses {
 
37
    my ( $this, $pattern ) = @_;
 
38
 
 
39
    $pattern =~ s/\*/.*/g;
 
40
    my @path = split( /::/, $pattern );
 
41
 
 
42
    my $places = \@INC;
 
43
 
 
44
    while ( scalar(@path) > 1 && @$places ) {
 
45
        my $pathel = shift(@path);
 
46
        eval "\$pathel = qr/^($pathel)\$/";    # () to untaint
 
47
        my @newplaces;
 
48
 
 
49
        foreach my $place (@$places) {
 
50
            if ( opendir( DIR, $place ) ) {
 
51
                #next if ($place =~ /^\..*/);
 
52
                foreach my $subplace ( readdir DIR ) {
 
53
                    next unless $subplace =~ $pathel;
 
54
                    #next if ($subplace =~ /^\..*/);
 
55
                    push( @newplaces, $place . '/' . $1 );
 
56
                }
 
57
            }
 
58
        }
 
59
        $places = \@newplaces;
 
60
    }
 
61
 
 
62
    my @list;
 
63
    my $leaf = shift(@path);
 
64
    eval "\$leaf = qr/$leaf\.pm\$/";
 
65
    my %known;
 
66
    foreach my $place (@$places) {
 
67
        if ( opendir( DIR, $place ) ) {
 
68
            foreach my $file ( readdir DIR ) {
 
69
                next unless $file =~ $leaf;
 
70
                next if ($file =~ /^\..*/);
 
71
                $file =~ /^(.*)\.pm$/;
 
72
                my $module = "$place/$1";
 
73
                $module =~ s./.::.g;
 
74
                $module =~ /($pattern)$/;
 
75
                push( @list, $1 ) unless $known{$1};
 
76
                $known{$1} = 1;
 
77
            }
 
78
        }
 
79
    }
 
80
 
 
81
    return \@list;
 
82
}
 
83
 
 
84
1;
 
85
__DATA__
 
86
#
 
87
# Foswiki - The Free and Open Source Wiki, http://foswiki.org/
 
88
#
 
89
# Copyright (C) 2008 Foswiki Contributors. All Rights Reserved.
 
90
# Foswiki Contributors are listed in the AUTHORS file in the root
 
91
# of this distribution. NOTE: Please extend that file, not this notice.
 
92
#
 
93
# Additional copyrights apply to some or all of the code in this
 
94
# file as follows:
 
95
#
 
96
# Copyright (C) 2000-2006 TWiki Contributors. All Rights Reserved.
 
97
# TWiki Contributors are listed in the AUTHORS file in the root
 
98
# of this distribution. NOTE: Please extend that file, not this notice.
 
99
#
 
100
# This program is free software; you can redistribute it and/or
 
101
# modify it under the terms of the GNU General Public License
 
102
# as published by the Free Software Foundation; either version 2
 
103
# of the License, or (at your option) any later version. For
 
104
# more details read LICENSE in the root of this distribution.
 
105
#
 
106
# This program is distributed in the hope that it will be useful,
 
107
# but WITHOUT ANY WARRANTY; without even the implied warranty of
 
108
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
109
#
 
110
# As per the GPL, removal of this notice is prohibited.