lib/TWiki/Configure/Type.pm
author Colas Nahaboo <colas@nahaboo.net>
Sat, 26 Jan 2008 15:50:53 +0100
changeset 0 414e01d06fd5
permissions -rw-r--r--
RELEASE 4.2.0 freetown
colas@0
     1
#
colas@0
     2
# TWiki Enterprise Collaboration Platform, http://TWiki.org/
colas@0
     3
#
colas@0
     4
# Copyright (C) 2000-2006 TWiki Contributors.
colas@0
     5
#
colas@0
     6
# This program is free software; you can redistribute it and/or
colas@0
     7
# modify it under the terms of the GNU General Public License
colas@0
     8
# as published by the Free Software Foundation; either version 2
colas@0
     9
# of the License, or (at your option) any later version. For
colas@0
    10
# more details read LICENSE in the root of this distribution.
colas@0
    11
#
colas@0
    12
# This program is distributed in the hope that it will be useful,
colas@0
    13
# but WITHOUT ANY WARRANTY; without even the implied warranty of
colas@0
    14
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
colas@0
    15
#
colas@0
    16
# As per the GPL, removal of this notice is prohibited.
colas@0
    17
#
colas@0
    18
# Base class of all types. Types are involved *only* in the presentation
colas@0
    19
# of values in the configure interface. They do not play any part in
colas@0
    20
# loading, saving or checking configuration values.
colas@0
    21
#
colas@0
    22
package TWiki::Configure::Type;
colas@0
    23
colas@0
    24
use strict;
colas@0
    25
colas@0
    26
use CGI qw( :any );
colas@0
    27
colas@0
    28
use vars qw( %knownTypes );
colas@0
    29
colas@0
    30
sub new {
colas@0
    31
    my ($class, $id) = @_;
colas@0
    32
colas@0
    33
    return bless({ name => $id }, $class);
colas@0
    34
}
colas@0
    35
colas@0
    36
# Static factory
colas@0
    37
sub load {
colas@0
    38
    my $id = shift;
colas@0
    39
    my $typer = $knownTypes{$id};
colas@0
    40
    unless ($typer) {
colas@0
    41
        my $typeClass = 'TWiki::Configure::Types::'.$id;
colas@0
    42
        $typer = eval 'use '.$typeClass.'; new '.$typeClass.'("'.$id.'")';
colas@0
    43
        # unknown type - give it default string behaviours
colas@0
    44
        $typer = new TWiki::Configure::Type($id) unless $typer;
colas@0
    45
        $knownTypes{$id} = $typer;
colas@0
    46
    }
colas@0
    47
    return $typer;
colas@0
    48
}
colas@0
    49
colas@0
    50
# Generates a suitable HTML prompt for the type. Default behaviour
colas@0
    51
# is a string 55% of the width of the display area.
colas@0
    52
sub prompt {
colas@0
    53
    my( $this, $id, $opts, $value ) = @_;
colas@0
    54
colas@0
    55
    my $size = '55%';
colas@0
    56
    if( $opts =~ /\b(\d+)\b/ ) {
colas@0
    57
        $size = $1;
colas@0
    58
        # These numbers are somewhat arbitrary..
colas@0
    59
        if( $size > 25 ) {
colas@0
    60
            $size = '55%';
colas@0
    61
        }
colas@0
    62
    }
colas@0
    63
    return CGI::textfield( -name => $id, -size=>$size, -default=>$value );
colas@0
    64
}
colas@0
    65
colas@0
    66
# Test to determine if two values of this type are equal.
colas@0
    67
sub equals {
colas@0
    68
    my ($this, $val, $def) = @_;
colas@0
    69
colas@0
    70
    if (!defined $val) {
colas@0
    71
        return 0 if defined $def;
colas@0
    72
        return 1;
colas@0
    73
    } elsif (!defined $def) {
colas@0
    74
        return 0;
colas@0
    75
    }
colas@0
    76
    return $val eq $def;
colas@0
    77
}
colas@0
    78
colas@0
    79
# Used to process input values from CGI. Values taken from the query
colas@0
    80
# are run through this method before being saved in the value store.
colas@0
    81
# It should *not* be used to do validation - use a Checker to do that, or
colas@0
    82
# JavaScript invoked from the prompt.
colas@0
    83
sub string2value {
colas@0
    84
    my ($this, $val) = @_;
colas@0
    85
    return $val;
colas@0
    86
}
colas@0
    87
colas@0
    88
1;