| 1 | #!/usr/bin/perl -w
|
|---|
| 2 | #
|
|---|
| 3 | # Convert OpenLDAP schema files into Fedora DS format with RFC2252 compliant printing
|
|---|
| 4 | #
|
|---|
| 5 | # First Release : Mike Jackson <mj@sci.fi> 14 June 2005
|
|---|
| 6 | # http://www.netauth.com/~jacksonm/ldap/ol-schema-migrate.pl
|
|---|
| 7 | # Professional LDAP consulting for large and small projects
|
|---|
| 8 | #
|
|---|
| 9 | # - 6 Dec 2005
|
|---|
| 10 | # - objectclass element ordering
|
|---|
| 11 | #
|
|---|
| 12 | # Second Release : Alyseo <info@alyseo.com> 05 Februrary 2006
|
|---|
| 13 | # Francois Billard <francois@alyseo.com>
|
|---|
| 14 | # Yacine Kheddache <yacine@alyseo.com>
|
|---|
| 15 | # http://www.alyseo.com/
|
|---|
| 16 | #
|
|---|
| 17 | # - 05 Februrary 2006
|
|---|
| 18 | # - parsing improvement to accept non-RFC compliant schemas (like ISPMAN)
|
|---|
| 19 | # - adding RFC element : Usage, No-user-modification, collective keywords
|
|---|
| 20 | # - 08 Februrary 2006
|
|---|
| 21 | # - adding help & usage
|
|---|
| 22 | # - now this script can also beautify your schemas: "-b"
|
|---|
| 23 | # - count attributes and objects class: "-c"
|
|---|
| 24 | # - display items that can not be converted (empty OID...): "-d"
|
|---|
| 25 | # - 15 February 2006
|
|---|
| 26 | # - adding workaround for Fedora DS bug 181465:
|
|---|
| 27 | # https://bugzilla.redhat.com/bugzilla/show_bug.cgi?id=181465
|
|---|
| 28 | # - adding duplicated OID check: "-d"
|
|---|
| 29 | # Useful to manually correct nasty schemas like:
|
|---|
| 30 | # https://sourceforge.net/tracker/?func=detail&atid=108390&aid=1429276&group_id=8390
|
|---|
| 31 | # - 13 September 2007
|
|---|
| 32 | # Based on Samba Team GPL Compliance Officer request, license has been updated from
|
|---|
| 33 | # GPL to GPLv3+
|
|---|
| 34 | #
|
|---|
| 35 | # - Fedora DS bug you need to correct by hand :
|
|---|
| 36 | # https://bugzilla.redhat.com/bugzilla/show_bug.cgi?id=179956
|
|---|
| 37 | #
|
|---|
| 38 | # GPLv3+ license
|
|---|
| 39 | #
|
|---|
| 40 |
|
|---|
| 41 | my $optionCount = 0;
|
|---|
| 42 | my $optionPrint = 0;
|
|---|
| 43 | my $optionBadEntries = 0;
|
|---|
| 44 | my $optionHelp = 0;
|
|---|
| 45 | my $filename = "" ;
|
|---|
| 46 |
|
|---|
| 47 | foreach (@ARGV) {
|
|---|
| 48 | $optionHelp = 1 if ( /^-h$/);
|
|---|
| 49 | $optionCount = 1 if ( /^-c$/);
|
|---|
| 50 | $optionPrint = 1 if ( /^-b$/);
|
|---|
| 51 | $optionBadEntries = 1 if ( /^-d$/);
|
|---|
| 52 | $filename = $_ if ( ! /^-b$/ && ! /^-c$/ && ! /^-d$/);
|
|---|
| 53 | }
|
|---|
| 54 |
|
|---|
| 55 | die "Usage : ol-schema-migrate-v2.pl [ -c ] [ -b ] [ -d ] schema\n" .
|
|---|
| 56 | " -c\tcount attribute and object class\n" .
|
|---|
| 57 | " -b\tconvert and beautify your schema\n" .
|
|---|
| 58 | " -d\tdisplay unrecognized elements, find empty and duplicated OID\n" .
|
|---|
| 59 | " -h\tthis help\n" if ($filename eq "" || ($optionHelp || (!$optionCount && !$optionPrint && !$optionBadEntries)));
|
|---|
| 60 |
|
|---|
| 61 | if($optionCount) {
|
|---|
| 62 | print "Schema verification counters:\n";
|
|---|
| 63 | my $ldapdata = &getSourceFile($filename);
|
|---|
| 64 | print "".(defined($ldapdata->{attributes}) ? @{$ldapdata->{attributes}} : 0) . " attributes\n";
|
|---|
| 65 | print "".(defined($ldapdata->{objectclass}) ? @{$ldapdata->{objectclass}} : 0) . " object classes\n\n"
|
|---|
| 66 | }
|
|---|
| 67 |
|
|---|
| 68 | if($optionPrint) {
|
|---|
| 69 | my $ldapdata = &getSourceFile($filename);
|
|---|
| 70 | &printit($ldapdata);
|
|---|
| 71 | }
|
|---|
| 72 |
|
|---|
| 73 | if($optionBadEntries) {
|
|---|
| 74 | print "Display unrecognized entries:\n";
|
|---|
| 75 | my $ldapdata = &getSourceFile($filename);
|
|---|
| 76 | my $errorsAttr = 0;
|
|---|
| 77 | my $errorsObjc = 0;
|
|---|
| 78 | my $errorsDup = 0;
|
|---|
| 79 | my $emptyOid = 0;
|
|---|
| 80 | my %dup;
|
|---|
| 81 |
|
|---|
| 82 | foreach (@{$ldapdata->{attributes}}) {
|
|---|
| 83 | my $attr = $_;
|
|---|
| 84 |
|
|---|
| 85 | push @{$dup{$attr->{OID}}{attr}}, {NAME => $attr->{NAME}, LINENUMBER => $attr->{LINENUMBER}};
|
|---|
| 86 |
|
|---|
| 87 | $attr->{DATA} =~ s/\n/ /g;
|
|---|
| 88 | $attr->{DATA} =~ s/\r//g;
|
|---|
| 89 | $attr->{DATA} =~ s/attribute[t|T]ypes?:?\s*\(//;
|
|---|
| 90 | $attr->{DATA} =~ s/\Q$attr->{OID}// if(defined $attr->{OID});
|
|---|
| 91 | $attr->{DATA} =~ s/NAME\s*\Q$attr->{NAME}// if(defined $attr->{NAME});
|
|---|
| 92 | $attr->{DATA} =~ s/DESC\s*'\Q$attr->{DESC}'// if(defined $attr->{DESC});
|
|---|
| 93 | $attr->{DATA} =~ s/$attr->{OBSOLETE}// if(defined $attr->{OBSOLETE});
|
|---|
| 94 | $attr->{DATA} =~ s/SUP\s*\Q$attr->{SUP}// if(defined $attr->{SUP});
|
|---|
| 95 | $attr->{DATA} =~ s/EQUALITY\s*\Q$attr->{EQUALITY}// if(defined $attr->{EQUALITY});
|
|---|
| 96 | $attr->{DATA} =~ s/ORDERING\s*\Q$attr->{ORDERING}// if(defined $attr->{ORDERING});
|
|---|
| 97 | $attr->{DATA} =~ s/SUBSTR\s*\Q$attr->{SUBSTR}// if(defined $attr->{SUBSTR});
|
|---|
| 98 | $attr->{DATA} =~ s/SYNTAX\s*\Q$attr->{SYNTAX}// if(defined $attr->{SYNTAX});
|
|---|
| 99 | $attr->{DATA} =~ s/SINGLE-VALUE// if(defined $attr->{SINGLEVALUE});
|
|---|
| 100 | $attr->{DATA} =~ s/NO-USER-MODIFICATION// if(defined $attr->{NOUSERMOD});
|
|---|
| 101 | $attr->{DATA} =~ s/COLLECTIVE// if(defined $attr->{COLLECTIVE});
|
|---|
| 102 | $attr->{DATA} =~ s/USAGE\s*\Q$attr->{USAGE}// if(defined $attr->{USAGE});
|
|---|
| 103 | $attr->{DATA} =~ s/\)\s$//;
|
|---|
| 104 | $attr->{DATA} =~ s/^\s+(\S)/\n$1/ ;
|
|---|
| 105 | $attr->{DATA} =~ s/(\S)\s+$/$1\n/;
|
|---|
| 106 | do {
|
|---|
| 107 | $errorsAttr ++;
|
|---|
| 108 | do { $emptyOid ++;
|
|---|
| 109 | print "Warning : no OID for attributes element at line $attr->{LINENUMBER} \n";
|
|---|
| 110 | } if( !defined($attr->{OID}));
|
|---|
| 111 | print "### Unknow element embedded in ATTRIBUTE at line $attr->{LINENUMBER} :\n$attr->{DATA}\n"
|
|---|
| 112 | } if($attr->{DATA} =~ /\w/);
|
|---|
| 113 | }
|
|---|
| 114 |
|
|---|
| 115 | foreach (@{$ldapdata->{objectclass}}) {
|
|---|
| 116 | my $objc = $_;
|
|---|
| 117 | push @{$dup{$objc->{OID}}{objc}} , {NAME => $objc->{NAME}, LINENUMBER => $objc->{LINENUMBER}};
|
|---|
| 118 | $objc->{DATA} =~ s/\n/ /g;
|
|---|
| 119 | $objc->{DATA} =~ s/\r//g;
|
|---|
| 120 | $objc->{DATA} =~ s/^object[c|C]lasse?s?:?\s*\(?//;
|
|---|
| 121 | $objc->{DATA} =~ s/\Q$objc->{OID}// if(defined $objc->{OID});
|
|---|
| 122 | $objc->{DATA} =~ s/NAME\s*\Q$objc->{NAME}\E// if(defined $objc->{NAME});
|
|---|
| 123 | $objc->{DATA} =~ s/DESC\s*'\Q$objc->{DESC}\E'// if(defined $objc->{DESC});
|
|---|
| 124 | $objc->{DATA} =~ s/OBSOLETE// if(defined $objc->{OBSOLETE});
|
|---|
| 125 | $objc->{DATA} =~ s/SUP\s*\Q$objc->{SUP}// if(defined $objc->{SUP});
|
|---|
| 126 | $objc->{DATA} =~ s/\Q$objc->{TYPE}// if(defined $objc->{TYPE});
|
|---|
| 127 | $objc->{DATA} =~ s/MUST\s*\Q$objc->{MUST}\E\s*// if(defined $objc->{MUST});
|
|---|
| 128 | $objc->{DATA} =~ s/MUST\s*\(?\s*\Q$objc->{MUST}\E\s*\)?// if(defined $objc->{MUST});
|
|---|
| 129 | $objc->{DATA} =~ s/MAY\s*\Q$objc->{MAY}\E// if(defined $objc->{MAY});
|
|---|
| 130 | $objc->{DATA} =~ s/\)\s$//;
|
|---|
| 131 | $objc->{DATA} =~ s/^\s+(\S)/\n$1/ ;
|
|---|
| 132 | $objc->{DATA} =~ s/(\S)\s+$/$1\n/;
|
|---|
| 133 |
|
|---|
| 134 | do {
|
|---|
| 135 | print "#" x 80 ."\n";
|
|---|
| 136 | $errorsObjc ++;
|
|---|
| 137 | do { $emptyOid++ ;
|
|---|
| 138 | print "Warning : no OID for object class element at line $objc->{LINENUMBER} \n";
|
|---|
| 139 | } if( $objc->{OID} eq "");
|
|---|
| 140 | print "### Unknow element embedded in OBJECT CLASS at line $objc->{LINENUMBER} :\n$objc->{DATA}\n"
|
|---|
| 141 | } if($objc->{DATA} =~ /\w/);
|
|---|
| 142 | }
|
|---|
| 143 |
|
|---|
| 144 | my $nbDup = 0;
|
|---|
| 145 | foreach (keys %dup) {
|
|---|
| 146 | my $sumOid = 0;
|
|---|
| 147 | $sumOid += @{$dup{$_}{attr}} if(defined (@{$dup{$_}{attr}}));
|
|---|
| 148 | $sumOid += @{$dup{$_}{objc}} if(defined (@{$dup{$_}{objc}}));
|
|---|
| 149 | if( $sumOid > 1 && $_ ne "") {
|
|---|
| 150 | $nbDup ++;
|
|---|
| 151 | print "#" x 80 ."\n";
|
|---|
| 152 | print "Duplicate OID founds : $_\n";
|
|---|
| 153 | foreach (@{$dup{$_}{attr}}) {
|
|---|
| 154 |
|
|---|
| 155 | print "Attribute : $_->{NAME} (line : $_->{LINENUMBER})\n";
|
|---|
| 156 | }
|
|---|
| 157 | foreach (@{$dup{$_}{objc}}) {
|
|---|
| 158 | print "Object class : $_->{NAME} (line : $_->{LINENUMBER})\n";
|
|---|
| 159 | }
|
|---|
| 160 |
|
|---|
| 161 | }
|
|---|
| 162 | }
|
|---|
| 163 |
|
|---|
| 164 | print "\n$errorsAttr errors detected in ATTRIBUTES list\n";
|
|---|
| 165 | print "$errorsObjc errors detected in OBJECT CLASS list\n";
|
|---|
| 166 | print "$nbDup duplicate OID founds\n";
|
|---|
| 167 | print "$emptyOid empty OID fields founds\n\n";
|
|---|
| 168 |
|
|---|
| 169 | }
|
|---|
| 170 |
|
|---|
| 171 |
|
|---|
| 172 | sub printit {
|
|---|
| 173 | my $ldapdata = shift;
|
|---|
| 174 | &printSeparator;
|
|---|
| 175 | print "dn: cn=schema\n";
|
|---|
| 176 | &printSeparator;
|
|---|
| 177 |
|
|---|
| 178 | # print elements in RFC2252 order
|
|---|
| 179 |
|
|---|
| 180 | foreach (@{$ldapdata->{attributes}}) {
|
|---|
| 181 | my $attr = $_;
|
|---|
| 182 | print "attributeTypes: (\n";
|
|---|
| 183 | print " $attr->{OID}\n";
|
|---|
| 184 | print " NAME $attr->{NAME}\n";
|
|---|
| 185 | print " DESC '$attr->{DESC}'\n" if(defined $attr->{DESC});
|
|---|
| 186 | print " OBSOLETE\n" if(defined $attr->{OBSOLETE});
|
|---|
| 187 | print " SUP $attr->{SUP}\n" if(defined $attr->{SUP});
|
|---|
| 188 | print " EQUALITY $attr->{EQUALITY}\n" if(defined $attr->{EQUALITY});
|
|---|
| 189 | print " ORDERING $attr->{ORDERING}\n" if(defined $attr->{ORDERING});
|
|---|
| 190 | print " SUBSTR $attr->{SUBSTR}\n" if(defined $attr->{SUBSTR});
|
|---|
| 191 | print " SYNTAX $attr->{SYNTAX}\n" if(defined $attr->{SYNTAX});
|
|---|
| 192 | print " SINGLE-VALUE\n" if(defined $attr->{SINGLEVALUE});
|
|---|
| 193 | print " NO-USER-MODIFICATION\n" if(defined $attr->{NOUSERMOD});
|
|---|
| 194 | print " COLLECTIVE\n" if(defined $attr->{COLLECTIVE});
|
|---|
| 195 | print " USAGE $attr->{USAGE}\n" if(defined $attr->{USAGE});
|
|---|
| 196 | print " )\n";
|
|---|
| 197 | &printSeparator;
|
|---|
| 198 | }
|
|---|
| 199 |
|
|---|
| 200 | foreach (@{$ldapdata->{objectclass}}) {
|
|---|
| 201 | my $objc = $_;
|
|---|
| 202 | # next 3 lines : Fedora DS space sensitive bug workaround
|
|---|
| 203 | $objc->{SUP} =~ s/^\(\s*(.*?)\s*\)$/\( $1 \)/ if (defined $objc->{SUP});
|
|---|
| 204 | $objc->{MUST} =~ s/^\(\s*(.*?)\s*\)$/\( $1 \)/ if (defined $objc->{MUST});
|
|---|
| 205 | $objc->{MAY} =~ s/^\(\s*(.*?)\s*\)$/\( $1 \)/ if (defined $objc->{MAY});
|
|---|
| 206 |
|
|---|
| 207 | print "objectClasses: (\n";
|
|---|
| 208 | print " $objc->{OID}\n";
|
|---|
| 209 | print " NAME $objc->{NAME}\n";
|
|---|
| 210 | print " DESC '$objc->{DESC}'\n" if(defined $objc->{DESC});
|
|---|
| 211 | print " OBSOLETE\n" if(defined $objc->{OBSOLETE});
|
|---|
| 212 | print " SUP $objc->{SUP}\n" if(defined $objc->{SUP});
|
|---|
| 213 | print " $objc->{TYPE}\n" if(defined $objc->{TYPE});
|
|---|
| 214 | print " MUST $objc->{MUST}\n" if(defined $objc->{MUST});
|
|---|
| 215 | print " MAY $objc->{MAY}\n" if(defined $objc->{MAY});
|
|---|
| 216 | print " )\n";
|
|---|
| 217 | &printSeparator;
|
|---|
| 218 | }
|
|---|
| 219 | }
|
|---|
| 220 |
|
|---|
| 221 | sub printSeparator {
|
|---|
| 222 | print "#\n";
|
|---|
| 223 | print "#" x 80 . "\n";
|
|---|
| 224 | print "#\n";
|
|---|
| 225 | }
|
|---|
| 226 |
|
|---|
| 227 | sub getSourceFile {
|
|---|
| 228 | my @data = &getFile(shift);
|
|---|
| 229 | my %result;
|
|---|
| 230 | my $result = \%result;
|
|---|
| 231 | my @allattrs;
|
|---|
| 232 | my @allattrsLineNumber;
|
|---|
| 233 | my @allobjc;
|
|---|
| 234 | my @allobjcLineNumber;
|
|---|
| 235 | my $at = 0;
|
|---|
| 236 | my $oc = 0;
|
|---|
| 237 | my $at_string;
|
|---|
| 238 | my $oc_string;
|
|---|
| 239 | my $idx = 0;
|
|---|
| 240 | my $beginParenthesis = 0;
|
|---|
| 241 | my $endParenthesis = 0;
|
|---|
| 242 | my $lineNumber = 0;
|
|---|
| 243 | for(@data) {
|
|---|
| 244 | $lineNumber++;
|
|---|
| 245 | next if (/^\s*\#/); # skip comments
|
|---|
| 246 |
|
|---|
| 247 | if($at) {
|
|---|
| 248 | s/ +/ /; # remove embedded tabs
|
|---|
| 249 | s/\t/ /; # remove multiple spaces after the $ sign
|
|---|
| 250 |
|
|---|
| 251 | $at_string .= $_;
|
|---|
| 252 | $beginParenthesis = 0; # Use best matching elements
|
|---|
| 253 | $endParenthesis = 0;
|
|---|
| 254 | for(my $i=0;$ i < length($at_string); $i++) {
|
|---|
| 255 | $beginParenthesis++ if(substr ($at_string,$i,1) eq "(");
|
|---|
| 256 | $endParenthesis++ if(substr ($at_string,$i,1) eq ")");
|
|---|
| 257 | }
|
|---|
| 258 | if($beginParenthesis == $endParenthesis) {
|
|---|
| 259 | push @allattrs, $at_string;
|
|---|
| 260 | $at = 0;
|
|---|
| 261 | $at_string = "";
|
|---|
| 262 | $endParenthesis = 0;
|
|---|
| 263 | $beginParenthesis = 0;
|
|---|
| 264 | }
|
|---|
| 265 | }
|
|---|
| 266 |
|
|---|
| 267 | if (/^attribute[t|T]ype/) {
|
|---|
| 268 | my $line = $_;
|
|---|
| 269 | push @allattrsLineNumber, $lineNumber; # keep starting line number
|
|---|
| 270 | for(my $i=0;$ i < length($line); $i++) {
|
|---|
| 271 | $beginParenthesis++ if(substr ($line, $i, 1) eq "(");
|
|---|
| 272 | $endParenthesis++ if(substr ($line, $i, 1) eq ")");
|
|---|
| 273 | }
|
|---|
| 274 | if($beginParenthesis == $endParenthesis && $beginParenthesis != 0) {
|
|---|
| 275 | push @allattrs, $line;
|
|---|
| 276 | $endParenthesis = 0;
|
|---|
| 277 | $beginParenthesis = 0;
|
|---|
| 278 | } else {
|
|---|
| 279 | $at_string = $line;
|
|---|
| 280 | $at = 1;
|
|---|
| 281 | }
|
|---|
| 282 | }
|
|---|
| 283 |
|
|---|
| 284 | #####################################
|
|---|
| 285 |
|
|---|
| 286 | if($oc) {
|
|---|
| 287 | s/ +/ /;
|
|---|
| 288 | s/\t/ /;
|
|---|
| 289 |
|
|---|
| 290 | $oc_string .= $_;
|
|---|
| 291 | $endParenthesis = 0; # best methode to accept an elements :
|
|---|
| 292 | $beginParenthesis = 0; # left parenthesis sum == right parenthesis sum, so we are sure to
|
|---|
| 293 | for(my $i=0;$ i < length($oc_string); $i++) { # have an element.
|
|---|
| 294 | $beginParenthesis++ if(substr ($oc_string, $i, 1) eq "(");
|
|---|
| 295 | $endParenthesis++ if(substr ($oc_string, $i, 1) eq ")");
|
|---|
| 296 | }
|
|---|
| 297 | if($beginParenthesis == $endParenthesis) {
|
|---|
| 298 | push @allobjc, $oc_string;
|
|---|
| 299 | $oc = 0;
|
|---|
| 300 | $oc_string = "";
|
|---|
| 301 | $endParenthesis = 0;
|
|---|
| 302 | $beginParenthesis = 0;
|
|---|
| 303 | }
|
|---|
| 304 | }
|
|---|
| 305 |
|
|---|
| 306 | if (/^object[c|C]lass/) {
|
|---|
| 307 | my $line = $_;
|
|---|
| 308 | push @allobjcLineNumber, $lineNumber; # keep starting line number
|
|---|
| 309 | for(my $i=0;$ i < length($line); $i++) {
|
|---|
| 310 | $beginParenthesis++ if(substr ($line, $i, 1) eq "(");
|
|---|
| 311 | $endParenthesis++ if(substr ($line, $i, 1) eq ")");
|
|---|
| 312 | }
|
|---|
| 313 | if($beginParenthesis == $endParenthesis && $beginParenthesis != 0) {
|
|---|
| 314 | push @allobjc, $line;
|
|---|
| 315 | $endParenthesis = 0;
|
|---|
| 316 | $beginParenthesis = 0;
|
|---|
| 317 | } else {
|
|---|
| 318 | $oc_string = $line;
|
|---|
| 319 | $oc = 1;
|
|---|
| 320 | }
|
|---|
| 321 | }
|
|---|
| 322 | }
|
|---|
| 323 |
|
|---|
| 324 | # Parsing attribute elements
|
|---|
| 325 |
|
|---|
| 326 | for(@allattrs) {
|
|---|
| 327 | s/\n/ /g;
|
|---|
| 328 | s/\r//g;
|
|---|
| 329 | s/ +/ /g;
|
|---|
| 330 | s/\t/ /g;
|
|---|
| 331 | $result->{attributes}->[$idx]->{DATA} = $_ if($optionBadEntries); # keep original data
|
|---|
| 332 | $result->{attributes}->[$idx]->{LINENUMBER} = $allattrsLineNumber[$idx];
|
|---|
| 333 | $result->{attributes}->[$idx]->{OID} = $1 if (m/^attribute[t|T]ypes?:?\s*\(?\s*([\.\d]*?)\s+/);
|
|---|
| 334 | $result->{attributes}->[$idx]->{NAME} = $1 if (m/NAME\s+('.*?')\s*/ || m/NAME\s+(\(.*?\))/);
|
|---|
| 335 | $result->{attributes}->[$idx]->{DESC} = $1 if (m/DESC\s+'(.*?)'\s*/);
|
|---|
| 336 | $result->{attributes}->[$idx]->{OBSOLETE} = "OBSOLETE" if (m/OBSOLETE/);
|
|---|
| 337 | $result->{attributes}->[$idx]->{SUP} = $1 if (m/SUP\s+(.*?)\s/);
|
|---|
| 338 | $result->{attributes}->[$idx]->{EQUALITY} = $1 if (m/EQUALITY\s+(.*?)\s/);
|
|---|
| 339 | $result->{attributes}->[$idx]->{ORDERING} = $1 if (m/ORDERING\s+(.*?)\s/);
|
|---|
| 340 | $result->{attributes}->[$idx]->{SUBSTR} = $1 if (m/SUBSTR\s+(.*?)\s/);
|
|---|
| 341 | $result->{attributes}->[$idx]->{SYNTAX} = $1 if (m/SYNTAX\s+(.*?)(\s|\))/);
|
|---|
| 342 | $result->{attributes}->[$idx]->{SINGLEVALUE} = "SINGLE-VALUE" if (m/SINGLE-VALUE/);
|
|---|
| 343 | $result->{attributes}->[$idx]->{COLLECTIVE} = "COLLECTIVE" if (m/COLLECTIVE/);
|
|---|
| 344 | $result->{attributes}->[$idx]->{USAGE} = $1 if (m/USAGE\s+(.*?)\s/);
|
|---|
| 345 | $result->{attributes}->[$idx]->{NOUSERMOD} = "NO-USER-MODIFICATION" if (m/NO-USER-MODIFICATION/);
|
|---|
| 346 | $idx ++;
|
|---|
| 347 | }
|
|---|
| 348 |
|
|---|
| 349 | $idx = 0;
|
|---|
| 350 |
|
|---|
| 351 | # Parsing object class elements
|
|---|
| 352 |
|
|---|
| 353 | for(@allobjc) {
|
|---|
| 354 | s/\n/ /g;
|
|---|
| 355 | s/\r//g;
|
|---|
| 356 | s/ +/ /g;
|
|---|
| 357 | s/\t/ /g;
|
|---|
| 358 | $result->{objectclass}->[$idx]->{DATA} = $_ if($optionBadEntries); # keep original data
|
|---|
| 359 | $result->{objectclass}->[$idx]->{LINENUMBER} = $allobjcLineNumber[$idx];
|
|---|
| 360 | $result->{objectclass}->[$idx]->{OID} = $1 if (m/^object[c|C]lasse?s?:?\s*\(?\s*([\.\d]*?)\s+/);
|
|---|
| 361 | $result->{objectclass}->[$idx]->{NAME} = $1 if (m/NAME\s+('.*?')\s*/ || m/NAME\s+(\(.*?\))/);
|
|---|
| 362 | $result->{objectclass}->[$idx]->{DESC} = $1 if (m/DESC\s+'(.*?)'\s*/);
|
|---|
| 363 | $result->{objectclass}->[$idx]->{OBSOLETE} = "OBSOLETE" if (m/OBSOLETE/);
|
|---|
| 364 | $result->{objectclass}->[$idx]->{SUP} = $1 if (m/SUP\s+([^()]+?)\s/ || m/SUP\s+(\(.+?\))\s/);
|
|---|
| 365 | $result->{objectclass}->[$idx]->{TYPE} = $1 if (m/((?:STRUCTURAL)|(?:AUXILIARY)|(?:ABSTRACT))/);
|
|---|
| 366 | $result->{objectclass}->[$idx]->{MUST} = $1 if (m/MUST\s+(\w+)\)?/ || m/MUST\s+(\(.*?\))(\s|\))/s);
|
|---|
| 367 | $result->{objectclass}->[$idx]->{MAY} = $1 if (m/MAY\s+(\w+)\)?/ || m/MAY\s+(\(.*?\))(\s|\))/s);
|
|---|
| 368 |
|
|---|
| 369 | $idx++;
|
|---|
| 370 | }
|
|---|
| 371 |
|
|---|
| 372 | return $result;
|
|---|
| 373 | }
|
|---|
| 374 |
|
|---|
| 375 | sub getFile {
|
|---|
| 376 | my @data;
|
|---|
| 377 | my $file = shift;
|
|---|
| 378 | die "File not found : $file\n" if(! -e $file);
|
|---|
| 379 | open FH, $file;
|
|---|
| 380 | @data = <FH>;
|
|---|
| 381 | close FH;
|
|---|
| 382 | @data;
|
|---|
| 383 | }
|
|---|
| 384 |
|
|---|
