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
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;
I reckon we are the only monastery ever to have a dungeon stuffed with 16,000 zombies
.
