File Coverage

blib/lib/X500/DN/Marpa/Actions.pm

Criterion	Covered	Total	%
statement	29	32	90.6
branch	7	10	70.0
condition	1	2	50.0
subroutine	7	7	100.0
pod	3	3	100.0
total	47	54	87.0

package X500::DN::Marpa::Actions;

use strict;
use utf8;
use warnings;
use warnings qw(FATAL utf8); # Fatalize encoding glitches.

our $VERSION = '1.00';

# ------------------------------------------------

sub attribute_type
{
	my($self, $t)    = @_;
	$t               = lc decode_result($t || '');
	my(%descriptors) =
	(
		commonname             => 'cn',
		countryname            => 'c',
		domaincomponent        => 'dc',
		localityname           => 'l',
		organizationalunitname => 'ou',
		organizationname       => 'o',
		stateorprovincename    => 'st',
		streetaddress          => 'street',
		userid                 => 'uid',
	);
	$t = $descriptors{$t} ? $descriptors{$t} : $t;

	return
	{
		type  => 'type',
		value => $t,
	};

} # End of attribute_type.

# ------------------------------------------------

sub attribute_value
{
	my($self, $t) = @_;

	return
	{
		type  => 'value',
		value => defined($t) ? decode_result($t) : '',
	};

} # End of attribute_value.

# ------------------------------------------------

sub decode_result
{
	my($result)   = @_;
	my(@worklist) = $result;

	my($obj);
	my($ref_type);
	my(@stack);

	do
	{
		$obj      = shift @worklist;
		$ref_type = ref $obj;

		if ($ref_type eq 'ARRAY')
		{
			unshift @worklist, @$obj;
		}
		elsif ($ref_type eq 'HASH')
		{
			push @stack, {%$obj};
		}
		elsif ($ref_type)
		{
			die "Unsupported object type $ref_type\n";
		}
		else
		{
			push @stack, $obj;
		}

	} while (@worklist);

	return join('', @stack);

} # End of decode_result.

# ------------------------------------------------

1;

=pod

=head1 NAME

C - Methods triggered by 'action' clauses in the grammar

=head1 Synopsis

See L.

=head1 Description

C provides a wrapper for actions which are called by Marpa as it
processes the grammar declared in L.

End users will never call methods in this module.

See instead L.

=head1 Distributions

This module is available as a Unix-style distro (*.tgz).

See L
for help on unpacking and installing distros.

=head1 Installation

Install C as you would any C module:

Run:

	cpanm X500::DN::Marpa

or run:

	sudo cpan X500::DN::Marpa

or unpack the distro, and then either:

	perl Build.PL
	./Build
	./Build test
	sudo ./Build install

or:

	perl Makefile.PL
	make (or dmake or nmake)
	make test
	make install

=head1 Methods

=head2 attribute_type($t)

For a DN such as 'UID=12345, OU=Engineering, CN=Kurt Zeilenga+L=Redwood Shores', returns the
lower-case version of the attribute type, e.g. 'uid'.

Where the type is a standard long form, e.g. 'OrganizationalUnitName', returns the corresponding
abbreviation, here 'ou'.

=head2 attribute_value($t)

For a DN such as 'UID=12345, OU=Engineering, CN=Kurt Zeilenga+L=Redwood Shores', returns the
original-case version of the attribute value, e.g. 'Engineering'.

=head1 Functions

=head2 decode_result($result)

Returns a string.

Processes the $result passed by Marpa to both L and L,
which will be a structure of arbitrarily nested scalars, hashrefs and arrayrefs.

=head1 Machine-Readable Change Log

The file Changes was converted into Changelog.ini by L.

=head1 Version Numbers

Version numbers < 1.00 represent development versions. From 1.00 up, they are production versions.

=head1 Repository

L

=head1 Support

Email the author, or log a bug on RT:

L.

=head1 Author

L was written by Ron Savage [e-mail]> in 2015.

Marpa's homepage: L.

My homepage: L.

=head1 Copyright

Australian copyright (c) 2015, Ron Savage.

	All Programs of mine are 'OSI Certified Open Source Software';
	you can redistribute them and/or modify them under the terms of
	The Artistic License 2.0, a copy of which is available at:
	http://opensource.org/licenses/alphabetical.

=cut