lib/CXGN/Page/Form/ElementI.pm

   1
   2 =head1 NAME
   3
   4 CXGN::Page::Form::ElementI -- a parent class for all form elements (such as edit boxes and drop down menus)
   5
   6 =cut
   7
   8 use strict;
   9
  10 package CXGN::Page::Form::ElementI;
  11
  12 =head1 CONSTANTS
  13
  14 The following error return codes are defined in this class and are
  15 available as globals:
  16
  17 $INPUT_REQUIRED_ERROR
  18
  19 $INTEGER_REQUIRED_ERROR
  20
  21 $NUMBER_REQUIRED_ERROR
  22
  23 $TOKEN_REQUIRED_ERROR
  24
  25 $DATE_REQUIRED_ERROR
  26
  27 $ALLELE_NAME_REQUIRED_ERROR
  28
  29 $LENGTH_EXCEEDED_ERROR  # not yet implemented
  30
  31
  32 =cut
  33
  34 our $INPUT_REQUIRED_ERROR = 1;
  35 our $INTEGER_REQUIRED_ERROR = 2;
  36 our $NUMBER_REQUIRED_ERROR = 3;
  37 our $TOKEN_REQUIRED_ERROR= 4;
  38 our $DATE_REQUIRED_ERROR=6;
  39 our $LENGTH_EXCEEDED_ERROR = 5;
  40 our $UNIQUE_REQUIRED_ERROR=7;
  41 our $ALLELE_SYMBOL_REQUIRED_ERROR=8;
  42
  43
  44 =head1 FUNCTIONS
  45
  46 =head2 new
  47
  48  Usage:
  49  Desc:
  50  Ret:
  51  Args:       a hash with the following keys:
  52                display_name  (name of the field for display purposes)
  53                field_name (name of the form element)
  54                id (the id of the html node)
  55                contents (varies by field type; usually the node value)
  56                selected (varies by field type; not used by all fields)
  57                object (the object this field maps to)
  58                getter (the getter function for this field in the object)
  59                setter (the setter function for this field in the object)
  60                validate (a string describing how to validate the user input; see set_validate() below)
  61
  62                All keys correspond to object properties with getter/setters
  63                which are described in more detail below.
  64
  65  Side Effects:
  66  Example:
  67
  68 =cut
  69
  70 sub new {
  71     my $class = shift;
  72     my $self = bless {}, $class;
  73     my %args = @_;
  74 #    print STDERR  "\nCLASS: $class.\n";
  75 #    foreach my $k (keys %args) { print  STDERR "Args to add_select $k, $args{$k}\n"; }
  76     if (!$args{field_name}) {
  77         my $args_list = "";
  78         foreach my $k (keys %args) {
  79             $args_list .= "$k ($args{$k}) | ";
  80         }
  81
  82         die qq { Usage: CXGN::Page::Form::ElementI->new( display_name=>"Foo:", field_name=>"foo", contents=>"bar", selected=>0, length => 20, object => \$foo_obj , setter=>"set_foo", getter=>"get_foo", validate=>1)<br /> Your argument list is: $args_list. field_name is required, others are optional };
  83     }
  84
  85     $self->set_display_name($args{display_name});
  86     $self->set_field_name($args{field_name});
  87     $self->set_id($args{id});
  88     $self->set_contents($args{contents});
  89     $self->set_selected($args{selected});
  90     $self->set_length($args{length});
  91     $self->set_object($args{object});
  92     $self->set_object_getter($args{getter});
  93     $self->set_object_setter($args{setter});
  94     $self->set_store_enabled(1); #default is to store
  95     $args{validate} = "" if !defined($args{validate}); #avoid error messages about uninitialized values in comparison
  96     $self->set_validate($args{validate});
  97     my $formatting = $args{formatting} || "";
  98     $self->set_formatting($formatting);
  99
 100     return $self;
 101 }
 102
 103 =head2 get_display_name
 104
 105  Usage:
 106  Desc:
 107  Ret:
 108  Args:
 109  Side Effects:
 110  Example:
 111
 112 =cut
 113
 114 sub get_display_name {
 115   my $self=shift;
 116   return $self->{display_name};
 117
 118 }
 119
 120 =head2 set_display_name
 121
 122  Usage:
 123  Desc:
 124  Ret:
 125  Args:
 126  Side Effects:
 127  Example:
 128
 129 =cut
 130
 131 sub set_display_name {
 132   my $self=shift;
 133   $self->{display_name}=shift;
 134 }
 135
 136 =head2 get_field_name
 137
 138  Usage:
 139  Desc:
 140  Ret:
 141  Args:
 142  Side Effects:
 143  Example:
 144
 145 =cut
 146
 147 sub get_field_name {
 148   my $self=shift;
 149   if (!exists($self->{field_name})) { $self->{field_name} = ""; }
 150   return $self->{field_name};
 151
 152 }
 153
 154 =head2 set_field_name
 155
 156  Usage:
 157  Desc:
 158  Ret:
 159  Args:
 160  Side Effects:
 161  Example:
 162
 163 =cut
 164
 165 sub set_field_name {
 166   my $self=shift;
 167   $self->{field_name}=shift;
 168 }
 169
 170 =head2 get_id
 171
 172  Usage:
 173  Desc:
 174  Ret:
 175  Args:
 176  Side Effects:
 177  Example:
 178
 179 =cut
 180
 181 sub get_id {
 182   my $self=shift;
 183   if (!exists($self->{id})) { $self->{id} = ""; }
 184   return $self->{id};
 185
 186 }
 187
 188 =head2 set_id
 189
 190  Usage:
 191  Desc:
 192  Ret:
 193  Args:
 194  Side Effects:
 195  Example:
 196
 197 =cut
 198
 199 sub set_id {
 200   my $self=shift;
 201   $self->{id}=shift;
 202 }
 203
 204 =head2 get_contents
 205
 206  Usage:
 207  Desc:
 208  Ret:
 209  Args:
 210  Side Effects:
 211  Example:
 212
 213 =cut
 214
 215 sub get_contents {
 216   my $self=shift;
 217   if (!exists($self->{contents})) { $self->{contents}=""; }
 218   return $self->{contents};
 219
 220 }
 221
 222 =head2 set_contents
 223
 224  Usage:
 225  Desc:
 226  Ret:
 227  Args:
 228  Side Effects:
 229  Example:
 230
 231 =cut
 232
 233 sub set_contents {
 234   my $self=shift;
 235   $self->{contents}=shift;
 236 }
 237
 238 =head2 set_from_external
 239
 240 Set the appropriate fields ('contents', 'selected', etc) from a value not in the form of an ElementI,
 241 such as one taken from a database or a request string.
 242 Meant to be overridden by some provided subclasses (eg Checkbox, which uses its contents field unusually)
 243 and some user-defined ones.
 244
 245  Args: a string with all provided values for this field separated by \0
 246
 247 =cut
 248
 249 sub set_from_external
 250 {
 251         my ($self, $value) = @_;
 252         $self->set_contents($value);
 253 }
 254
 255
 256 =head2 get_length
 257
 258  Usage:
 259  Desc:
 260  Ret:
 261  Args:
 262  Side Effects:
 263  Example:
 264
 265 =cut
 266
 267 sub get_length {
 268   my $self=shift;
 269   if (!exists($self->{length})) { $self->{length}=20; }
 270   return $self->{length};
 271
 272 }
 273
 274 =head2 set_length
 275
 276  Usage:
 277  Desc:
 278  Ret:
 279  Args:
 280  Side Effects:
 281  Example:
 282
 283 =cut
 284
 285 sub set_length {
 286   my $self=shift;
 287   $self->{length}=shift;
 288 }
 289
 290
 291
 292 =head2 get_selected
 293
 294  Usage:
 295  Desc:
 296  Ret:
 297  Args:
 298  Side Effects:
 299  Example:
 300
 301 =cut
 302
 303 sub get_selected {
 304   my $self=shift;
 305   if (!exists($self->{selected})) { $self->{selected}=""; }
 306   return $self->{selected};
 307
 308 }
 309
 310 =head2 set_selected
 311
 312  Usage:
 313  Desc:
 314  Ret:
 315  Args:
 316  Side Effects:
 317  Example:
 318
 319 =cut
 320
 321 sub set_selected {
 322   my $self=shift;
 323   $self->{selected}=shift;
 324 }
 325
 326
 327
 328 =head2 get_object
 329
 330  Usage:
 331  Desc:
 332  Ret:
 333  Args:
 334  Side Effects:
 335  Example:
 336
 337 =cut
 338
 339 sub get_object {
 340   my $self=shift;
 341   if (!exists($self->{object})) { $self->{object}=""; }
 342   return $self->{object};
 343
 344 }
 345
 346 =head2 set_object
 347
 348  Usage:
 349  Desc:
 350  Ret:
 351  Args:
 352  Side Effects:
 353  Example:
 354
 355 =cut
 356
 357 sub set_object {
 358   my $self=shift;
 359   $self->{object}=shift;
 360 }
 361
 362 =head2 get_object_getter
 363
 364  Usage:
 365  Desc:
 366  Ret:
 367  Args:
 368  Side Effects:
 369  Example:
 370
 371 =cut
 372
 373 sub get_object_getter {
 374   my $self=shift;
 375   if (!exists($self->{object_getter})) { $self->{object_getter}=""; }
 376   return $self->{object_getter};
 377
 378 }
 379
 380 =head2 set_object_getter
 381
 382  Usage:
 383  Desc:
 384  Ret:
 385  Args:
 386  Side Effects:
 387  Example:
 388
 389 =cut
 390
 391 sub set_object_getter {
 392   my $self=shift;
 393   $self->{object_getter}=shift;
 394 }
 395
 396 =head2 get_object_setter
 397
 398  Usage:
 399  Desc:
 400  Ret:
 401  Args:
 402  Side Effects:
 403  Example:
 404
 405 =cut
 406
 407 sub get_object_setter {
 408   my $self=shift;
 409   if (!exists($self->{object_setter})) { $self->{object_setter}=""; }
 410   return $self->{object_setter};
 411
 412 }
 413
 414 =head2 set_object_setter
 415
 416  Usage:
 417  Desc:
 418  Ret:
 419  Args:
 420  Side Effects:
 421  Example:
 422
 423 =cut
 424
 425 sub set_object_setter {
 426   my $self=shift;
 427   $self->{object_setter}=shift;
 428 }
 429
 430 =head2 is_store_enabled
 431
 432  Usage:
 433  Desc:
 434  Ret: whether this field will store its value on the next form submission
 435  Args:
 436  Side Effects:
 437  Example:
 438
 439 =cut
 440
 441 sub is_store_enabled {
 442   my $self=shift;
 443   return $self->{store_enabled};
 444
 445 }
 446
 447 =head2 set_store_enabled
 448
 449  Usage: default is ON for all fields
 450  Desc:
 451  Ret:
 452  Args: a value that will be interpreted in Boolean context
 453  Side Effects:
 454  Example:
 455
 456 =cut
 457
 458 sub set_store_enabled {
 459   my ($self, $enable) = @_;
 460   $self->{store_enabled} = $enable;
 461 }
 462
 463
 464 =head2 accessors get_formatting, set_formatting
 465
 466  Usage: handle html tag formatting
 467  Desc:
 468  Property
 469  Side Effects:
 470  Example:
 471
 472 =cut
 473
 474 sub get_formatting {
 475   my $self = shift;
 476   return $self->{formatting};
 477 }
 478
 479 sub set_formatting {
 480   my $self = shift;
 481   $self->{formatting} = shift;
 482 }
 483
 484
 485 =head2 get_validate
 486
 487  Usage:
 488  Desc:
 489  Ret:
 490  Args:
 491  Side Effects:
 492  Example:
 493
 494 =cut
 495
 496 sub get_validate {
 497   my $self=shift;
 498   if (!exists($self->{validate})) { $self->{validate}=""; }
 499   return $self->{validate};
 500
 501 }
 502
 503 =head2 set_validate
 504
 505  Usage:
 506  Desc:
 507  Ret:
 508  Args:         one of:
 509                o a true value (1). This means that the
 510                  field is required, any data type may be given.
 511                o "string": same as 1
 512                o "integer": this field requires an integer
 513                o "number": this field requires a number (maybe in
 514                  exp format etc).
 515                o "token": a string consisting of letter and numbers
 516                  only, no spaces allowed.
 517                o "date": a string of the format \d+[-/]\d+[-/]\d+
 518                o "unique": 1 if it must be a unique field.
 519                  (the database accessor class needs to implement
 520                  the exists_in_database function, as described in
 521                  L<CXGN::DB::ModifiableI>. Uniqueness
 522                  should also be enforced on the database level.
 523  Side Effects:
 524  Example:
 525
 526 =cut
 527
 528 sub set_validate {
 529   my $self=shift;
 530   my $validation = shift;
 531   if ($validation && ($validation!~/1|string|integer|number|token|date|allele_symbol/i)) {
 532       die "unknown validation type";
 533   }
 534   $self->{validate}=$validation;
 535 }
 536
 537 =head2 validate
 538
 539  Usage:
 540  Desc:
 541  Ret:          an error code if the field does not validate,
 542                0 if the field validates.
 543                Error codes:
 544                  $INPUT_REQUIRED_ERROR
 545                  $INTEGER_REQUIRED_ERROR
 546                  $NUMBER_REQUIRED_ERROR
 547                  $DATE_REQUIRED_ERROR
 548                  $TOKEN_REQUIRED_ERROR
 549                  $LENGTH_EXCEEDED_ERROR
 550                  $UNIQUE_REQUIRED_ERROR
 551                  $ALLELE_SYMBOL_REQUIRED_ERROR
 552  Args:         none
 553  Side Effects:
 554  Example:
 555
 556 =cut
 557
 558 sub validate {
 559     my $self = shift;
 560     if (($self->get_validate()=~/1|string/i) && !$self->get_contents()) {
 561         return $INPUT_REQUIRED_ERROR;
 562     }
 563     if (($self->get_validate()=~/integer/i) && ($self->get_contents()!~/^\s*\-?\d+\s*$/) ) {
 564         return $INTEGER_REQUIRED_ERROR;
 565     }
 566     if (($self->get_validate()=~/number/i) && ($self->get_contents() !~ /\s*\-?\d+(\.)?[Ee]?\-?\d*/) ) {
 567         return $NUMBER_REQUIRED_ERROR;
 568     }
 569     if (($self->get_validate()=~/token/i) && ($self->get_contents() !~ m/^[A-Za-z0-9\-\_]+$/)) {
 570         return $TOKEN_REQUIRED_ERROR;
 571     }
 572     if (($self->get_validate()=~/date/i) && ($self->get_contents() !~ /^\d+[-\/]\d+[-\/]+\d+$/)) {
 573         return $DATE_REQUIRED_ERROR;
 574     }
 575     if (($self->get_validate()=~/allele_symbol/i) && ($self->get_contents() !~ /^[A-Za-z0-9]+(\-\d+)?$/)) {
 576         return $ALLELE_SYMBOL_REQUIRED_ERROR;
 577     }
 578 #    if ( length($self->get_contents())>$self->get_length()) {
 579 #       return $LENGTH_EXCEEDED_ERROR;
 580 #    }
 581
 582     if ($self->get_validate()=~/unique/i) {
 583         if ($self->get_object()->can("exists_in_database")) {
 584             if ($self->get_object()->exists_in_database()) {
 585                 return $UNIQUE_REQUIRED_ERROR;
 586             }
 587         }
 588     }
 589
 590
 591 #    print STDERR "VALIDATION OF FIELD ".$self->get_field_name()." CONTENTS: ".$self->get_contents()." - NO ERROR DETECTED\n";
 592     # the field has validated
 593     return 0;
 594
 595 }
 596
 597 =head2 render
 598
 599  Usage:
 600  Desc:
 601  Ret:
 602  Args:
 603  Side Effects:
 604  Example:
 605
 606 =cut
 607
 608 sub render {
 609     print STDERR "ElementI does not render anything...please subclass.\n";
 610     exit();
 611 }
 612
 613 return 1;