Convert the C Function to Perl - perl

I am stuck while trying to convert the C function convertCNGFileToJPGFile mentioned in the program cng2jpg.c
I have been trying to write the same in Perl but don't have enough knowhow with hex,pack and unpack functions.
Would really appreciate if somebody can write a similar code in Perl as mentioned below.
while ((bytesRead = fread(buffer, 1, kBufferSize, inputFile))) {
if (!isValidCNG) {
if (bytesRead < 11 || strncmp("\xa5\xa9\xa6\xa9", (char *)(buffer + 6), 4)) {
fprintf(stderr, "%s does not appear to be a valid CNG file\n", inputFileName);
return 0;
}
isValidCNG = 1;
}
for (size_t i = 0; i < bytesRead; i++)
buffer[i] ^= 0xEF;
size_t bytesWritten = fwrite(buffer, 1, bytesRead, outputFile);
if (bytesWritten < bytesRead) {
fprintf(stderr, "Error writing %s\n", outputFileName);
return 0;
}
}
Thanks in advance.

If I'm reading the code right, all it's doing (besides the validity check) is XORing each byte in the file with the byte 0xEF (i.e. flipping all but the fifth lowest bit of each byte). In Perl, you could implement that with:
local $/ = \(2**16); # ignore line breaks, read in 64 kiB chunks
while (<>) {
$_ ^= "\xEF" x length;
print;
}
The validity check is just checking that the output is actually a valid JPEG file — specifically, that the 7th to 10th bytes of the output file contain the magic word "JFIF" (which becomes "\xa5\xa9\xa6\xa9" when XORed with 0xEF). Generally, unless you're expecting to frequently run this code on files which are not actually CNG files, I wouldn't bother with it, since it's easier to just check the validity of the output afterwards. (Besides, the check will fail if the decoded file is actually an Exif JPEG image, which have the magic word "Exif" instead.)
If you do want to include the check, something like this should do it:
local $/ = \(2**16); # ignore line breaks, read in 64 kiB chunks
while (<>) {
$_ ^= "\xEF" x length;
die "Not a valid CNG file" if $. == 1 and not /^.{6}(JFIF|Exif)/s;
print;
}
Ps. If this code runs too slow, I'd suggest two possible improvements: 1) use a larger buffer, and b) preallocate the mask of 0xEF bytes instead of rebuilding it on the fly each time:
local $/ = \(2**20); # ignore line breaks, read in 1 MiB chunks
my $mask = "\xEF" x $$/;
while (<>) {
$_ ^= substr($mask, 0, length);
die "Not a valid CNG file" if $. == 1 and not /^.{6}(JFIF|Exif)/s;
print;
}

Related

Can someone explain this loop to me?

