File Coverage

blib/lib/X500/DN/Marpa.pm
Criterion Covered Total %
statement 156 171 91.2
branch 44 60 73.3
condition 14 21 66.6
subroutine 23 24 95.8
pod 10 12 83.3
total 247 288 85.7


line stmt bran cond sub pod time code
1             package X500::DN::Marpa;
2              
3 2     2   27279 use strict;
  2         5  
  2         62  
4 2     2   10 use warnings;
  2         10  
  2         102  
5              
6 2         25 use Const::Exporter constants =>
7             [
8             nothing_is_fatal => 0, # The default.
9             print_errors => 1,
10             print_warnings => 2,
11             print_debugs => 4,
12             ambiguity_is_fatal => 8,
13             exhaustion_is_fatal => 16,
14             long_descriptors => 32,
15             return_hex_as_chars => 64,
16 2     2   1701 ];
  2         42494  
17              
18 2     2   2884 use Marpa::R2;
  2         378658  
  2         96  
19              
20 2     2   4654 use Moo;
  2         22092  
  2         13  
21              
22 2     2   6107 use Set::Array;
  2         25666  
  2         81  
23              
24 2     2   1974 use Types::Standard qw/Any Int Str/;
  2         138054  
  2         24  
25              
26 2     2   2042 use Try::Tiny;
  2         5  
  2         135  
27              
28 2     2   1200 use X500::DN::Marpa::Actions;
  2         5  
  2         5075  
