Dermot wrote:
Hi All,
Hello,
I have been trying to write this email for a day or two but the
content keeps shifting as my understanding of the problem develops.
I have encountered a bit of code that I am struggling to understand
completely. The code is for dealing with database fields that are
bigint(20) type.
| allowcountry1 | bigint(20) | NO | | -1
| |
| allowcountry2 | bigint(20) | NO | | -1
| |
| allowcountry3 | bigint(20) | NO | | -1
| |
| allowcountry5 | bigint(20) | NO | | -1
| |
| allowcountry4 | bigint(20) | NO | | -1
| |
| allowcountry6 | bigint(20) | NO | | -1
| |
| allowcountry7 | bigint(20) | NO | | -1
| |
| allowcountry0 | bigint(20) | NO | | -1
| |
The DB table is for a product. The product can only be sold in
particularly countries and I think these fields/columns use a bit
pattern to represent that.
I have tracked down a piece of code that I believe insert the data
into each column. I have taken as small a snippet as possible and
tried to test it. It produces this:
$VAR1 = {
'allowcountry6' => '0xffffffffffffffff',
'allowcountry1' => '0xffffffffffffffff',
'allowcountry5' => '0xffffffffffffffff',
'allowcountry2' => '0xffffffffffffffff',
'allowcountry3' => '0xffffffffffffffff',
'allowcountry4' => '0xffffffffffffffff',
'allowcountry0' => '0xffffffffefffffff',
'allowcountry7' => '0xffffffffffffffff'
};
The code that produced this is below and it should run as stood alone.
I can understand parts of it but the overall logic is...well, I think
beyond me.
The routine expect a countryid (156) in this case and a string within
a set of tags. The string can be negated so
RS.CY1> ANTARCTICA</ means available in all countries EXCEPT ANTARCTICA
RS.CY1>* ANTARCTICA</ mean only IN ANTARCTICA.
I have put some questions inline and I would really appreciate an help
understanding the logic behind this. There are problems elsewhere in
the program and I can't really tackling them until I understand how
this bit pattern works. Also if anyone has an pointers to reference
material that might help with this sort of programming, I'd appreciate
it. Mastrering Perl does touch on it but not to this extent.
Thanx in advance.
Dp.
#!/usr/bin/perl
use strict;
use warnings;
use Data::Dumper;
my %hr;
my $countryid = 156;
my $val = '<RS.CY1> ANTARCTICA</RS.CY1>';
create_bit_mask($val, $countryid, \%hr);
print Dumper(\%hr);
sub create_bit_mask {
my $DEBUG = 1;
my $val = shift;
my $countryid=shift;
my $hr = shift;
my $isinclude = 0;
# Figure out whether this is an 'allow' or 'deny' entry
if( $val =~ /\*/ ){
$val =~ s/\*//;
There is no need to search for the pattern twice:
if ( $val =~ s/\*// ) {
$val =~ s/^\s+(\S.*)/$1/;
$isinclude = 1;
print STDERR "ProcessCountry ISINC $isinclude\n" if ($DEBUG == 1);
}
# Have we already got bitmaps? (Authors' comment)
if( not exists $hr->{'allowcountry0'} )
If you want to test whether %$hr is empty ot not then:
unless ( %$hr ) {
{
## Is this how the pattern is negated?
my $bmval = $isinclude? ## So it's hex not base 2?
'0x0000000000000000'
:'0xFFFFFFFFFFFFFFFF';
You are using strings which doesn't make sense in this context. Perhaps
you meant:
my $bmval = $isinclude ? 0 : 0xFFFFFFFFFFFFFFFF;
for(my $i=0;$i<8;$i++) ## Set all the field to there
default; either all 0's or F's
That is usually written as:
for my $i ( 0 .. 7 ) ## Set all the field to their default; either
all 0's or F's
{
$hr->{'allowcountry'.$i} = $bmval;
}
}
Or, more compactly:
%$hr = map { "allowcountry$_" => $bmval } 0 .. 7 unless %$hr;
# The highest
countryid is 243. How can fieldno ever be greater than 3?
my $fieldno=int($countryid/64); # 156/64 2.43, fieldno=2
my $str="";
my $currentno=$fieldno*64; # 2 * 64
What this is doing is clearing out the lowest 6 bits to 0.
$ perl -le'
my $x = 243;
printf "%16b\n", $x;
my $y = int $x / 64;
printf "%16b\n", $y;
my $z = $y * 64;
printf "%16b\n", $z;
'
11110011
11
11000000
The same thing could be done using bit-wise operators instead of
arithmetic operators:
$ perl -le'
my $x = 243;
printf "%16b\n", $x;
my $y = int $x >> 6;
printf "%16b\n", $y;
my $z = $y << 6;
printf "%16b\n", $z;
'
11110011
11
11000000
$ perl -le'
my $x = 243;
printf "%16b\n", $x;
my $y = $x & 0xFFC0;
printf "%16b\n", $y;
'
11110011
11000000
# Amend the bitmaps. This is necessarily a bit ugly. (Authors comment).
for(my $i=0;$i<8;$i++)
That is usually written as:
for my $i ( 0 .. 7 )
{
my $digits=$hr->{"allowcountry$i"}; ## Changing the bit pattern !!!
for(my $j=0;$j<16;$j++)
That is usually written as:
for my $j ( 0 .. 15 )
{
my $bits=hex( substr($digits,17-$j,1));
$bits will be the numerical value of the characters of the string
'0x0000000000000000' or '0xFFFFFFFFFFFFFFFF', starting at the right of
the string and moving leftward for each loop iteration, so the value
will be either 0 or 15.
if(($countryid - $currentno) < 4 && ($countryid >= $currentno))
$currentno changes inside the loop, but you are testing $countryid two
bits at a time for the lowest 6 bits of $countryid, and this only
happens for the 'allowcountry0' key of the hash as $currentno is never
reset after the first key/value is modified.
{
if($isinclude)
{
$bits |= 1<< ($countryid - $currentno); ###
What
is this left shift doing? Is that a or complement?
Left shift moves all the bits in the number (in this case 1) $countryid
- $currentno places to the left. So this sets the bits in $bits to 1 at
location $countryid - $currentno.
}
else
{
$bits &= 15- (1<< ($countryid - $currentno)); ### ditto
This sets the bits in $bits to 0 at location $countryid - $currentno.
}
}
$currentno+=4;
substr($digits,17-$j,1,sprintf("%1x",$bits));
This converts the number back to a text character and stores it in the
correct place in $digits.
}
$hr->{"allowcountry$i"}=$digits;
print STDERR "allowed ", $digits, "\n";
}
}
Your code is using a combination of arithmetic and bit-wise operations
on strings and numbers which would probably be better if you just stuck
to bit-wise operators on numbers throughout.
John
--
Those people who think they know everything are a great
annoyance to those of us who do. -- Isaac Asimov
--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/
