Perl在url中每次出现斜线后从文件中插入字符串

以下是散文中的算法:

Open File2.txt. Read in all lines, removing the newline. We call the array @words.

Open File2.txt. We call the file handle $fh.

As long as we can read a $line from $fh:

    Remove the newline, remove starting and ending slashes.
    Split the $line at every slash, call the array @animals.

    Loop through the @words, calling each element $word:

        Loop through the indices of the @animals, calling each index $i:

            Make a @copy of the @animals.
            Append the $word to the $i-th element of @copy.
            Join the @copy with slashes, surround it with slashes, and print with newline.

        Print an empty line.

这个程序会按照你的要求执行。

use strict;
use warnings;
use autodie;

my @f1 = do {
  open my $fh, '<', 'FILE1.txt';
  <$fh>;
};
chomp @f1;

my @f2 = do {
  open my $fh, '<', 'FILE2.txt';
  <$fh>;
};
chomp @f2;

for my $f1 (@f1) {
  my @fields = $f1 =~ m{[^/]+}g;
  for my $f2 (@f2) {
    for my $i (0 .. $#fields) {
      my @new = @fields;
      $new[$i] .= $f2;
      print qq{/$_/\n}, for join '/', @new;
    }
    print "\n\n";
  }
}

输出

/dogHELLO/cat/rabbit/hamster/
/dog/catHELLO/rabbit/hamster/
/dog/cat/rabbitHELLO/hamster/
/dog/cat/rabbit/hamsterHELLO/


/dogGOODBYE/cat/rabbit/hamster/
/dog/catGOODBYE/rabbit/hamster/
/dog/cat/rabbitGOODBYE/hamster/
/dog/cat/rabbit/hamsterGOODBYE/


/lionHELLO/tiger/elephant/
/lion/tigerHELLO/elephant/
/lion/tiger/elephantHELLO/


/lionGOODBYE/tiger/elephant/
/lion/tigerGOODBYE/elephant/
/lion/tiger/elephantGOODBYE/

您可以使用正则表达式来完成这一切,而不是在每个斜杠上拆分行。

更新版本:

#!usr/bin/perl
use strict;
use warnings;

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

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__
/dog/cat/rabbit/hamster/
http://www.stackoverflow.com/dog/cat/rabbit/hamster/

关键是替换运算符: s|(?<!/)(?:/(?!/)[^/]*){$repeat}[^/]*\K|$word| .

(?<!/) 和 (?!/) 分别是消极的向后看和向前看。他们确保我们只匹配一个 / ,从而忽略 http:// .

(?:/(?!/)[^/]*){$repeat} 是一个必须匹配指定次数的捕获组,我们会增加该次数,直到不再匹配为止。

我不得不使用 [^/]* 而不是 [^/]+ 以满足您在字符串末尾匹配的要求。这就是为什么既需要向后看,也需要向前看。

\K 意思是“匹配到此为止的所有内容,但不要将其包含在匹配本身中。”因此,我们不必担心将匹配字符串的整个开头包含在替换中。

注: 这个 r 选项是在不修改原始字符串的情况下执行替换的另一种方法。然而,它需要Perl 5.16(感谢Amon)。因此,我将其从示例中删除。