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__

=head1 NAME

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

=head1 SYNOPSIS

  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");

=head1 DESCRIPTION

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.

=head1 METHODS

=head2 new (ARGUMENTS)

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

=head2 syntax (TYPE)

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

=head2 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.

=head2 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.

=head2 allow (COMMANDS)

Adds COMMANDS to the allow list.

=head2 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.

=head1 SYNTAX TYPES

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

=head2 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.

=head2 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.

=head1 ALPHA SYNTAX

Here is the proper syntax of each Alpha command.

=head2 +TRIGGER

See SYNTAX TYPES.

=head2 ~REGEXP

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

=head2 -RESPONSE

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

=head2 >LABEL

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

=head2 <LABEL

One argument given.

=head2 @REDIRECT

Follows the same rules as +TRIGGER

=head2 &HOLDER

Follows the same rules as -RESPONSE

=head2 *CONDITION

Must follow this syntax exactly:

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

=head2 #CODE

Must have a length to it.

=head1 KNOWN BUGS

No bugs known at the moment.

=head1 CHANGES

  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.

=head1 FUTURE PLANS

  - 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.

=head1 SEE ALSO

L<Chatbot::Alpha>

=head1 AUTHOR

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

=head1 COPYRIGHT AND LICENSE

    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

=cut