0
|
1 package CPT::Util::CRC64;
|
|
2
|
|
3 # This was taken from Bio::GMOD::Bulkfiles::SWISS_CRC64
|
|
4
|
|
5 use Moose;
|
|
6 use strict;
|
|
7 use warnings;
|
|
8 use autodie;
|
|
9
|
|
10
|
|
11 has 'POLY64REVh' => ( is => 'ro', isa => 'Any', default => 0xd8000000 );
|
|
12 has 'CRCTableh' => ( is => 'rw', isa => 'ArrayRef', default => sub { [] });
|
|
13 has 'CRCTablel' => ( is => 'rw', isa => 'ArrayRef', default => sub { [] });
|
|
14 has 'initialized' => ( is => 'rw', isa => 'Bool', default => 0 );
|
|
15 has 'size' => ( is => 'rw', isa => 'Int' );
|
|
16 has 'crcl' => (is => 'rw', isa => 'Any', default => 0);
|
|
17 has 'crch' => (is => 'rw', isa => 'Any', default => 0);
|
|
18
|
|
19 sub add {
|
|
20 my ($self, $sequence) = @_;
|
|
21 my $crcl = $self->crcl();
|
|
22 my $crch = $self->crch();
|
|
23 my $size = $self->size();
|
|
24 my @CRCTableh = @{$self->CRCTableh()};
|
|
25 my @CRCTablel = @{$self->CRCTablel()};
|
|
26
|
|
27 foreach (split //, $sequence){
|
|
28 my $shr = ($crch & 0xFF) << 24;
|
|
29 my $temp1h = $crch >> 8;
|
|
30 my $temp1l = ($crcl >> 8) | $shr;
|
|
31 my $tableindex = ($crcl ^ (unpack "C", $_)) & 0xFF;
|
|
32 $crch = $temp1h ^ $CRCTableh[$tableindex];
|
|
33 $crcl = $temp1l ^ $CRCTablel[$tableindex];
|
|
34 $size++;
|
|
35 }
|
|
36 $self->crcl($crcl);
|
|
37 $self->crch($crch);
|
|
38 $self->size($size);
|
|
39 }
|
|
40
|
|
41 sub hexsum {
|
|
42 my ($self) = @_;
|
|
43 my $crcl = $self->crcl();
|
|
44 my $crch = $self->crch();
|
|
45 return sprintf("%08X%08X", $crch, $crcl);
|
|
46 }
|
|
47
|
|
48 sub init {
|
|
49 my ($self) = @_;
|
|
50 $self->crcl(0);
|
|
51 $self->crch(0);
|
|
52 $self->size(0);
|
|
53 my @h;
|
|
54 my @l;
|
|
55 my $POLY64REVh = $self->POLY64REVh();
|
|
56 if(! $self->initialized() ){
|
|
57 $self->initialized(1);
|
|
58 for (my $i=0; $i<256; $i++) {
|
|
59 my $partl = $i;
|
|
60 my $parth = 0;
|
|
61 for (my $j=0; $j<8; $j++) {
|
|
62 my $rflag = $partl & 1;
|
|
63 $partl >>= 1;
|
|
64 $partl |= (1 << 31) if $parth & 1;
|
|
65 $parth >>= 1;
|
|
66 $parth ^= $POLY64REVh if $rflag;
|
|
67 }
|
|
68 $h[$i] = $parth;
|
|
69 $l[$i] = $partl;
|
|
70 }
|
|
71 $self->CRCTableh(\@h);
|
|
72 $self->CRCTablel(\@l);
|
|
73 }
|
|
74 }
|
|
75
|
|
76 sub crc64 {
|
|
77 my ($self, $sequence) = @_;
|
|
78 $self->init();
|
|
79 $self->add($sequence);
|
|
80 return $self->hexsum();
|
|
81 }
|
|
82
|
|
83 no Moose;
|
|
84
|
|
85 1;
|
|
86
|
|
87 __END__
|
|
88
|
|
89 =pod
|
|
90
|
|
91 =encoding UTF-8
|
|
92
|
|
93 =head1 NAME
|
|
94
|
|
95 CPT::Util::CRC64
|
|
96
|
|
97 =head1 VERSION
|
|
98
|
|
99 version 1.99.4
|
|
100
|
|
101 =head1 CRC64 perl module documentation
|
|
102
|
|
103 =head2 NAME
|
|
104
|
|
105 CRC64 - Calculate the cyclic redundancy check.
|
|
106
|
|
107 =head2 SYNOPSIS
|
|
108
|
|
109 use CPT::Util::CRC64;
|
|
110
|
|
111 my $crc = CPT::Util::CRC64->new();
|
|
112 $crc = $crc->add("IHATEMATH");
|
|
113 #returns the string "E3DCADD69B01ADD1"
|
|
114
|
|
115 =head2 DESCRIPTION
|
|
116
|
|
117 SWISS-PROT + TREMBL use a 64-bit Cyclic Redundancy Check for the
|
|
118 amino acid sequences.
|
|
119
|
|
120 The algorithm to compute the CRC is described in the ISO 3309
|
|
121 standard. The generator polynomial is x64 + x4 + x3 + x + 1.
|
|
122 Reference: W. H. Press, S. A. Teukolsky, W. T. Vetterling, and B. P.
|
|
123 Flannery, "Numerical recipes in C", 2nd ed., Cambridge University
|
|
124 Press. Pages 896ff.
|
|
125
|
|
126 =head2 Functions
|
|
127
|
|
128 =over
|
|
129
|
|
130 =item crc64 string
|
|
131
|
|
132 Calculate the CRC64 (cyclic redundancy checksum) for B<string>.
|
|
133
|
|
134 In array context, returns two integers equal to the higher and lower
|
|
135 32 bits of the CRC64. In scalar context, returns a 16-character string
|
|
136 containing the CRC64 in hexadecimal format.
|
|
137
|
|
138 =back
|
|
139
|
|
140 =head1 AUTHOR
|
|
141
|
|
142 Alexandre Gattiker, gattiker@isb-sib.ch
|
|
143
|
|
144 Eric Rasche <rasche.eric@yandex.ru> (reworte for CPT framework)
|
|
145
|
|
146 =head1 ACKNOWLEDGEMENTS
|
|
147
|
|
148 Based on SPcrc, a C implementation by Christian Iseli, available at
|
|
149 ftp://ftp.ebi.ac.uk/pub/software/swissprot/Swissknife/old/SPcrc.tar.gz
|
|
150
|
|
151 =head1 AUTHOR
|
|
152
|
|
153 Eric Rasche <rasche.eric@yandex.ru>
|
|
154
|
|
155 =head1 COPYRIGHT AND LICENSE
|
|
156
|
|
157 This software is Copyright (c) 2014 by Eric Rasche.
|
|
158
|
|
159 This is free software, licensed under:
|
|
160
|
|
161 The GNU General Public License, Version 3, June 2007
|
|
162
|
|
163 =cut
|