Регулярное выражение Perl для вставки / замены в строку в определенных местах

Question

По заданному URL-адресу следующее регулярное выражение может вставлять / заменять слова в определенных точках URL-адресов.

Код:

#!/usr/bin/perl

use strict;
use warnings;
#use diagnostics;

my @insert_words = qw/HELLO GOODBYE/;
my $word = 0;
my $match;

while (<DATA>) {
    chomp;
    foreach my $word (@insert_words)
    {
        my $repeat = 1;
        while ((my $match=$_) =~ s|(?<![/])(?:[/](?![/])[^/]*){$repeat}[^/]*\K|$word|)
        {
            print "$match\n";
            $repeat++;
        }

    print "\n";
    }
}

__DATA__
http://www.stackru.com/dog/cat/rabbit/
http://www.superuser.co.uk/dog/cat/rabbit/hamster/
10.15.16.17/dog/cat/rabbit/

Вывод данных (для первого примера URL в __DATA__ с HELLO слово):

http://www.stackru.com/dogHELLO/cat/rabbit/
http://www.stackru.com/dog/catHELLO/rabbit/
http://www.stackru.com/dog/cat/rabbitHELLO/
http://www.stackru.com/dog/cat/rabbit/HELLO

Где я сейчас застрял

Теперь я хотел бы изменить регулярное выражение, чтобы вывод был похож на то, что показано ниже:

http://www.stackru.com/dogHELLO/cat/rabbit/
http://www.stackru.com/dog/catHELLO/rabbit/
http://www.stackru.com/dog/cat/rabbitHELLO/
http://www.stackru.com/dog/cat/rabbit/HELLO
#above is what it already does at the moment
#below is what i also want it to be able to do as well
http://www.stackru.com/HELLOdog/cat/rabbit/  #<-puts the word at the start of the string
http://www.stackru.com/dog/HELLOcat/rabbit/
http://www.stackru.com/dog/cat/HELLOrabbit/
http://www.stackru.com/dog/cat/rabbit/HELLO
http://www.stackru.com/HELLO/cat/rabbit/  #<- now also replaces the string with the word
http://www.stackru.com/dog/HELLO/rabbit/
http://www.stackru.com/dog/cat/HELLO/
http://www.stackru.com/dog/cat/rabbit/HELLO

Но у меня возникают проблемы с автоматическим выполнением этого в одном регулярном выражении.

Любая помощь в этом вопросе будет высоко оценена, большое спасибо

Answer 1

Одно из решений:

use strict;
use warnings;

use URI qw( );

my @insert_words = qw( HELLO );

while (<DATA>) {
   chomp;
   my $url = URI->new($_);
   my $path = $url->path();

   for (@insert_words) {
      # Use package vars to communicate with /(?{})/ blocks.
      local our $insert_word = $_;
      local our @paths;
      $path =~ m{
         ^(.*/)([^/]*)((?:/.*)?)\z
         (?{
            push @paths, "$1$insert_word$2$3";
            if (length($2)) {
               push @paths, "$1$insert_word$3";
               push @paths, "$1$2$insert_word$3";
            }
         })
         (?!)
      }x;

      for (@paths) {
         $url->path($_);
         print "$url\n";
      }
   }
}

__DATA__
http://www.stackru.com/dog/cat/rabbit/
http://www.superuser.co.uk/dog/cat/rabbit/hamster/
http://10.15.16.17/dog/cat/rabbit/

Answer 2

Без сумасшедших регулярных выражений:

use strict;
use warnings;

use URI qw( );

my @insert_words = qw( HELLO );

while (<DATA>) {
   chomp;
   my $url = URI->new($_);
   my $path = $url->path();

   for my $insert_word (@insert_words) {
      my @parts = $path =~ m{/([^/]*)}g;
      my @paths;
      for my $part_idx (0..$#parts) {
         my $orig_part = $parts[$part_idx];
         local $parts[$part_idx];
         {
            $parts[$part_idx] = $insert_word . $orig_part;
            push @paths, join '', map "/$_", @parts;
         }
         if (length($orig_part)) {
            {
               $parts[$part_idx] = $insert_word;
               push @paths, join '', map "/$_", @parts;
            }
            {
               $parts[$part_idx] = $orig_part . $insert_word;
               push @paths, join '', map "/$_", @parts;
            }
         }
      }

      for (@paths) {
         $url->path($_);
         print "$url\n";
      }
   }
}

__DATA__
http://www.stackru.com/dog/cat/rabbit/
http://www.superuser.co.uk/dog/cat/rabbit/hamster/
http://10.15.16.17/dog/cat/rabbit/

Answer 3

Еще одно решение:

#!/usr/bin/perl

use strict;
use warnings;

my @insert_words = qw/HELLO GOODBYE/;

while (<DATA>) {
    chomp;
    /(?<![\/])(?:[\/](?![\/])[^\/]*)/p;
    my $begin_part = ${^PREMATCH};
    my $tail = ${^MATCH} . ${^POSTMATCH};
    my @tail_chunks = split /\//, $tail; 

    foreach my $word (@insert_words) {                      
        for my $index (1..$#tail_chunks) {
            my @new_tail = @tail_chunks;

            $new_tail[$index] = $word . $tail_chunks[$index];
            my $str = $begin_part . join "/", @new_tail;
            print $str, "\n";

            $new_tail[$index] = $tail_chunks[$index] . $word;
            $str = $begin_part . join "/", @new_tail;  
            print $str, "\n";
        }

        print "\n";
    }
}

__DATA__
http://www.stackru.com/dog/cat/rabbit/
http://www.superuser.co.uk/dog/cat/rabbit/hamster/
10.15.16.17/dog/cat/rabbit/