The other day in the cb kailas asked how to reproduce the following cut command in perl:

  cut -c2-11,12-61,62-63,64-76,90-92 $str
[download]

Well, reproducing cut in perl is actually not quite as trivial as it seems on first look, because cut can take some pretty hairy specifications, such as descending indices, e.g. 12-8,5,4.

Here's an attempt to do at least part of what cut can do, in a native perly context of extracting either sub-strings or sub-arrays. It can handle any amount of overlapping and descending ranges. However, it does not do argument validation. If you attempt to get string/array elements beyond the range of the input, ugly things may happen.

The string-oriented solution uses unpack, and makes the optimization of calling unpack only once. The array-oriented solution has to return arrays, and since there's no way (afaik, in perl 5) to get multiple slices of an array, separately, in a single slicing operation, it can't make a similar optimization: it has to get as many distinct slices as there are "ranges" in the spec. Consequently, that solution is more elegant-looking. We could take the same approach for strings, using substr, and it would look about as elegant, but clearly not as optimized.

Note that indexing starts at 1 in both cases, in accordance with cut.

{
package Cut;

sub from_list
{
    my( $spec ) = @_;
    map
    [
        $_->[1] < $_->[0]
            ? reverse @_[ $_->[1] .. $_->[0] ]
            :         @_[ $_->[0] .. $_->[1] ]
    ],
    map
    [
        /(.*)\s*-\s*(.*)/
            ? ( $1, $2 )
            : ( $_, $_ )
    ],
    split /\s*,\s*/, $spec;
}

sub from_string
{
    my( $spec, $input ) = @_;
    my @spec =
    map
    [
        /(.*)\s*-\s*(.*)/
            ? ( $1, $2 )
            : ( $_, $_ )
    ],
    split /\s*,\s*/, $spec;

    my $ofs=0;
    my %reverse;
    my @pat;
    for ( 0 .. $#spec )
    {
        my( $lo, $hi ) = @{ $spec[$_] };
        if ( $hi < $lo )
        {
            $reverse{$_} = 1;
            ( $lo, $hi ) = ( $hi, $lo );
        }
        my $move = $lo - $ofs - 1;
        my $len  = $hi - $lo  + 1;
        $ofs = $hi;
        $pat[$_] =
        ( $move > 0 ? 'x'.$move : $move < 0 ? 'X'.(-$move) : '' )
        . 'a'.$len;
    }
    my @result = unpack "@pat", $input;
    $result[$_] = reverse $result[$_] for keys %reverse;
    @result
}

}

# some test cases:

my @a = Cut::from_string( '1,3-4,6-10,12-8,1,1,1', join '', 'a'..'z' )
+;
print "'$_'\n" for @a;

my @b = Cut::from_list( '1,3-4,6-10,12-8,1,1,1', 'a'..'z' );
print "> @$_\n" for @b;
[download]