MergeDrl.pl

#!/usr/bin/perl -w

# MergeDrl.pl
#
# CC-BY 2012 9DOF <9dof.gg@gmail.com>
#
# Merges several Excellon format drill files into a single file.
#
# Usage: MergeDrl.pl input_file [...] > output_file
#
# Output's header will be copied from first input file

use strict;

use IO::File;

use Data::Dumper;

sub parseExcellon($);

# Get arguments
my @drills;

# Parse args and dump content
foreach my $fn (@ARGV) {
  push @drills, parseExcellon($fn);
#  my $f = new IO::File($fn, 'r');
#  print 'Dumping ', $fn, "\n";
#  dumpExcellon($f);
}

#print Dumper(\@drills);

# Combine drills
my %mergedDrills = (
  tools => {},
  coords => {});

my @comboTools = ();
foreach my $t(@drills) {
  while (my($k,$v)=each %{$t->{tools}}){
    push @comboTools, {spec => $v, coords => $t->{coords}->{$k}};
  }
}

#print "Combo:\n";
#print Dumper(\@comboTools);

# Sort spec and allocate new indices
my $currTool;
my $prevTool;
my $currIndex = 1;
my @finalTools = ();

foreach my $e(sort {$a->{spec} cmp $b->{spec}} @comboTools) {
  # Check if same spec as last one
  if ($prevTool && $prevTool->{spec} eq $e->{spec}) {
    push @{$prevTool->{coords}}, @{$e->{coords}};
  } else {
    $e->{tool} = 'T'.$currIndex++;
    $prevTool = $e;
    push @finalTools, $prevTool;
  }
}
#  print Dumper(\@finalTools);

# Output result
local $/ = "\r\n";
# Header
print "M48$/";
foreach my $h(@{$drills[0]->{headers}}) {
  print "$h$/";
}
# List of tools
foreach my $t(@finalTools) {
  print $t->{tool}.$t->{spec}.$/;
}
# End of header
print "\%$/";
# Body
print "G90$/";
print "G05$/";
print "M72$/";
# Coords
foreach my $t(@finalTools) {
  print $t->{tool}, $/;
  foreach my $c(@{$t->{coords}}) {
    print "$c$/";
  }
}
# End
print "T0$/";
print "M30$/";

exit 0;

# Excellon parser
sub parseExcellon($) {
  my ($fn) = @_;
  my %res = (
    filename => $fn,
    tools => {},
    coords => {},
    headers => []);

  my $f = new IO::File($fn, 'r');

  my $inHeader = 0;
  my $inBody = 0;
  my $currTool;
#  print "Inside parseExcellon(${fn})\n";
  while(<$f>){
    local $/ = "\r\n";
    chomp;
#    chop;	# input is MSDOS line terminated
    if (!$inHeader && !$inBody) {	# Search for start of header (^M48)
      if (/^M48/) {
        # Found start of header
        $inHeader = 1;
      } else {
#        print 's';
      }
    } elsif ($inHeader) {	# Inside header, collect info until end of header (^%)
      if (!/^\%/) {
#        print 'h';
        if (/^(T\d+)(.*)/) {
          $res{tools}->{$1} = $2;
          $res{coords}->{$1} = [];
        } else {
          push @{$res{headers}}, $_;
        }
      } else {
        $inHeader = 0;
        $inBody = 1;
      }
    } elsif ($inBody) {	# Inside body, collect coords until end of body (^M30)
      if (!/^M30/) {
#        print 'b';
        if (/^(T\d+)/) {
          $currTool = $1;
        } elsif ($currTool && exists $res{coords}->{$currTool}) {
          push @{$res{coords}->{$currTool}}, $_;
        }
      } else {
        $inBody = 0;
#        print "\n";
        last;
      }
    }
  }
  $f->close;
  # Dump info
#  print "Info dump\n";
#  print "Headers:\n";
#  print @headers;
#  print "Tools:\n";
#  print join(",", @tools), "\n";
#  print "Coords:\n";
#  foreach my $t(@tools) {
#    print "Tool: ", $t, "\n";
#    print @{$coords{$t}};
    \%res;
  }