deny-allow.pl

#!/usr/bin/env perl

# Adapted from tutorial Copyright (c) 2013 Peter Stuifzand
# at http://marpa-guide.github.io/chapter3.html
# In particular this is an attempt at Exercise 3

use strict;
use warnings;

package Authorization;

use Moo;
use Marpa::R2;
use Data::Dumper;

has spec => (
             is => 'ro',
             isa => sub { die if ref $_[0] },
            );

has grammar => (
                is => 'lazy',
               );

has recognizer => (
                   is => 'ro',
                  );

has ACL => (
            is => 'ro',
           );

sub _build_grammar {
  return <<'END_OF_SOURCE'
rules         ::= rule+ separator => eol

rule          ::= cmd_type user_list | cmd_type all | user_decl

user_decl  ::= user '=' user_list
user_list  ::= user_spec+
user_spec  ::= user | list_ref

list_ref        ~ '@' username
user            ~ username

cmd_type        ~ 'Deny' | 'Allow'
username        ~ [\w]+

all             ~ 'all' | 'everybody'

:discard        ~ ws
ws              ~ [ \t]+

eol             ~ [\n]+
END_OF_SOURCE
}

sub BUILD {
  my ($self) = @_;
  my $grammar = Marpa::R2::Scanless::G->new({
                                             default_action => '::array',
                                             source         => \$self->grammar,
                                            });
  my $recognizer = Marpa::R2::Scanless::R->new({ grammar => $grammar });
  $self->{recognizer} = $recognizer;

  print "Trying to parse:\n" . $self->spec . "\n\n";
  $recognizer->read(\$self->spec);
  my $ACL = ${$recognizer->value};
  $self->{ACL} = $ACL;

  print "Output:\n".Dumper($ACL);

  return;
}

sub CanAccess {
  my ($self, $username) = @_;
  # ... make sense of $self->{ACL}
}

package main;
use Data::Dumper;
$Data::Dumper::Indent = 1;
$Data::Dumper::Terse = 1;
$Data::Dumper::Deepcopy = 1;

my $input = <<'INPUT';
super_admins = me
admins = @super_admins admin root administrator peter
Deny all
Allow @admins carter
INPUT

my $auth = Authorization->new(spec => $input);
# print Dumper($auth);
print Dumper($auth->ACL);