Differentiate normal and base64 DN

META6.json

@@ -1,8 +1,12 @@
 {
   "name": "Text::LDIF",
   "description": "Pure Perl6 LDIF file parser",
-  "version": "1.0",
+  "version": "1.0.5",
   "perl": "6.c",
+  "authors": [
+    "Sylwester Lunski",
+    "Alexander Kiryuhin"
+  ],
   "auth": "github:slunski",
   "depends": [],
   "test-depends": [
@@ -14,7 +18,6 @@
     "Text::LDIF::Grammar": "lib/Text/LDIF/Grammar.pm6"
   },
   "license": "Artistic-2.0",
-  "source-url": "git://github.com/slunski/perl6-text-ldif.git",
-  "author": "Sylwester Lunski",
+  "source-url": "git://github.com/Altai-man/perl6-text-ldif.git",
   "repo-type": "git"
 }

README.md

@@ -117,9 +117,7 @@ if $result {
 }
 ```
 
-BUGS:
+### Authors
 
-Grammar for basic attributes values use just \N* pattern so some
-invalid values (eg. binary numbers with invalid format) are accepted.
-If database don't allow such values they will be rejected during
-import.
+* The original module was developed by @slunski
+* Current fork was started by @Altai-man who introduced some compatibility breaking changes

lib/Text/LDIF/Actions.pm6

@@ -2,7 +2,7 @@ use v6;
 
 class Text::LDIF::Actions {
 	method TOP($/) {
-		my %attrs = version => ~$<version-spec>[0];
+		my %attrs = version => $<version-spec>[0].Int;
 
 		with $<ldif-changes> {
 			%attrs<changes> = .made;
@@ -25,36 +25,33 @@ class Text::LDIF::Actions {
 		my %attrs;
 		for $attributes.kv -> $k, $v {
 			if $v.elems == 1 {
-				%attrs{$k} = $v[0].value;
+				%attrs{$k} = $v[0];
 			} else {
-				if $v.map(*.key eq '').all {
-					%attrs{$k} = $v.map(*.value);
-				} else {
-					%attrs{$k} = $v.Hash;
-				}
+				%attrs{$k} = $v.List;
 			}
 		}
+		if %attrs.elems == 1 {
+			# We have only single key, so return a single Pair
+			return %attrs.keys[0] => %attrs{%attrs.keys[0]};
+		}
 		%attrs;
 	}
 
 	method dn-spec($/) {
 		with $<distinguishedName> {
 			make .Str;
 		} orwith $<base64-distinguishedName> {
-			make .Str;
+			make Pair.new('base64', .Str);
 		}
 	}
 
 	method attrval-spec($/) {
 		with $<AttributeDescription> -> $attr {
-			my @options;
-			with $attr<options> {
-				@options.push($_.Str) for $_<option>;
-			}
-			my $options-key = @options.join(',');
+			my $attribute = $attr<AttributeType>.Str;
+			# If attribute has options, add those too
+			$attribute ~= ';' ~ $_.Str with $attr<options>;
 			my $value = $<value-spec>.made;
-			my $optioned-value = Pair.new($options-key // '', $value);
-			make Pair.new(~$attr<AttributeType>, $optioned-value);
+			make Pair.new($attribute, $value);
 		}
 	}
 
@@ -106,13 +103,9 @@ class Text::LDIF::Actions {
 	method mod-spec($/) {
 		my $attribute;
 		with $<AttributeDescription> -> $attr {
-			my @options;
-			with $attr<options> {
-				@options.push($_.Str) for $_<option>;
-			}
-			my $options-key = @options.join(',');
-			my $attribute-str = ~$attr<AttributeType>;
-			$attribute = $options-key ?? Pair.new($attribute-str, $options-key) !! $attribute-str;
+            $attribute = $attr<AttributeType>.Str;
+			# if attribute has options, add them too
+            $attribute ~= ';' ~ $_.Str with $attr<options>;
 		}
 		my $vals = $<attrval-spec>>>.made.classify(*.key, as => *.value);
 		if $vals {
@@ -124,9 +117,19 @@ class Text::LDIF::Actions {
 	}
 
 	method change-moddn($/) {
-		my $newrdn = ~($<rdn> // $<base64-rdn>);
+		my $newrdn;
+		with $<rdn> {
+			$newrdn = ~$_;
+		} orwith $<base64-rdn> {
+			$newrdn = base64 => ~$_;
+		}
 		my $delete-on-rdn = $<del-on-rdn> eq '1';
-		my $newsuperior = $<distinguishedName> // $<base64-distinguishedName>;
+		my $newsuperior;
+		with $<distinguishedName> {
+			$newsuperior = ~$_;
+		} orwith $<base64-distinguishedName> {
+			$newsuperior = base64 => ~$_;
+		}
 		make Pair.new('moddn', %(:$newrdn, :$delete-on-rdn, :$newsuperior));
 	}
 }

t/01.t

@@ -12,37 +12,38 @@ sub check-parses(Str $fn, &check) {
 }
 
 check-parses '1', -> $r {
-    is $r<version>, 1, "Version is correct";
+    is-deeply $r<version>, 1, "Version is correct";
     my $recs = $r<entries>;
-    is $recs.elems, 2, "Two entries were read";
+    is-deeply $recs.elems, 2, "Two entries were read";
 
-    is $recs[0]<dn>, 'cn=Barbara Jensen, ou=Product Development, dc=airius, dc=com', "DN is correct for first entry";
+    is-deeply $recs[0]<dn>, 'cn=Barbara Jensen, ou=Product Development, dc=airius, dc=com', "DN is correct for first entry";
     my $rec-attrs = $recs[0]<attrs>;
-    is $rec-attrs<objectclass>, <top person organizationalPerson>, "objectclass multi-values are concatenated";
-    is $rec-attrs<sn>, 'Jensen', "sn is correct";
-    is $rec-attrs<telephonenumber>, '+1 408 555 1212', 'phonenumber is read ok';
+    is-deeply $rec-attrs<objectclass>, <top person organizationalPerson>, "objectclass multi-values are concatenated";
+    is-deeply $rec-attrs<sn>, 'Jensen', "sn is correct";
+    is-deeply $rec-attrs<telephonenumber>, '+1 408 555 1212', 'phonenumber is read ok';
 
-    is $recs[1]<dn>, 'cn=Bjorn Jensen, ou=Accounting, dc=airius, dc=com', 'DN is correct for second entry';
+    is-deeply $recs[1]<dn>, 'cn=Bjorn Jensen, ou=Accounting, dc=airius, dc=com', 'DN is correct for second entry';
     $rec-attrs = $recs[1]<attrs>;
-    is $rec-attrs<objectclass>, <top person organizationalPerson>, 'objectclass multi-values are concatenated';
+    is-deeply $rec-attrs<objectclass>, <top person organizationalPerson>, 'objectclass multi-values are concatenated';
 }
 
 check-parses '2', -> $r {
-    is $r<entries>[0]<attrs><description>, 'Babs is a big sailing fan, and travels extensively in search of perfect sailing conditions.',
+    is-deeply $r<entries>[0]<attrs><description>, 'Babs is a big sailing fan, and travels extensively in search of perfect sailing conditions.',
             'folded description was concatenated';
 }
 
 check-parses '3', -> $r {
-     is $r<entries>[0]<attrs><description>, Pair.new('base64', 'V2hhdCBhIGNhcmVmdWwgcmVhZGVyIHlvdSBhcmUhICBUaGlzIHZhbHVlIGlzIGJhc2UtNjQtZW5jb2RlZCBiZWNhdXNlIGl0IGhhcyBhIGNvbnRyb2wgY2hhcmFjdGVyIGluIGl0IChhIENSKS4NICBCeSB0aGUgd2F5LCB5b3Ugc2hvdWxkIHJlYWxseSBnZXQgb3V0IG1vcmUu'),
+     is-deeply $r<entries>[0]<attrs><description>, Pair.new('base64', 'V2hhdCBhIGNhcmVmdWwgcmVhZGVyIHlvdSBhcmUhICBUaGlzIHZhbHVlIGlzIGJhc2UtNjQtZW5jb2RlZCBiZWNhdXNlIGl0IGhhcyBhIGNvbnRyb2wgY2hhcmFjdGVyIGluIGl0IChhIENSKS4NICBCeSB0aGUgd2F5LCB5b3Ugc2hvdWxkIHJlYWxseSBnZXQgb3V0IG1vcmUu'),
             'base64 value is read';
 }
 
 check-parses '4', -> $r {
-    my $ou = $r<entries>[0]<attrs><ou>;
-    is-deeply $ou{''}, Pair.new('base64', '5Za25qWt6YOo'), "Option-less attribute";
-    is-deeply $ou<lang-en>, 'Sales', "Simple option attribute";
-    is-deeply $ou<lang-ja>, Pair.new('base64', '5Za25qWt6YOo'), 'BASE64 option attribute';
-    is-deeply $ou<lang-ja,phonetic>, Pair.new('base64', '44GI44GE44GO44KH44GG44G2'), 'Multi-option attribute';
+    my $entry = $r<entries>[0];
+    is-deeply $entry<dn>, Pair.new('base64', 'b3U95Za25qWt6YOoLG89QWlyaXVz'), 'Base64 is expressed as Pair';
+    is-deeply $entry<attrs><ou>, Pair.new('base64', '5Za25qWt6YOo'), "Option-less attribute";
+    is-deeply $entry<attrs><ou;lang-en>, 'Sales', "Simple option attribute";
+    is-deeply $entry<attrs><ou;lang-ja>, Pair.new('base64', '5Za25qWt6YOo'), 'BASE64 option attribute';
+    is-deeply $entry<attrs><ou;lang-ja;phonetic>, Pair.new('base64', '44GI44GE44GO44KH44GG44G2'), 'Multi-option attribute';
 }
 
 check-parses '5', -> $r {
@@ -54,39 +55,39 @@ check-parses '6', -> $r {
 
     my $change = $changes[0];
     is-deeply $change<dn>, 'cn=Fiona Jensen, ou=Marketing, dc=airius, dc=com';
-    is $change<change>.key, 'add';
-    is $change<change>.value<cn>, 'Fiona Jensen';
+    is-deeply $change<change>.key, 'add';
+    is-deeply $change<change>.value<cn>, 'Fiona Jensen';
     is-deeply $change<change>.value<jpegphoto>, Pair.new('file', 'file://foo.jpg');
     is-deeply $change<controls>, [];
 
     $change = $changes[1];
-    is $change<change>, 'delete';
+    is-deeply $change<change>, 'delete';
 
     $change = $changes[2];
-    is $change<change>.key, 'moddn';
+    is-deeply $change<change>.key, 'moddn';
     ok $change<change><moddn><delete-on-rdn>;
-    is $change<change><moddn><newrdn>, 'cn=Paula Jensen';
+    is-deeply $change<change><moddn><newrdn>, 'cn=Paula Jensen';
 
     $change = $changes[3];
-    is $change<change>.key, 'moddn';
+    is-deeply $change<change>.key, 'moddn';
     nok $change<change><moddn><delete-on-rdn>;
-    is $change<change><moddn><newrdn>, 'ou=Product Development Accountants';
+    is-deeply $change<change><moddn><newrdn>, 'ou=Product Development Accountants';
 
     $change = $changes[4];
-    is $change<change>.key, 'modify';
-    is $change<change><modify>[0], Pair.new('add', Pair.new('postaladdress', '123 Anystreet $ Sunnyvale, CA $ 94086'));
-    is $change<change><modify>[1], Pair.new('delete', 'description');
-    is $change<change><modify>[2], Pair.new('replace', Pair.new('telephonenumber', ('+1 408 555 1234', '+1 408 555 5678')));
+    is-deeply $change<change>.key, 'modify';
+    is-deeply $change<change><modify>[0], Pair.new('add', Pair.new('postaladdress', '123 Anystreet $ Sunnyvale, CA $ 94086'));
+    is-deeply $change<change><modify>[1], Pair.new('delete', 'description');
+    is-deeply $change<change><modify>[2], Pair.new('replace', Pair.new('telephonenumber', ('+1 408 555 1234', '+1 408 555 5678')));
 
     $change = $changes[5];
-    is $change<change>.key, 'modify';
-    is $change<change><modify>[0], Pair.new('replace', 'postaladdress');
-    is $change<change><modify>[1], Pair.new('delete', 'description');
+    is-deeply $change<change>.key, 'modify';
+    is-deeply $change<change><modify>[0], Pair.new('replace', 'postaladdress');
+    is-deeply $change<change><modify>[1], Pair.new('delete', 'description');
 }
 
 check-parses '7', -> $r {
-    is $r<changes>[0]<dn>, 'ou=Product Development, dc=airius, dc=com';
-    is $r<changes>[0]<controls>[0]<ldap-oid>, '1.2.840.113556.1.4.805';
+    is-deeply $r<changes>[0]<dn>, 'ou=Product Development, dc=airius, dc=com';
+    is-deeply $r<changes>[0]<controls>[0]<ldap-oid>, '1.2.840.113556.1.4.805';
     ok $r<changes>[0]<controls>[0]<criticality>;
 }