Mercurial > ec-dotfiles

comparison bin/cek.pl @ 124:5bafb912837e

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Massive addition of old scripts collection.
author Edho Prima Arief <edho@myconan.net>
date Wed, 26 Oct 2011 15:22:00 +0700
parents
children 1a996b35eaab
comparison
equal deleted inserted replaced
123:173833e4ba35 124:5bafb912837e
1 #!/usr/bin/env perl
2
3 use strict;
4 use warnings;
5 use String::CRC32;
6 use File::Basename;
7
8 my @files = @ARGV or print("Usage: ",basename($0)," file1 file2 ... fileN\n") && exit(1);
9 my $num_ok=0;
10 my $num_err=0;
11 my $num_nf=0;
12 my $num_na=@files;
13
14 foreach(@files) {
15 my $filename = $_;
16 my ($name_crc,$real_crc);
17 unless (-f $filename) {
18 $num_nf++;$num_na--;
19 print(qq(Could not find "$filename", skipping\n));
20 next();
21 }
22 if(/(\[|\()([0-9A-F]{8})(\]|\))/i){
23 $name_crc=uc($2);
24 }
25 open(FILE,"<",$filename);
26 binmode(FILE);
27 $real_crc=sprintf("%08X",crc32(*FILE));
28 close(FILE);
29 if($name_crc) {
30 $num_na--;
31 if($name_crc eq $real_crc) {
32 $num_ok++;
33 print("$filename: OK - $real_crc\n");
34 } else {
35 $num_err++;
36 print("$filename: NOT OK - $real_crc, should be $name_crc\n");
37 }
38 } else {
39 print("$filename: $real_crc\n");
40 }
41 }
42
43 printf("%s\n","-"x40);
44 if($num_ok > 0) { print("Files OK: $num_ok\n"); }
45 if($num_err > 0) { print("Files error: $num_err\n"); }
46 if($num_nf > 0) { print("Files not found: $num_nf\n"); }
47 if($num_na > 0) { print("Files without crc information: $num_na\n"); }
48
49 exit(0);