view release on metacpan or  search on metacpan

script/merge  view on Meta::CPAN

#!/usr/bin/perl -w

# Author          : Johan Vromans
# Created On      : Fri Apr  8 13:11:26 2022
# Last Modified By: Johan Vromans
# Last Modified On: Fri Apr  8 15:35:33 2022
# Update Count    : 40
# Status          : Unknown, Use with caution!

################ Common stuff ################

use strict;
use warnings;

# Package name.
my $my_package = 'Album';
# Program name and version.
my ($my_name, $my_version) = qw( merge 0.01 );

################ Command line parameters ################

use Getopt::Long 2.13;

# Command line options.
my $verbose = 1;		# verbose processing

# Development options (not shown with -help).
my $debug = 0;			# debugging
my $trace = 0;			# trace (show process)
my $test = 0;			# test mode.

# Process command line options.
app_options();

# Post-processing.
$trace |= ($debug || $test);

################ Presets ################

my $TMPDIR = $ENV{TMPDIR} || $ENV{TEMP} || '/usr/tmp';

################ The Process ################

my $file = shift;
die("$file; $!\n") unless -s $file;

my %ht;

my @pre;
my @lines;

open( my $fh, '<:utf8', $file ) or die("$file: $!\n");
while ( <$fh> ) {
    chomp;
    next unless /\S/;
    if ( /^!(?!tag)/ && !%ht ) {
	push( @pre, $_ );
	next;
    }

    if ( /^!tag\s+(.*)/ ) {
	$ht{ substr( $_ = scalar(<$fh>), 0, 8 ) } = $1;
	redo;
    }

    if ( /^(\d{8})\S+/ ) {
	push( @lines, $_ );
	next;
    }
    if ( /^\#/ ) {
	push( @lines, $_ );
	next;
    }

    die("?? $_\n");
}

close($fh);

print( "$_\n" ) for @pre;

for ( sort @lines ) {
    if ( defined $ht{substr($_,0,8)} ) {
	print( "\n!tag ", delete $ht{substr($_,0,8)}, "\n" );
    }
    print( "$_\n" );
}

exit 0;

################ Subroutines ################

sub app_options {
    my $help = 0;		# handled locally
    my $ident = 0;		# handled locally
    my $man = 0;		# handled locally

    my $pod2usage = sub {
        # Load Pod::Usage only if needed.
        require Pod::Usage;
        Pod::Usage->import;
        &pod2usage;
    };

    # Process options.
    if ( @ARGV > 0 ) {
	GetOptions( 'ident'	=> \$ident,
		    'verbose+'	=> \$verbose,
		    'quiet'	=> sub { $verbose = 0 },
		    'trace'	=> \$trace,
		    'help|?'	=> \$help,
		    'man'	=> \$man,