Chatbot::Alpha::Syntax - Syntax checking for Chatbot::Alpha replies.

Chatbot-Alpha documentation Contained in the Chatbot-Alpha distribution.

Index

Code Index:

NAME

Top

Chatbot::Alpha::Syntax - Syntax checking for Chatbot::Alpha replies.

SYNOPSIS

Top

  use Chatbot::Alpha::Syntax;

  my $syntax = new Chatbot::Alpha::Syntax;

  # Set 'strict' syntax.
  $syntax->syntax ('strict');

  # Changed my mind, use 'loose'
  $syntax->syntax ('loose');

  # Only allow SOME commands.
  $syntax->deny_type ('allow_some');

  # Allow only +'s and -'s.
  $syntax->allow ('+', '-');

  # Syntax-check this file.
  $syntax->check ("replies.cba");

DESCRIPTION

Top

Chatbot::Alpha::Syntax provides syntax checking for Alpha documents. All syntax errors result in a 'die' so don't expect to run your syntax checking halfway through a large application's process. Doing it in initialization is always fine though.

METHODS

Top

new (ARGUMENTS)

Creates a new Chatbot::Alpha::Syntax object. You can pass in any defaults here.

syntax (TYPE)

Define a syntax type, either 'strict' or 'loose'. Defaults to strict. See below for definitions on the various syntax types.

deny_type (DENYTYPE)

Must be 'deny_all', 'deny_some', 'allow_some', or 'allow_all' - defaults to 'allow_all'. If you're going to want to deny/allow certain commands, it's best to use deny_type to set this. The automatic settings of deny() and allow() may not always end up how you want them.

deny (COMMANDS)

Denies a list of COMMANDS. These are the Alpha commands (+, -, @, &, etc). Syntax errors will arrise when these commands are found in the Alpha document.

allow (COMMANDS)

Adds COMMANDS to the allow list.

check (FILE)

Check the syntax of FILE. Will return 0 if the file couldn't be opened, return 1 if everything went well, or die if a syntax error is found.

SYNTAX TYPES

Top

Syntax types mostly only refer to the +TRIGGER command, as that's the part of your code that's put through a regexp.

strict

This is the default (and most recommended) syntax type. The rules are as follows:

  - Triggers must be lowercase, numbers and letters only.
  - Spaces are allowed. All other symbols are NOT allowed.

loose

This one is less strict on your trigger syntax. The recommended rules are as follows:

  - Triggers can be capitilized, lowercase, or any combination.
  - Triggers can contain letters or numbers or spaces.
  - Any foreign symbols aren't recommended, however it won't kill you.

The loose syntax check will only 'warn' when one of these isn't true, but it won't hold it against you.

ALPHA SYNTAX

Top

Here is the proper syntax of each Alpha command.

+TRIGGER

See SYNTAX TYPES.

~REGEXP

No syntax rules have been applied to these. Just make sure your regexp triggers are friendly.

-RESPONSE

A value of any length must be given. A response of all spaces is bad.

>LABEL

Two arguments must be given, separated by spaces: the label type, and its one-word value.

<LABEL

One argument given.

@REDIRECT

Follows the same rules as +TRIGGER

&HOLDER

Follows the same rules as -RESPONSE

*CONDITION

Must follow this syntax exactly:

  * ___=___::___
    ^var  ^val ^response

#CODE

Must have a length to it.

KNOWN BUGS

Top

No bugs known at the moment.

CHANGES

Top

  Version 0.2
  - Fixed some bugs, blank lines shouldn't ever be considered commands,
    and incase of unknown command anyway only a warn is used but not a
    die.

  Version 0.1
  - Initial release.

FUTURE PLANS

Top

  - Add methods for defining your own syntax, for example if you make
    a custom mod to Chatbot::Alpha to add new commands, the syntax
    checker would know what to do with them.

SEE ALSO

Top

Chatbot::Alpha

AUTHOR

Top

Casey Kirsle, http://www.cuvou.com/

COPYRIGHT AND LICENSE

