Лаборатория изучения механизмов органических реакций

a2j

#!/usr/bin/perl -ws

our ($h,$help);
if ($h || $help) {
  (my $program = $0) =~ s/^.*[\/\\]//;
  print "Usage: $program file.txt

Convert ASCII-full output from gNMR program to JCAMP-DX format which can be read
by Bruker TopSpin.
";
  exit;
}

my $d = qr/-?\d+(?:\.\d+)?/;

foreach my $file (@ARGV) {
  (my $name = $file) =~ s/\.txt$//;
  my (%param, @spc);
  open L, '<', $file or die "Can't open $file: $!\n";
  while (<L>) {
    if (/^\s*([A-Za-z]\w*)\s+(.+)/) {
      $param{$1} = $2;
      $param{$1} =~ s/\s+$//;
    }
    elsif (/^\s*($d)\s+$d\s+($d)\s+($d)/) {
      $spc[$1] = [$2,$3];
    }
  }
  close L;
  my @spc_r;
  foreach (@spc) {
    unshift @spc_r, $_;
  } 
  write_jcamp(\@spc_r, $name, $param{Nucleus},$param{SFreq});
} 

sub write_jcamp {
  my ($spc, $file, $nuc,$SF) = @_;
  
  my ($sec,$min,$hour,$mday,$mon,$year) = 
     localtime(-f $file ? (stat $file)[9] : time());
  my $DATE = sprintf "%02d/%02d/%02d", $year % 100, $mon+1, $mday;
  my $TIME = sprintf "%02d:%02d:%02d", $hour,$min,$sec;
  
  open F, '>', "$file.dx" or die "Can't write $file.dx: $!\n";
  print F "##TITLE= $nuc NMR from $file
##JCAMP-DX= 4.24
##DATA TYPE= NMR SPECTRUM
##ORIGIN= $0
##OWNER= $ENV{USER}
##DATE= $DATE
##TIME= $TIME
##.OBSERVE FREQUENCY= $SF
##.OBSERVE NUCLEUS= ^$nuc
##DELTAX= @{[$spc->[1][0]-$spc->[0][0]]}
##XUNITS= PPM
##YUNITS= ABSORBANCE
##XFACTOR= 1.00
##YFACTOR= 1.00
##FIRSTX= $spc->[0][0]
##LASTX= $spc->[-1][0]
##NPOINTS= @{[$#{$spc}+1]}
##FIRSTY= @{[$spc->[0][1]*1e8]}
##XYDATA= (X++(Y..Y))
";

  foreach (@$spc) {
    printf F "  %11.6f  %12d\n", $_->[0], $_->[1]*1e8;
  }
  print F "##END= \n";
  close F;
}