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 F<in.adi> -o F<out.adi>

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

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

adif-pota2sig.pl -r K-TEST -t F<out_REF.adi> < F<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_refs = "";
my $output_template = "";
my $force_output = 0;

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

=pod

=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. One file for each POTA reference. For output filenames
see B<-t>.

With B<-r> you can also include the location in the format REFERENCE@LOCATION,
which is handy for trails. E. g. -r DE-0622@DE-HH

=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>.

Also set the entries MY_SIG and MY_SIG_INFO matching the reference in the
output files. By default already existing entries with MY_SIG and MY_SIG_INFO
won't be overwritten and the program will stop. Using B<-f> will overwrite the
entries.

B<-t> is mandatory for this option.

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

Use F<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_refs ne "") && ($output_template eq "")) {
	die "-t is mandatory for -r";
}

if (($output_template ne "") && ($my_refs 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 %filenames_ref = ();

if ($my_refs ne "") {
	foreach (split(/,/, $my_refs)) {
		$filenames_ref{$output_template =~ s/REF/$_/r} = $_;
	}
} else {
	$filenames_ref{$output_file} = "";
}

foreach my $output_filename (keys %filenames_ref) {
	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

			# maybe add MY_SIG
			my $my_ref = $filenames_ref{$output_filename};
			if ($my_ref ne "") {
				my $last = pop(@entry);
				push(@entry, "<MY_SIG:4>POTA\r\n");
				push(@entry, "<MY_SIG_INFO:" . length($my_ref) . ">" . $my_ref . "\r\n");
				push(@entry, $last);
			}

			# print whole entry
			if (scalar(@pota_refs) > 0) {
				# maybe print entry multiple times
				# 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\r\n";
					print "<SIG_INFO:" . length($ref) . ">" . $ref . "\r\n";
					# print last
					print $entry[-1];
				}
			} else {
				# no park reference in this entry
				# print entry only once
				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;
		} elsif (m/^<MY_SIG(_INFO)?:/) {
			if ($force_output) {
				# remove MY_SIG and MY_SIG_INFO
				pop(@entry);
			} else {
				die "MY_SIG exists. Overwrite with --force";
			}
		}
	}
	close($FH_OUT);
}
close($FH_IN);