My solution to exercise 1-3 of http://marpa-guide.github.io/chapter3.html

Authorization.pm

package Authorization;

# My solution to exercise parts 1, 2, and 3 of http://marpa-guide.github.io/chapter3.html

use warnings;
use strict;

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

# Grammar based on Peter Stuifzand's tutorial script from http://marpa-guide.github.io/chapter3.html
# Original code Copyright (c) 2013 Peter Stuifzand

my $_dsl = <<'END_OF_SOURCE';

:start        ::= rules
rules         ::= rule_line+            action => clean_up

rule          ::= cmd_type users        action => process_rule
                | cmd_type r_user_list  action => process_rule
                | user_list             action => store_list

# Wrapping the eol in parenthesis discards (or doesn't include) that text (lexeme?) after using it for a match
rule_line     ::= rule ( eol )          action => elevate

user_list     ::= user '=' users 
users         ::= user+

# Define this as a separate rule so that '@list' is correctly nested underneath the cmd_type, similar to the other rules
r_user_list      ::= list_ref  action => expand_list

list_ref        ~ '@' username

cmd_type        ~ 'Allow' | 'Deny'

username        ~ [\w]+ 
user            ~ username | 'all' | 'everybody'

eol             ~ [\n]+

:discard        ~ ws 
ws              ~ [ \t]+ 

END_OF_SOURCE

sub new
{
    my $class = shift;
    my $self = {@_};

    die "?no source specified" unless $self->{source};

    # Parse grammar, set things up
    my $g = Marpa::R2::Scanless::G->new({
        default_action  => '::array',
        source          => \$_dsl,
    });
    $self->{grammar} = $g;

    # Normalized rules resulting from processing the user-provided source
    #
    # parse() returns a reference to the results of the parse, so since it's an array reference, $ref_ref contains a reference to an array reference
    my $ref_ref = $g->parse( \$self->{source}, 'Authorization::Actions' );
    $self->{rules} = ${$ref_ref};

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

# Walk through processed rules list looking for username match
sub CanAccess
{
    my ($self, $username) = @_;

    die "?no user specified" unless ($username);
RULE:
    for my $lref (@{$self->{rules}}) {
        my ($verb, @users) = @{$lref};
        my %u = map { $_ => 1; } @users;
        next RULE unless (exists $u{'*'} or exists $u{$username});
        return 1 if ($verb eq 'Allow');
        return;                         # Deny
    }
}

# Actions called during dsl parsing
package Authorization::Actions;

use Data::Dumper;

my %user_list;

sub store_list
{
    my ($self, $lref) = @_;
    $user_list{ $lref->[0] } =  [@{$lref->[2]}];
    return ;
}

# Expand alias lists in place, also die if they're not defined [properly]
sub expand_list
{
    my ($self, $name) = @_;
    $name =~ s/^\@//;
    warn "?unknown user list $name" unless exists ($user_list{$name});
    return  $user_list{$name};
}

# Reduce the rule verb and user(s) to a single list, simplify rules including all/everybody 
sub process_rule
{
    my ($self, $action, $lref) = @_;

    my @users;
USERS:
    for my $u (@{$lref}) {
        if (lc($u) eq 'everybody' or lc($u) eq 'all') {
            @users = ('*'); 
            last USERS;
        }
        else {
            push @users, $u;
        }
    }
    return [ $action, @users ];
}

# Remove unnecessary list reference wrappings
sub elevate
{
    my ($self, @x) = @_;
    return $x[0] if (scalar(@x) == 1);
    return @x;
}

# Remove all undef entries from "rule list"
sub clean_up
{
    my ($self, @rule_results) = @_;
    my @clean_list = grep { $_; } @rule_results;
    return \@clean_list;
}

1;

example-3.pl

#!/usr/bin/perl

# Part of my solution to exercise parts 1, 2, and 3 of http://marpa-guide.github.io/chapter3.html

use strict;
use warnings;

use Authorization;
use Data::Dumper;

# Allow/deny source data
my $input = <<'EXERCISE';
admins = admin root dbcooper
Deny baduser cracker
Allow @admins
Allow jessica murphy
Deny everybody

EXERCISE

my $auth = Authorization->new( source => $input );

# Test access permission for multiple users, die if unexpected results
my %expected = (
    admin       => 1,
    root        => 1,
    dbcooper    => 1,
    baduser     => 0,
    cracker     => 0,
    jessica     => 1,
    murphy      => 1,
    all         => 0,
    everybody   => 0,
    guest       => 0,
);

for my $u (sort keys %expected) {
    my $authorized = $auth->CanAccess($u);
    if ($expected{$u} xor $authorized) {
        warn "?unexpected result for user $u, expected $expected{$u}, got $authorized\n";
    }
    else {
        my $verb = ($authorized) ? 'allowed' : 'denied';
        printf "%-10s $verb\n", $u;
    }
}