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