CrossQuip

## ** PERL ** use strict; use CGI; print "Content-type: text/html\n\n"; print < CrossQuip HTML my %query_hash; my $buff; $ENV{'REQUEST_METHOD'} =~ tr/a-z/A-Z/; if ($ENV{'REQUEST_METHOD'} eq "POST") { read(STDIN, $buff, $ENV{'CONTENT_LENGTH'}); }else { $buff = $ENV{'QUERY_STRING'}; } if ($buff) { my @pairs = split(/&/,$buff); foreach my $pair (@pairs) { my ($name, $value) = split(/=/,$pair); $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; $value =~ s/\+/ /g; $query_hash{$name} = $value; } } if ($query_hash{'quip'}) { my $str = $query_hash{'quip'}; $str =~ s/[^A-Za-z0-9\s]//g; # remove all non-letters/spaces my @str_array = split(/ /,$str); my @prev = (); my @sp = quipvec(\@prev,\@str_array); print_with_length(\@sp); print "-----
\n"; if ($query_hash{'author'}) { my $auth = $query_hash{'author'}; quip_author($auth,\@sp); } print "
\n"; print "

\n"; } print "

Input a quip to break it up for a crossword theme.\n
\n"; print "

\n"; print "Source code for this application here.\n"; # # SUBS # sub print_with_length { my $s = shift; if ($s) { my @sp = @$s; foreach my $w (@sp) { print "$w "; my $l = $w; $l =~ s/ //g; print length($l)."
\n"; } } } sub quip_author { my @return_array = (); my $return_ctr = 0; my $auth = shift; my $auth2 = $auth; $auth2 =~ s/\s//g; my $quip_vec_array = shift; my @qva = @$quip_vec_array; my $quip = "@qva"; my @quip_array = split(/ /,$quip); my $quip_vec_array_length = @qva; for my $i (0..$quip_vec_array_length) { if ($i < $quip_vec_array_length/2) { my @first = @qva[0..$i-1]; my @last = @qva[@qva-$i..@qva-1]; my @middle = @qva[$i..@qva-$i-1]; my $middle_string = "@middle"; my @midvec = split(/ /,$middle_string); # Check to see if $auth2 can match up with the end of "middle" my $l = 0; my $ctr = @midvec - 1; while ($l < length($auth2)) { $l += length($midvec[$ctr]); $ctr--; if ($ctr == -1 && $l != length($auth2)) {$l = length($auth2) + 1;} } if ($l == length($auth2)) { # If they match, we're good. my @author_match = @midvec[$ctr+1..@midvec-1]; print_with_length(\@first); print "$auth ".length($auth2)."
\n"; if ($ctr > -1 && $ctr < @midvec) { my @p = (); my @m = @midvec[0..$ctr]; my @sp = quipvec(\@p,\@m); print_with_length(\@sp) } print "@author_match ".length($auth2)."
\n"; print_with_length(\@last); print "-----
\n"; } } elsif ($i > $quip_vec_array_length/2) { my @first = @qva[0..@qva-$i-1]; my @last = @qva[$i..@qva-1]; my @middle = @qva[@qva-$i..$i-1]; my $middle_string = "@middle"; my @midvec = split(/ /,$middle_string); # Check to see if $auth2 can match up with the beginning of "middle" my $l = 0; my $ctr = 0; while ($l < length($auth2)) { $l += length($midvec[$ctr]); $ctr++; if ($ctr == @midvec && $l != length($auth2)) {$l = length($auth2) + 1;} } if ($l == length($auth2)) { # If they match, we're good. my @author_match = @midvec[0..$ctr-1]; print_with_length(\@first); print "@author_match ".length($auth2)."
\n"; if ($ctr > -1 && $ctr < @midvec) { my @p = (); my @m = @midvec[$ctr..@midvec-1]; my @sp = quipvec(\@p,\@m); print_with_length(\@sp); } print "$auth ".length($auth2)."
\n"; print_with_length(\@last); print "-----
\n"; } } elsif ($i == $quip_vec_array_length/2) { my @first = @qva[0..$i-1]; my @last = @qva[$i..@qva-1]; print_with_length(\@first); print "$auth ".length($auth2)."
\n"; print_with_length(\@last); print "-----
\n"; } } } sub quipvec { my $p = shift; my $s = shift; my @prev = @$p; my @str_array = @$s; my @lengths; my $total_length = 0; my $p_size = @prev; my $insert_point = $p_size/2; my $s_size = @str_array; for my $i (0..$s_size-1) { $lengths[$i] = length($str_array[$i]); $total_length += $lengths[$i]; } my $ctr = 0; my $ctr2 = $s_size - 1; my $l1 = 0; my $l2 = 0; while ($l1 <= $total_length/2) { $l1 += $lengths[$ctr]; while ($l2 < $l1) { $l2 += $lengths[$ctr2]; $ctr2--; } if ($l1 == $l2) { # End if the two strings overlap if ($l1 == $total_length) { @prev = (@prev[0..$insert_point-1],"@str_array",@prev[$insert_point..@prev-1]); return @prev; } # If the two strings do not overlap we can add new stuff in the middle @prev = (@prev[0..$insert_point-1],"@str_array[0..$ctr]","@str_array[$ctr2+1..$s_size-1]",@prev[$insert_point..@prev-1]); # We are done if we have written the whole string. if ($l1 + $l2 == $total_length) { return @prev; } # Otherwise we use a recursive process else { @str_array = @str_array[$ctr+1..$ctr2]; return quipvec(\@prev,\@str_array); } # end else } # end if $l1 == $l2 $ctr++; } # end while $l1 <= tot ... @prev = (@prev[0..$insert_point-1],"@str_array",@prev[$insert_point..@prev-1]); return @prev; }