Top

    Chatbot::Alpha - A simple chatterbot brain.
    Copyright (C) 2005  Casey Kirsle

    This program is free software; you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation; either version 2 of the License, or
    (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program; if not, write to the Free Software
    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
Chatbot-Alpha documentation Contained in the Chatbot-Alpha distribution. 
package Chatbot::Alpha::Syntax;

our $VERSION = '0.4';

use strict;
use warnings;

sub new {
	my $proto = shift;
	my $class = ref($proto) || $proto;

	my $self = {
		debug    => 0,
		version  => $VERSION,
		deny     => {},
		allow    => {},
		denytype => 'alloy_all', # deny_all, allow_some, deny_some
		cusdeny  => 0,
		syntax   => 'strict',
	};

	bless ($self,$class);
	return $self;
}

sub syntax {
	my ($self,$syn) = @_;

	if ($syn =~ /^(loose|strict)$/i) {
		$self->{syntax} = $syn;
		return 1;
	}

	return 0;
}

sub deny_type {
	my ($self,$type) = @_;

	if ($type =~ /^(alloy|deny)_(all|some)$/i) {
		$self->{cusdeny} = 1;

		$type = lc($type);
		$type =~ s/ //g;

		$self->{denytype} = $type;
	}
	else {
		return 0;
	}
	return 1;
}

sub deny {
	my ($self,@commands) = @_;

	# Deny each command.
	foreach my $cmd (@commands) {
		delete $self->{allow}->{$cmd} if exists $self->{allow}->{$cmd};
		$self->{deny}->{$cmd} = 1;
	}

	$self->deny_type ('deny_some') unless $self->{cusdeny} == 1;
}

sub allow {
	my ($self,@commands) = @_;

	# Allow each command.
	foreach my $cmd (@commands) {
		delete $self->{deny}->{$cmd} if exists $self->{deny}->{$cmd};
		$self->{allow}->{$cmd} = 1;
	}

	$self->deny_type ('allow_some') unless $self->{cusdeny} == 1;
}

sub check {
	my ($self,$file) = @_;

	open (FILE, $file) or return 0;
	my @data = <FILE>;
	close (FILE);

	# Handle dos text files on Mac and Unix
	if($/ ne "\r\n") {
		local $/ = "\r\n";
		chomp @data;
	}

	chomp @data;

	# Go through each line.
	my $num = 0;
	foreach my $line (@data) {
		$num++;
		next if length $line == 0;
		next if $line =~ /^\//;
		$line =~ s/^\s+//g;
		$line =~ s/^\t+//g;
		$line =~ s/^\s//g;
		$line =~ s/^\t//g;

		my ($cmd,$data) = split(//, $line, 2);
		$data =~ s/^\s+//g;
		$data =~ s/^\s//g;

		next unless length $cmd > 0;

		# Denied/Not allowed?
		if ($self->{denytype} ne 'allow_all') {
			if ($self->{denytype} eq 'deny_some') {
				if (exists $self->{deny}->{$cmd}) {
					die "Command $cmd is not allowed at $file line $num; ";
				}
			}
			elsif ($self->{denytype} eq 'allow_some') {
				if (!exists $self->{allow}->{$cmd}) {
					die "Command $cmd not in allowlist at $file line $num; ";
				}
			}
		}
		elsif ($self->{denytype} eq 'deny_all') {
			die "No commands allowed at $file line $num; ";
		}

		if ($cmd eq '>') {
			my @args = split(/\s+/, $data);
			if (scalar(@args) != 2) {
				die "Bad number of arguments in >LABEL at $file line $num; ";
			}
		}
		elsif ($cmd eq '<') {
			my @args = split(/\s+/, $data);
			if (scalar(@args) != 1) {
				die "Bad number of arguments in <LABEL at $file line $num; ";
			}
		}
		elsif ($cmd eq '+') {
			# On strict: must be lowercase, simplistic.
			if ($self->{syntax} eq 'strict') {
				if ($data =~ /[^a-z0-9 \*]/) {
					die "+TRIGGERS must be lowercase alphanumeric "
						. "while in 'strict' syntax at $file line $num; ";
				}
			}
			elsif ($self->{syntax} eq 'loose') {
				if ($data =~ /[^A-Za-z0-9 \*]/) {
					warn "+TRIGGERS must be alphanumeric while in 'loose' "
						. "syntax at $file line $num; ";
				}
			}
		}
		elsif ($cmd eq '%') {
			# On strict: must be lowercase, simplistic.
			if ($self->{syntax} eq 'strict') {
				if ($data =~ /[^a-z0-9 ]/) {
					die "+TRIGGERS must be lowercase alphanumeric "
						. "while in 'strict' syntax at $file line $num; ";
				}
			}
			elsif ($self->{syntax} eq 'loose') {
				if ($data =~ /[^A-Za-z0-9 ]/) {
					warn "+TRIGGERS must be alphanumeric while in 'loose' "
						. "syntax at $file line $num; ";
				}
			}
		}
		elsif ($cmd eq '-') {
			if (length $data == 0) {
				die "Empty -RESPONSE data at $file line $num; ";
			}
		}
		elsif ($cmd eq '^') {
			if (length $data == 0) {
				die "Empty ^CONTINUE data at $file line $num; ";
			}
		}
		elsif ($cmd eq '@') {
			if ($self->{syntax} eq 'strict') {
				if ($data =~ /[^a-z0-9 \*\<\>]/) {
					die "\@REDIRECTIONS must be lowercase alphanumeric "
						. "while in 'strict' syntax at $file line $num; ";
				}
			}
			elsif ($self->{syntax} eq 'loose') {
				if ($data =~ /[^A-Za-z0-9 \*\<\>]/) {
					die "\@REDIRECTIONS must be alphanumeric while in 'loose' "
						. "syntax at $file line $num; ";
				}
			}
		}
		elsif ($cmd eq '*') {
			if ($data !~ /^(.*?)=(.*?)::(.*?)$/i) {
				die "Syntax error at *CONDITION at $file line $num; ";
			}
		}
		elsif ($cmd eq '&') {
			if (length $data == 0) {
				die "Empty &HOLDER data at $file line $num; ";
			}
		}
		elsif ($cmd eq '#') {
			if (length $data == 0) {
				die "Empty #CODE data at $file line $num; ";
			}
		}
		elsif ($cmd eq '/') {
			# Comment data.
		}
		elsif ($cmd eq '~') {
			# A regexp. Leave it be.
		}
		else {
			warn "Unknown command '$cmd' with data '$data' at $file line $num; ";
		}
	}

	return 1;
}

1;
__END__