29              
30             has bnf =>
31             (
32             default => sub{return ''},
33             is => 'rw',
34             isa => Any,
35             required => 0,
36             );
37              
38             has error_message =>
39             (
40             default => sub{return ''},
41             is => 'rw',
42             isa => Str,
43             required => 0,
44             );
45              
46             has error_number =>
47             (
48             default => sub{return 0},
49             is => 'rw',
50             isa => Int,
51             required => 0,
52             );
53              
54             has grammar =>
55             (
56             default => sub {return ''},
57             is => 'rw',
58             isa => Any,
59             required => 0,
60             );
61              
62             has options =>
63             (
64             default => sub{return 0},
65             is => 'rw',
66             isa => Int,
67             required => 0,
68             );
69              
70             has recce =>
71             (
72             default => sub{return ''},
73             is => 'rw',
74             isa => Any,
75             required => 0,
76             );
77              
78             # The default value of $self -> stack is set to Set::Array -> new, so that if anyone
79             # accesses $self -> stack before calling $self -> parse, gets a meaningful result.
80             # This is despite the fact the parser() resets the stack at the start of each call.
81              
82             has stack =>
83             (
84             default => sub{return Set::Array -> new},
85             is => 'rw',
86             isa => Any,
87             required => 0,
88             );
89              
90             has text =>
91             (
92             default => sub{return ''},
93             is => 'rw',
94             isa => Str,
95             required => 0,
96             );
97              
98             my(%descriptors) =
99             (
100             cn => 'commonName',
101             c => 'countryName',
102             dc => 'domainComponent',
103             l => 'localityName',
104             ou => 'organizationalUnitName',
105             o => 'organizationName',
106             st => 'stateOrProvinceName',
107             street => 'streetAddress',
108             uid => 'userId',
109             );
110              
111             our $VERSION = '1.00';
112              
113             # ------------------------------------------------
114              
115             sub BUILD
116             {
117 5     5 0 143 my($self) = @_;
118              
119             # Policy: Event names are always the same as the name of the corresponding lexeme.
120             #
121             # References:
122             # o https://www.ietf.org/rfc/rfc4512.txt (secondary)
123             # - Lightweight Directory Access Protocol (LDAP): Directory Information Models
124             # o https://www.ietf.org/rfc/rfc4514.txt (primary)
125             # - Lightweight Directory Access Protocol (LDAP): String Representation of Distinguished Names
126             # o https://www.ietf.org/rfc/rfc4517.txt
127             # - Lightweight Directory Access Protocol (LDAP): Syntaxes and Matching Rules
128             # o https://www.ietf.org/rfc/rfc4234.txt
129             # - Augmented BNF for Syntax Specifications: ABNF
130             # o https://www.ietf.org/rfc/rfc3629.txt
131             # - UTF-8, a transformation format of ISO 10646
132              
133 5         12 my($bnf) = <<'END_OF_GRAMMAR';
134              
135             :default ::= action => [values]
136              
137             lexeme default = latm => 1
138              
139             :start ::= dn
140              
141             # dn.
142              
143             dn ::=
144             dn ::= rdn
145             | rdn separators dn
146              
147             separators ::= separator+
148              
149             separator ::= comma
150             | space
151              
152             rdn ::= attribute_pair rank => 1
153             | attribute_pair spacer plus spacer rdn rank => 2
154              
155             attribute_pair ::= attribute_type spacer equals spacer attribute_value
156              
157             spacer ::= space*
158              
159             # attribute_type.
160              
161             attribute_type ::= description action => attribute_type
162             | numeric_oid action => attribute_type
163              
164             description ::= description_prefix description_suffix
165              
166             description_prefix ::= alpha
167              
168             description_suffix ::= description_tail*
169              
170             description_tail ::= alpha
171             | digit
172             | hyphen
173              
174             numeric_oid ::= number oid_suffix
175              
176             number ::= digit
177             | digit_sequence
178              
179             digit_sequence ::= non_zero_digit digit_suffix
180              
181             digit_suffix ::= digit+
182              
183             oid_suffix ::= oid_sequence+
184              
185             oid_sequence ::= dot number
186              
187             # attribute_value.
188              
189             attribute_value ::= string action => attribute_value
190             | hex_string action => attribute_value
191              
192             string ::=
193             string ::= string_prefix string_suffix
194              
195             string_prefix ::= lutf1
196             | utfmb
197             | pair
198              
199             utfmb ::= utf2
200             | utf3
201             | utf4
202              
203             utf2 ::= utf2_prefix utf2_suffix
204              
205             utf3 ::= utf3_prefix_1 utf3_suffix_1
206             | utf3_prefix_2 utf3_suffix_2
207             | utf3_prefix_3 utf3_suffix_3
208             | utf3_prefix_4 utf3_suffix_4
209              
210             utf4 ::= utf4_prefix_1 utf4_suffix_1
211             | utf4_prefix_2 utf4_suffix_2
212             | utf4_prefix_3 utf4_suffix_3
213              
214             pair ::= escape_char escaped_char
215              
216             escaped_char ::= escape_char
217             | special_char
218             | hex_pair
219              
220             string_suffix ::=
221             string_suffix ::= string_suffix_1 string_suffix_2
222              
223             string_suffix_1 ::= string_suffix_1_1*
224              
225             string_suffix_1_1 ::= sutf1
226             | utfmb
227             | pair
228              
229             string_suffix_2 ::= tutf1
230             | utfmb
231             | pair
232              
233             hex_string ::= sharp hex_suffix
234              
235             hex_suffix ::= hex_pair+
236              
237             hex_pair ::= hex_digit hex_digit
238              
239             # Lexemes in alphabetical order.
240              
241             alpha ~ [A-Za-z] # [\x41-\x5a\x61-\x7a].
242              
243             comma ~ ',' # [\x2c].
244              
245             digit ~ [0-9] # [\x30-\x39].
246              
247             dot ~ '.' # [\x2e].
248              
249             equals ~ '=' # [\x3d].
250              
251             escape_char ~ '\' # [\x5c]. Use ' in comment for UltraEdit syntax hiliter.
252              
253             hex_digit ~ [0-9A-Fa-f] # [\x30-\x39\x41-\x46\x61-\x66].
254              
255             hyphen ~ '-'
256              
257             # \x01-\x1f: All control chars except the first (^@). Skip [ ] = [\x20].
258             # \x21: !. Skip ["#] = [\x22\x23].
259             # \x24-\x2a: $%&'()*. Skip: [+,] = [\x2b\x2c].
260             # \x2d-\x3a: -./0123456789:. Skip [;<] = [\x3b\x3c].
261             # \x3d: =.
262             # \x3f-\x5b: ?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[.
263             # \x5d-\x7f: ]^_`abcdefghijklmnopqrstuvwxyz{|}~ and DEL.
264              
265             lutf1 ~ [\x01-\x1f\x21\x24-\x2a\x2d-\x3a\x3d\x3f-\x5b\x5d-\x7f]
266              
267             non_zero_digit ~ [1-9] # [\x31-\x39].
268              
269             plus ~ '+' # [\x2b].
270              
271             sharp ~ '#' # [\x23].
272              
273             space ~ ' ' # [\x20].
274              
275             special_char ~ ["+,;<> #=] # Use " in comment for UltraEdit syntax hiliter.
276              
277             sutf1 ~ [\x01-\x21\x23-\x2a\x2d-\x3a\x3d\x3f-\x5b\x5d-\x7f]
278              
279             tutf1 ~ [\x01-\x1f\x21\x23-\x2a\x2d-\x3a\x3d\x3f-\x5b\x5d-\x7f]
280              
281             utf0 ~ [\x80-\xbf]
282              
283             utf2_prefix ~ [\xc2-\xdf]
284              
285             utf2_suffix ~ utf0
286              
287             utf3_prefix_1 ~ [\xe0\xa0-\xbf]
288              
289             utf3_suffix_1 ~ utf0
290              
291             utf3_prefix_2 ~ [\xe1-\xec]
292              
293             utf3_suffix_2 ~ utf0 utf0
294              
295             utf3_prefix_3 ~ [\xed\x80-\x9f]
296              
297             utf3_suffix_3 ~ utf0
298              
299             utf3_prefix_4 ~ [\xee-\xef]
300              
301             utf3_suffix_4 ~ utf0 utf0
302              
303             utf4_prefix_1 ~ [\xf0\x90-\xbf]
304              
305             utf4_suffix_1 ~ utf0 utf0
306              
307             utf4_prefix_2 ~ [\xf1-\xf3]
308              
309             utf4_suffix_2 ~ utf0 utf0 utf0
310              
311             utf4_prefix_3 ~ [\xf4\x80-\x8f]
312              
313             utf4_suffix_3 ~ utf0 utf0
314              
315             END_OF_GRAMMAR
316              
317 5         82 $self -> bnf($bnf);
318 5         1389 $self -> grammar
319             (
320             Marpa::R2::Scanless::G -> new
321             ({
322             source => \$self -> bnf
323             })
324             );
325              
326             } # End of BUILD.
327              
328             # ------------------------------------------------
329              
330             sub decode_result
331             {
332 30     30 0 52 my($self, $result) = @_;
333 30         82 my(@worklist) = $result;
334              
335 30         49 my($obj);
336             my($ref_type);
337 0         0 my(@stack);
338              
339             do
340 30         62 {
341 668         891 $obj = shift @worklist;
342 668         878 $ref_type = ref $obj;
343              
344 668 100       1520 if ($ref_type eq 'ARRAY')
    100          
    50          
345             {
346 409         1151 unshift @worklist, @$obj;
347             }
348             elsif ($ref_type eq 'HASH')
349             {
350 132         649 push @stack, {%$obj};
351             }
352             elsif ($ref_type)
353             {
354 0         0 die "Unsupported object type $ref_type\n";
355             }
356             else
357             {
358 127         402 push @stack, $obj;
359             }
360              
361             } while (@worklist);
362              
363 30         160 return [@stack];
364              
365             } # End of decode_result.
366              
367             # ------------------------------------------------
368              
369             sub _combine
370             {
371 30     30   73 my($self) = @_;
372 30         753 my(@temp) = $self -> stack -> print;
373 30         587 my($multivalued) = 0;
374              
375 30         42 my(@dn);
376              
377 30         106 for (my $i = 0; $i <= $#temp; $i++)
378             {
379             # The 'multivalued' key is use for temporary storage. See parse().
380             # 'count' holds the count of RDNs within this stack element.
381              
382 73 100       219 if ($temp[$i]{multivalued})
    100          
383             {
384 7         22 $multivalued = 1;
385             }
386             elsif ($multivalued)
387             {
388 7         10 $multivalued = 0;
389 7         15 $dn[$#dn]{count} += 1;
390 7         32 $dn[$#dn]{value} .= "+$temp[$i]{type}=$temp[$i]{value}";
391             }
392             else
393             {
394             # Zap 'multivalued' so it does not end up in the stack.
395              
396 59         109 undef $temp[$i]{multivalued};
397              
398 59         187 push @dn, $temp[$i];
399             }
400             }
401              
402 30         109 $self -> stack(Set::Array -> new(@dn) );
403              
404             } # End of _combine.
405              
406             # ------------------------------------------------
407              
408             sub dn
409             {
410 25     25 1 12533 my($self) = @_;
411              
412 25         45 return join(',', map{"$$_{type}=$$_{value}"} reverse @{$self -> stack});
  47         366  
  25         749  
413              
414             } # End of dn.
415              
416             # ------------------------------------------------
417              
418             sub openssl_dn
419             {
420 25     25 1 391 my($self) = @_;
421              
422 25         49 return join('+', map{"$$_{type}=$$_{value}"} @{$self -> stack});
  47         305  
  25         581  
423              
424             } # End of openssl_dn.
425              
426             # ------------------------------------------------
427              
428             sub parse
429             {
430 31     31 1 322549 my($self, $string) = @_;
431 31 50       931 $self -> text($string) if (defined $string);
432              
433 31         2623 $self -> recce
434             (
435             Marpa::R2::Scanless::R -> new
436             ({
437             exhaustion => 'event',
438             grammar => $self -> grammar,
439             ranking_method => 'high_rule_only',
440             semantics_package => 'X500::DN::Marpa::Actions',
441             })
442             );
443              
444             # Return 0 for success and 1 for failure.
445              
446 31         14200 my($result) = 0;
447              
448 31         55 my($message);
449              
450             try
451             {
452 31     31   2030 my($text) = $self -> text;
453 31         222 my($text_length) = length($text);
454 31         662 my($read_length) = $self -> recce -> read(\$text);
455              
456 31 50       32550 if ($text_length != $read_length)
457             {
458 0         0 die "Text is $text_length characters, but read() only read $read_length characters. \n";
459             }
460              
461 31 50       813 if ($self -> recce -> exhausted)
    100          
462             {
463 0         0 $message = 'Parse exhausted';
464              
465 0         0 $self -> error_message($message);
466 0         0 $self -> error_number(1);
467              
468 0 0       0 if ($self -> options & exhaustion_is_fatal)
469             {
470             # This 'die' is inside try{}catch{}, which adds the prefix 'Error: '.
471              
472 0         0 die "$message\n";
473             }
474             else
475             {
476 0         0 $self -> error_number(-1);
477              
478 0 0       0 print "Warning: $message\n" if ($self -> options & print_warnings);
479             }
480             }
481             elsif (my $status = $self -> recce -> ambiguous)
482             {
483 1         113 my($terminals) = $self -> recce -> terminals_expected;
484 1 50       83 $terminals = ['(None)'] if ($#$terminals < 0);
485 1         6 $message = "Ambiguous parse. Status: $status. Terminals expected: " . join(', ', @$terminals);
486              
487 1         5 $self -> error_message($message);
488 1         623 $self -> error_number(2);
489              
490 1 50       641 if ($self -> options & ambiguity_is_fatal)
    50          
491             {
492             # This 'die' is inside try{}catch{}, which adds the prefix 'Error: '.
493              
494 0         0 die "$message\n";
495             }
496             elsif ($self -> options & print_warnings)
497             {
498 0         0 $self -> error_number(-2);
499              
500 0         0 print "Warning: $message\n";
501             }
502             }
503              
504 31         5174 my($hex_as_char) = $self -> options & return_hex_as_chars;
505 31         1554 my($long_form) = $self -> options & long_descriptors;
506 31         830 my($value_ref) = $self -> recce -> value;
507              
508 31         28873 my(@hex);
509              
510 31 100       106 if (defined $value_ref)
511             {
512 30         220 $self -> stack(Set::Array -> new);
513              
514 30         3345 my($count) = 0;
515              
516 30         63 my($type);
517             my($value);
518              
519 30         53 for my $item (@{$self -> decode_result($$value_ref)})
  30         127  
520             {
521 259 50       3298 next if (! defined($item) );
522 259 100       826 next if ($item =~ /^[=,; ]$/);
523              
524 139 100       371 if ($item eq '+')
525             {
526             # The 'multivalued' key is use for temporary storage. See _combine().
527             # 'count' holds the count of RDNs within this stack element.
528              
529 7         307 $self -> stack -> push({multivalued => 1});
530              
531 7         402 next;
532             }
533              
534 132         175 $count++;
535              
536             # This line uses $$item{value}, not $$item{type}!
537             # $$item{type} takes these values:
538             # Count Type
539             # 1 type
540             # 2 value
541             # 3 type
542             # 4 value
543             # ...
544              
545 132         236 $value = $$item{value};
546              
547 132 100       325 if ( ($count % 2) == 1)
548             {
549 66 50 33     249 $type = $long_form && $descriptors{$value} ? $descriptors{$value} : $value;
550             }
551             else
552             {
553 66 100 100     329 if ($hex_as_char && (substr($value, 0, 1) eq '#') )
554             {
555 1         4 @hex = ();
556 1         3 $value = substr($value, 1);
557              
558 1         7 while ($value =~ /(..)/g)
559             {
560 3         12 push @hex, $1;
561             }
562              
563 1         3 $value = join('', map{chr hex} @hex);
  3         11  
564             }
565              
566             # The 'multivalued' key is use for temporary storage. See _combine().
567             # 'count' holds the count of RDNs within this stack element.
568              
569 66         1452 $self -> stack -> push({count => 1, multivalued => 0, type => $type, value => $value});
570             }
571             }
572              
573 30         2227 $self -> _combine;
574             }
575             else
576             {
577 1         2 $result = 1;
578              
579 1 50       24 print "Error: Parse failed\n" if ($self -> options & print_errors);
580             }
581             }
582             catch
583             {
584 0     0   0 $result = 1;
585              
586 0 0       0 print "Error: Parse failed. ${_}" if ($self -> options & print_errors);
587 31         442 };
588              
589             # Return 0 for success and 1 for failure.
590              
591 31         3029 return $result;
592              
593             } # End of parse.
594              
595             # ------------------------------------------------
596              
597             sub rdn
598             {
599 25     25 1 168 my($self, $n) = @_;
600 25         53 $n -= 1;
601 25         815 my(@rdn) = $self -> stack -> print;
602              
603 25 100 66     558 return ( ($n < 0) || ($n > $#rdn) ) ? '' : "${$rdn[$n]}{type}=${$rdn[$n]}{value}";
  24         90  
  24         94  
604              
605             } # End of rdn.
606              
607             # ------------------------------------------------
608              
609             sub rdn_count
610             {
611 22     22 1 102 my($self, $n) = @_;
612 22         39 $n -= 1;
613 22         469 my(@rdn) = $self -> stack -> print;
614              
615 22 100 66     364 return ( ($n < 0) || ($n > $#rdn) ) ? 0 : ${$rdn[$n]}{count};
  21         70  
616              
617             } # End of rdn_count.
618              
619             # ------------------------------------------------
620              
621             sub rdn_number
622             {
623 25     25 1 98 my($self) = @_;
624              
625 25         587 return $self -> stack -> length;
626              
627             } # End of rdn_number.
628              
629             # ------------------------------------------------
630              
631             sub rdn_type
632             {
633 22     22 1 1816 my($self, $n) = @_;
634 22         38 $n -= 1;
635 22         499 my(@rdn) = $self -> stack -> print;
636              
637 22 100 66     363 return ( ($n < 0) || ($n > $#rdn) ) ? '' : ${$rdn[$n]}{type};
  21         85  
638              
639             } # End of rdn_type.
640              
641             # ------------------------------------------------
642              
643             sub rdn_types
644             {
645 26     26 1 113 my($self, $n) = @_;
646 26         38 $n -= 1;
647 26         571 my(@rdn) = $self -> stack -> print;
648              
649 26         304 my(@result);
650              
651 26 100 66     158 return @result if ( ($n < 0) || ($n > $#rdn) );
652              
653 25         46 my(@bits) = split(/\+/, "${$rdn[$n]}{type}=${$rdn[$n]}{value}");
  25         71  
  25         97  
654 25         97 my(@parts) = map{split(/=/, $_)} @bits;
  32         117  
655              
656 25         87 for my $i (0 .. $#parts)
657             {
658 62 100       212 push @result, $parts[$i] if ( ($i % 2) == 0);
659             }
660              
661 25         125 return @result;
662              
663             } # End of rdn_types.
664              
665             # ------------------------------------------------
666              
667             sub rdn_value
668             {
669 22     22 1 107 my($self, $n) = @_;
670 22         42 $n -= 1;
671 22         515 my(@rdn) = $self -> stack -> print;
672 22         278 my($result) = '';
673              
674 22 100 66     121 if ( ($n >= 0) && ($n <= $#rdn) )
675             {
676             # This returns '' for an RDN of 'x='. See *::Actions.attribute_value().
677              
678 21         31 $result = ${$rdn[$n]}{value};
  21         62  
679             }
680              
681 22         67 return $result;
682              
683             } # End of rdn_value.
684              
685             # ------------------------------------------------
686              
687             sub rdn_values
688             {
689 33     33 1 2427 my($self, $type) = @_;
690 33         67 $type = lc $type;
691              
692 33         59 my(@result);
693              
694 33         888 for my $rdn ($self -> stack -> print)
695             {
696 87 100       646 push @result, $$rdn{value} if ($$rdn{type} eq $type);
697             }
698              
699 33         140 return @result;
700              
701             } # End of rdn_values.
702              
703             # ------------------------------------------------
704              
705             1;
706              
707             =pod
708              
709             =encoding utf8
710              
711             =head1 NAME
712              
713             C - Parse X.500 DNs
714              
715             =head1 Synopsis
716              
717             #!/usr/bin/env perl
718              
719             use strict;
720             use warnings;
721              
722             use X500::DN::Marpa ':constants';
723              
724             # -----------
725              
726             my(%count) = (fail => 0, success => 0, total => 0);
727             my($parser) = X500::DN::Marpa -> new
728             (
729             options => long_descriptors,
730             );
731             my(@text) =
732             (
733             q||,
734             q|1.4.9=2001|,
735             q|cn=Nemo,c=US|,
736             q|cn=Nemo, c=US|,
737             q|cn = Nemo, c = US|,
738             q|cn=John Doe, o=Acme, c=US|,
739             q|cn=John Doe, o=Acme\\, Inc., c=US|,
740             q|x= |,
741             q|x=\\ |,
742             q|x = \\ |,
743             q|x=\\ \\ |,
744             q|x=\\#\"\\41|,
745             q|x=#616263|,
746             q|SN=Lu\C4\8Di\C4\87|, # 'Lučić'.
747             q|foo=FOO + bar=BAR + frob=FROB, baz=BAZ|,
748             q|UID=jsmith,DC=example,DC=net|,
749             q|OU=Sales+CN=J. Smith,DC=example,DC=net|,
750             q|CN=James \"Jim\" Smith\, III,DC=example,DC=net|,
751             q|CN=Before\0dAfter,DC=example,DC=net|,
752             q|1.3.6.1.4.1.1466.0=#04024869|,
753             q|UID=nobody@example.com,DC=example,DC=com|,
754             q|CN=John Smith,OU=Sales,O=ACME Limited,L=Moab,ST=Utah,C=US|,
755             );
756              
757             my($result);
758              
759             for my $text (@text)
760             {
761             $count{total}++;
762              
763             print "# $count{total}. Parsing |$text|. \n";
764              
765             $result = $parser -> parse($text);
766              
767             print "Parse result: $result (0 is success)\n";
768              
769             if ($result == 0)
770             {
771             $count{success}++;
772              
773             for my $item ($parser -> stack -> print)
774             {
775             print "$$item{type} = $$item{value}. count = $$item{count}. \n";
776             }
777              
778             print 'DN: ', $parser -> dn, ". \n";
779             print 'OpenSSL DN: ', $parser -> openssl_dn, ". \n";
780             }
781              
782             print '-' x 50, "\n";
783             }
784              
785             $count{fail} = $count{total} - $count{success};
786              
787             print "\n";
788             print 'Statistics: ', join(', ', map{"$_ => $count{$_}"} sort keys %count), ". \n";
789              
790             See scripts/synopsis.pl.
791              
792             This is part of the printout of synopsis.pl:
793              
794             # 3. Parsing |cn=Nemo,c=US|.
795             Parse result: 0 (0 is success)
796             commonName = Nemo. count = 1.
797             countryName = US. count = 1.
798             DN: countryName=US,commonName=Nemo.
799             OpenSSL DN: commonName=Nemo+countryName=US.
800             --------------------------------------------------
801             ...
802             --------------------------------------------------
803             # 13. Parsing |x=#616263|.
804             Parse result: 0 (0 is success)
805             x = #616263. count = 1.
806             DN: x=#616263.
807             OpenSSL DN: x=#616263.
808             --------------------------------------------------
809             ...
810             --------------------------------------------------
811             # 15. Parsing |foo=FOO + bar=BAR + frob=FROB, baz=BAZ|.
812             Parse result: 0 (0 is success)
813             foo = FOO+bar=BAR+frob=FROB. count = 3.
814             baz = BAZ. count = 1.
815             DN: baz=BAZ,foo=FOO+bar=BAR+frob=FROB.
816             OpenSSL DN: foo=FOO+bar=BAR+frob=FROB+baz=BAZ.
817              
818             If you set the option C, as discussed in the L, then case 13 will print:
819              
820             # 13. Parsing |x=#616263|.
821             Parse result: 0 (0 is success)
822             x = abc. count = 1.
823             DN: x=abc.
824             OpenSSL DN: x=abc.
825              
826             =head1 Description
827              
828             C provides a L-based parser for parsing X.500 Distinguished Names.
829              
830             It is based on L:
831             Lightweight Directory Access Protocol (LDAP): String Representation of Distinguished Names.
832              
833             =head1 Distributions
834              
835             This module is available as a Unix-style distro (*.tgz).
836              
837             See L
838             for help on unpacking and installing distros.
839              
840             =head1 Installation
841              
842             Install C as you would any C module:
843              
844             Run:
845              
846             cpanm X500::DN::Marpa
847              
848             or run:
849              
850             sudo cpan X500::DN::Marpa
851              
852             or unpack the distro, and then either:
853              
854             perl Build.PL
855             ./Build
856             ./Build test
857             sudo ./Build install
858              
859             or:
860              
861             perl Makefile.PL
862             make (or dmake or nmake)
863             make test
864             make install
865              
866             =head1 Constructor and Initialization
867              
868             C is called as C<< my($parser) = X500::DN::Marpa -> new(k1 => v1, k2 => v2, ...) >>.
869              
870             It returns a new object of type C.
871              
872             Key-value pairs accepted in the parameter list (see corresponding methods for details
873             [e.g. L]):
874              
875             =over 4
876              
877             =item o options => $bit_string
878              
879             This allows you to turn on various options.
880              
881             Default: 0 (nothing is fatal).
882              
883             See the L for details.
884              
885             =item o text => $a_string_to_be_parsed
886              
887             Default: ''.
888              
889             =back
890              
891             =head1 Methods
892              
893             =head2 bnf()
894              
895             Returns a string containing the grammar used by this module.
896              
897             =head2 dn()
898              
899             Returns the RDNs, separated by commas, as a single string in the reverse order compared with the
900             order of the RNDs in the input text.
901              
902             The order reversal is discussed in section 2.1 of L.
903              
904             Hence 'cn=Nemo, c=US' is returned as 'countryName=US,commonName=Nemo' (when the
905             C option is used), and as 'c=US,cn=Nemo' by default.
906              
907             See also L.
908              
909             =head2 error_message()
910              
911             Returns the last error or warning message set.
912              
913             Error messages always start with 'Error: '. Messages never end with "\n".
914              
915             Parsing error strings is not a good idea, ever though this module's format for them is fixed.
916              
917             See L.
918              
919             =head2 error_number()
920              
921             Returns the last error or warning number set.
922              
923             Warnings have values < 0, and errors have values > 0.
924              
925             If the value is > 0, the message has the prefix 'Error: ', and if the value is < 0, it has the
926             prefix 'Warning: '. If this is not the case, it's a reportable bug.
927              
928             Possible values for error_number() and error_message():
929              
930             =over 4
931              
932             =item o 0 => ""
933              
934             This is the default value.
935              
936             =item o 1/-1 => "Parse exhausted"
937              
938             If L returns 1, it's an error, and if it returns -1 it's a warning.
939              
940             You can set the option C to make it fatal.
941              
942             =item o 2/-2 => "Ambiguous parse. Status: $status. Terminals expected: a, b, ..."
943              
944             This message is only produced when the parse is ambiguous.
945              
946             If L returns 2, it's an error, and if it returns -2 it's a warning.
947              
948             You can set the option C to make it fatal.
949              
950             =back
951              
952             See L.
953              
954             =head2 new()
955              
956             See L for details on the parameters accepted by L.
957              
958             =head2 openssl_dn()
959              
960             Returns the RDNs, separated by pluses, as a single string in the same order compared with the
961             order of the RNDs in the input text.
962              
963             Hence 'cn=Nemo, c=US' is returned as 'commonName=Nemo+countryName=US' (when the
964             C option is used), and as 'cn=Nemo+c=US' by default.
965              
966             See also L.
967              
968             =head2 options([$bit_string])
969              
970             Here, the [] indicate an optional parameter.
971              
972             Get or set the option flags.
973              
974             For typical usage, see scripts/synopsis.pl.
975              
976             See the L for details.
977              
978             'options' is a parameter to L. See L for details.
979              
980             =head2 parse([$string])
981              
982             Here, the [] indicate an optional parameter.
983              
984             This is the only method the user needs to call. All data can be supplied when calling L.
985              
986             You can of course call other methods (e.g. L ) after calling L but
987             before calling C.
988              
989             Note: If a string is passed to C, it takes precedence over any string passed to
990             C<< new(text => $string) >>, and over any string passed to L. Further,
991             the string passed to C is passed to L, meaning any subsequent
992             call to C returns the string passed to C.
993              
994             See scripts/synopsis.pl.
995              
996             Returns 0 for success and 1 for failure.
997              
998             If the value is 1, you should call L to find out what happened.
999              
1000             =head2 rdn($n)
1001              
1002             Returns a string containing the $n-th RDN, or returns '' if $n is out of range.
1003              
1004             $n counts from 1.
1005              
1006             If the input is 'UID=nobody@example.com,DC=example,DC=com', C returns
1007             'uid=nobody@example.com'. Note the lower-case 'uid'.
1008              
1009             See t/dn.t.
1010              
1011             =head2 rdn_count($n)
1012              
1013             Returns a string containing the $n-th RDN's count (multivalue indicator), or returns 0 if $n is out
1014             of range.
1015              
1016             $n counts from 1.
1017              
1018             If the input is 'UID=nobody@example.com,DC=example,DC=com', C returns 1.
1019              
1020             If the input is 'foo=FOO+bar=BAR+frob=FROB, baz=BAZ', C returns 3.
1021              
1022             Not to be confused with L.
1023              
1024             See t/dn.t.
1025              
1026             =head2 rdn_number()
1027              
1028             Returns the number of RDNs, which may be 0.
1029              
1030             If the input is 'UID=nobody@example.com,DC=example,DC=com', C returns 3.
1031              
1032             Not to be confused with L.
1033              
1034             See t/dn.t.
1035              
1036             =head2 rdn_type($n)
1037              
1038             Returns a string containing the $n-th RDN's attribute type, or returns '' if $n is out of range.
1039              
1040             $n counts from 1.
1041              
1042             If the input is 'UID=nobody@example.com,DC=example,DC=com', C returns 'uid'.
1043              
1044             See t/dn.t.
1045              
1046             =head2 rdn_types($n)
1047              
1048             Returns an array containing all the types of all the RDNs for the given RDN, or returns () if $n is
1049             out of range.
1050              
1051             $n counts from 1.
1052              
1053             If the DN is 'foo=FOO+bar=BAR+frob=FROB, baz=BAZ', C returns ('foo', 'bar', frob').
1054              
1055             See t/dn.t.
1056              
1057             =head2 rdn_value($n)
1058              
1059             Returns a string containing the $n-th RDN's attribute value, or returns '' if $n is out of
1060             range.
1061              
1062             $n counts from 1.
1063              
1064             If the input is 'UID=nobody@example.com,DC=example,DC=com', C returns
1065             'nobody@example.com'.
1066              
1067             See t/dn.t.
1068              
1069             =head2 rdn_values($type)
1070              
1071             Returns an array containing the RDN attribute values for the attribute type $type, or ().
1072              
1073             If the input is 'UID=nobody@example.com,DC=example,DC=com', C returns
1074             ('example', 'com').
1075              
1076             See t/dn.t.
1077              
1078             =head2 stack()
1079              
1080             Returns an object of type L, which holds the parsed data.
1081              
1082             Obviously, it only makes sense to call C after calling L.
1083              
1084             The structure of elements in this stack is documented in the L.
1085              
1086             See scripts/tiny.pl for sample code.
1087              
1088             =head2 text([$string])
1089              
1090             Here, the [] indicate an optional parameter.
1091              
1092             Get or set a string to be parsed.
1093              
1094             'text' is a parameter to L. See L for details.
1095              
1096             =head1 FAQ
1097              
1098             =head2 Where are the error messages and numbers described?
1099              
1100             See L and L.
1101              
1102             See also L below.
1103              
1104             =head2 What is the structure in RAM of the parsed data?
1105              
1106             The module outputs a stack, which is an object of type L. See L.
1107              
1108             Elements in this stack are in the same order as the RDNs are in the input string.
1109              
1110             The L method returns the RDNs, separated by commas, as a single string in the reverse order,
1111             whereas L separates them by pluses and uses the original order.
1112              
1113             Each element of this stack is a hashref, with these (key => value) pairs:
1114              
1115             =over 4
1116              
1117             =item o count => $number
1118              
1119             The number of attribute types and values in a (possibly multivalued) RDN.
1120              
1121             $number counts from 1.
1122              
1123             =item o type => $type
1124              
1125             The attribute type.
1126              
1127             =item o value => $value
1128              
1129             The attribute value.
1130              
1131             =back
1132              
1133             Sample DNs:
1134              
1135             Note: These examples assume the default case of the option C (discussed below)
1136             I being used.
1137              
1138             If the input is 'UID=nobody@example.com,DC=example,DC=com', the stack will contain:
1139              
1140             =over 4
1141              
1142             =item o [0]: {count => 1, type => 'uid', value => 'nobody@example.com'}
1143              
1144             =item o [1]: {count => 1, type => 'dc', value => 'example'}
1145              
1146             =item o [2]: {count => 1, type => 'dc', value => 'com'}
1147              
1148             =back
1149              
1150             If the input is 'foo=FOO+bar=BAR+frob=FROB, baz=BAZ', the stack will contain:
1151              
1152             =over 4
1153              
1154             =item o [0]: {count => 3, type => 'foo', value => 'FOO+bar=BAR+frob=FROB'}
1155              
1156             =item o [1]: {count => 1, type => 'baz', value => 'BAZ'}
1157              
1158             =back
1159              
1160             Sample Code:
1161              
1162             A typical script uses code like this (copied from scripts/tiny.pl):
1163              
1164             $result = $parser -> parse($text);
1165              
1166             print "Parse result: $result (0 is success)\n";
1167              
1168             if ($result == 0)
1169             {
1170             for my $item ($parser -> stack -> print)
1171             {
1172             print "$$item{type} = $$item{value}. count = $$item{count}. \n";
1173             }
1174             }
1175              
1176             If the option C is I used in the call to L, then $$item{type}
1177             defaults to lower-case. L says 'Short names are case
1178             insensitive....'. I've chosen to use lower-case as the canonical form output by my code.
1179              
1180             If that option I used, then some types are output in mixed case. The list of such types is given
1181             in section 3 (at the top of page 6) in L. This
1182             document is one of those listed in L, below.
1183              
1184             For a discussion of the mixed-case descriptors, see
1185             L below.
1186              
1187             An extended list of such long descriptors is given in section 4 (page 25) in
1188             L. Note that 'streetAddress' is missing from this
1189             list.
1190              
1191             =head2 What are the possible values for the 'options' parameter to new()?
1192              
1193             Firstly, to make these constants available, you must say:
1194              
1195             use X500::DN::Marpa ':constants';
1196              
1197             Secondly, more detail on errors and warnings can be found at L.
1198              
1199             Thirdly, for usage of these option flags, see scripts/synopsis.pl and scripts/tiny.pl.
1200              
1201             Now the flags themselves:
1202              
1203             =over 4
1204              
1205             =item o nothing_is_fatal
1206              
1207             This is the default.
1208              
1209             C has the value of 0.
1210              
1211             =item o print_errors
1212              
1213             Print error messages if this flag is set.
1214              
1215             C has the value of 1.
1216              
1217             =item o print_warnings
1218              
1219             Print various warnings if this flag is set:
1220              
1221             =over 4
1222              
1223             =item o The ambiguity status and terminals expected, if the parse is ambiguous
1224              
1225             =item o See L for other warnings which might be printed
1226              
1227             Ambiguity is not, in and of itself, an error. But see the C option, below.
1228              
1229             =back
1230              
1231             It's tempting to call this option C, but Perl already has C, so I didn't.
1232              
1233             C has the value of 2.
1234              
1235             =item o print_debugs
1236              
1237             Print extra stuff if this flag is set.
1238              
1239             C has the value of 4.
1240              
1241             =item o ambiguity_is_fatal
1242              
1243             This makes L return 2 rather than -2.
1244              
1245             C has the value of 8.
1246              
1247             =item o exhaustion_is_fatal
1248              
1249             This makes L return 1 rather than -1.
1250              
1251             C has the value of 16.
1252              
1253             =item o long_descriptors
1254              
1255             This makes the C key in the output stack's elements contain long descriptor names rather than
1256             abbreviations.
1257              
1258             For example, if the input was 'cn=Nemo,c=US', the output stack would contain, I, i.e.
1259             without setting this option:
1260              
1261             =over 4
1262              
1263             =item o [0]: {count => 1, type => 'cn', value => 'Nemo'}
1264              
1265             =item o [1]: {count => 1, type => 'c', value => 'US'}
1266              
1267             =back
1268              
1269             However, if this option is set, the output will contain:
1270              
1271             =over 4
1272              
1273             =item o [0]: {count => 1, type => 'commonName', value => 'Nemo'}
1274              
1275             =item o [1]: {count => 1, type => 'countryName', value => 'US'}
1276              
1277             =back
1278              
1279             C has the value of 32.
1280              
1281             =item o return_hex_as_chars
1282              
1283             This triggers extra processing of attribute values which start with '#':
1284              
1285             =over 4
1286              
1287             =item o The value is assumed to consist entirely of hex digits (after the '#' is discarded)
1288              
1289             =item o The digits are converted 2 at-a-time into a string of (presumably ASCII) characters
1290              
1291             =item o These characters are concatenated into a single string, which becomes the new value
1292              
1293             =back
1294              
1295             So, if this option is I used, 'x=#616263' is parsed as {type => 'x', value => '#616263'},
1296             but if the option I used, you get {type => 'x', value => 'abc'}.
1297              
1298             C has the value of 64.
1299              
1300             =back
1301              
1302             =head2 Does this package support Unicode/UTF8?
1303              
1304             Handling of UTF8 is discussed in one of the RFCs listed in L, below.
1305              
1306             =head2 What is the homepage of Marpa?
1307              
1308             L.
1309              
1310             That page has a long list of links.
1311              
1312             =head2 How do I run author tests?
1313              
1314             This runs both standard and author tests:
1315              
1316             shell> perl Build.PL; ./Build; ./Build authortest
1317              
1318             =head1 References
1319              
1320             I found RFCs 4514 and 4512 to be the most directly relevant ones.
1321              
1322             L: The Index. Just search for 'LDAP'.
1323              
1324             L:
1325             Lightweight Directory Access Protocol (LDAP): String Representation of Distinguished Names.
1326              
1327             L:
1328             Lightweight Directory Access Protocol (LDAP): Directory Information Models.
1329              
1330             L:
1331             Lightweight Directory Access Protocol (LDAP): Syntaxes and Matching Rules.
1332              
1333             L:
1334             Augmented BNF for Syntax Specifications: ABNF.
1335              
1336             L: UTF-8, a transformation format of ISO 10646.
1337              
1338             RFC4514 also discusses UTF8. Search it using the string 'UTF-8'.
1339              
1340             =head1 See Also
1341              
1342             L. Note: This module is based on the obsolete
1343             L.
1344              
1345             =head1 Machine-Readable Change Log
1346              
1347             The file Changes was converted into Changelog.ini by L.
1348              
1349             =head1 Version Numbers
1350              
1351             Version numbers < 1.00 represent development versions. From 1.00 up, they are production versions.
1352              
1353             =head1 Repository
1354              
1355             L
1356              
1357             =head1 Support
1358              
1359             Email the author, or log a bug on RT:
1360              
1361             L.
1362              
1363             =head1 Author
1364              
1365             L was written by Ron Savage Iron@savage.net.auE> in 2015.
1366              
1367             Marpa's homepage: L.
1368              
1369             My homepage: L.
1370              
1371             =head1 Copyright
1372              
1373             Australian copyright (c) 2015, Ron Savage.
1374              
1375             All Programs of mine are 'OSI Certified Open Source Software';
1376             you can redistribute them and/or modify them under the terms of
1377             The Artistic License 2.0, a copy of which is available at:
1378             http://opensource.org/licenses/alphabetical.
1379              
1380             =cut