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