path: root/fml/lib/FML/Command/DataCheck.pm

#-*- perl -*-
#
#  Copyright (C) 2002,2003,2004,2005,2006 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: DataCheck.pm,v 1.20 2006/07/03 13:58:32 fukachan Exp $
#

package FML::Command::DataCheck;
use strict;
use vars qw(@ISA @EXPORT @EXPORT_OK $AUTOLOAD);
use Carp;


#
# XXX-TODO: rename DataCheck -> Parse ?
#


=head1 NAME

FML::Command::DataCheck - parse, clean up et.al. command buffer.

=head1 SYNOPSIS

use FML::Command::DataCheck;
my $check = new FML::Command::DataCheck;
my ($comname, $comsubname) = $check->parse_command_buffer($clean_command);
my $options = $check->parse_command_arguments($clean_command, $comname);

=head1 DESCRIPTION

This class provides command parsing functions.

=head1 METHODS

=head2 new($args)

constructor.

=cut


# Descriptions: 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;
}


=head2 parse_command_buffer($command)

return command name ( ^\S+ in $command ) and the sub name as
ARRAY (STR, STR).

The returned values are already clean.

=head2 parse_command_arguments($command, $comname)

return arguments after command name $comname in $command as ARRAY_REF.

=cut


# Descriptions: return command name ( ^\S+ in $command ) and the sub name.
#               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->cleanup($command);
    my ($comname, $comsubname) = split(/\s+/, $command);
    return ($comname, $comsubname);
}


# Descriptions: return arguments after command name $comname in $command
#               as ARRAY_REF.
#    Arguments: OBJ($self) STR($command) STR($comname)
# Side Effects: none
# Return Value: ARRAY_REF
sub parse_command_arguments
{
    my ($self, $command, $comname) = @_;
    my $found     = 0;
    my (@options) = ();

    # XXX-TODO: $comname matches exactly.
    # XXX-TODO: so, you need lower/uppercase before this routine.

    # pick up arguments into @options after $comname.
    # Example:
    #    $comname = "subscribe";
    #    $command = "subscribe rudo von schmit";
    #    @options = [ 'rudo', 'von', 'shmit' ];
    for my $buf (split(/\s+/, $command)) {
	push(@options, $buf) if $found;
	$found = 1 if $buf eq $comname;
    }

    return \@options;
}


=head2 find_special_keyword($curproc, $ra_data)

check the message of the current process to find whether it contains
some special keyword e.g. "confirm".

=cut


#
# XXX-TODO: find_special_keyword() NOT USED ? YES. REMOVE IT.
#


# Descriptions: check the message of the current process to find
#               whether it contains some special 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->cleanup($confirm_prefix);
    $admin_prefix   = $self->cleanup($admin_prefix);

    # XXX $ra_data is not whole body but already parsed and prepared buffer.
    # XXX See below and FML::Process::Command module, for example.
    # XXX not use /^$regexp/ due to the case such as "> confirm ...".
    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,
    };
}


=head2 find_anonymous_command_mail_allowed_commands($curproc)

check the message of the current process to find whether it contais
special keyword e.g. "confirm".

=cut


#
# XXX-TODO: find_anonymous_command_mail_allowed_commands() NOT USED? YES. RM!
#


# Descriptions: check the message of the current process to find
#               whether it contais special keyword e.g. "confirm".
#    Arguments: OBJ($self) OBJ($curproc)
# Side Effects: none
# Return Value: NUM( 1 or )
sub find_anonymous_command_mail_allowed_commands
{
    my ($self, $curproc) = @_;
    my $config   = $curproc->config();
    my $commands = $config->get_as_array_ref('anonymous_command_mail_allowed_commands');
    my $body     = $curproc->incoming_message_body();
    my $msg      = $body->find_first_plaintext_message();

    # assert
    unless (defined $msg) {
	return 0;
    }

    # XXX-TODO: use message_text_as_array_ref().
    my (@body)   = split(/\n/, $msg->message_text );
    my $comname  = '';

  LINE:
    for my $buf (@body) {
	($comname) = $self->parse_command_buffer( $buf );
	next LINE unless defined($comname) && $comname;

	# $comname matches one of $anonymous_command_mail_allowed_commands ?
	# XXX-TODO: we need to care for lowercase/uppercase mismtach ?
	# XXX-TODO: need to define macro EQUAL_CASE_INSENSITIVE(a,b) ?
      COMMAND:
	for my $proc (@$commands) {
	    next COMMAND unless defined($proc) && $proc;

	    return 1 if $comname eq $proc;
	}
    };

    my $data = $self->find_special_keyword($curproc, \@body);
    return 1 if $data->{ confirm_keyword };

    return 0;
}


=head2 cleanup($string)

clean up the given string and return a cleaned one.
For example, "# ls uja " -> "ls uja"

=cut


# 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 cleanup
{
    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,2003,2004,2005,2006 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 first appeared in fml8 mailing list driver package.
See C<http://www.fml.org/> for more details.

=cut


1;