Re: any pointers please? combine words script

From: Uri Guttman (uri_at_stemsystems.com)
Date: 08/01/04 

Date: Sun, 01 Aug 2004 05:17:48 GMT

>>>>> "sf" == steve f <me@example.com> writes:

  sf> #!/usr/bin/perl -Tw
  sf> use strict;
  sf> #use CGI::Carp qw(fatalsToBrowser);

  sf> my $query = $ENV{QUERY_STRING};
  sf> my %config = combine_hash($query);

use CGI.pm. never parse your queries on your own unless you have a good
reason.

ever heard of comments?

  sf> my %kv = get_input($config{cgi});

don't use short cryptic variable names like kv. and you have too many
file lexicals IMO (but i can tell for sure unless i do a full analysis).

  sf> $config{user_input} = $kv{words};
  sf> print header($config{title});
  sf> for my $key (keys %kv) {
  sf> for my $option (@{ $config{options}}) {
  sf> if ($key eq $option) {push @{ $config{user_config}}, $key}

don't put blocks on one line like that.

  sf> }
  sf> }
  sf> print table($config{intro},form(%config, %kv));
  sf> if ($kv{got_input} eq "yes") { print format_output($config{action}(%kv)); }

  sf> exit(0);

  sf> sub combine_hash {

  sf> my $query = shift;

  sf> my ($language, $num);

  sf> if ($query =~ /mkt=(\w+)/) { $language = $1 }
  sf> if ($query =~ /boxes=(\w+)/) { $num = $1 }

don't parse a query like that. gack! what if someone sent you an encoded
value for mkt which had %20 like hex in it?

  sf> if (!$num) { $num = 2 }

$num ||= 2 ;

  sf> my $intro =
  sf> "<b>Combine words</b>";

  sf> my %page = (script => "combine.cgi?boxes=$num",
  sf> cgi => [get_textareas($num), @options],
  sf> title => 'Combine two lists',
  sf> intro => $intro,
  sf> textarea => [ get_textareas($num) ],
  sf> options => [@options],
  sf> defaults => ['no quotes', 'reverse'],
  sf> submit => get_submit($num),
  sf> action => sub { my %kv = @_;
  sf> my @array = combine_lists(%kv);
  sf> return @array;
  sf> },
  sf> );

why assign to %page when it is the last thing in a sub? just return the
list.

  sf> }

  sf> sub get_submit {
  sf> my $num = shift;
  sf> if ($num == 1) { return 'combine one' }
  sf> if ($num == 2) { return 'combine two' }
  sf> if ($num == 3) { return 'combine three' }

return( 'combine' . qw( one two three )[ shift - 1 ] ) ;

ugly but i hate repeated code like that sub has.

  sf> }

  sf> sub menu {
  sf> my $source = shift;
  sf> my %hash = @_;

my ($source, %hash) = @_;

assign from @_ is more common and better IMO than shift

  sf> my @temp;

never name a temp, temp. name it for what is it a temp FOR. and i can't
recall the last time i needed a temp var. it is a flag that the code
isn't designed well.

  sf> for my $element (sort keys %hash) {
  sf> if ($element eq $source) { push(@temp, "<b>$source</b>") }
  sf> else { push(@temp, "<a href=\"./$hash{$element}\">$element</a>") }
  sf> }

        push( @better_name, $element eq $source ?
                "<b>$source</b>" :
                qq{$element} ;

also use qq{} when you have quotes in your text

  sf> my $output .= join(" | \n", @temp);
  sf> return $output;

let's combine all of that:

        return join " | \n", map {
                $_ eq $source ?
                        "<b>$source</b>" :
                        qq{$element}
                } sort keys %hash ;

not too cluttered, i think. :)

  sf> }

  sf> sub get_options {
  sf> my $num = shift;
  sf> if ($num == 1) { return 'no_quotes', 'quotes', 'brackets', 'skip_space'}
  sf> elsif ($num == 2) { return 'no_quotes', 'quotes', 'brackets',
  sf> 'reverse_words', 'skip_space'}
  sf> elsif ($num == 3) { return 'no_quotes', 'quotes', 'brackets',
  sf> 'reverse_words', 'skip_space'}
  sf> else { return 'no_quotes', 'no_quotes', 'quotes', 'brackets', 'skip_space'}
  sf> }

