removed CGI::Untaint::Maypole, 29 tests now passing

[maypole.git] / lib / Maypole / Model / CDBI / AsForm.pm

diff --git a/lib/Maypole/Model/CDBI/AsForm.pm b/lib/Maypole/Model/CDBI/AsForm.pm
index 267cbeaff12e15e92369816974967b68736ab3b4..d11ba70579db16a5dba13cdf54b7c519db58dd3a 100644 (file)
--- a/lib/Maypole/Model/CDBI/AsForm.pm
+++ b/lib/Maypole/Model/CDBI/AsForm.pm
@@ -193,6 +193,12 @@ sub unselect_element {
 }
 
 
+=head2 a_select_box
+
+  Returns a HTML::Element representing a select box, based on the arguments
+
+=cut
+
 # make a select box from args
 sub a_select_box {
        my ($self, $name, $vals, $selected_val, $contents) = @_;
@@ -262,7 +268,6 @@ sub to_field {
 
     my $args = shift @args;  # argument hash ref  
        use Data::Dumper;
-       warn "args to_field  are $field, " . Dumper(\@args);
 
        return  $self->_field_from_how($field, $how, $args)   || 
                $self->_field_from_relationship($field, $args) ||
@@ -280,10 +285,10 @@ Override at will.
 sub _field_from_how {
        my ($self, $field, $how, $args) = @_;
        $args ||= '';
-       warn "field is $field. how is $how. args are $args";
+#      warn "field is $field. how is $how. args are $args";
        no strict 'refs';
        my $meth = $how ? "_to_$how" : '' ;
-       warn "Meth is $meth. field is $field";
+#      warn "Meth is $meth. field is $field";
        return $self->$meth($field, $args) if $meth and $self->can($meth);
        return;
 }
@@ -308,7 +313,7 @@ sub _field_from_relationship {
        my $fclass_is_cdbi = $fclass ? $fclass->isa('Class::DBI') : 0;
 
        # maybe has_a select 
-       warn "Dumper of relmeta. " . Dumper($rel_meta);
+#      warn "Dumper of relmeta. " . Dumper($rel_meta);
        if ($rel_meta->{name} eq 'has_a' and $fclass_is_cdbi) {
            # This condictions allows for trumping of the has_a args
                if  (not $rel_meta->{args}{no_select} and not $args->{no_select}) 
@@ -339,7 +344,7 @@ sub _field_from_relationship {
        }
        return;
 }
-                       
+
 =head2 _field_from_column($field, $args)
 
 Returns an input based on the column's characteristics, namely type, or nothing.
@@ -417,7 +422,7 @@ sub _to_textfield {
             $val = $self->$col;
             if (ref $val) {
                                if (my $meta = $self->related_meta('',$col)) {
-                               warn "Meta for $col";
+#                              warn "Meta for $col";
                                if (my $code = $meta->{args}{deflate4edit} ) {
                        $val  = ref $code ? &$code($val) : $val->$code;
                                        }
@@ -566,7 +571,7 @@ sub _to_select {
                }
                else {
                        $args->{selected} ||= [ $self->$col ] if  ref $self; 
-                       warn "selected is " . Dumper($args->{selected});
+#                      warn "selected is " . Dumper($args->{selected});
                        my $c = $rel_meta->{args}{constraint} || {};
                        my $j = $rel_meta->{args}{join} || {};
                        my @join ; 
@@ -595,7 +600,7 @@ sub _to_select {
 
        # Get items to select from
     $args->{items} = _select_items($args);
-    warn "Items selecting from are " . Dumper($args->{items});
+#    warn "Items selecting from are " . Dumper($args->{items});
 #use Data::Dumper;
 #warn "Just got items. They are  " . Dumper($args->{items});
 
@@ -642,7 +647,7 @@ sub _select_items {
        $sql .= " WHERE " . $args->{where}   if $args->{where};
        $sql .= " ORDER BY " . $args->{order_by} if $args->{order_by};
        $sql .= " LIMIT " . $args->{limit} if $args->{limit};
-warn "_select_items sql is : $sql";
+#warn "_select_items sql is : $sql";
 
        return $fclass->db_Main->selectall_arrayref($sql);
 
@@ -779,7 +784,7 @@ sub _to_link_hidden {
     my $r = $args->{r} || '';
     my $url = $args->{url} || '';
    use Data::Dumper;
-   warn "$self Args are " . Dumper($args);
+#   warn "$self Args are " . Dumper($args);
     $self->_croak("_to_link_hidden called without Maypole Request object (\$r) and url. Need one or other.")
         unless $r;
     my ($obj, $name);
@@ -914,12 +919,10 @@ sub _hash_selected {
                return \%hashed;
        }
        else { warn "AsForm Could not hash the selected argument: $selected"; }
-} 
-               
-
+}
 
 
-=head2 _select_guts 
+=head2 _select_guts
 
 Internal api  method to make the actual select box form elements.
 
@@ -927,8 +930,8 @@ Internal api  method to make the actual select box form elements.
   Array of CDBI objects.
   Array of scalars , 
   Array or  Array refs with cols from class.
-=cut
 
+=cut
 
 
 sub _select_guts {
@@ -1037,23 +1040,23 @@ sub _options_from_scalars {
 }
 
 sub _options_from_hashes {
-    my ($self, $items, $args) = @_;
-       my $selected = $args->{selected} || {};
-       my $pk = eval {$args->{class}->primary_column} || 'id';
-       my $fclass = $args->{class} || '';
-       my $stringify = $args->{stringify} || '';
-       my @res;
-       for (@$items) {
-               my $val = $_->{$pk};
-               my $opt = HTML::Element->new("option", value => $val );
-               $opt->attr(selected => "selected") if $selected->{$val};
-               my $content = $fclass and $stringify and $fclass->can($stringify) ? 
-                             $fclass->$stringify($_) : 
-                                 join(' ', @$_);
-               $opt->push_content( $content );
-        push @res, $opt; 
-    }
-       return @res;
+  my ($self, $items, $args) = @_;
+  my $selected = $args->{selected} || {};
+  my $pk = eval {$args->{class}->primary_column} || 'id';
+  my $fclass = $args->{class} || '';
+  my $stringify = $args->{stringify} || '';
+  my @res;
+  for (@$items) {
+    my $val = $_->{$pk};
+    my $opt = HTML::Element->new("option", value => $val );
+    $opt->attr(selected => "selected") if $selected->{$val};
+    my $content = ($fclass && $stringify && $fclass->can($stringify)) ? 
+      $fclass->$stringify($_) : 
+       join(' ', @$_);
+    $opt->push_content( $content );
+    push (@res, $opt); 
+  }
+  return @res;
 }
        
 #