diff options
| author | fukachan <fukachan> | 2002-04-26 09:20:17 +0000 |
|---|---|---|
| committer | fukachan <fukachan> | 2002-04-26 09:20:17 +0000 |
| commit | 3f212e22b7ecddfd3da34ddccc38d2b3e5d189ab (patch) | |
| tree | 6a0a768fdc63abbc44b057413dce06443b8ad5c0 /fml | |
| parent | 6d75e2085d82ef3b063b914e442462d69155186c (diff) | |
| download | fml8-3f212e22b7ecddfd3da34ddccc38d2b3e5d189ab.tar.gz fml8-3f212e22b7ecddfd3da34ddccc38d2b3e5d189ab.tar.bz2 fml8-3f212e22b7ecddfd3da34ddccc38d2b3e5d189ab.zip | |
prototype to use FML::Command::DataCheck to share codes
Diffstat (limited to 'fml')
| -rw-r--r-- | fml/lib/FML/Command/DataCheck.pm | 154 | ||||
| -rw-r--r-- | fml/lib/FML/Process/Command.pm | 55 |
2 files changed, 169 insertions, 40 deletions
diff --git a/fml/lib/FML/Command/DataCheck.pm b/fml/lib/FML/Command/DataCheck.pm new file mode 100644 index 00000000..00d1d2e6 --- /dev/null +++ b/fml/lib/FML/Command/DataCheck.pm @@ -0,0 +1,154 @@ +#-*- perl -*- +# +# Copyright (C) 2002 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$ +# + +package FML::Command::DataCheck; +use strict; +use vars qw(@ISA @EXPORT @EXPORT_OK $AUTOLOAD); +use Carp; +use FML::Log qw(Log LogWarn LogError); + + +=head1 NAME + +FML::Command::DataCheck - check data as command(s) + +=head1 SYNOPSIS + +=head1 DESCRIPTION + +=head1 METHODS + +=head2 new($args) + +=cut + + +# Descriptions: ordinary constructor +# Arguments: OBJ($self) HASH_REF($args) +# Side Effects: none +# Return Value: OBJ +sub new +{ + my ($self, $args) = @_; + my ($type) = ref($self) || $self; + my $me = {}; + return bless $me, $type; +} + + +# Descriptions: return command name ( ^\S+ in $command ). +# remove the prepending strings such as \s, #, ... +# Arguments: OBJ($self) STR($command) +# Side Effects: none +# Return Value: ARRAY(STR, STR) +sub parse_command_buffer +{ + my ($self, $command) = @_; + + $command = $self->clean_up($command); + my ($comname, $comsubname) = split(/\s+/, $command); + return ($comname, $comsubname); +} + + +# Descriptions: parse command buffer to make +# argument vector after command name +# Arguments: OBJ($STR) STR($command) STR($comname) +# Side Effects: none +# Return Value: ARRAY_REF +sub parse_command_arguments +{ + my ($command, $comname) = @_; + my $found = 0; + my (@options) = (); + + for my $buf (split(/\s+/, $command)) { + push(@options, $buf) if $found; + $found = 1 if $buf eq $comname; + } + + return \@options; +} + + +# Descriptions: check message of the current process +# whether it contais keyword e.g. "confirm". +# Arguments: OBJ($self) OBJ($curproc) ARRAY_REF($ra_data) +# Side Effects: none +# Return Value: HASH_REF +sub find_special_keyword +{ + my ($self, $curproc, $ra_data) = @_; + my $config = $curproc->{ config }; + my $confirm_prefix = $config->{ confirm_command_prefix }; + my $admin_prefix = $config->{ privileged_command_prefix }; + my $confirm_found = ''; + my $admin_found = ''; + + # clean up + $confirm_prefix = $self->clean_up($confirm_prefix); + $admin_prefix = $self->clean_up($admin_prefix); + + for my $buf (@$ra_data) { + if ($buf =~ /$confirm_prefix\s+\w+\s+([\w\d]+)/) { + $confirm_found = $1; + } + + if ($buf =~ /$admin_prefix\s+\w+\s+([\w\d]+)/) { + $admin_found = $1; + } + } + + return { + confirm_keyword => $confirm_found, + admin_keyword => $admin_found, + }; +} + + +# Descriptions: clean up the given string and return a cleaned one. +# For example, "# ls uja " -> "ls uja" +# Arguments: OBJ($self) STR($s) +# Side Effects: none +# Return Value: STR +sub clean_up +{ + my ($self, $s) = @_; + + $s =~ s/^[\#\s]*//; + $s =~ s/\s*$//; + + return $s; +} + + +=head1 CODING STYLE + +See C<http://www.fml.org/software/FNF/> on fml coding style guide. + +=head1 AUTHOR + +Ken'ichi Fukamachi + +=head1 COPYRIGHT + +Copyright (C) 2002 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::Command::DataCheck appeared in fml5 mailing list driver package. +See C<http://www.fml.org/> for more details. + +=cut + + +1; diff --git a/fml/lib/FML/Process/Command.pm b/fml/lib/FML/Process/Command.pm index 5e8915cc..67f55a01 100644 --- a/fml/lib/FML/Process/Command.pm +++ b/fml/lib/FML/Process/Command.pm @@ -3,7 +3,7 @@ # Copyright (C) 2000,2001,2002 Ken'ichi Fukamachi # All rights reserved. # -# $FML: Command.pm,v 1.46 2002/04/13 14:53:08 fukachan Exp $ +# $FML: Command.pm,v 1.50 2002/04/25 04:15:21 fukachan Exp $ # package FML::Process::Command; @@ -211,35 +211,17 @@ sub finish # Descriptions: check message of the current process # whether it contais keyword e.g. "confirm". -# Arguments: OBJ($self) STR_REF($ra_body) +# Arguments: OBJ($curproc) ARRAY_REF($ra_data) # Side Effects: none # Return Value: ARRAY sub _pre_scan { - my ($curproc, $ra_body) = @_; - my $config = $curproc->{ config }; - - # special traps - my $confirm_prefix = $config->{ confirm_command_prefix }; - my $admin_prefix = $config->{ privileged_command_prefix }; - my $confirm_found = ''; - my $admin_found = ''; - - # clean up - $confirm_prefix =~ s/\s*$//; - $admin_prefix =~ s/\s*$//; - - for (@$ra_body) { - if (/$confirm_prefix\s+\w+\s+([\w\d]+)/) { - $confirm_found = $1; - } + my ($curproc, $ra_data) = @_; - if (/$admin_prefix\s+\w+\s+([\w\d]+)/) { - $admin_found = $1; - } - } - - return ($confirm_found, $admin_found); + use FML::Command::DataCheck; + my $check = new FML::Command::DataCheck; + my $data = $check->find_special_keyword($curproc, $ra_data); + return ($data->{ confirm_keyword }, $data->{ admin_keyword }); } @@ -285,18 +267,13 @@ sub _is_valid_command # Arguments: STR($command) STR($comname) # Side Effects: none # Return Value: ARRAY_REF -sub _parse_command_options +sub _parse_command_arguments { my ($command, $comname) = @_; - my $found = 0; - my (@options) = (); - for (split(/\s+/, $command)) { - push(@options, $_) if $found; - $found = 1 if $_ eq $comname; - } - - return \@options; + use FML::Command::DataCheck; + my $check = new FML::Command::DataCheck; + $check->parse_command_arguments($command, $comname); } @@ -309,11 +286,9 @@ sub _get_command_name { my ($command) = @_; - # cut off the prepended strings - $command =~ s/^[\#\s]*//; - - my ($comname, $comsubname) = split(/\s+/, $command); - return ($comname, $comsubname); + use FML::Command::DataCheck; + my $check = new FML::Command::DataCheck; + $check->parse_command_buffer($command) } @@ -518,7 +493,7 @@ sub _evaluate_command comname => $comname, command => $command, ml_name => $ml_name, - options => _parse_command_options($command, $comname), + options => _parse_command_arguments($command, $comname), argv => $argv, args => $args, }; |
