|
1 #!perl -w |
|
2 # Copyright (c) 2007-2009 Nokia Corporation and/or its subsidiary(-ies). |
|
3 # All rights reserved. |
|
4 # This component and the accompanying materials are made available |
|
5 # under the terms of "Eclipse Public License v1.0" |
|
6 # which accompanies this distribution, and is available |
|
7 # at the URL "http://www.eclipse.org/legal/epl-v10.html". |
|
8 # |
|
9 # Initial Contributors: |
|
10 # Nokia Corporation - initial contribution. |
|
11 # |
|
12 # Contributors: |
|
13 # |
|
14 # Description: |
|
15 # |
|
16 |
|
17 use strict; |
|
18 |
|
19 # |
|
20 # Perl module to create and maintain feature manager data files. |
|
21 # You can either set up the information programmatically or else load up |
|
22 # information from a pre-existing feature data file and then modify it. You |
|
23 # can also save the information to a file (in feature manager dataset format). |
|
24 # |
|
25 # This class maintains header information plus two arrays, one containing |
|
26 # feature flag information and the other containing default supported range |
|
27 # information. Those are themselves objects and have their own accessor |
|
28 # methods. |
|
29 # |
|
30 |
|
31 package FMCreate; |
|
32 |
|
33 use featureflag; |
|
34 use featuredsr; |
|
35 |
|
36 # |
|
37 # n e w |
|
38 # |
|
39 # Create a new FMCreate object. For example 'my $fmc = FMCreate->new(); |
|
40 # |
|
41 sub new |
|
42 { |
|
43 my $arg = shift; |
|
44 my $class = ref($arg) || $arg; |
|
45 my $self = { |
|
46 typefield => "feat", # 4 bytes wide. |
|
47 fileversion => 1, # 2 bytes. |
|
48 fileflags => 0, # 2 bytes. |
|
49 numfeatures => 0, # 4 bytes. (this is 'x') |
|
50 numdefuid => 0, # 4 bytes. (this is 'y') |
|
51 endian => "LE", |
|
52 packprefix => "V", # Changed with endian-ness. |
|
53 # Used to create binary strings. |
|
54 |
|
55 featureflags => [], # There are x of these. |
|
56 dsrs => [], # There are y of these. |
|
57 }; |
|
58 bless $self, $class; |
|
59 return $self; |
|
60 } |
|
61 |
|
62 # Print to STDOUT the header information, feature flags information and |
|
63 # default supported range information. |
|
64 sub ShowALL |
|
65 { |
|
66 my $self = shift; |
|
67 return undef unless(ref($self)); |
|
68 $self->ShowHeader(); |
|
69 $self->ShowFeatureFlags(); |
|
70 $self->ShowDSRs(); |
|
71 return 1; |
|
72 } |
|
73 |
|
74 # Print to STDOUT the header information we have. |
|
75 sub ShowHeader |
|
76 { |
|
77 my $self = shift; |
|
78 return undef unless(ref($self)); |
|
79 |
|
80 # Get header information.. |
|
81 my $typefield = $self->TypeField(); |
|
82 my $fileversion = $self->FileVersion(); |
|
83 my $fileflags = $self->FileFlags(); |
|
84 my $numfeatures = $self->NumFeatures(); |
|
85 my $numdefuid = $self->NumDefUid(); |
|
86 |
|
87 # Display it in English. |
|
88 print "TYPEFIELD: '$typefield'\n"; |
|
89 print "FILEVERSION: '$fileversion'\n"; |
|
90 print "FILEFLAGS: '$fileflags'\n"; |
|
91 print "NUMFEATURES: '$numfeatures'\n"; |
|
92 print "NUMDSRS: '$numdefuid'\n"; |
|
93 |
|
94 return(1); |
|
95 } |
|
96 |
|
97 # Call the 'Show' method in each of the feature flag objects we |
|
98 # have - this will print their content to STDOUT. |
|
99 sub ShowFeatureFlags |
|
100 { |
|
101 my $self = shift; |
|
102 return undef unless(ref($self)); |
|
103 my $ffs = $self->FeatureFlags; |
|
104 return 1 unless(@$ffs); |
|
105 |
|
106 print "\nFeature Flags\n"; |
|
107 print "=============\n"; |
|
108 for my $ff (@$ffs) |
|
109 { |
|
110 $ff->Show(); |
|
111 } |
|
112 return 1; |
|
113 } |
|
114 |
|
115 # Call the 'Show' method in each of the default supported range objects we |
|
116 # have - this will print their content to STDOUT. |
|
117 sub ShowDSRs |
|
118 { |
|
119 my $self = shift; |
|
120 return undef unless(ref($self)); |
|
121 my $fds = $self->FeatureDSRs; |
|
122 return 1 unless(@$fds); |
|
123 print "\nFeature DSRs\n"; |
|
124 print "============\n"; |
|
125 for my $fd (@$fds) |
|
126 { |
|
127 $fd->Show(); |
|
128 } |
|
129 return 1; |
|
130 } |
|
131 |
|
132 # Get/Set the endian-ness we want. Changes the 'packprefix' member which is |
|
133 # used in the creation of binary data. |
|
134 sub Endian |
|
135 { |
|
136 my $self = shift; |
|
137 return undef unless(ref($self)); |
|
138 my $arg = shift; |
|
139 return $self->{endian} unless(defined($arg)); |
|
140 if($arg =~ m/(LE|BE)/i) |
|
141 { |
|
142 my $endian = uc($1); |
|
143 $self->{endian} = $endian; |
|
144 # Used by 'pack' to generate binary strings. |
|
145 $self->{packprefix} = "V" if($endian eq "LE"); |
|
146 $self->{packprefix} = "N" if($endian eq "BE"); |
|
147 } |
|
148 return $self->{endian}; |
|
149 } |
|
150 |
|
151 # This is 'feat'. |
|
152 sub TypeField |
|
153 { |
|
154 my $self = shift; |
|
155 return undef unless(ref($self)); |
|
156 my $arg = shift; |
|
157 $self->{typefield} = $arg if(defined($arg)); |
|
158 return $self->{typefield}; |
|
159 } |
|
160 |
|
161 sub FileVersion |
|
162 { |
|
163 my $self = shift; |
|
164 return undef unless(ref($self)); |
|
165 my $arg = shift; |
|
166 # Should we be testing for a numeric value? |
|
167 $self->{fileversion} = $arg if(defined($arg)); |
|
168 return $self->{fileversion}; |
|
169 } |
|
170 |
|
171 sub FileFlags |
|
172 { |
|
173 my $self = shift; |
|
174 return undef unless(ref($self)); |
|
175 my $arg = shift; |
|
176 $self->{fileflags} = $arg if(defined($arg)); |
|
177 return $self->{fileflags}; |
|
178 } |
|
179 |
|
180 # How many feature flag objects have we got? |
|
181 sub NumFeatures |
|
182 { |
|
183 my $self = shift; |
|
184 return undef unless(ref($self)); |
|
185 my $arg = shift; |
|
186 $self->{numfeatures} = $arg if(defined($arg)); |
|
187 return $self->{numfeatures}; |
|
188 } |
|
189 |
|
190 # How many default supported range objects have we got? |
|
191 sub NumDefUid |
|
192 { |
|
193 my $self = shift; |
|
194 return undef unless(ref($self)); |
|
195 my $arg = shift; |
|
196 $self->{numdefuid} = $arg if(defined($arg)); |
|
197 return $self->{numdefuid}; |
|
198 } |
|
199 |
|
200 # Create a binary string containing the header information for the |
|
201 # feature manager data file based on the various fields in this object. |
|
202 sub CreateBinaryHeader |
|
203 { |
|
204 my $self = shift; |
|
205 return undef unless(ref($self)); |
|
206 my $hdrstring; |
|
207 |
|
208 # Get the letter for packing information with 'pack' into a binary form. |
|
209 my $pack16 = lc($self->{packprefix}); |
|
210 my $pack32 = uc($self->{packprefix}); |
|
211 |
|
212 # Get header information.. |
|
213 my $typefield = $self->TypeField(); |
|
214 my $fileversion = $self->FileVersion(); |
|
215 my $fileflags = $self->FileFlags(); |
|
216 my $numfeatures = $self->NumFeatures(); |
|
217 my $numdefuid = $self->NumDefUid(); |
|
218 |
|
219 # Write the 'type' field out. This is 'feat'. Would this be different on |
|
220 # big-endian systems? |
|
221 $hdrstring = $typefield; |
|
222 |
|
223 # Now the file version number. A 16-bit value.. Will this cause trouble |
|
224 # if the shifted value is signed? |
|
225 $hdrstring .= pack($pack16 . "1", $fileversion); |
|
226 |
|
227 # Now the file flags. Another 16-bit value.. |
|
228 $hdrstring .= pack($pack16 . "1", $fileflags); |
|
229 |
|
230 # Now the number of listed features - a 32-bit value. |
|
231 $hdrstring .= pack($pack32 . "1", $numfeatures); |
|
232 |
|
233 # Now the number of listed features - a 32-bit value. |
|
234 $hdrstring .= pack($pack32 . "1", $numdefuid); |
|
235 |
|
236 return $hdrstring; |
|
237 } |
|
238 |
|
239 # Writes the binary file specified as an argument with the content of this |
|
240 # and contained feature flag and dsr objects. |
|
241 sub WriteToFile |
|
242 { |
|
243 my $self = shift; |
|
244 return undef unless(ref($self)); |
|
245 my $file = shift; |
|
246 return undef unless(defined($file)); |
|
247 open FILE, "> $file" or die "Couldn't open file '$file' for writing.\n"; |
|
248 binmode FILE; |
|
249 print FILE $self->BinaryContent(); |
|
250 close FILE; |
|
251 return 1; |
|
252 } |
|
253 |
|
254 |
|
255 # Create the binary equivalent of the internal data and return it as a |
|
256 # string. |
|
257 sub BinaryContent |
|
258 { |
|
259 my $self = shift; |
|
260 return undef unless(ref($self)); |
|
261 |
|
262 # First get the header information for the registry manager data file. |
|
263 my $ret = $self->CreateBinaryHeader(); |
|
264 |
|
265 # Get the feature flag entries.. This is an array reference. |
|
266 # For each one append the binary representation of the information |
|
267 # contained. |
|
268 my $ffs = $self->FeatureFlags; |
|
269 for my $ff (@$ffs) |
|
270 { |
|
271 $ret .= $ff->BinaryContent(); |
|
272 } |
|
273 |
|
274 # Get the feature default supported range entries.. This is an array |
|
275 # reference too. For each one append the binary representation of |
|
276 # uid range contained. |
|
277 my $fdsrs = $self->FeatureDSRs; |
|
278 for my $ff (@$fdsrs) |
|
279 { |
|
280 $ret .= $ff->BinaryContent(); |
|
281 } |
|
282 return $ret; |
|
283 } |
|
284 |
|
285 # Return a reference to the 'feature flags' array. |
|
286 sub FeatureFlags |
|
287 { |
|
288 my $self = shift; |
|
289 return undef unless(ref($self)); |
|
290 return $self->{featureflags}; |
|
291 } |
|
292 |
|
293 # Add a Feature Flag object. Perhaps there should be code to check if we |
|
294 # already know about this feature flag. (i.e check the uid against the ones |
|
295 # we have). |
|
296 sub AddFeatureFlag |
|
297 { |
|
298 my $self = shift; |
|
299 return undef unless(ref($self)); |
|
300 my $arg = shift; |
|
301 die "Method 'AddFeatureFlag' requires a 'FeatureFlag' object as argument.\n" |
|
302 unless(ref($arg) eq "FeatureFlag"); |
|
303 push @{$self->FeatureFlags()}, $arg; |
|
304 $self->NumFeatures($self->NumFeatures() + 1); |
|
305 return 1; |
|
306 } |
|
307 |
|
308 # Return a reference to the 'feature dsrs' array. |
|
309 sub FeatureDSRs |
|
310 { |
|
311 my $self = shift; |
|
312 return undef unless(ref($self)); |
|
313 return $self->{dsrs}; |
|
314 } |
|
315 |
|
316 # Add a Feature 'Default Support Range' object. |
|
317 sub AddFeatureDSR |
|
318 { |
|
319 my $self = shift; |
|
320 return undef unless(ref($self)); |
|
321 my $arg = shift; |
|
322 die "Method 'AddFeatureDSR' requires a 'FeatureDSR' object as argument.\n" |
|
323 unless(ref($arg) eq "FeatureDSR"); |
|
324 push @{$self->FeatureDSRs()}, $arg; |
|
325 $self->NumDefUid($self->NumDefUid() + 1); |
|
326 return 1; |
|
327 } |
|
328 |
|
329 # This method loads up it's information from an existing feature manager |
|
330 # data file. This will die if it thinks there is something wrong with the file. |
|
331 sub LoadUp |
|
332 { |
|
333 my $self = shift; |
|
334 return undef unless(ref($self) eq "FMCreate"); |
|
335 |
|
336 my $packprefix16 = lc($self->{packprefix}); |
|
337 my $packprefix32 = uc($self->{packprefix}); |
|
338 |
|
339 my $file = shift; |
|
340 return undef unless(defined($file) and -f $file); |
|
341 open FILE, $file or die "Couldn't open '$file'\n"; |
|
342 binmode FILE; |
|
343 my ($tmp, $feat); |
|
344 |
|
345 # First get the file size. |
|
346 my $fsz = sysseek(FILE, 0, 2); |
|
347 sysseek(FILE, 0, 0); |
|
348 |
|
349 # Read the 'feat' marker from the top of the file. Check it. |
|
350 die "Unable to read first 4 bytes from '$file'" |
|
351 unless(4 == sysread(FILE, $feat, 4) ); |
|
352 die "First four bytes of '$file' do not contain 'feat'" |
|
353 unless($feat eq "feat"); |
|
354 $self->TypeField($feat); # Pointless. It's set to that anyway. |
|
355 |
|
356 # Read the file version number. |
|
357 die "Unable to read two bytes from index 4 from '$file'" |
|
358 unless(2 == sysread(FILE, $tmp, 2) ); |
|
359 my $filever = unpack( $packprefix16, $tmp ); |
|
360 $self->FileVersion($filever); |
|
361 |
|
362 # Read the file flags. |
|
363 die "Unable to read two bytes from index 6 from '$file'" |
|
364 unless(2 == sysread(FILE, $tmp, 2) ); |
|
365 my $fileflags = unpack( $packprefix16, $tmp ); |
|
366 $self->FileFlags($fileflags); |
|
367 |
|
368 # Read the number of features. Don't do anything with this yet.. |
|
369 die "Unable to read four bytes from index 8 from '$file'" |
|
370 unless(4 == sysread(FILE, $tmp, 4) ); |
|
371 my $nfeat = unpack( $packprefix32, $tmp ); |
|
372 |
|
373 # Read the number of DSRs. Don't do anything with this yet.. |
|
374 die "Unable to read four bytes from index 12 from '$file'" |
|
375 unless(4 == sysread(FILE, $tmp, 4) ); |
|
376 my $ndsr = unpack( $packprefix32, $tmp ); |
|
377 |
|
378 # Forget it if the filesize is clearly wrong. |
|
379 my $expsz = 16 + 12*$nfeat + 8*$ndsr; |
|
380 die "The file '$file' is $fsz bytes long, but the content suggests it should be $expsz bytes long. NFeatures: $nfeat NDSRs: $ndsr\n" unless($expsz == $fsz); |
|
381 |
|
382 # Now read in the feature flags. |
|
383 my $offset = 16; |
|
384 for(my $ff=0 ; $ff<$nfeat ; $ff++) |
|
385 { |
|
386 # Get the UID. |
|
387 die "Unable to read four bytes (uid) from index $offset from '$file'" |
|
388 unless(4 == sysread(FILE, $tmp, 4) ); |
|
389 $offset += 4; |
|
390 my $uid = unpack( $packprefix32, $tmp ); |
|
391 |
|
392 # Get the status word. |
|
393 die "Unable to read four bytes (sw) from index $offset from '$file'" |
|
394 unless(4 == sysread(FILE, $tmp, 4) ); |
|
395 $offset += 4; |
|
396 my $sw = unpack( $packprefix32, $tmp ); |
|
397 |
|
398 # Get the user data word. |
|
399 die "Unable to read four bytes (udw) from index $offset from '$file'" |
|
400 unless(4 == sysread(FILE, $tmp, 4) ); |
|
401 $offset += 4; |
|
402 my $ud = unpack( $packprefix32, $tmp ); |
|
403 |
|
404 my $featflag = FeatureFlag->new($uid, $sw, $ud); |
|
405 die "Couldn't create a feature flag object!\n" unless(ref($featflag)); |
|
406 $self->AddFeatureFlag($featflag); |
|
407 } |
|
408 |
|
409 # Now read in the DSRs. |
|
410 for( my $dsr=0 ; $dsr<$ndsr ; $dsr++ ) |
|
411 { |
|
412 # Get the low UID. |
|
413 die "Unable to read four bytes (lowuid) from index $offset from '$file'" |
|
414 unless(4 == sysread(FILE, $tmp, 4) ); |
|
415 $offset += 4; |
|
416 my $lowuid = unpack( $packprefix32, $tmp ); |
|
417 |
|
418 # Get the high UID. |
|
419 die "Can't read four bytes (high uid) from index $offset from '$file'" |
|
420 unless(4 == sysread(FILE, $tmp, 4) ); |
|
421 $offset += 4; |
|
422 my $highuid = unpack( $packprefix32, $tmp ); |
|
423 |
|
424 my $fd = FeatureDSR->new($lowuid, $highuid); |
|
425 die "Couldn't create 'FeatureDSR' object!\n" unless(ref($fd)); |
|
426 $self->AddFeatureDSR($fd); |
|
427 } |
|
428 |
|
429 # Check if our calculated file offset matches the end of the file. |
|
430 # This is pointless actually, because we've already checked the file |
|
431 # size.. |
|
432 my $fileoffset = sysseek(FILE, 0, 2); |
|
433 die "End of file offset ($fileoffset) does not match end of DSRs!\n" |
|
434 unless($fileoffset == $offset); |
|
435 |
|
436 close FILE; |
|
437 return 1; |
|
438 } |
|
439 |
|
440 # Remove the feature flag object specified by UID held in this object (in |
|
441 # the internal 'featureflags' array). Returns 1 on success, undef otherwise. |
|
442 sub RemoveFeatureFlagByUID |
|
443 { |
|
444 my $self = shift; |
|
445 return undef unless(ref($self)); |
|
446 my $arg = shift; |
|
447 return undef unless(defined($arg)); |
|
448 my $ffs = $self->FeatureFlags; |
|
449 |
|
450 my $idx = 0; |
|
451 for my $ff (@$ffs) |
|
452 { |
|
453 if($ff->UID() == $arg) |
|
454 { |
|
455 splice(@$ffs, $idx, 1); |
|
456 $self->NumFeatures($self->NumFeatures() - 1); |
|
457 return 1; |
|
458 } |
|
459 $idx++; |
|
460 } |
|
461 return undef; |
|
462 } |
|
463 |
|
464 # Return a reference to the 'FeatureFlag' object held in this object (in |
|
465 # the internal 'featureflags' array) with the uid specified as an |
|
466 # argument. This returns a reference so it's still in this object on return, |
|
467 # you can modify it and then write out (for example) the data file. |
|
468 sub GetFeatureFlagByUID |
|
469 { |
|
470 my $self = shift; |
|
471 return undef unless(ref($self)); |
|
472 my $arg = shift; |
|
473 return undef unless(defined($arg)); |
|
474 my $ffs = $self->FeatureFlags; |
|
475 for my $ff (@$ffs) |
|
476 { |
|
477 return $ff if($ff->UID() == $arg); |
|
478 } |
|
479 return undef; |
|
480 } |
|
481 |
|
482 |
|
483 # Remove the feature DSR object specified by UIDs held in this object (in |
|
484 # the internal 'dsrs' array). Returns 1 on success, undef otherwise. |
|
485 sub RemoveDSRByUIDs |
|
486 { |
|
487 my $self = shift; |
|
488 return undef unless(ref($self)); |
|
489 my($lowuid, $highuid) = @_; |
|
490 return undef unless(defined($lowuid) and defined($highuid)); |
|
491 my $fdsrs = $self->FeatureDSRs; |
|
492 |
|
493 my $idx = 0; |
|
494 for my $fdsr (@$fdsrs) |
|
495 { |
|
496 if( ($fdsrs->LowUID() == $lowuid) and |
|
497 ($fdsrs->HighUID() == $highuid) ) |
|
498 { |
|
499 splice(@$fdsrs, $idx, 1); |
|
500 $self->NumDefUid($self->NumDefUid() - 1); |
|
501 return 1; |
|
502 } |
|
503 $idx++; |
|
504 } |
|
505 return undef; |
|
506 } |
|
507 |
|
508 # Return a reference to the 'FeatureDSR' object held in this object (in |
|
509 # the internal 'dsrs' array) with the low and high uids specified in the |
|
510 # arguments. This returns a reference so it's still in this object on return, |
|
511 # you can modify it (by changing the uids) and then write out (for example) |
|
512 # the data file. |
|
513 sub GetDSRByUIDs |
|
514 { |
|
515 my $self = shift; |
|
516 return undef unless(ref($self)); |
|
517 my($lowuid, $highuid) = @_; |
|
518 return undef unless(defined($lowuid) and defined($highuid)); |
|
519 my $fdsrs = $self->FeatureDSRs; |
|
520 for my $fdsr (@$fdsrs) |
|
521 { |
|
522 return $fdsr if( ($fdsr->LowUID() == $lowuid) and |
|
523 ($fdsr->HighUID() == $highuid)); |
|
524 } |
|
525 return undef; |
|
526 } |
|
527 |
|
528 1; |
|
529 |