summaryrefslogtreecommitdiff
path: root/fml/lib/FML/Process/CGI/Param.pm
blob: c167dd2c82cc1da2e94b0fb0220683eb3c9360e7 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
#-*- perl -*-
#
#  Copyright (C) 2001 Ken'ichi Fukamachi
#   All rights reserved. This program is free software; you can
#   redistribute it and/or modify it under the same terms as Perl itself. 
#
# $FML: CGI.pm,v 1.18 2001/11/07 14:25:55 fukachan Exp $
#

package FML::Process::CGI::Param;
use strict;
use vars qw(@ISA @EXPORT @EXPORT_OK $AUTOLOAD);
use Carp;

=head1 NAME

FML::Process::CGI::Param - CGI basic functions

=head1 SYNOPSIS

   use FML::Process::CGI::Param;
   my $obj = new FML::Process::CGI::Param;
   $obj->prepare($args);
      ... snip ...

This new() creates CGI object which wraps C<FML::Process::Param>.

=head1 DESCRIPTION

the base class of CGI programs.
It provides basic functions and flow.

=head1 METHODS

=head2 safe_param(str, filter)

=cut


# Descriptions: 
#    Arguments: $self $args
# Side Effects: 
#      History: fml 4.0's SecureP()
# Return Value: none
sub safe_param
{
    my ($key, $filter) = @_;
    my $value = param($key);

    if (defined $filter && defined $value) {
	if ($value =~ /^$filter$/) {
	    return $value;
	}
	else {
	    return undef;
	}
    }
    else {
	return undef;
    }
}


=head2 safe_param_xxx()

get and filter param('xxx') via AUTOLOAD().

=cut


my %allow_regexp = (
		    'address' => '[-a-z0-9_]@[-A-Z0-9\.]+',
		    'ml_name' => '[-a-z0-9_]+',
		    'method'  => '[a-z]+',
		    'user'    => '[-a-z0-9_]+',
		    );


sub AUTOLOAD
{
    my ($curproc) = @_;

    return if $AUTOLOAD =~ /DESTROY/;

    my $comname = $AUTOLOAD;
    $comname =~ s/.*:://;

    if ($comname =~ /^safe_param_(\S+)/) {
	my $varname = $1;

	# diagnostic
	unless (defined $allow_regexp{ $varname }) {
	    croak("no allow_regexp for $comname");
	}
	return safe_param($varname, $allow_regexp{ $varname });
    }
    else {
	croak("unknown method $comname");
    }
}


=head1 AUTHOR

Ken'ichi Fukamachi

=head1 COPYRIGHT

Copyright (C) 2001 Ken'ichi Fukamachi

All rights reserved. This program is free software; you can
redistribute it and/or modify it under the same terms as Perl itself. 

=head1 HISTORY

FML::Process::CGI::Param appeared in fml5 mailing list driver package.
See C<http://www.fml.org/> for more details.

=cut


1;