GACK!!!!!

whay do you do a elsif if you RETURN in the previous block? you don't in
the combine one/two/three sub earlier. do the same thing here. in fact
do the same thing i did above. factor out the common code and just index
by $num into a qw.

  sf> sub get_textareas {
  sf> my $num = shift;
  sf> if ($num == 1) { return 'kw_1'}
  sf> elsif ($num == 2) { return 'kw_1', 'kw_2'}
  sf> elsif ($num == 3) { return 'kw_1', 'kw_2', 'kw_3'}
  sf> else { return 'kw_1'}
  sf> }

same as above.

  sf> sub combine_lists {
  sf> my %kv = @_;

better names please!!

  sf> my @array;
  sf> if ($kv{kw_1} && !$kv{kw_2} && !$kv{kw_3}) {
  sf> @array = split /\n/, $kv{kw_1};
  sf> if ($kv{skip_space}) { push @array, simple_merge(@array) }
  sf> }
  sf> if ($kv{kw_1} && $kv{kw_2} && !$kv{kw_3}) {
  sf> @array = combine_two($kv{kw_1}, $kv{kw_2});
  sf> if ($kv{reverse_words}) {
  sf> push @array, combine_two($kv{kw_2}, $kv{kw_1});
  sf> }
  sf> if ($kv{skip_space}) { push @array, simple_merge(@array) }
  sf> }
  sf> if ($kv{kw_1} && $kv{kw_2} && $kv{kw_3}) {
  sf> @array = combine_three($kv{kw_1}, $kv{kw_2}, $kv{kw_3});
  sf> if ($kv{reverse_words}) {
  sf> push @array, combine_three($kv{kw_3}, $kv{kw_2}, $kv{kw_1});
  sf> }
  sf> if ($kv{skip_space}) { push @array, simple_merge(@array) }
  sf> }
  sf> my @return_array;
  sf> if ($kv{no_quotes}) { @return_array = @array }
  sf> if ($kv{quotes}) {
  sf> for my $element (@array) { push @return_array, qq("$element") }
  sf> }
  sf> if ($kv{brackets}) {
  sf> for my $element (@array) { push @return_array, qq([$element]) }
  sf> }
  sf> if (!$kv{no_quotes} &&!$kv{quotes} && !$kv{brackets}) { @return_array = @array }
  sf> return @return_array;
  sf> }

