lib/CXGN/Page/Form/Editable.pm

   1
   2 =head1 NAME
   3
   4 CXGN::Page::Form::Editable.pm -- classes to deal with user-modifiable web forms
   5
   6 =head1 DESCRIPTION
   7
   8 This is a subclass of L<CXGN::Page::Form::Static>, and overrides the functions therein to generate editable components in the form. For more information, see L<CXGN::Page::Form::Static>.
   9
  10 =head1 AUTHOR(S)
  11
  12 Lukas Mueller (lam87@cornell.edu)
  13
  14 =cut
  15
  16 use strict;
  17 use CXGN::Page;
  18 use CXGN::Page::Form::Static;
  19 use CXGN::Page::Form::EditableField;
  20 use CXGN::Page::Form::EditableSelect;
  21 use CXGN::Page::Form::EditableHidden;
  22 use CXGN::Page::Form::EditableTextArea;
  23 use CXGN::Page::Form::EditableCheckbox;
  24 use CXGN::Page::Form::EditablePasswordField;
  25 use CXGN::Page::Form::EditableRadioList;
  26 use CXGN::Page::Form::EditableMultiSelect;
  27
  28 package CXGN::Page::Form::Editable;
  29
  30 use base qw / CXGN::Page::Form::Static /;
  31
  32 sub new {
  33         my $class = shift;
  34         my $self = $class->SUPER::new(@_);
  35         my $args=shift;
  36         $self->set_form_id($args->{form_id}); #optional. Set a form id. Required for javasctipt forms
  37         $self->set_no_buttons($args->{no_buttons}); #optional. Used in javascript forms, which should generate their own 'store' and 'reset form' buttons.
  38         $self->set_reset_button_text("Reset form");
  39         $self->set_submit_button_text("Store");
  40         $self->set_submit_method(); #use hardcoded default
  41
  42         return $self;
  43 }
  44
  45 =head2 is_editable
  46
  47 Whether the form can be filled in.
  48
  49 =cut
  50
  51 sub is_editable {
  52         return 1;
  53 }
  54
  55 =head2 propagate_input
  56
  57  Usage:
  58  Desc:
  59  Ret:
  60  Args:
  61  Side Effects:
  62  Example:
  63
  64 =cut
  65
  66 sub propagate_input {
  67     my $self = shift;
  68     my %args = @_;
  69
  70     my %distinct_objects = ();
  71     # propagate the input to the form object
  72     #
  73
  74     foreach my $f ($self->get_fields()) {
  75         my $setter = $f->get_object_setter();
  76
  77         #print STDERR "FUNCTION: " .$setter." field contents: ".($args{$f->get_field_name()})." field name: ".$f->get_field_name()." getter: ".$f->get_object_getter()." setter: ".$f->get_object_setter()."\n";
  78
  79         if ($setter)
  80         {
  81                 if($f->is_store_enabled())
  82                 {
  83                         $f->get_object()->$setter($args{$f->get_field_name()});
  84                 }
  85                 $f->set_store_enabled(1); #must be re-disabled at each visit to the form
  86             my $object = $f->get_object();
  87             my $object_type = ref($object);
  88             $distinct_objects{$object_type}=$f->get_object(); #can only have one object of a given type associated with a given form
  89         }
  90     }
  91     $self->set_distinct_objects(%distinct_objects);
  92
  93 }
  94
  95 =head2 get_distinct_objects
  96
  97  Usage:
  98  Desc:         stores a hash of distinct objects in the form
  99                which will be used to call store on.
 100                The hash keys are object types and the values are
 101                the actual objects.
 102  Ret:
 103  Args:
 104  Side Effects:
 105  Example:
 106
 107 =cut
 108
 109 sub get_distinct_objects {
 110   my $self=shift;
 111   return %{$self->{distinct_objects}};
 112 }
 113
 114 =head2 set_distinct_objects
 115
 116  Usage:
 117  Desc:
 118  Ret:
 119  Args:
 120  Side Effects:
 121  Example:
 122
 123 =cut
 124
 125 sub set_distinct_objects {
 126   my $self=shift;
 127   my %distinct_objects = @_;
 128   %{$self->{distinct_objects}}=%distinct_objects;
 129 }
 130
 131 =head2 validate
 132
 133  Usage:
 134  Desc:
 135  Ret:
 136  Args:
 137  Side Effects:
 138  Example:
 139
 140 =cut
 141
 142 sub validate {
 143     my $self = shift;
 144     my %args = @_;
 145
 146 #    $self->propagate_input(%args); #think this is unnecessary, and leaving it in would mess up SimpleFormPage::validate_parameters_before_store() -- Evan, 1 / 15 / 07
 147     my %error_hash = ();
 148     foreach my $f ($self->get_fields()) {
 149         my $error =  $f->validate();
 150         #print STDERR "validate ".$f->get_field_name()." - error $error\n";
 151         if ($error) {
 152             $error_hash{$f->get_field_name()}=$error;
 153         }
 154     }
 155     $self->set_error_hash(%error_hash);
 156     return %error_hash;
 157 }
 158
 159 =head2 store
 160
 161  Usage:
 162  Desc:
 163  Ret:
 164  Args:
 165  Side Effects:
 166  Example:
 167
 168 =cut
 169
 170 sub store {
 171     my $self = shift;
 172     my %args = @_;
 173
 174     $self->propagate_input(%args);
 175
 176
 177
 178     # commit the changes to the database using the store method on
 179     # each object
 180     #
 181     #print STDERR "STORING OBJECT...\n";
 182
 183     my %distinct_objects = $self->get_distinct_objects();
 184
 185
 186     # check the uniqueness constraints of the object
 187     #
 188     foreach my $k (keys(%distinct_objects)) {
 189                 my $obj = $distinct_objects{$k};
 190       if ($obj->can("exists_in_database")) {
 191                 my $message = $obj->exists_in_database; #message is optional
 192          if ($message) {
 193                 my $text =      "This object (" . ref($distinct_objects{$k}) . ") already seems to exist in the database and violates constraints. Please correct your input.\n";
 194                 $message = "" unless ($message =~ /[a-zA-Z]/);
 195             CXGN::Page->new()->message_page($text, $message);
 196         }
 197       }
 198     }
 199     foreach my $k (keys %distinct_objects) {
 200         #print STDERR " DUMP:" .Data::Dumper::Dumper($distinct_objects{$k});
 201         #print STDERR " STORING OBJECT: ".ref($distinct_objects{$k})."\n";
 202
 203         my $id = $distinct_objects{$k}->store();
 204         $self->set_insert_id($k, $id);
 205     }
 206 }
 207
 208 =head2 add_field
 209
 210  Usage:
 211  Desc:
 212  Ret:
 213  Args:         a hash with the following keys:
 214                 screen_name
 215                 field_name
 216                 contents
 217                 length
 218                 object
 219                 getter
 220                 setter
 221                                          set_if
 222                                          validate
 223                required fields: field_name.
 224  Side Effects:
 225  Example:
 226
 227 =cut
 228
 229 sub add_field {
 230
 231     my $self = shift;
 232     my %args = @_;
 233     my $field = CXGN::Page::Form::EditableField->new(%args);
 234     if(exists $args{validate})
 235     {
 236         $field->set_validate($args{validate});
 237     }
 238     if (!exists($self->{fields})) { $self->{fields}=(); }
 239     push @{$self->{fields}}, $field;
 240 }
 241
 242 =head2 add_password_field
 243
 244  Usage:
 245  Desc:
 246  Ret:
 247  Args:         a hash with the following keys:
 248                 screen_name
 249                 field_name
 250                 contents
 251                 length
 252                 object
 253                 getter
 254                 setter
 255                                          set_if
 256                                          validate
 257                required fields: field_name.
 258  Side Effects:
 259  Example:
 260
 261 =cut
 262
 263 sub add_password_field {
 264
 265     my $self = shift;
 266     my %args = @_;
 267     my $field = CXGN::Page::Form::EditablePasswordField->new(%args);
 268     if(exists $args{validate})
 269     {
 270         $field->set_validate($args{validate});
 271     }
 272     if (!exists($self->{fields})) { $self->{fields}=(); }
 273     push @{$self->{fields}}, $field;
 274 }
 275
 276 =head2 function add_textarea
 277
 278   Synopsis:
 279   Arguments:    a hash with the following keys:
 280                 screen_name
 281                 field_name
 282                 contents
 283                 length
 284                 object
 285                 getter
 286                 setter
 287                                          set_if
 288                                          validate
 289                 required fields: field_name.
 290   Returns:
 291   Side effects:
 292   Description:
 293
 294 =cut
 295
 296 sub add_textarea {
 297     my $self = shift;
 298     my %args = @_;
 299     my $field = CXGN::Page::Form::EditableTextArea->new(%args);
 300     if(exists $args{validate})
 301     {
 302         $field->set_validate($args{validate});
 303     }
 304     $self->add_field_obj($field);
 305 }
 306
 307 =head2 add_select
 308
 309  Usage:
 310  Desc:
 311  Ret:
 312  Args:         display_name
 313                field_name
 314                contents
 315                length
 316                object
 317                getter
 318                setter
 319                                         set_if
 320                                         validate
 321                select_list_ref
 322                select_id_list_ref
 323
 324  Side Effects:
 325  Example:
 326
 327 =cut
 328
 329 sub add_select {
 330     my $self = shift;
 331     my %args = @_;
 332
 333     #foreach my $k (keys %args) { print "Args to add_select $k, $args{$k}\n<br />"; }
 334     my $select = CXGN::Page::Form::EditableSelect->new(%args);
 335     if(exists $args{validate})
 336     {
 337         $select->set_validate($args{validate});
 338     }
 339     if (!exists($self->{fields})) { $self->{fields}=(); }
 340     push @{$self->{fields}}, $select;
 341 }
 342
 343 =head2 add_hidden
 344
 345  Usage:
 346  Desc:
 347  Ret:
 348  Args:
 349  Side Effects:
 350  Example:
 351
 352 =cut
 353
 354 sub add_hidden {
 355     my $self = shift;
 356     my %args = @_;
 357
 358     my $hidden = CXGN::Page::Form::EditableHidden->new(%args);
 359     if(exists $args{validate})
 360     {
 361         $hidden->set_validate($args{validate});
 362     }
 363     $self->add_field_obj($hidden);
 364 }
 365
 366 =head2 add_checkbox
 367
 368  Usage:
 369  Desc:
 370  Ret:
 371  Args:
 372  Side Effects:
 373  Example:
 374
 375 =cut
 376
 377 sub add_checkbox
 378 {
 379     my $self = shift;
 380     my %args = @_;
 381
 382     my $checkbox = CXGN::Page::Form::EditableCheckbox->new(%args);
 383     $self->add_field_obj($checkbox);
 384 }
 385
 386 =head2 add_radio_list
 387
 388  Usage:
 389  Desc:
 390  Ret:
 391  Args:
 392  Side Effects:
 393  Example:
 394
 395 =cut
 396
 397 sub add_radio_list
 398 {
 399         my $self = shift;
 400     my %args = @_;
 401
 402     my $radio = CXGN::Page::Form::EditableRadioList->new(%args);
 403     $self->add_field_obj($radio);
 404 }
 405
 406 =head2 add_multiselect
 407
 408  Usage:
 409  Desc:
 410  Ret:
 411  Args:
 412  Side Effects:
 413  Example:
 414
 415 =cut
 416
 417 sub add_multiselect
 418 {
 419         my $self = shift;
 420     my %args = @_;
 421
 422     my $radio = CXGN::Page::Form::EditableMultiSelect->new(%args);
 423     $self->add_field_obj($radio);
 424 }
 425
 426 sub get_form_start {
 427     my $self = shift;
 428
 429     return "<form id =\"" . $self->get_form_id() . "\" method=\"" . $self->get_submit_method() . "\" action=\"\">"; #must have action parameter for xhtml 1.0+ -- Evan, 1/7/07
 430 }
 431
 432 sub get_form_end {
 433     my $self = shift;
 434     return undef if $self->get_no_buttons();
 435     return "<input type=\"submit\" value=\"" . $self->get_submit_button_text() . "\" />
 436             <input type=\"reset\" value=\"" . $self->get_reset_button_text() . "\" />
 437             </form>";
 438 }
 439
 440 =head2 get_submit_method
 441
 442 'get' or 'post'
 443
 444 =cut
 445
 446 sub get_submit_method
 447 {
 448         my $self = shift;
 449         return $self->{form_submit_method};
 450 }
 451
 452 =head2 set_submit_method
 453
 454 'get' or 'post' (case doesn't matter)
 455
 456 default is 'get' if no or invalid argument
 457
 458 =cut
 459
 460 sub set_submit_method
 461 {
 462         my ($self, $method) = @_;
 463         $method = 'get' if(!defined($method) or $method !~ /^get|post$/i);
 464         $self->{form_submit_method} = lc($method); #lowercase
 465 }
 466
 467 sub get_reset_button_text
 468 {
 469         my $self = shift;
 470         return $self->{reset_button_text};
 471 }
 472
 473 =head2 set_reset_button_text
 474
 475 Args: new button text (default is 'reset form')
 476
 477 [1 / 9 / 07] Not currently possible to remove the reset button.
 478
 479 =cut
 480
 481 sub set_reset_button_text
 482 {
 483         my ($self, $text) = @_;
 484         $self->{reset_button_text} = $text;
 485 }
 486
 487 sub get_submit_button_text
 488 {
 489         my $self = shift;
 490         return $self->{submit_button_text};
 491 }
 492
 493 =head2 set_submit_button_text
 494
 495  Args: new button text (default is 'store')
 496
 497 =cut
 498
 499 sub set_submit_button_text
 500 {
 501         my ($self, $text) = @_;
 502         $self->{submit_button_text} = $text;
 503 }
 504
 505 =head2 as_table_string
 506
 507  Usage:
 508  Desc:
 509  Ret:
 510  Args:
 511                Note: as table does not call validate itself to give some
 512                more control on the appearance (you don't want the
 513                new input field to appear with error messages).
 514  Side Effects:
 515  Example:
 516
 517 =cut
 518
 519 sub as_table_string {
 520     my $self = shift;
 521     my $string = "";
 522
 523     my %error_hash = $self->get_error_hash();
 524
 525     my %html = $self->get_field_hash();
 526
 527     my $has_required_field=0;
 528     $string .= $self->get_form_start();
 529     $string .=  qq { <table> };
 530     foreach my $f ($self->get_fields()) {
 531         my $error = "";
 532         if (exists($error_hash{$f->get_field_name()})) {
 533             $error=$self->get_error_message($error_hash{$f->get_field_name()})."<br />";
 534
 535         }
 536         my $required_field = "";
 537         if ($f->get_validate()) {
 538             $required_field = qq { <font color="red">*</font> };
 539             $has_required_field=1;
 540         }
 541
 542         # print everything except the hidden fields
 543         #
 544         if (ref($f)!~/hidden/i) {
 545             $string .= "<tr><td>$error".($f->get_display_name())."$required_field</td><td width=\"20\">&nbsp;</td><td>".($html{$f->get_field_name()})."</td></tr>\n";
 546
 547         }
 548     }
 549
 550     $string .= qq { <tr><td colspan="3" align="center"> };
 551
 552     # print the hidden fields
 553     #
 554     foreach my $f ($self->get_fields()) {
 555         if (ref($f)=~/hidden/i) {
 556             $string .= $html{$f->get_field_name()};
 557         }
 558     }
 559     if ($has_required_field) {
 560         $string .= qq { (<font color="red">*</font> denotes required field.)<br /><br /> };
 561     }
 562     $string .= qq { </td></tr></table> };
 563     $string .= $self->get_form_end();
 564     return $string;
 565 }
 566
 567 return 1;