Home | History | Annotate | Download | only in tools 
      1 #!/usr/bin/perl
      2 
      3 use strict;
      4 use warnings;
      5 
      6 use version;
      7 use Carp;
      8 use Digest;
      9 use File::Spec;
     10 use File::Spec::Unix;
     11 use YAML::Tiny;
     12 
     13 my $version = qv('0.0.1');
     14 
     15 sub say {
     16     print @_, "\n";
     17 }
     18 
     19 my $basedir = '../..';
     20 
     21 my $commands = {
     22     'help'   => \&help,
     23     'add'    => \&add,
     24     'status' => \&status,
     25 };
     26 
     27 my $help = {};
     28 
     29 sub filetype {
     30     my ($path) = @_;
     31 
     32     if ($path =~ /\.(java|g)$/xms) {
     33         return 'text/plain';
     34     }
     35     else {
     36         return 'application/octet-stream';
     37     }
     38 }
     39 
     40 sub sha1sum {
     41     my ($filename) = @_;
     42 
     43     open my $in, '<', $filename or croak "Can't open $filename: $!";
     44     if (filetype($filename) =~ /^text\//xms) {
     45         # keep standard line feed conversion
     46     } else {
     47         if (!binmode $in) {
     48             croak "Can't binmode $filename: $!";
     49         }
     50     }
     51     my $sha1 = Digest->new('SHA-1');
     52     $sha1->addfile($in);
     53     my $digest = $sha1->hexdigest;
     54     close $in or warn "Can't close $filename: $!";
     55     return $digest;
     56 }
     57 
     58 my $inc_paths = [
     59     $basedir,
     60     "$basedir/runtime/Java/src",
     61 ];
     62     
     63 sub resolve_file {
     64     my ($filename) = @_;
     65 
     66     my $resolved_file;
     67     if (-e $filename) {
     68         $resolved_file = $filename;
     69     }
     70     else {
     71         my @canidates 
     72             = grep { -e $_ } 
     73               map { File::Spec->catfile($_, $filename) } 
     74               @$inc_paths;
     75         $resolved_file = $canidates[0];
     76     }
     77 
     78     if (defined $resolved_file) {
     79         $resolved_file = File::Spec::Unix->canonpath($resolved_file);
     80     }
     81 
     82     return $resolved_file;
     83 }
     84 
     85 $help->{help} = << 'EOH';
     86 help: Describe the usage of this program or its subcommands.
     87 Usage: help [SUBCOMMAND...]
     88 EOH
     89 
     90 sub help {
     91     my ($cmd) = @_;
     92 
     93     if (defined $cmd) {
     94         print $help->{$cmd};
     95     }
     96     else {
     97         say << 'EOH';
     98 Usage: port <subcommand> [options] [args]
     99 EOH
    100         say "Available subcommands:";
    101         foreach my $cmd (keys %$help) {
    102             say "   $cmd";
    103         }
    104     }
    105 
    106 }
    107 
    108 $help->{add} = << 'EOH';
    109 add: Adds the file to the list of ported files.
    110 Usage: add PATH...
    111 EOH
    112 
    113 sub add {
    114     my ($filename) = @_;
    115 
    116     my $port = YAML::Tiny->read('port.yml');
    117     my $status = $port->[0]->{status};
    118     if (!defined $status) {
    119         $status = $port->[0]->{status} = {};
    120     }
    121 
    122     my $path = resolve_file($filename);
    123     if (!defined $path) {
    124         croak "File not found: $filename";
    125     }
    126     my $digest = sha1sum($path);
    127     $status->{$filename} = {
    128         'sha1' => $digest,
    129     };
    130     $port->write('port.yml');
    131 }
    132 
    133 $help->{status} = << 'EOH';
    134 status: Print the status of the ported files.
    135 usage: status [PATH...]
    136 EOH
    137 
    138 sub status {
    139     my $port = YAML::Tiny->read('port.yml');
    140 
    141     my $status = $port->[0]->{status};
    142 
    143     while (my ($filename, $fstatus) = each (%$status)) {
    144         my $path = resolve_file($filename);
    145 
    146         my $digest = sha1sum($path);
    147 
    148         if ($digest ne $fstatus->{sha1}) {
    149             say "M $filename";
    150         }
    151     }
    152 }
    153 
    154 my ($cmd, @args) = @ARGV;
    155 
    156 if (defined $cmd) {
    157     my $cmd_f = $commands->{$cmd};
    158     if (defined $cmd_f) {
    159         $cmd_f->(@args);
    160     }
    161     else {
    162         say "Unknown command: '$cmd'";
    163         say "Type 'port help' for usage.";
    164         exit 1;
    165     }
    166 }
    167 else {
    168     say "Type 'port help' for usage.";
    169     exit 1;
    170 }
    171 
    172 __END__
    173 
    174 =head1 NAME
    175 
    176 port - ANTLR Perl 5 port status
    177 
    178 =head1 VERSION
    179 
    180 This documentation refers to port version 0.0.1
    181 
    182 =head1 USAGE
    183 
    184     port help
    185 
    186     port status
    187 
    188 =head1 DESCRIPTION
    189 
    190 The primary language target for ANTLR is Java.  The Perl 5 port only follows
    191 this primary target language.  This brings up the problem to follow the
    192 changes made to the primary target, by knowing I<what> has changed and I<how>.
    193 
    194 This tool keeps a database of file paths and content checksum.  Once the port
    195 of a file (Java class, grammar, ...) is completed it is added to the
    196 database (C<port add>).  This database can then be queried to check what
    197 primary files have changed (C<port status>).  The revision control software
    198 should be helpful to determine the actual changes.
    199 
    200 =head1 AUTHOR
    201 
    202 Ronald Blaschke (ron@rblasch.org)
    203 
    204