that sub is totally incomprehensible. it looks like it had redundant and
repeated code and calls those odd little subs you have written. no idea
what it wants to do.

  sf> sub simple_merge {
  sf> my @words = @_;
  sf> my @return_array;
  sf> for my $word (@words) {
  sf> my @array = split(//, $word);
  sf> my $i = 0;
  sf> my @location;
  sf> for my $character (@array) {

you rarely need to loop over characters in perl. again, i have no clue
as to what you are trying to do so i can't fix it. the sub's name is
meaningless as well.

  sf> if ($character =~ / /) {

WHAT!! you have a single char and you use a slow regex to see if it is a
blank? eq is the correct operator.

  sf> push @location, $i;

ever heard of index? it does this location of character searching for you.

  sf> }
  sf> $i++
  sf> }
  sf> for my $num (@location) {
  sf> my $temp;

again with temp. bad boy! no cookie for you!

  sf> for my $i (0..$#array) {
  sf> if ($num == $i) { next }
  sf> else { $temp .= $array[$i] }
  sf> }
  sf> push @return_array, $temp;
  sf> $temp = ();
  sf> }
  sf> }
  sf> return @return_array;
  sf> }

  sf> sub combine_two {
  sf> my $words_1 = shift;
  sf> my $words_2 = shift;
  sf> my @array;
  sf> for my $word_1 (split /\n/, $words_1) {
  sf> for my $word_2 (split /\n/, $words_2) {
  sf> push @array, "$word_1 $word_2"
  sf> }
  sf> }
  sf> return @array;
  sf> }

you have a fetish for combine. it must mean something to you but not to
anyone else.

  sf> sub combine_three {
  sf> my $words_1 = shift;
  sf> my $words_2 = shift;
  sf> my $words_3 = shift;
  sf> my @array;
  sf> for my $word_1 (split /\n/, $words_1) {
  sf> for my $word_2 (split /\n/, $words_2) {
  sf> for my $word_3 (split /\n/, $words_3) {
  sf> push @array, "$word_1 $word_2 $word_3"
  sf> }
  sf> }
  sf> }
  sf> return @array;
  sf> }

  sf> sub get_input {
  sf> my $ref_array = shift;
  sf> my @form_variables = @{ $ref_array};
  sf> my %kv = ();
  sf> read (STDIN, my $input, $ENV{'CONTENT_LENGTH'});
  sf> if ($input) { $kv{got_input} = "yes" }
  sf> my @kv = split (/&/, $input);
  sf> for my $kv (@kv) {
  sf> (my $key, my $value) = split (/=/, $kv);
  sf> $value =~ tr/+/ /;
  sf> $value =~ s/%([\dA-Fa-f][\dA-Fa-f])/pack ("C", hex ($1))/eg;
  sf> $value =~ s/\r//g;
  sf> $value =~ s/^\s+//;
  sf> $value =~ s/\s+$//;
  sf> $value =~ s/\n\s+/\n/;
  sf> $value =~ s/\s+\n/\n/;
  sf> for my $variable (@form_variables) {
  sf> if ($key eq "$variable") { $kv{$key} = $value }
  sf> }
  sf> }
  sf> return %kv;
  sf> }

CGI.pm or you die! BLECHHH!!!!!!

  sf> sub header {
  sf> my $title = shift;
  sf> my $string = qq(Content-type: text/html\n\n);
  sf> $string .= qq(<html>\n<head><title>$title</title></head>\n);
  sf> $string .= qq(<body bgcolor="#ffffff" text="#000000" link="#000000" vlink="#800000" alink="#ff00ff">\n\n);
  sf> return $string;
  sf> }

cgi.pm again.

enough for me. i should bill you for this posting!

uri 

-- 
Uri Guttman  ------  uri@stemsystems.com  -------- http://www.stemsystems.com
--Perl Consulting, Stem Development, Systems Architecture, Design and Coding-
Search or Offer Perl Jobs  ----------------------------  http://jobs.perl.org

Relevant Pages

  • Re: Packages and returning errors
    ... > array intact. ... sub is_a_instance_method { ... my $class = shift; ... You need to fix the scope of $error by moving its declaration outside ...
    (comp.lang.perl.misc)
  • Re: Packages and returning errors
    ... The perldoc function guide says about shift (which is ... "Shifts the first value of the array off and returns it, ... If an array of values are passed to a sub, ... Back to my package (which I am currently thinking might be out of my depth, ...
    (comp.lang.perl.misc)
  • Re: Replacing a line
    ... #Using core module Tie::File to process a file in this subroutine ... sub process_one_file { ... $cpp_file = shift; ... for (@array) #Each line should come one by one ...
    (comp.lang.perl.misc)
  • Re: Excel temporary files
    ... but temp files get left. ... 'we use an array and store the file objects as this avoids any problems ... 'now go back and delete empty folders below the temp folder ... Sub SelectFiles ...
    (microsoft.public.excel)
  • Both Methods and Indexing for Objects?
    ... constructor that returns a blessed ref to an underlying tied array, ... implement the tied array as a blessed hash behind the scenes. ... sub new ... bless $self, shift; ...
    (comp.lang.perl.misc)