I have to randomly generate IPV6 address using Perl.
Please help me.
It's unclear whether you want just any 128-bit pattern, or if you need to skip reserved IP addresses
This program solves the most basic interpretation
use strict;
use warnings 'all';
use feature 'say';
my $ipv6 = join ':', map { sprintf '%04X', rand 0x10000 } 1 .. 8;
say $ipv6;
output example
FDFE:5E91:137C:8482:DCB2:03D9:2C1D:8A75
If you need a string that contains some ipv6-address, you can use this code:
my $addr_str = '';
$addr_str .= (($_) ? ':' : '') . sprintf "%04x", rand 0xFFFF + 1 for 0..7;
# $addr_str =~ s/0000//g; # to reduce when zero-block appears
Related
I am having trouble figuring out how to effectively use the BitVector module in Perl to find the Exclusive Or (XOR) of two numbers in hexadecimal form.
This is my whole code:
use Bit::Vector;
$bits = Bit::Vector->Word_Bits(); # bits in a machine word
print "This program will take two numbers and will return the XOR of the two numbers.\n";
print "Enter the first number in hexadecimal form:\n";
$firstHexNumber = <STDIN>;
$vector = Bit::Vector->new($bits, $firstHexNumber); # bit vector constructor
print "Enter the second number in hexadecimal form:\n";
$secondHexNumber = <STDIN>;
$vector2 = Bit::Vector->new($bits, $secondHexNumber); # bit vector constructor
$vector3 = Bit::Vector->new($bits); # bit vector constructor
$vector3->Xor($vector,$vector2);
print $vector3;
I am not sure if I am doing the syntax right for the BitVector module.
If I try to run it, I get an output like this.
Output
When I input 1 and 16 as my arguments, the output is supposed to be 17.
Please help me see what's wrong with my code to get the output correct.
Thank you.
No need for a module.
# Make sure the bitwise feature wasn't activated (e.g. by `use 5.022;`)
no if $] >= 5.022, feature => qw( bitwise );
my $hex1 = '012345';
my $hex2 = '000AAA';
my $hex_xor = unpack('H*', pack('H*', $hex1) ^ pack('H*', $hex2) );
say $hex_xor; # 0129ef
or (5.22+)
# Safe. Feature accepted without change in 5.28.
use experimental qw( bitwise );
my $hex1 = '012345';
my $hex2 = '000AAA';
my $hex_xor = unpack('H*', pack('H*', $hex1) ^. pack('H*', $hex2) );
say $hex_xor; # 0129ef
or (5.28+)
use feature qw( bitwise ); # Or: use 5.028; # Or: use v5.28;
my $hex1 = '012345';
my $hex2 = '000AAA';
my $hex_xor = unpack('H*', pack('H*', $hex1) ^. pack('H*', $hex2) );
say $hex_xor; # 0129ef
These solutions work with numbers of arbitrary length, which is why I assume Bit::Vector was selected for use. (Just pad the numbers so that both have the same length if necessary, or Perl will effectively right-pad with zeroes.)
You can use new_Hex() and to_Hex():
use strict;
use warnings;
use Bit::Vector;
my $bits = Bit::Vector->Word_Bits(); # bits in a machine word
my $firstHexNumber = "1";
my $vector = Bit::Vector->new_Hex($bits, $firstHexNumber);
my $secondHexNumber = "17";
my $vector2 = Bit::Vector->new_Hex($bits, $secondHexNumber);
my $vector3 = Bit::Vector->new($bits); # bit vector constructor
$vector3->Xor($vector,$vector2);
print $vector3->to_Hex;
Output:
0000000000000016
I have two Characters first Sequences and Second Quality.
Second Quality show first sequence`s quality like below.
1. ACTGACTGACTG
2. KKKKKKKKKKKK
After processing(Aligned) first sequence it will change as below
1. ACT-GACTG-ACTG
2. KKKKKKKKKKKK
So I have to extend Second information also as below (Using space)
1. ACT-GACTG-ACTG
2. KKK KKKKK KKKK
I already did using for loop and check each character for first one and make a space for second one.
is there any easy and simple way to make it?
Thank you!
Use Positional Information and substr:
use strict;
use warnings;
my $str1 = 'ACT-GACTG-ACTG';
my $str2 = 'KKKKKKKKKKKK';
while ($str1 =~ /\W/g) {
substr $str2, $-[0], 0, ' ';
}
print "$str1\n";
print "$str2\n";
Outputs:
ACT-GACTG-ACTG
KKK KKKKK KKKK
One way would be to add a space to Quality each time you add a dash to Sequence.
Or, you can loop over Sequence and check the positions of dashes, and insert spaces to Quality based on that:
#!/usr/bin/perl
use strict;
use warnings;
my $sequence = 'ACT-GACTG-ACTG';
my $quality = 'KKKKKKKKKKKK';
my $pos = 0;
while (0 <= ($pos = index $sequence, '-', $pos)) {
substr $quality, $pos++, 0, ' ';
}
print "$quality\n";
I am using substr on a very long UTF-8 string (~250,000,000 characters).
The thing is my program almost freeze around the 200,000,000th character.
Does somebody know about this issue? What are my options?
As I am indexing a document using a suffix array, I need:
to keep my string in one piece;
to access variable length substrings using an index.
As for a MWE:
use strict;
use warnings;
use utf8;
my $text = 'あいうえお' x 50000000;
for( my $i = 0 ; $i < length($text) ; $i++ ){
print "\r$i";
my $char = substr($text,$i,1);
}
print "\n";
Perl has two string storage formats. One that's capable of storing 8-bit characters, and one capable of storing 72-bit characters (practically limited to 32 or 64). Your string necessarily uses the latter format. This wide-character format uses a variable number of bytes per character like UTF-8 does.
Finding the ith element of a string in the first format is trivial: Add the offset to the string pointer. With the second format, finding the ith character requires scanning the string from the beginning, just like you would have to scan a file from the beginning to find the nth line. There is a mechanism that caches information about the string as it's discovered, but it's not perfect.
The problem goes away if you use a fixed number of bytes per character.
use utf8;
use Encode qw( encode );
my $text = 'あいうえお' x 50000000;
my $packed = encode('UCS-4le', $text);
for my $i (0..length($packed)/4) {
print "\r$i";
my $char = chr(unpack('V', substr($packed, $i*4, 4)));
}
print "\n";
Note that the string will use 33% more memory for hiragana characters. Or maybe not, since there's no cache anymore.
I suggest that you use a regular expression instead of substr.
Benchmarking these two methods shows that a regex is nearly 100 times faster:
use strict;
use warnings;
use utf8;
my $text = 'あいうえお' x 50_000;
sub mysubstr {
for( my $i = 0 ; $i < length($text) ; $i++ ){
my $char = substr($text,$i,1);
}
}
sub myregex {
while ($text =~ /(.)/g) {
my $char = $1;
}
}
use Benchmark qw(:all) ;
timethese(10, {
'substr' => \&mysubstr,
'regex' => \&myregex,
});
Outputs:
Benchmark: timing 10 iterations of regex, substr...
regex: 2 wallclock secs ( 2.18 usr + 0.00 sys = 2.18 CPU) # 4.58/s (n=10)
substr: 198 wallclock secs (184.66 usr + 0.16 sys = 184.81 CPU) # 0.05/s (n=10)
It is a known issue listed under Bugs for Perl 5.20.0:
http://perldoc.perl.org/perlunicode.html#Speed
The most important part is the first paragraph of my quote:
Speed
Some functions are slower when working on UTF-8 encoded strings than on byte encoded strings. All functions that need to hop over characters such as length(), substr() or index(), or matching regular expressions can work much faster when the underlying data are byte-encoded.
In Perl 5.8.0 the slowness was often quite spectacular; in Perl 5.8.1 a caching scheme was introduced which will hopefully make the slowness somewhat less spectacular, at least for some operations. In general, operations with UTF-8 encoded strings are still slower. As an example, the Unicode properties (character classes) like \p{Nd} are known to be quite a bit slower (5-20 times) than their simpler counterparts like \d (then again, there are hundreds of Unicode characters matching Nd compared with the 10 ASCII characters matching d ).
The easiest way to avoid it is using byte-strings instead of unicode-strings.
In your particular sample, you can just remove characters from the beginning of the $text string as they are processed in order to avoid the linear lookup:
use utf8;
use Encode qw( encode );
$| = 1;
my $text = 'あいうえお' x 50000000;
while ($text ne '') {
print ".";
my $char = substr($text, 0, 1, '');
}
print "\n";
Read a file that contains an address and a data, like below:
#0, 12345678
#1, 5a5a5a5a
...
My aim is to read the address and the data. Consider the data I read is in hex format, and then I need to unpack them to binary number.
So 12345678 would become 00010010001101000101011001111000
Then, I need to further unpack the transferred binary number to another level.
So it becomes, 00000000000000010000000000010000000000000001000100000001000000000000000100000001000000010001000000000001000100010001000000000000
They way I did is like below
while(<STDIN>) {
if (/\#(\S+)\s+(\S+)/) {
$addr = $1;
$data = $2;
$mem{$addr} = ${data};
}
}
foreach $key (sort {$a <=> $b} (keys %mem)) {
my $str = unpack ('B*', pack ('H*',$mem{$key}));
my $str2 = unpack ('B*', pack ('H*', $str));
printf ("#%x ", $key);
printf ("%s",$str2);
printf ("\n");
}
It works, however, my next step is to do some numeric operation on the transferred bits.
Such as bitwise or and shifting. I tried << and | operator, both are for numbers, not strings. So I don't know how to solve this.
Please leave your comments if you have better ideas. Thanks.
You can employ Bit::Vector module from metaCPAN
use strict;
use warnings;
use Bit::Vector;
my $str = "1111000011011001010101000111001100010000001111001010101000111010001011";
printf "orig str: %72s\n", $str;
#only 72 bits for better view
my $vec = Bit::Vector->new_Bin(72,$str);
printf "vec : %72s\n", $vec->to_Bin();
$vec->Move_Left(2);
printf "left 2 : %72s\n", $vec->to_Bin();
$vec->Move_Right(4);
printf "right 4 : %72s\n", $vec->to_Bin();
prints:
orig str: 1111000011011001010101000111001100010000001111001010101000111010001011
vec : 001111000011011001010101000111001100010000001111001010101000111010001011
left 2 : 111100001101100101010100011100110001000000111100101010100011101000101100
right 4 : 000011110000110110010101010001110011000100000011110010101010001110100010
If you need do some math with arbitrary precision, you can also use Math::BigInt or use bigint (http://perldoc.perl.org/bigint.html)
Hex and binary are text representation of numbers. Shifting and bit manipulations are numerical operations. You want a number, not text.
my $hex = '5a5a5a5a';
$num = hex($hex); # Convert to number.
$num >>= 1; # Manipulate the number.
$hex = sprintf('%08X', $num); # Convert back to hex.
In a comment, you mention you want to deal with 256 bit numbers. The native numbers don't support that, but you can use Math::BigInt.
My final solution of this is forget about treat them as numbers, just treat them as string . I use substring and string concentration instead of shift. Then for the or operation , I just add each bit of the string, if it's 0 the result is 0, else is 1.
It may not be the best way to solve this problem. But that's the way I finally used.
How do I create valid IP ranges given an IP address and Subnet mask in Perl? I understand the concept of generating the IP ranges but need help writing in Perl. For example, if I AND the IP address and subnet mask I get the subnet number. Adding 1 to this number should give me the first valid IP. If I invert the subnet mask and OR with the subnet number, I should get the broadcast address. Subtracting 1 from it should give the last valid IP address.
See perldoc perlop for information about the bitwise operators (they are the same as in most other C-like languages):
& is bitwise AND
| is bitwise OR
^ is bitwise XOR
>> is right-shift
<< is left-shift
However, if you really want to do some work with network blocks and IP addresses (as opposed to simply answering a homework assignment - although I'm curious what course you'd be taking that used Perl), you can avoid reinventing the wheel by turning to CPAN:
Net::Netmask
Network::IPv4Addr
If you want to play with bitwise operators yourself, it becomes this:
#!/usr/bin/perl
use strict;
use warnings;
use Socket;
my $ip_address = '192.168.0.15';
my $netmask = 28;
my $ip_address_binary = inet_aton( $ip_address );
my $netmask_binary = ~pack("N", (2**(32-$netmask))-1);
my $network_address = inet_ntoa( $ip_address_binary & $netmask_binary );
my $first_valid = inet_ntoa( pack( 'N', unpack('N', $ip_address_binary & $netmask_binary ) + 1 ));
my $last_valid = inet_ntoa( pack( 'N', unpack('N', $ip_address_binary | ~$netmask_binary ) - 1 ));
my $broadcast_address = inet_ntoa( $ip_address_binary | ~$netmask_binary );
print $network_address, "\n";
print $first_valid, "\n";
print $last_valid, "\n";
print $broadcast_address, "\n";
exit;
With Net::Netmask it's easier to understand:
#!/usr/bin/perl
use strict;
use warnings;
use Net::Netmask;
my $ip_address = '192.168.0.15';
my $netmask = 28;
my $block = Net::Netmask->new( "$ip_address/$netmask" );
my $network_address = $block->base();
my $first_valid = $block->nth(1);
my $last_valid = $block->nth( $block->size - 2 );
my $broadcast_address = $block->broadcast();
print $network_address, "\n";
print $first_valid, "\n";
print $last_valid, "\n";
print $broadcast_address, "\n";
exit;
Quick & dirty way to find the subnet mask:
use Socket;
my $subnet_mask = inet_ntoa(inet_aton($ip_str) & inet_aton($mask_str)):
Following Snippet can help you to find ip address and subnet mask on rhel7
my $ip=`hostname -i`;
my $subnet = `ip addr show|grep -i ".*${ip}/.*"|tail -1|cut -d "/" -f2|cut -d " " -f1`;