sl@0: #!perl -w
sl@0: # Copyright (c) 2007-2009 Nokia Corporation and/or its subsidiary(-ies).
sl@0: # All rights reserved.
sl@0: # This component and the accompanying materials are made available
sl@0: # under the terms of "Eclipse Public License v1.0"
sl@0: # which accompanies this distribution, and is available
sl@0: # at the URL "http://www.eclipse.org/legal/epl-v10.html".
sl@0: #
sl@0: # Initial Contributors:
sl@0: # Nokia Corporation - initial contribution.
sl@0: #
sl@0: # Contributors:
sl@0: #
sl@0: # Description:
sl@0: #
sl@0: 
sl@0: use strict;
sl@0: 
sl@0: #
sl@0: # Perl module to create and maintain feature manager data files.
sl@0: # You can either set up the information programmatically or else load up
sl@0: # information from a pre-existing feature data file and then modify it. You
sl@0: # can also save the information to a file (in feature manager dataset format).
sl@0: #
sl@0: # This class maintains header information plus two arrays, one containing
sl@0: # feature flag information and the other containing default supported range
sl@0: # information. Those are themselves objects and have their own accessor
sl@0: # methods.
sl@0: #
sl@0: 
sl@0: package FMCreate;
sl@0: 
sl@0: use featureflag;
sl@0: use featuredsr;
sl@0: 
sl@0: #
sl@0: # n e w
sl@0: #
sl@0: # Create a new FMCreate object. For example 'my $fmc = FMCreate->new();
sl@0: #
sl@0: sub new
sl@0: {
sl@0: 	my $arg = shift;
sl@0: 	my $class = ref($arg) || $arg;
sl@0: 	my $self = {
sl@0: 			        typefield => "feat",  # 4 bytes wide.
sl@0: 					fileversion => 1,     # 2 bytes.
sl@0: 					fileflags => 0,       # 2 bytes.
sl@0: 					numfeatures => 0,     # 4 bytes. (this is 'x')
sl@0: 					numdefuid => 0,       # 4 bytes. (this is 'y')
sl@0: 					endian => "LE",
sl@0: 					packprefix => "V",    # Changed with endian-ness.
sl@0: 					                      # Used to create binary strings.
sl@0: 
sl@0: 					featureflags => [],   # There are x of these.
sl@0: 					dsrs => [],           # There are y of these.
sl@0: 	           };
sl@0: 	bless $self, $class;
sl@0: 	return $self;
sl@0: }
sl@0: 
sl@0: # Print to STDOUT the header information, feature flags information and
sl@0: # default supported range information.
sl@0: sub ShowALL
sl@0: {
sl@0: 	my $self = shift;
sl@0: 	return undef unless(ref($self));
sl@0: 	$self->ShowHeader();
sl@0: 	$self->ShowFeatureFlags();
sl@0: 	$self->ShowDSRs();
sl@0: 	return 1;
sl@0: }
sl@0: 
sl@0: # Print to STDOUT the header information we have.
sl@0: sub ShowHeader
sl@0: {
sl@0: 	my $self = shift;
sl@0: 	return undef unless(ref($self));
sl@0: 
sl@0: 	# Get header information..
sl@0: 	my $typefield = $self->TypeField();
sl@0: 	my $fileversion = $self->FileVersion();
sl@0: 	my $fileflags = $self->FileFlags();
sl@0: 	my $numfeatures = $self->NumFeatures();
sl@0: 	my $numdefuid = $self->NumDefUid();
sl@0: 
sl@0: 	# Display it in English.
sl@0: 	print "TYPEFIELD: '$typefield'\n";
sl@0: 	print "FILEVERSION: '$fileversion'\n";
sl@0: 	print "FILEFLAGS: '$fileflags'\n";
sl@0: 	print "NUMFEATURES: '$numfeatures'\n";
sl@0: 	print "NUMDSRS: '$numdefuid'\n";
sl@0: 
sl@0: 	return(1);
sl@0: }
sl@0: 
sl@0: # Call the 'Show' method in each of the feature flag objects we
sl@0: # have - this will print their content to STDOUT.
sl@0: sub ShowFeatureFlags
sl@0: {
sl@0: 	my $self = shift;
sl@0: 	return undef unless(ref($self));
sl@0: 	my $ffs = $self->FeatureFlags;
sl@0: 	return 1 unless(@$ffs);
sl@0: 
sl@0: 	print "\nFeature Flags\n";
sl@0: 	print "=============\n";
sl@0: 	for my $ff (@$ffs)
sl@0: 	{
sl@0: 		$ff->Show();
sl@0: 	}
sl@0: 	return 1;
sl@0: }
sl@0: 
sl@0: # Call the 'Show' method in each of the default supported range objects we
sl@0: # have - this will print their content to STDOUT.
sl@0: sub ShowDSRs
sl@0: {
sl@0: 	my $self = shift;
sl@0: 	return undef unless(ref($self));
sl@0: 	my $fds = $self->FeatureDSRs;
sl@0: 	return 1 unless(@$fds);
sl@0: 	print "\nFeature DSRs\n";
sl@0: 	print "============\n";
sl@0: 	for my $fd (@$fds)
sl@0: 	{
sl@0: 		$fd->Show();
sl@0: 	}
sl@0: 	return 1;
sl@0: }
sl@0: 
sl@0: # Get/Set the endian-ness we want. Changes the 'packprefix' member which is
sl@0: # used in the creation of binary data.
sl@0: sub Endian
sl@0: {
sl@0: 	my $self = shift;
sl@0: 	return undef unless(ref($self));
sl@0: 	my $arg = shift;
sl@0: 	return $self->{endian} unless(defined($arg));
sl@0: 	if($arg =~ m/(LE|BE)/i)
sl@0: 	{
sl@0: 		my $endian = uc($1);
sl@0: 		$self->{endian} = $endian;
sl@0: 		# Used by 'pack' to generate binary strings.
sl@0: 		$self->{packprefix} = "V" if($endian eq "LE");
sl@0: 		$self->{packprefix} = "N" if($endian eq "BE");
sl@0: 	}
sl@0: 	return $self->{endian};
sl@0: }
sl@0: 
sl@0: # This is 'feat'.
sl@0: sub TypeField
sl@0: {
sl@0: 	my $self = shift;
sl@0: 	return undef unless(ref($self));
sl@0: 	my $arg = shift;
sl@0: 	$self->{typefield} = $arg if(defined($arg));
sl@0: 	return $self->{typefield};
sl@0: }
sl@0: 
sl@0: sub FileVersion
sl@0: {
sl@0: 	my $self = shift;
sl@0: 	return undef unless(ref($self));
sl@0: 	my $arg = shift;
sl@0: 	# Should we be testing for a numeric value?
sl@0: 	$self->{fileversion} = $arg if(defined($arg));
sl@0: 	return $self->{fileversion};
sl@0: }
sl@0: 
sl@0: sub FileFlags
sl@0: {
sl@0: 	my $self = shift;
sl@0: 	return undef unless(ref($self));
sl@0: 	my $arg = shift;
sl@0: 	$self->{fileflags} = $arg if(defined($arg));
sl@0: 	return $self->{fileflags};
sl@0: }
sl@0: 
sl@0: # How many feature flag objects have we got?
sl@0: sub NumFeatures
sl@0: {
sl@0: 	my $self = shift;
sl@0: 	return undef unless(ref($self));
sl@0: 	my $arg = shift;
sl@0: 	$self->{numfeatures} = $arg if(defined($arg));
sl@0: 	return $self->{numfeatures};
sl@0: }
sl@0: 
sl@0: # How many default supported range objects have we got?
sl@0: sub NumDefUid
sl@0: {
sl@0: 	my $self = shift;
sl@0: 	return undef unless(ref($self));
sl@0: 	my $arg = shift;
sl@0: 	$self->{numdefuid} = $arg if(defined($arg));
sl@0: 	return $self->{numdefuid};
sl@0: }
sl@0: 
sl@0: # Create a binary string containing the header information for the
sl@0: # feature manager data file based on the various fields in this object.
sl@0: sub CreateBinaryHeader
sl@0: {
sl@0: 	my $self = shift;
sl@0: 	return undef unless(ref($self));
sl@0: 	my $hdrstring;
sl@0: 
sl@0: 	# Get the letter for packing information with 'pack' into a binary form.
sl@0: 	my $pack16 = lc($self->{packprefix});
sl@0: 	my $pack32 = uc($self->{packprefix});
sl@0: 	
sl@0: 	# Get header information..
sl@0: 	my $typefield = $self->TypeField();
sl@0: 	my $fileversion = $self->FileVersion();
sl@0: 	my $fileflags = $self->FileFlags();
sl@0: 	my $numfeatures = $self->NumFeatures();
sl@0: 	my $numdefuid = $self->NumDefUid();
sl@0: 
sl@0: 	# Write the 'type' field out. This is 'feat'. Would this be different on
sl@0: 	# big-endian systems?
sl@0: 	$hdrstring = $typefield;
sl@0: 
sl@0: 	# Now the file version number. A 16-bit value.. Will this cause trouble
sl@0: 	# if the shifted value is signed?
sl@0: 	$hdrstring .= pack($pack16 . "1", $fileversion);
sl@0: 
sl@0: 	# Now the file flags. Another 16-bit value..
sl@0: 	$hdrstring .= pack($pack16 . "1", $fileflags);
sl@0: 
sl@0: 	# Now the number of listed features - a 32-bit value.
sl@0: 	$hdrstring .= pack($pack32 . "1", $numfeatures);
sl@0: 
sl@0: 	# Now the number of listed features - a 32-bit value.
sl@0: 	$hdrstring .= pack($pack32 . "1", $numdefuid);
sl@0: 
sl@0: 	return $hdrstring;
sl@0: }
sl@0: 
sl@0: # Writes the binary file specified as an argument with the content of this
sl@0: # and contained feature flag and dsr objects.
sl@0: sub WriteToFile
sl@0: {
sl@0: 	my $self = shift;
sl@0: 	return undef unless(ref($self));
sl@0: 	my $file = shift;
sl@0: 	return undef unless(defined($file));
sl@0:     open FILE, "> $file" or die "Couldn't open file '$file' for writing.\n";
sl@0: 	binmode FILE;
sl@0: 	print FILE $self->BinaryContent();
sl@0: 	close FILE;
sl@0: 	return 1;
sl@0: }
sl@0: 
sl@0: 
sl@0: # Create the binary equivalent of the internal data and return it as a
sl@0: # string.
sl@0: sub BinaryContent
sl@0: {
sl@0: 	my $self = shift;
sl@0: 	return undef unless(ref($self));
sl@0: 
sl@0: 	# First get the header information for the registry manager data file.
sl@0: 	my $ret = $self->CreateBinaryHeader();
sl@0: 
sl@0:     # Get the feature flag entries.. This is an array reference.
sl@0: 	# For each one append the binary representation of the information
sl@0: 	# contained.
sl@0: 	my $ffs = $self->FeatureFlags;
sl@0: 	for my $ff (@$ffs)
sl@0: 	{
sl@0: 		$ret .= $ff->BinaryContent();
sl@0: 	}
sl@0: 
sl@0:     # Get the feature default supported range entries.. This is an array
sl@0: 	# reference too. For each one append the binary representation of 
sl@0: 	# uid range contained.
sl@0: 	my $fdsrs = $self->FeatureDSRs;
sl@0: 	for my $ff (@$fdsrs)
sl@0: 	{
sl@0: 		$ret .= $ff->BinaryContent();
sl@0: 	}
sl@0: 	return $ret;
sl@0: }
sl@0: 
sl@0: # Return a reference to the 'feature flags' array.
sl@0: sub FeatureFlags
sl@0: {
sl@0: 	my $self = shift;
sl@0: 	return undef unless(ref($self));
sl@0: 	return $self->{featureflags};
sl@0: }
sl@0: 
sl@0: # Add a Feature Flag object. Perhaps there should be code to check if we
sl@0: # already know about this feature flag. (i.e check the uid against the ones
sl@0: # we have).
sl@0: sub AddFeatureFlag
sl@0: {
sl@0: 	my $self = shift;
sl@0: 	return undef unless(ref($self));
sl@0: 	my $arg = shift;
sl@0: 	die "Method 'AddFeatureFlag' requires a 'FeatureFlag' object as argument.\n"
sl@0:    	    unless(ref($arg) eq  "FeatureFlag");
sl@0: 	push @{$self->FeatureFlags()}, $arg;
sl@0: 	$self->NumFeatures($self->NumFeatures() + 1);
sl@0:     return 1;
sl@0: }
sl@0: 
sl@0: # Return a reference to the 'feature dsrs' array.
sl@0: sub FeatureDSRs
sl@0: {
sl@0: 	my $self = shift;
sl@0: 	return undef unless(ref($self));
sl@0: 	return $self->{dsrs};
sl@0: }
sl@0: 
sl@0: # Add a Feature 'Default Support Range' object.
sl@0: sub AddFeatureDSR
sl@0: {
sl@0: 	my $self = shift;
sl@0: 	return undef unless(ref($self));
sl@0: 	my $arg = shift;
sl@0: 	die "Method 'AddFeatureDSR' requires a 'FeatureDSR' object as argument.\n"
sl@0:    	    unless(ref($arg) eq  "FeatureDSR");
sl@0: 	push @{$self->FeatureDSRs()}, $arg;
sl@0: 	$self->NumDefUid($self->NumDefUid() + 1);
sl@0:     return 1;
sl@0: }
sl@0: 
sl@0: # This method loads up it's information from an existing feature manager
sl@0: # data file. This will die if it thinks there is something wrong with the file.
sl@0: sub LoadUp
sl@0: {
sl@0: 	my $self = shift;
sl@0: 	return undef unless(ref($self) eq "FMCreate");
sl@0: 
sl@0: 	my $packprefix16 = lc($self->{packprefix});
sl@0: 	my $packprefix32 = uc($self->{packprefix});
sl@0: 
sl@0: 	my $file = shift;
sl@0: 	return undef unless(defined($file) and -f $file);
sl@0: 	open FILE, $file or die "Couldn't open '$file'\n";
sl@0: 	binmode FILE;
sl@0: 	my ($tmp, $feat);
sl@0: 
sl@0: 	# First get the file size.
sl@0: 	my $fsz = sysseek(FILE, 0, 2);
sl@0: 	sysseek(FILE, 0, 0);
sl@0: 
sl@0: 	# Read the 'feat' marker from the top of the file. Check it.
sl@0: 	die "Unable to read first 4 bytes from '$file'"
sl@0: 	    unless(4 == sysread(FILE, $feat, 4) );
sl@0: 	die "First four bytes of '$file' do not contain 'feat'"
sl@0: 	    unless($feat eq "feat");
sl@0: 	$self->TypeField($feat); # Pointless. It's set to that anyway.
sl@0: 
sl@0: 	# Read the file version number.
sl@0: 	die "Unable to read two bytes from index 4 from '$file'"
sl@0: 	    unless(2 == sysread(FILE, $tmp, 2) );
sl@0: 	my $filever = unpack( $packprefix16, $tmp );
sl@0: 	$self->FileVersion($filever);
sl@0: 
sl@0: 	# Read the file flags.
sl@0: 	die "Unable to read two bytes from index 6 from '$file'"
sl@0: 	    unless(2 == sysread(FILE, $tmp, 2) );
sl@0: 	my $fileflags = unpack( $packprefix16, $tmp );
sl@0: 	$self->FileFlags($fileflags);
sl@0: 
sl@0: 	# Read the number of features. Don't do anything with this yet..
sl@0: 	die "Unable to read four bytes from index 8 from '$file'"
sl@0: 	    unless(4 == sysread(FILE, $tmp, 4) );
sl@0: 	my $nfeat = unpack( $packprefix32, $tmp );
sl@0: 
sl@0: 	# Read the number of DSRs. Don't do anything with this yet..
sl@0: 	die "Unable to read four bytes from index 12 from '$file'"
sl@0: 	    unless(4 == sysread(FILE, $tmp, 4) );
sl@0: 	my $ndsr = unpack( $packprefix32, $tmp );
sl@0: 
sl@0: 	# Forget it if the filesize is clearly wrong.
sl@0: 	my $expsz = 16 + 12*$nfeat + 8*$ndsr;
sl@0: 	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);
sl@0: 
sl@0: 	# Now read in the feature flags.
sl@0: 	my $offset = 16;
sl@0: 	for(my $ff=0 ; $ff<$nfeat ; $ff++)
sl@0: 	{
sl@0: 		# Get the UID.
sl@0: 	    die "Unable to read four bytes (uid) from index $offset from '$file'"
sl@0: 	        unless(4 == sysread(FILE, $tmp, 4) );
sl@0: 		$offset += 4;
sl@0: 		my $uid = unpack( $packprefix32, $tmp );
sl@0: 
sl@0: 		# Get the status word.
sl@0: 	    die "Unable to read four bytes (sw) from index $offset from '$file'"
sl@0: 	        unless(4 == sysread(FILE, $tmp, 4) );
sl@0: 		$offset += 4;
sl@0: 		my $sw = unpack( $packprefix32, $tmp );
sl@0: 
sl@0: 		# Get the user data word.
sl@0: 	    die "Unable to read four bytes (udw) from index $offset from '$file'"
sl@0: 	        unless(4 == sysread(FILE, $tmp, 4) );
sl@0: 		$offset += 4;
sl@0: 		my $ud = unpack( $packprefix32, $tmp );
sl@0: 
sl@0: 		my $featflag = FeatureFlag->new($uid, $sw, $ud);
sl@0: 		die "Couldn't create a feature flag object!\n" unless(ref($featflag));
sl@0: 		$self->AddFeatureFlag($featflag);
sl@0: 	}
sl@0: 
sl@0: 	# Now read in the DSRs.
sl@0: 	for( my $dsr=0 ; $dsr<$ndsr ; $dsr++ )
sl@0: 	{
sl@0: 		# Get the low UID.
sl@0: 	    die "Unable to read four bytes (lowuid) from index $offset from '$file'"
sl@0: 	        unless(4 == sysread(FILE, $tmp, 4) );
sl@0: 		$offset += 4;
sl@0: 		my $lowuid = unpack( $packprefix32, $tmp );
sl@0: 
sl@0: 		# Get the high UID.
sl@0: 	    die "Can't read four bytes (high uid) from index $offset from '$file'"
sl@0: 	        unless(4 == sysread(FILE, $tmp, 4) );
sl@0: 		$offset += 4;
sl@0: 		my $highuid = unpack( $packprefix32, $tmp );
sl@0: 
sl@0: 		my $fd = FeatureDSR->new($lowuid, $highuid);
sl@0: 		die "Couldn't create 'FeatureDSR' object!\n" unless(ref($fd));
sl@0: 		$self->AddFeatureDSR($fd);
sl@0: 	}
sl@0: 
sl@0: 	# Check if our calculated file offset matches the end of the file.
sl@0: 	# This is pointless actually, because we've already checked the file
sl@0: 	# size..
sl@0: 	my $fileoffset = sysseek(FILE, 0, 2);
sl@0: 	die "End of file offset ($fileoffset) does not match end of DSRs!\n"
sl@0: 	    unless($fileoffset == $offset);
sl@0: 
sl@0: 	close FILE;
sl@0: 	return 1;
sl@0: }
sl@0: 
sl@0: # Remove the feature flag object specified by UID held in this object (in
sl@0: # the internal 'featureflags' array). Returns 1 on success, undef otherwise.
sl@0: sub RemoveFeatureFlagByUID
sl@0: {
sl@0: 	my $self = shift;
sl@0: 	return undef unless(ref($self));
sl@0: 	my $arg = shift;
sl@0: 	return undef unless(defined($arg));
sl@0: 	my $ffs = $self->FeatureFlags;
sl@0: 
sl@0: 	my $idx = 0;
sl@0: 	for my $ff (@$ffs)
sl@0: 	{
sl@0: 		if($ff->UID() == $arg)
sl@0: 		{
sl@0: 			splice(@$ffs, $idx, 1);
sl@0: 			$self->NumFeatures($self->NumFeatures() - 1);
sl@0: 			return 1;
sl@0: 		}
sl@0: 		$idx++;
sl@0: 	}
sl@0: 	return undef;
sl@0: }
sl@0: 
sl@0: # Return a reference to the 'FeatureFlag' object held in this object (in
sl@0: # the internal 'featureflags' array) with the uid specified as an
sl@0: # argument. This returns a reference so it's still in this object on return,
sl@0: # you can modify it and then write out (for example) the data file.
sl@0: sub GetFeatureFlagByUID
sl@0: {
sl@0: 	my $self = shift;
sl@0: 	return undef unless(ref($self));
sl@0: 	my $arg = shift;
sl@0: 	return undef unless(defined($arg));
sl@0: 	my $ffs = $self->FeatureFlags;
sl@0: 	for my $ff (@$ffs)
sl@0: 	{
sl@0: 		return $ff if($ff->UID() == $arg);
sl@0: 	}
sl@0: 	return undef;
sl@0: }
sl@0: 
sl@0: 
sl@0: # Remove the feature DSR object specified by UIDs held in this object (in
sl@0: # the internal 'dsrs' array). Returns 1 on success, undef otherwise.
sl@0: sub RemoveDSRByUIDs
sl@0: {
sl@0: 	my $self = shift;
sl@0: 	return undef unless(ref($self));
sl@0: 	my($lowuid, $highuid) = @_;
sl@0: 	return undef unless(defined($lowuid) and defined($highuid));
sl@0: 	my $fdsrs = $self->FeatureDSRs;
sl@0: 
sl@0: 	my $idx = 0;
sl@0: 	for my $fdsr (@$fdsrs)
sl@0: 	{
sl@0: 		if( ($fdsrs->LowUID() == $lowuid) and
sl@0:             ($fdsrs->HighUID() == $highuid) )
sl@0: 		{
sl@0: 			splice(@$fdsrs, $idx, 1);
sl@0: 			$self->NumDefUid($self->NumDefUid() - 1);
sl@0: 			return 1;
sl@0: 		}
sl@0: 		$idx++;
sl@0: 	}
sl@0: 	return undef;
sl@0: }
sl@0: 
sl@0: # Return a reference to the 'FeatureDSR' object held in this object (in
sl@0: # the internal 'dsrs' array) with the low and high uids specified in the
sl@0: # arguments. This returns a reference so it's still in this object on return,
sl@0: # you can modify it (by changing the uids) and then write out (for example)
sl@0: # the data file.
sl@0: sub GetDSRByUIDs
sl@0: {
sl@0: 	my $self = shift;
sl@0: 	return undef unless(ref($self));
sl@0: 	my($lowuid, $highuid) = @_;
sl@0: 	return undef unless(defined($lowuid) and defined($highuid));
sl@0: 	my $fdsrs = $self->FeatureDSRs;
sl@0: 	for my $fdsr (@$fdsrs)
sl@0: 	{
sl@0: 		return $fdsr if( ($fdsr->LowUID() == $lowuid) and
sl@0:                          ($fdsr->HighUID() == $highuid));
sl@0: 	}
sl@0: 	return undef;
sl@0: }
sl@0: 
sl@0: 1;
sl@0: