| 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 |  | 
|---|