annotate bin/cek.pl @ 614:70355e17653e

Use zlib which is more available
author nanaya <me@nanaya.pro>
date Mon, 02 Apr 2018 17:45:56 +0900
parents 1a996b35eaab
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
124
5bafb912837e Massive addition of old scripts collection.
Edho Prima Arief <edho@myconan.net>
parents:
diff changeset
1 #!/usr/bin/env perl
5bafb912837e Massive addition of old scripts collection.
Edho Prima Arief <edho@myconan.net>
parents:
diff changeset
2
5bafb912837e Massive addition of old scripts collection.
Edho Prima Arief <edho@myconan.net>
parents:
diff changeset
3 use strict;
5bafb912837e Massive addition of old scripts collection.
Edho Prima Arief <edho@myconan.net>
parents:
diff changeset
4 use warnings;
614
70355e17653e Use zlib which is more available
nanaya <me@nanaya.pro>
parents: 613
diff changeset
5 use Compress::Zlib;
124
5bafb912837e Massive addition of old scripts collection.
Edho Prima Arief <edho@myconan.net>
parents:
diff changeset
6 use File::Basename;
5bafb912837e Massive addition of old scripts collection.
Edho Prima Arief <edho@myconan.net>
parents:
diff changeset
7
5bafb912837e Massive addition of old scripts collection.
Edho Prima Arief <edho@myconan.net>
parents:
diff changeset
8 my @files = @ARGV or print("Usage: ",basename($0)," file1 file2 ... fileN\n") && exit(1);
613
1a996b35eaab Style updates
nanaya <me@nanaya.pro>
parents: 124
diff changeset
9 my $num_ok = 0;
1a996b35eaab Style updates
nanaya <me@nanaya.pro>
parents: 124
diff changeset
10 my $num_err = 0;
1a996b35eaab Style updates
nanaya <me@nanaya.pro>
parents: 124
diff changeset
11 my $num_nf = 0;
1a996b35eaab Style updates
nanaya <me@nanaya.pro>
parents: 124
diff changeset
12 my $num_na = @files;
1a996b35eaab Style updates
nanaya <me@nanaya.pro>
parents: 124
diff changeset
13
1a996b35eaab Style updates
nanaya <me@nanaya.pro>
parents: 124
diff changeset
14 foreach (@files) {
1a996b35eaab Style updates
nanaya <me@nanaya.pro>
parents: 124
diff changeset
15 my $filename = $_;
1a996b35eaab Style updates
nanaya <me@nanaya.pro>
parents: 124
diff changeset
16 my ($name_crc,$real_crc);
1a996b35eaab Style updates
nanaya <me@nanaya.pro>
parents: 124
diff changeset
17
1a996b35eaab Style updates
nanaya <me@nanaya.pro>
parents: 124
diff changeset
18 unless (-f $filename) {
1a996b35eaab Style updates
nanaya <me@nanaya.pro>
parents: 124
diff changeset
19 $num_nf++;
1a996b35eaab Style updates
nanaya <me@nanaya.pro>
parents: 124
diff changeset
20 $num_na--;
1a996b35eaab Style updates
nanaya <me@nanaya.pro>
parents: 124
diff changeset
21 print(qq(Could not find "$filename", skipping\n));
1a996b35eaab Style updates
nanaya <me@nanaya.pro>
parents: 124
diff changeset
22 next();
1a996b35eaab Style updates
nanaya <me@nanaya.pro>
parents: 124
diff changeset
23 }
124
5bafb912837e Massive addition of old scripts collection.
Edho Prima Arief <edho@myconan.net>
parents:
diff changeset
24
613
1a996b35eaab Style updates
nanaya <me@nanaya.pro>
parents: 124
diff changeset
25 if (/(\[|\()([0-9A-F]{8})(\]|\))/i){
1a996b35eaab Style updates
nanaya <me@nanaya.pro>
parents: 124
diff changeset
26 $name_crc = uc($2);
1a996b35eaab Style updates
nanaya <me@nanaya.pro>
parents: 124
diff changeset
27 }
1a996b35eaab Style updates
nanaya <me@nanaya.pro>
parents: 124
diff changeset
28
1a996b35eaab Style updates
nanaya <me@nanaya.pro>
parents: 124
diff changeset
29 open(FILE,"<",$filename);
1a996b35eaab Style updates
nanaya <me@nanaya.pro>
parents: 124
diff changeset
30 binmode(FILE);
614
70355e17653e Use zlib which is more available
nanaya <me@nanaya.pro>
parents: 613
diff changeset
31 my $file_crc = 0;
70355e17653e Use zlib which is more available
nanaya <me@nanaya.pro>
parents: 613
diff changeset
32 my $file_part = '';
70355e17653e Use zlib which is more available
nanaya <me@nanaya.pro>
parents: 613
diff changeset
33 while (read(FILE, $file_part, 4096)) {
70355e17653e Use zlib which is more available
nanaya <me@nanaya.pro>
parents: 613
diff changeset
34 $file_crc = crc32($file_part, $file_crc);
70355e17653e Use zlib which is more available
nanaya <me@nanaya.pro>
parents: 613
diff changeset
35 }
613
1a996b35eaab Style updates
nanaya <me@nanaya.pro>
parents: 124
diff changeset
36 close(FILE);
614
70355e17653e Use zlib which is more available
nanaya <me@nanaya.pro>
parents: 613
diff changeset
37 $real_crc = sprintf("%08X", $file_crc);
613
1a996b35eaab Style updates
nanaya <me@nanaya.pro>
parents: 124
diff changeset
38
1a996b35eaab Style updates
nanaya <me@nanaya.pro>
parents: 124
diff changeset
39 if ($name_crc) {
1a996b35eaab Style updates
nanaya <me@nanaya.pro>
parents: 124
diff changeset
40 $num_na--;
1a996b35eaab Style updates
nanaya <me@nanaya.pro>
parents: 124
diff changeset
41 if($name_crc eq $real_crc) {
1a996b35eaab Style updates
nanaya <me@nanaya.pro>
parents: 124
diff changeset
42 $num_ok++;
1a996b35eaab Style updates
nanaya <me@nanaya.pro>
parents: 124
diff changeset
43 print("$filename: OK - $real_crc\n");
1a996b35eaab Style updates
nanaya <me@nanaya.pro>
parents: 124
diff changeset
44 } else {
1a996b35eaab Style updates
nanaya <me@nanaya.pro>
parents: 124
diff changeset
45 $num_err++;
1a996b35eaab Style updates
nanaya <me@nanaya.pro>
parents: 124
diff changeset
46 print("$filename: NOT OK - $real_crc, should be $name_crc\n");
1a996b35eaab Style updates
nanaya <me@nanaya.pro>
parents: 124
diff changeset
47 }
1a996b35eaab Style updates
nanaya <me@nanaya.pro>
parents: 124
diff changeset
48 } else {
1a996b35eaab Style updates
nanaya <me@nanaya.pro>
parents: 124
diff changeset
49 print("$filename: $real_crc\n");
1a996b35eaab Style updates
nanaya <me@nanaya.pro>
parents: 124
diff changeset
50 }
124
5bafb912837e Massive addition of old scripts collection.
Edho Prima Arief <edho@myconan.net>
parents:
diff changeset
51 }
5bafb912837e Massive addition of old scripts collection.
Edho Prima Arief <edho@myconan.net>
parents:
diff changeset
52
5bafb912837e Massive addition of old scripts collection.
Edho Prima Arief <edho@myconan.net>
parents:
diff changeset
53 printf("%s\n","-"x40);
613
1a996b35eaab Style updates
nanaya <me@nanaya.pro>
parents: 124
diff changeset
54 if ($num_ok > 0) {
1a996b35eaab Style updates
nanaya <me@nanaya.pro>
parents: 124
diff changeset
55 print("Files OK: $num_ok\n");
1a996b35eaab Style updates
nanaya <me@nanaya.pro>
parents: 124
diff changeset
56 }
1a996b35eaab Style updates
nanaya <me@nanaya.pro>
parents: 124
diff changeset
57 if ($num_err > 0) {
1a996b35eaab Style updates
nanaya <me@nanaya.pro>
parents: 124
diff changeset
58 print("Files error: $num_err\n");
1a996b35eaab Style updates
nanaya <me@nanaya.pro>
parents: 124
diff changeset
59 }
1a996b35eaab Style updates
nanaya <me@nanaya.pro>
parents: 124
diff changeset
60 if ($num_nf > 0) {
1a996b35eaab Style updates
nanaya <me@nanaya.pro>
parents: 124
diff changeset
61 print("Files not found: $num_nf\n");
1a996b35eaab Style updates
nanaya <me@nanaya.pro>
parents: 124
diff changeset
62 }
1a996b35eaab Style updates
nanaya <me@nanaya.pro>
parents: 124
diff changeset
63 if ($num_na > 0) {
1a996b35eaab Style updates
nanaya <me@nanaya.pro>
parents: 124
diff changeset
64 print("Files without crc information: $num_na\n");
1a996b35eaab Style updates
nanaya <me@nanaya.pro>
parents: 124
diff changeset
65 }
124
5bafb912837e Massive addition of old scripts collection.
Edho Prima Arief <edho@myconan.net>
parents:
diff changeset
66
5bafb912837e Massive addition of old scripts collection.
Edho Prima Arief <edho@myconan.net>
parents:
diff changeset
67 exit(0);