Takes text input files and generates William Borroughs-style cutup poetry

cutup.pl

#!/usr/bin/perl

use strict;

use Options;

my $options = new Options(params => [
				 					['file', 'f', undef, 'The data file of return-separated lines to cutup.'],
				 					['lines', 'l', 10, 'Resulting cutup will contain this many lines.'],
				 					#['density', 'd', 3, 'Each line will contain, at most, this many pieces.'],
									['chars', 'c', 70, 'The desired approximate length of a line.']
									],
						   flags => [
									['burroughs', 'b', 'Create a William Burroughs-style cutup.']
									]);

$options->get_options();
my $file = $options->get_result('file');
my $line_count = $options->get_result('lines');
my $density = 3; #$options->get_result('density');
my $chars = $options->get_result('chars');
my $burroughs = $options->get_result('burroughs');
my @lines = ();

open(INPUT, $file);
while(<INPUT>){
	chomp;
	push(@lines, $_);
}
close(INPUT);

shuffle(\@lines);

for(my $i = 0; $i < $line_count; $i++){
	my @chosen_pieces = ();
	for(my $j = 0; $j < $density; $j++){
		my $random = rand() * @lines;
		my $selected_piece = splice(@lines, $random, 1);
		my $fragment_length = $chars / $density;
		my $fragment = substr($selected_piece, rand() * (length($selected_piece) - $fragment_length), $fragment_length);
		my $space_count = scalar($fragment =~ m/\s/);
		my $start = rand() * $space_count;
		my $length = abs((rand() * $space_count) - $start) / $density;
		my (undef, @pieces, undef) = split(m/\s/, $selected_piece);
		splice(@pieces, $start, $length);
		my $line = join(" ", @pieces);
		push(@chosen_pieces, $line);
		#print "$finished_line ";
	}
	my $finished_line = substr(join(($burroughs ? " -- " : " "), @chosen_pieces), 0, $chars);
	($finished_line) = ($finished_line =~ m/(.*?)\s*[^\s]*$/);
	$finished_line =~ s/^\s+//;
	$finished_line =~ s/\s+$//;
	$finished_line =~ s/\s{2,}/ /g;

	print $finished_line . "\n";
}

# fisher_yates_shuffle( \@array ) : generate a random permutation of @array in place
sub shuffle {
	my $array = shift;
	my $i;
	for ($i = @$array; --$i; ) {
		my $j = int rand ($i+1);
		next if $i == $j;
		@$array[$i,$j] = @$array[$j,$i];
	}
}