view release on metacpan or  search on metacpan

source-tree-marathon.pl  view on Meta::CPAN

#!/usr/bin/perl -Ilib

use Acme::KeyboardMarathon;
use Cwd 'abs_path';
use DB_File;
use File::Find;
use File::Slurp;
use Math::BigInt lib => 'GMP';
use strict;
use warnings;

=head1 source-tree-marathon.pl

This script is designed to recursively crawl a directory of source files 
to generate a Keyboard-Marathon report for your whole project.

In does it's best to skip binary files. It will not uncompact compressed 
files.

To conserve ram, it will create a local berkley DB (called 
"marathon.db") in the current working directory. If you want to run this 
script on a regular basis this will vastly accelerate calculations as 
only new and changed files will be processed. (Deleted files will 
automatically be pruned from the DB and from calculations.)

The report will include the grand total distance, as well as a breakdown by
file type.

Processing status is presented on STDERR. The report is output on STDOUT. So
it is very easy to redirect the output to a file:

  %> ./source-tree-marathon.pl /my/source/directory > report.txt

This script requires the following perl modules: File::Find, 
File::Slurp, Math::BigInt and Acme::KeyboardMarathon

=cut

### Conf

my $dbfile = 'marathon.db';

my $base_dir;

if ( $ARGV[0] and -d $ARGV[0] ) {
  $base_dir = abs_path($ARGV[0]);
}

unless ( $base_dir ) {
  print STDERR "Usage: ./source-tree-marathon.pl /source/directory/to/crawl > report.txt\n";
  exit 1;
}

### Constants

my $skip_file_extension_regex = qr{\.(binmode|bmp|docx|exe|gif|gz|ico|jar|jpe?g|o|obj|pdf|png|pptx|pyc|so|tar(\.xz)?|tiff?|tgz|ttf|vsd|zip)$};
my $skip_dirs_regex = qr/^(\.git|tpc|debian|linux-kernel)/;

### Bootstrap


my %data;

if ( -f $dbfile ) {
  print STDERR "Reusing file: $dbfile\n";
} else {
  print STDERR "Creating file: $dbfile\n";
}

my $ref = tie %data, 'DB_File', $dbfile;

my $akm = new Acme::KeyboardMarathon;
 
### Main

# Remove file stats for missing files
for my $file ( keys %data ) {
  next if -f $file;
  print STDERR "DEL: $file\n";
  delete $data{$file}
}

### Store stats