펄 : 번호가 매겨진 순서에서 컴팩트 이름을 만드는 방법

Question

[펄 5.8.8]

내가 좋아하는 것들의 이름의 순서가 : 이름이 연속 된 문자열 만 다른

names='foobar1304,foobar1305,foobar1306,foobar1307' 

을 이름의 어딘가에. 모든 시퀀스의 숫자 문자열은 모두 같은 길이이며 숫자 문자열은 건너 뛰기가없는 연속 숫자 시퀀스를 형성합니다 (예 : 003,004,005. 일부 세트에 걸칠 수도 있지만,

이

compact_name='foobar1304-7' 

(소형 폼 그냥 이름이고, 그래서 정확한 형식은 협상이다입니다.) 보통 < 10 가지가있을 것입니다 :

나는 컴팩트 한 표현처럼 원하는 10 년

'foobaz2205-11' 

몇 가지 간결한 방법이 있나요?

names='foobar33-pqq,foobar34-pqq,foobar35-pqq' 

이상적인 스크립트를 깔끔하게 할 수있는 경우에 다시 'firstname2301-lastname9922'에 떨어질 것이다 '내가 좋아하는 임베디드 시퀀스를 처리하기위한 ... 그래서 조금 부드럽게,

보너스 포인트를 큰 펄 해커가 아니에요 이름의 순서를 식별합니다.

Answer 1

나는 당신의 사양을 가지고 잘 모르겠지만, 어떻게 든 작동합니다

이

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

use Test::More; 

sub compact { 
    my $string = shift; 
    my ($name, $value) = split /=/, $string; 

    $name =~ s/s$// or die "Cannot create compact name for $name.\n"; #/ SO hilite bug 
    $name = 'compact_' . $name; 

    $value =~ s/^'|'$//g;            #/ SO hilite bug 
    my @values = split /,/, $value;         #/ SO hilite bug 
    my ($prefix, $first, $suffix) = $values[0] =~ /^(.+?)([0-9]+)(.*)$/; 

    my $last = $first + $#values; 
    my $same = 0; 
    $same++ while substr($first, 0, $same) eq substr($last, 0, $same); 
    $last = substr $last, $same - 1; 

    for my $i ($first .. $first + $#values) { 
     $values[$i - $first] eq ($prefix . $i . $suffix) 
      or die "Invalid sequence at $values[$i-$first].\n"; 
    } 
    return "$name='$prefix$first-$last$suffix'"; 
} 


is(compact("names='foobar1304,foobar1305,foobar1306,foobar1307'"), 
    "compact_name='foobar1304-7'"); 

is(compact("names='foobaz2205,foobaz2206,foobaz2207,foobaz2208,foobaz2209,foobaz2210,foobaz2211'"), 
    "compact_name='foobaz2205-11'"); 

is(compact("names='foobar33-pqq,foobar34-pqq,foobar35-pqq'"), 
    "compact_name='foobar33-5-pqq'"); 

done_testing(); 

Answer 2

반드시 누군가가 더 우아한 해결책을 게시 할 예정입니다,하지만

use strict; 
use warnings; 

my $names='foobar1308-xy,foobar1309-xy,foobar1310-xy,foobar1311-xy'; 
my @names = split /,/,$names; 

my $pfx = lcp(@names); 

my @nums = map { m/$pfx(\d*)/; $1 } @names; 
my $first=shift @nums; 
my $last = pop @nums; 
my $suf=$names[0]; 
$suf =~ s/$pfx\d*//; 

print "$pfx\{$first-$last}$suf\n"; 

#https://gist.github.com/3309172 
sub lcp { 
    my $match = shift; 
    substr($match, (($match^$_) =~ /^\0*/, $+[0])) = '' for @_; 
    $match; 
} 

인쇄 다음

foobar13{08-11}-xy