Question

I have an input file that looks like

*firsttitle
nameA
nameB
nameC
*secondtitle
xnameA
xnameB
xnameC

I want to create a Perl script that takes this file and basically will create another perl script that looks like

  #!/usr/bin/perl

        use strict;
        use warnings;

        my %tags = (
            "firsttitle" => [ qw (nameA nameB nameC) ],
            "secondtitle" => [ qw (xnameA xnameB xnameC) ]);

 my $rx = join '|', keys %tags;

 while (<>) {
    s/^\s*($rx):\s*(\d+)/$1: $tags{$1}[$2]/;
    print;
 }

My thought process is that I have to first match print out the regular perl code (#!,use..etc.).Then add ” my%tags=(. Then take the input file and look for the * and that’s the lookup for the hash and start parsing everything after until the next(*) or end of life. If it’s another * then do it again. If it’s EOF then add “);” and end. And then finish with printing the last bit of perl code. Help/ideas would be appreciated. If you’re going to post code snippets could you go through and explain what each part is doing? Thanks!

Answer 1

Very simple script. First just parse through the input file. Lines that start with * will be titles, and all the following lines up until the next *-line will be values. We put this into a hash of arrays.

The map statement gives us a list of the hash key (the title), and it’s values joined together with space. We put this in an array for printing. The printing itself is done with printf, which can be a bit difficult to use, since meta characters will mess us up. Any % that are to be literal must be written as %%. I also changed single quotes from the original to double quotes. I use single quotes on the printf pattern to avoid accidental interpolation of variables.

An alternative – possibly better one – is to not just printf at all, and simply concatenate the string in a normal fashion.

use strict;
use warnings;

my ($title, %hash);
while (<DATA>) {
    chomp;
    if (/^\*(.+)$/) {
        $title = $1;
    } else {
        push @{$hash{$title}}, $_;
    }
}

my @args = ( map { $_, join(' ', @{$hash{$_}}) } keys %hash );
printf '#!/usr/bin/perl

use strict;
use warnings;

my %%tags = (
        "%s" => [ qw ( %s ) ],
        "%s" => [ qw ( %s ) ]);

my $rx = join "|", keys %%tags;

while (<>) {
    s/^\s*($rx):\s*(\d+)/$1: $tags{$1}[$2]/;
    print;
}', @args;

__DATA__
*firsttitle
nameA
nameB
nameC
*secondtitle
xnameA
xnameB
xnameC

Update:

This will use a different method of printing, which will be more stable.

my @args = ( map { "    '$_' => [ qw ( @{$hash{$_}} ) ],\n" } keys %hash );
print '#!/usr/bin/perl

use strict;
use warnings;

my %tags = (
', @args, '
);

my $rx = join "|", keys %tags;

while (<>) {
    s/^\s*($rx):\s*(\d+)/$1: $tags{$1}[$2]/;
    print;
}';