I have the following Perl code. I Know what the end result is: if I run it and pass in an x9.37 file, it will spit out each field of text. That's great, but I am trying to port this to another language, and I can't read Perl at all. If someone could turn this into some form of pseudocode (I don't need working Java - I can write that part) I just need someone to explain what is going on in the Perl below!
#!/usr/bin/perl -w
use strict;
use Encode;
my $tiff_flag = 0;
my $count = 0;
open(FILE,'<',$ARGV[0]) or die 'Error opening input file';
binmode(FILE) or die 'Error setting binary mode on input file';
while (read (FILE,$_,4)) {
my $rec_len = unpack("N",$_);
die "Bad record length: $rec_len" unless ($rec_len > 0);
read (FILE,$_,$rec_len);
if (substr($_,0,2) eq "\xF5\xF2") {
$_ = substr($_,0,117);
}
print decode ('cp1047', $_) . "\n";
}
close FILE;
read (FILE,$_,4) : read 4 bytes from FILE input stream and load into the variable $_
$rec_len = unpack("N",$_): interpret the first 4 bytes of the variable $_ as an unsigned 32-bit integer in big-endian order, assign to the variable $rec_len
read (FILE,$_,$rec_len): read $rec_len bytes from FILE stream into variable $_
substr($_,0,2): the first two characters of the variable $_
"\xF5\xF2": a two-character string consisting of the bytes 245 and 242
$_ = substr($_,0,117): set $_ to the first 117 characters of $_
use Encode;print decode ('cp1047', $_): interpret the contents of $_ with "code page 1047", i.e., EBCDIC and output to standard output
-w is the old way of enabling warnings.
my declares a lexically scoped variable.
open with < opens a file for reading, the filename is taken from the #ARGV array, i.e. the program's parameters. FILE is the file handle associated with the file.
read reads four bytes into the $_ variable. unpack interprets it as an unsigned 32-bit long (so the following condition can fail only when it's 0).
The next read reads that many bytes to $_ again. substr extracts a substring, and if the first two bytes there are "\xf5\xf2", it shortens the string to the first 117 bytes. It then converts the string to the code page 1047.

Count subsequences in hundreds of GB of data

I'm trying to process a very large file and tally the frequency of all sequences of a certain length in the file.
To illustrate what I'm doing, consider a small input file containing the sequence abcdefabcgbacbdebdbbcaebfebfebfeb
Below, the code reads the whole file in, and takes the first substring of length n (below I set this to 5, although I want to be able to change this) and counts its frequency:
abcde => 1
Next line, it moves one character to the right and does the same:
bcdef => 1
It then continues for the rest of the string and prints the 5 most frequent sequences:
open my $in, '<', 'in.txt' or die $!; # 'abcdefabcgbacbdebdbbcaebfebfebfeb'
my $seq = <$in>; # read whole file into string
my $len = length($seq);
my $seq_length = 5; # set k-mer length
my %data;
for (my $i = 0; $i <= $len - $seq_length; $i++) {
my $kmer = substr($seq, $i, $seq_length);
$data{$kmer}++;
}
# print the hash, showing only the 5 most frequent k-mers
my $count = 0;
foreach my $kmer (sort { $data{$b} <=> $data{$a} } keys %data ){
print "$kmer $data{$kmer}\n";
$count++;
last if $count >= 5;
}
ebfeb 3
febfe 2
bfebf 2
bcaeb 1
abcgb 1
However, I would like to find a more efficient way of achieving this. If the input file was 10GB or 1000GB, then reading the whole thing into a string would be very memory expensive.
I thought about reading in blocks of characters, say 100 at a time and proceeding as above, but here, sequences that span 2 blocks would not be tallied correctly.
My idea then, is to only read in n number of characters from the string, and then move onto the next n number of characters and do the same, tallying their frequency in a hash as above.
Are there any suggestions about how I could do this? I've had a look a read using an offset, but can't get my head around how I could incorporate this here
Is substr the most memory efficient tool for this task?
From your own code it's looking like your data file has just a single line of data -- not broken up by newline characters -- so I've assumed that in my solution below. Even if it's possible that the line has one newline character at the end, the selection of the five most frequent subsequences at the end will throw this out as it happens only once
This program uses sysread to fetch an arbitrarily-sized chunk of data from the file and append it to the data we already have in memory
The body of the loop is mostly similar to your own code, but I have used the list version of for instead of the C-style one as it is much clearer
After processing each chunk, the in-memory data is truncated to the last SEQ_LENGTH-1 bytes before the next cycle of the loop pulls in more data from the file
I've also use constants for the K-mer size and the chunk size. They are constant after all!
The output data was produced with CHUNK_SIZE set to 7 so that there would be many instances of cross-boundary subsequences. It matches your own required output except for the last two entries with a count of 1. That is because of the inherent random order of Perl's hash keys, and if you require a specific order of sequences with equal counts then you must specify it so that I can change the sort
use strict;
use warnings 'all';
use constant SEQ_LENGTH => 5; # K-mer length
use constant CHUNK_SIZE => 1024 * 1024; # Chunk size - say 1MB
my $in_file = shift // 'in.txt';
open my $in_fh, '<', $in_file or die qq{Unable to open "$in_file" for input: $!};
my %data;
my $chunk;
my $length = 0;
while ( my $size = sysread $in_fh, $chunk, CHUNK_SIZE, $length ) {
$length += $size;
for my $offset ( 0 .. $length - SEQ_LENGTH ) {
my $kmer = substr $chunk, $offset, SEQ_LENGTH;
++$data{$kmer};
}
$chunk = substr $chunk, -(SEQ_LENGTH-1);
$length = length $chunk;
}
my #kmers = sort { $data{$b} <=> $data{$a} } keys %data;
print "$_ $data{$_}\n" for #kmers[0..4];
output
ebfeb 3
febfe 2
bfebf 2
gbacb 1
acbde 1
Note the line: $chunk = substr $chunk, -(SEQ_LENGTH-1); which sets $chunk as we pass through the while loop. This ensures that strings spanning 2 chunks get counted correctly.
The $chunk = substr $chunk, -4 statement removes all but the last four characters from the current chunk so that the next read appends CHUNK_SIZE bytes from the file to those remaining characters. This way the search will continue, but starts with the last 4 of the previous chunk's characters in addition to the next chunk: data doesn't fall into a "crack" between the chunks.
Even if you don't read the entire file into memory before processing it, you could still run out of memory.
A 10 GiB file contains almost 11E9 sequences.
If your sequences are sequences of 5 characters chosen from a set of 5 characters, there are only 55 = 3,125 unique sequences, and this would easily fit in memory.
If your sequences are sequences of 20 characters chosen from a set of 5 characters, there are 520 = 95E12 unique sequences, so the all 11E9 sequences of a 10 GiB file could unique. That does not fit in memory.
In that case, I suggest doing the following:
Create a file that contains all the sequences of the original file.
The following reads the file in chunks rather than all at once. The tricky part is handling sequences that span two blocks. The following program uses sysread[1] to fetch an arbitrarily-sized chunk of data from the file and append it to the last few character of the previously read block. This last detail allows sequences that span blocks to be counted.
perl -e'
use strict;
use warnings qw( all );
use constant SEQ_LENGTH => 20;
use constant CHUNK_SIZE => 1024 * 1024;
my $buf = "";
while (1) {
my $size = sysread(\*STDIN, $buf, CHUNK_SIZE, length($buf));
die($!) if !defined($size);
last if !$size;
for my $offset ( 0 .. length($buf) - SEQ_LENGTH ) {
print(substr($buf, $offset, SEQ_LENGTH), "\n");
}
substr($buf, 0, -(SEQ_LENGTH-1), "");
}
' <in.txt >sequences.txt
Sort the sequences.
sort sequences.txt >sorted_sequences.txt
Count the number of instances of each sequeunces, and store the count along with the sequences in another file.
perl -e'
use strict;
use warnings qw( all );
my $last = "";
my $count;
while (<>) {
chomp;
if ($_ eq $last) {
++$count;
} else {
print("$count $last\n") if $count;
$last = $_;
$count = 1;
}
}
' sorted_sequences.txt >counted_sequences.txt
Sort the sequences by count.
sort -rns counted_sequences.txt >sorted_counted_sequences.txt
Extract the results.
perl -e'
use strict;
use warnings qw( all );
my $last_count;
while (<>) {
my ($count, $seq) = split;
last if $. > 5 && $count != $last_count;
print("$seq $count\n");
$last_count = $count;
}
' sorted_counted_sequences.txt
This also prints ties for 5th place.
This can be optimized by tweaking the parameters passed to sort[2], but it should offer decent performance.
sysread is faster than previously suggested read since the latter performs a series of 4 KiB or 8 KiB reads (depending on your version of Perl) internally.
Given the fixed-length nature of the sequence, you could also compress the sequences into ceil(log256(520)) = 6 bytes then base64-encode them into ceil(6 * 4/3) = 8 bytes. That means 12 fewer bytes would be needed per sequence, greatly reducing the amount to read and to write.
Portions of this answer was adapted from content by user:622310 licensed under cc by-sa 3.0.
Generally speaking Perl is really slow at character-by-character processing solutions like those posted above, it's much faster at something like regular expressions since essentially your overhead is mainly how many operators you're executing.
So if you can turn this into a regex-based solution that's much better.
Here's an attempt to do that:
$ perl -wE 'my $str = "abcdefabcgbacbdebdbbcaebfebfebfeb"; for my $pos (0..4) { $str =~ s/^.// if $pos; say for $str =~ m/(.{5})/g }'|sort|uniq -c|sort -nr|head -n 5
3 ebfeb
2 febfe
2 bfebf
1 gbacb
1 fabcg
I.e. we have our string in $str, and then we pass over it 5 times generating sequences of 5 characters, after the first pass we start chopping off a character from the front of the string. In a lot of languages this would be really slow since you'd have to re-allocate the entire string, but perl cheats for this special case and just sets the index of the string to 1+ what it was before.
I haven't benchmarked this but I bet something like this is a much more viable way to do this than the algorithms above, you could also do the uniq counting in perl of course by incrementing a hash (with the /e regex option is probably the fastest way), but I'm just offloading that to |sort|uniq -c in this implementation, which is probably faster.
A slightly altered implementation that does this all in perl:
$ perl -wE 'my $str = "abcdefabcgbacbdebdbbcaebfebfebfeb"; my %occur; for my $pos (0..4) { substr($str, 0, 1) = "" if $pos; $occur{$_}++ for $str =~ m/(.{5})/gs }; for my $k (sort { $occur{$b} <=> $occur{$a} } keys %occur) { say "$occur{$k} $k" }'
3 ebfeb
2 bfebf
2 febfe
1 caebf
1 cgbac
1 bdbbc
1 acbde
1 efabc
1 aebfe
1 ebdbb
1 fabcg
1 bacbd
1 bcdef
1 cbdeb
1 defab
1 debdb
1 gbacb
1 bdebd
1 cdefa
1 bbcae
1 bcgba
1 bcaeb
1 abcgb
1 abcde
1 dbbca
Pretty formatting for the code behind that:
my $str = "abcdefabcgbacbdebdbbcaebfebfebfeb";
my %occur;
for my $pos (0..4) {
substr($str, 0, 1) = "" if $pos;
$occur{$_}++ for $str =~ m/(.{5})/gs;
}
for my $k (sort { $occur{$b} <=> $occur{$a} } keys %occur) {
say "$occur{$k} $k";
}
The most straightforward approach is to use the substr() function:
% time perl -e '$/ = \1048576;
while ($s = <>) { for $i (0..length $s) {
$hash{ substr($s, $i, 5) }++ } }
foreach my $k (sort { $hash{$b} <=> $hash{$a} } keys %hash) {
print "$k $hash{$k}\n"; $it++; last if $it == 5;}' nucleotide.data
NNCTA 337530
GNGGA 337362
NCACT 337304
GANGN 337290
ACGGC 337210
269.79 real 268.92 user 0.66 sys
The Perl Monks node on iterating along a string was a useful resource, as were the responses and comments from #Jonathan Leffler, #ÆvarArnfjörðBjarmason, #Vorsprung, #ThisSuitIsBlackNotm #borodin and #ikegami here in this SO posting. As was pointed out, the issue with very large files is memory, which in turn requires that files be read in chunks. When reading from a file in chunks, if your code is iterating through the data it has to properly handle switching from one chunk/source to the next without dropping any bytes.
As a simplistic example, next unless length $kmer == 5; will get checked during each 1048576 byte/character iteration in the script above, meaning strings that exist at the end of one chunk and the beginning of another will be missed (cf. #ikegami's and #Borodin's solutions). This will alter the resulting count, though perhaps not in a statistically significant way[1]. Both #borodin and #ikegami address the issue of missing/overlapping strings between chunks by appending each chunk to the remaining characters of the previous chunk as they sysread in their while() loops. See Borodin's response and comments for an explanation of how it works.
Using Stream::Reader
Since perl has been around for quite a while and has collected a lot of useful code, another perfectly valid approach is to look for a CPAN module that achieves the same end. Stream::Reader can create a "stream" interface to a file handle that wraps the solution to the chunking issue behind a set of convenient functions for accessing the data.
use Stream::Reader;
use strict;
use warnings;
open( my $handler, "<", shift );
my $stream = Stream::Reader->new( $handler, { Mode => "UB" } );
my %hash;
my $string;
while ($stream->readto("\n", { Out => \$string }) ) {
foreach my $i (0..length $string) {
$hash{ substr($string, $i, 5) }++
}
}
my $it;
foreach my $k (sort { $hash{$b} <=> $hash{$a} } keys %hash ) {
print "$k $hash{$k}\n";
$it++; last if $it == 5;
}
On a test data file nucleotide.data, both Borodin's script and the Stream::Reader approach shown above produced the same top five results. Note the small difference compared to the results from the shell command above. This illustrates the need to properly handle reading data in chunks.
NNCTA 337530
GNGGA 337362
NCACT 337305
GANGN 337290
ACGGC 337210
The Stream::Reader based script was significantly faster:
time perl sequence_search_stream-reader.pl nucleotide.data
252.12s
time perl sequence_search_borodin.pl nucleotide.data
350.57s
The file nucleotide.data was a 1Gb in size, consisting of single string of approximately 1 billion characters:
% wc nucleotide.data
0 0 1048576000 nucleotide.data
% echo `head -c 20 nucleotide.data`
NCCANGCTNGGNCGNNANNA
I used this command to create the file:
perl -MString::Random=random_regex -e '
open (my $fh, ">>", "nucleotide.data");
for (0..999) { print $fh random_regex(q|[GCNTA]{1048576}|) ;}'
Lists and Strings
Since the application is supposed to read a chunk at a time and move this $seq_length sized window along the length of the data building a hash for tracking string frequency, I thought a "lazy list" approach might work here. But, to move a window through a collection of data (or slide as with List::Gen) reading elements natatime, one needs a list.
I was seeing the data as one very long string which would first have to be made into a list for this approach to work. I'm not sure how efficient this can be made. Nevertheless, here is my attempt at a "lazy list" approach to the question:
use List::Gen 'slide';
$/ = \1048575; # Read a million character/bytes at a time.
my %hash;
while (my $seq = <>) {
chomp $seq;
foreach my $kmer (slide { join("", #_) } 5 => split //, $seq) {
next unless length $kmer == 5;
$hash{$kmer}++;
}
}
foreach my $k (sort { $hash{$b} <=> $hash{$a} } keys %hash) {
print "$k $hash{$k}\n";
$it++; last if $it == 5;
}
I'm not sure this is "typical perl" (TIMTOWDI of course) and I suppose there are other techniques (cf. gather/take) and utilities suitable for this task. I like the response from #Borodin best since it seems to be the most common way to take on this task and is more efficient for the potentially large file sizes that were mentioned (100Gb).
Is there a fast/best way to turn a string into a list or object? Using an incremental read() or sysread() with substr wins on this point, but even with sysread a 1000Gb string would require a lot of memory just for the resulting hash. Perhaps a technique that serialized/cached the hash to disk as it grew beyond a certain size would work with very, very large strings that were liable to create very large hashes.
Postscript and Results
The List::Gen approach was consistently between 5 and 6 times slower than #Borodin's approach. The fastest script used the Stream::Reader module. Results were consistent and each script selected the same top five strings with the two smaller files:
1 million character nucleotide string
sequence_search_stream-reader.pl : 0.26s
sequence_search_borodin.pl : 0.39s
sequence_search_listgen.pl : 2.04s
83 million character nucleotide string
With the data in file xaa:
wc xaa
0 1 83886080 xaa
% time perl sequence_search_stream-reader.pl xaa
GGCNG 31510
TAGNN 31182
AACTA 30944
GTCAN 30792
ANTAT 30756
21.33 real 20.95 user 0.35 sys
% time perl sequence_search_borodin.pl xaa
GGCNG 31510
TAGNN 31182
AACTA 30944
GTCAN 30792
ANTAT 30756
28.13 real 28.08 user 0.03 sys
% time perl sequence_search_listgen.pl xaa
GGCNG 31510
TAGNN 31182
AACTA 30944
GTCAN 30792
ANTAT 30756
157.54 real 156.93 user 0.45 sys
1 billion character nucleotide string
In a larger file the differences were of similar magnitude but, because as written it does not correctly handle sequences spanning chunk boundaries, the List::Gen script had the same discrepancy as the shell command line at the beginning of this post. The larger file meant a number of chunk boundaries and a discrepancy in the count.
sequence_search_stream-reader.pl : 252.12s
sequence_search_borodin.pl : 350.57s
sequence_search_listgen.pl : 1928.34s
The chunk boundary issue can of course be resolved, but I'd be interested to know about other potential errors or bottlenecks that are introduced using a "lazy list" approach. If there were any benefit in terms of CPU usage from using slide to "lazily" move along the string, it seems to be rendered moot by the need to make a list out of the string before starting.
I'm not surprised that reading data across chunk boundaries is left as an implementation exercise (perhaps it cannot be handled "magically") but I wonder what other CPAN modules or well worn subroutine style solutions might exist.
1. Skipping four characters - and thus four 5 character string combinations - at the end of each megabyte read of a terabyte file would mean the results would not include 3/10000 of 1% from the final count.
echo "scale=10; 100 * (1024^4/1024^2 ) * 4 / 1024^4 " | bc
.0003814697

Read binary file bit by bit

Is there a way that I can read a binary file bit by bit, without saving it as an array?
I have a very large binary file that I need to to read it bit by bit. And saving it as an array takes a lot of time, so I want to prevent this. I don't care what happened to the file content.
$size = stat($args{file});
my $vector;
open BIN, "<$args{file}";
read(BIN, $vector, $size->[7], 0);
close BIN;
# The code below is the part that takes a lot of time.
my #unpacked = split //, (unpack "B*", $vector);
return #unpacked;
Read in the file 1 byte at a time using the special $/ variable, and then use bitwise operators to check each bit in the byte. Should end up being something like the following:
$/ = \1; # read 1 byte at a time
while(<>) {
my $ord = ord($_);
# for each bit in the byte
for(1 .. 8) {
if($ord & 1) {
# do 1 stuff
}
else {
# do 0 stuff
}
# move onto the next bit
$ord >>= 1;
}
}
Use the builtin vec function to manipulate Perl scalars as bit vectors.

Can you extend pack() to handle custom, variable length fields?

The Bitcoin protocol, in order to save space, encodes their integers using what they call variable length integers or varints. The first byte of the varint encodes its length and its interpretation:
FirstByte Value
< 0xfd treat the byte itself as an 8 bit integer
0xfd next 2 bytes form a 16 bit integer
0xfe next 4 bytes form a 32 bit integer
0xff next 8 bytes form a 64 bit integer
(All ints are little endian and unsigned). I wrote the following function to unpack varints:
my $varint = "\xfd\x00\xff"; # \x00\xff in little endian == 65280
say unpack_varint($varint); # print 65280
sub unpack_varint{
my $v = shift;
my $first_byte = unpack "C", $v;
say $first_byte;
if ($first_byte < 253) { # \xfd == 253
return $first_byte;
}
elsif ($first_byte == 253){
return unpack "S<", substr $v, 1, 2;
}
elsif ($first_byte == 254){
return unpack "L<", substr $v, 1, 4;
}
elsif ($first_byte == 255){
return unpack "Q<", substr $v, 1, 8;
}
else{
die "error";
}
}
This works... but its very inelegant b/c if I have a long bytestring with embedded varints, I would have to read up to the beginning of the varint, pass the remainder to the function above, find out how long the encoded varint was, etc. etc. Is there a better way to write this? In particular, can I somehow extend pack() to support this kind of structure?
You can create a set of shift_$type functions that read and delete some value at the beginning of the given string, so your code becomes something as the following:
my $buffer = ...;
my $val1 = shift_varint($buffer);
my $val2 = shift_string($buffer);
my $val3 = shift_uint32($buffer);
...
You can also add a multirecord "shifter":
my ($val1, $val2, $val3) = shift_multi($buffer, qw(varint string uint32));
If you need more speed you could also write a compiler which can convert a set of types into an unpacker sub.

md5 "%02x" fprintf

I have to calculate md5 hash for a file. I succesfully find libraries to do it, and they print the hash on screen.
I have to print the hash on a txt file, but I have some problems. It only prints 00 intead of the all 32 bit hash. This is the print function. I only add the lines to open the file and to print on it, the rest of the function is from the library and works fine, because on the screen the hash is printed in the right way.
Seems to be some kind of problems with fprintf and %02x". Thanks.
static void MDPrint (mdContext)
MD5_CTX *mdContext;
{
int i;
FILE *fp;
if((fp=fopen("userDatabase.txt", "ab"))==NULL) printf("Error while opening the file..\n");
else {
for (i = 0; i < 16; i++)
printf ("%02x", mdContext->digest[i]);
fprintf(fp, "%02x", mdContext->digest[i]);
}
fclose(fp);
}
Your problem is here;
for (i = 0; i < 16; i++)
printf ("%02x", mdContext->digest[i]);
fprintf(fp, "%02x", mdContext->digest[i]);
Since there are no curly braces, only the printf line will be inside the loop. You need to add braces to make both lines be inside the loop;
for (i = 0; i < 16; i++)
{
printf ("%02x", mdContext->digest[i]);
fprintf(fp, "%02x", mdContext->digest[i]);
}