adif-pota2sig/adif-pota2sig.pl

#!/usr/bin/env perl
#
# SPDX-License-Identifier: Beerware
# Wolfgang DM5WK Kroener wrote this file. As long as you retain this notice you
# can do whatever you want with this stuff. If we meet some day, and you think
# this stuff is worth it, you can buy me a beer in return.
#
# modified from perlmonks - TedPride - http://www.perlmonks.org/?node_id=559222
# modified from https://scruss.com/blog/2011/05/23/parsing-adif-with-perl/
#
# Description and Usage:
# adif-pota2sig.pl -h

=pod

=head1 NAME

adif-pota2sig - Process adif file for POTA uploads

=head1 SYNOPSIS

adif-pota2sig.pl -i in.adi -o out.adi

adif-pota2sig.pl < in.adi > out.adi

adif-pota2sig.pl -r K-TEST -t out_REF.adi -i in.adi

adif-pota2sig.pl -r K-TEST -t out_REF.adi < in.adi

adif-pota2sig.pl -h

=cut

use strict;
use warnings;

use Getopt::Long qw(:config gnu_compat);
use Pod::Usage;

my $input_file = "";
my $output_file = "";
my $my_ref = "";
my $output_template = "";
my $force_output = 0;

GetOptions (
	"i|input=s"	=> \$input_file,
	"o|output=s"	=> \$output_file,
	"r|reference=s"	=> \$my_ref,
	"f|force"	=> \$force_output,
	"t|template=s"	=> \$output_template,
	"h|help"	=> sub {pod2usage(-verbose => 2)}
) or die("Error in command line arguments\n");

=pod

=head1 OPTIONS

=over

=item B<-h|--help>

Print a brief help message and exits.

=item B<-i F<in.adi>|--input=F<in.adi>>

Use F<in.adi> as input (default: - for stdin).

=item B<-o F<out.adi>|--output=F<out.adi>>

Use F<out.adi> as output (default: - for stdout).

=item B<-r MY_POTA_REF|--reference=MY_POTA_REF>

Use MY_POTA_REF as own POTA reference. If there are more than one (for a
n-fer) create a list with commas, e. g. S<B<-r> K-TEST1,K-TEST2,K-TEST3>

B<-t> is mandatory for this option.

=item B<-t F<out_REF.adi>|--template=F<out_REF.adi>>

Use out_REF.adi as output filename template for multiple references. REF will
be replaced by a POTA reference. Multiple filenames will be created.

B<-o> is not allowed for this option.

B<-r> is mandatory for this option.

=item B<-f|--force>

By default filenames selected with B<-o> and B<-t> won't be overwritten and the
program will stop. Using B<-f> will overwrite output files.

=back

=cut

if (($my_ref ne "") && ($output_template eq "")) {
	die "-t is mandatory for -r";
}

if (($output_template ne "") && ($my_ref eq "")) {
	die "-r is mandatory for -t";
}

if (($output_template ne "") && ($output_file ne "")) {
	die "-o is not allowed with -t";
}

if (($output_template ne "") && ($output_template !~ /REF/)) {
	die "-t needs REF in output filename template";
}

my $FH_IN;
if (($input_file eq "-") || ($input_file eq "")) {
	$FH_IN = "STDIN";
} else {
	open($FH_IN, '<', $input_file) or die "$input_file: $!";
}

my @output_filenames;

if ($my_ref ne "") {
	foreach (split(/,/, $my_ref)) {
		push(@output_filenames, $output_template =~ s/REF/$_/r);
	}
} else {
	push(@output_filenames, $output_file);
}

foreach my $output_filename (@output_filenames) {
	seek $FH_IN, 0, 0;

	my $FH_OUT;

	if (($output_filename eq "-") || ($output_filename eq "")) {
		$FH_OUT = "STDOUT";
	} else {
		if ((-e $output_filename) && (! $force_output)) {
			die "File $output_filename exists. Use --force to overwrite";
		} else {
			open($FH_OUT, '>', $output_filename) or die "$output_filename: $!";
		}
	}

	# select filehandle for print
	select($FH_OUT);

	while (<$FH_IN>) {
		print;
		# fast forward past header
		last if m/<EOH>\s+$/i;
	}

	my @entry = ();
	my @pota_refs = ();
	while (<$FH_IN>) {
		push @entry, $_;
		if (m/<EOR>\s+$/i) {
			# entry complete
			if (scalar(@pota_refs) > 0) {
				# add sig_info to each pota reference
				foreach my $ref (@pota_refs) {
					# print all except last
					print @entry[0 .. $#entry - 1];
					# insert POTA SIG
					print "<SIG:4>POTA\n";
					print "<SIG_INFO:" . length($ref) . ">" . $ref . "\n";
					# print last
					print $entry[-1];
				}
			} else {
				# no park reference in this entry
				print @entry;
			}
			# clear entry and pota refs for next entry
			@entry = ();
			@pota_refs = ();
		} elsif (m/^<POTA_REF:/) {
			# get last element of split >
			my $val = (split(/>/))[-1];
			chomp($val);
			# fill pota_refs with references
			@pota_refs = split(/,/, $val);
			chomp @pota_refs;
		}
	}
	close($FH_OUT);
}
close($FH_IN);

__END__

=head1 DESCRIPTION

B<adif-pota2sig> will read an adif file, if a contact has one or more POTA_REF
entries (delimited by a comma), add SIG POTA and SIG_INFO with reference.
Multiply contact such, that every POTA_REF entry is a separate contact with own
SIG_INFO. Extendet adif file will be printed to stdout or a file.

If used with B<-r> and B<-t> options a number of files with contents described
above will be created. On file for each POTA reference. For output filenames
see B<-t>.

=cut