home *** CD-ROM | disk | FTP | other *** search
/ CD Actual Thematic 7: Programming / CDAT7.iso / Share / Editores / Perl5 / perl / lib / site / Tk / HTML / Form.pm next >
Encoding:
Perl POD Document  |  1997-08-10  |  4.4 KB  |  231 lines
  1. package Tk::HTML::Form;
  2. use AutoLoader;
  3. use Carp;
  4. @ISA = qw(AutoLoader HTML::Element);
  5.  
  6. *SUBMIT = \&Button;
  7. *RESET  = \&Button;
  8. *PASSWORD = \&TEXT;
  9.  
  10. use strict;
  11.  
  12. sub encode 
  13. {
  14.  my $class = shift;
  15.  my $a = shift;
  16.  $a =~ s/\n/\015\012/gm;
  17.  $a =~ s/([^0-9A-Za-z ])/sprintf('%%%02X',ord($1))/egm;
  18.  $a =~ s/ /+/gm;
  19.  return $a;
  20. }
  21.  
  22. sub Owner
  23. {
  24.  return shift->{'Owner'};
  25. }
  26.  
  27. sub Variable
  28. {
  29.  my ($form,$elem) = @_;
  30.  my $name = $elem->attr('NAME');
  31.  my @pair = ($name,undef);
  32.  push(@{$form->{'Values'}},\@pair);
  33.  return \$pair[1];
  34. }
  35.  
  36. sub Reset
  37. {
  38.  my ($f) = @_;
  39.  my ($a,$b);
  40.  my $r = $f->{'Reset'};
  41.  my $v = $f->{'Values'};
  42.  my $i;
  43.  for ($i= 0; $i < @$v; $i++)
  44.   {
  45.    if (ref($v->[$i][1]))
  46.     {
  47.      $v->[$i][1]->Call($r->[$i]);
  48.     }
  49.    else
  50.     {
  51.      $v->[$i][1] = $r->[$i];
  52.     }
  53.   }
  54. }
  55.  
  56. sub link_text 
  57. {
  58.   my($f,$e) = @_;
  59.   my @t = @{$f->{'LINKED_TEXT'}};
  60.   my $i;
  61.   for($i=0;$i<=$#t;$i++) 
  62.    {
  63.     last if $t[$i] == $e;
  64.    }
  65.   $i++;
  66.   $i = 0 if $i > $#t;
  67.   $t[$i]->focus();
  68. }
  69.  
  70. sub TEXT
  71. {
  72.  my ($form,$elem) = @_;
  73.  my $h = $form->Owner;
  74.  my $w = $h->Widget;
  75.  my $var = $form->Variable($elem);
  76.  $$var= $elem->attr('VALUE');
  77.  my $e = $w->Entry(-relief => 'sunken', -textvariable => $var );
  78.  push(@{$form->{'LINKED_TEXT'}},$e);
  79.  $e->bind('<Return>' => [$form,'link_text',$e]);
  80.  my $size = $elem->attr('size'); 
  81.  $e->configure(-width => $size) if ($size);
  82.  $e->configure(-show => '*') if ($elem->attr('type') =~ /PASSWORD/i);
  83.  $w->window('create','insert',-window => $e);
  84.  $h->{NL} = 0;                
  85. }
  86.  
  87.  
  88. sub Button
  89. {
  90.  my ($form,$elem) = @_;
  91.  my $h = $form->Owner;
  92.  my $w = $h->Widget;
  93.  my $type = $elem->attr('type');
  94.  my $method = "\u\L$type";
  95.  my $text = $elem->attr('value'); 
  96.  $text   = $method unless (defined $text);
  97.  if ($elem->attr('name'))
  98.   {
  99.    my $var = $form->Variable($elem);
  100.    $$var = $elem->attr('value');
  101.   }
  102.  my $e = $w->Button(-text => $text, -command => [$form,$method]);
  103.  $w->window('create','insert',-window => $e);
  104.  $h->{NL} = 0;                
  105. }
  106.  
  107. sub CHECKBOX
  108. {
  109.  my ($form,$elem) = @_;
  110.  my $h = $form->Owner;
  111.  my $w = $h->Widget;
  112.  my $var = $form->Variable($elem);
  113.  $elem->{'value'} = 1 unless (defined $elem->{'value'});
  114.  ${$var} = ($elem->attr('checked')) ?$elem->attr('value'): undef;
  115.  my $e = $w->Checkbutton(-variable => $var, -onvalue => $elem->attr('value'), -offvalue => undef);
  116.  $w->window('create','insert',-window => $e);
  117.  $h->{NL} = 0;                
  118. }
  119.  
  120. sub RadioValue
  121. {
  122.  my ($bv,$val) = @_;
  123.  $$bv = $val if (@_ > 1);
  124.  return $$bv;
  125. }
  126.  
  127. sub RADIO
  128. {
  129.  my ($form,$elem) = @_;
  130.  my $h = $form->Owner;
  131.  my $w = $h->Widget;
  132.  $form->{'RadioVars'} = {} unless (exists $form->{'RadioVars'});
  133.  my $name = $elem->attr('NAME');
  134.  $name = '__NONAME__' unless (defined $name);
  135.  unless (exists $form->{'RadioVars'}{$name})
  136.   {
  137.    my $var = $form->Variable($elem);
  138.    $$var = Tk::Callback->new([\&RadioValue,\$form->{'RadioVars'}{$name}]);
  139.   }
  140.  my $bv = \$form->{'RadioVars'}{$name};
  141.  $$bv = $elem->attr('VALUE') if (defined $elem->attr('SELECTED'));
  142.  my $e = $w->Radiobutton(-variable => $bv, -value => $elem->attr('VALUE'));
  143.  $w->window('create','insert',-window => $e);
  144.  $h->{NL} = 0;                
  145. }
  146.  
  147. sub HIDDEN
  148. {
  149.  my ($form,$elem) = @_;
  150.  my $var = $form->Variable($elem);
  151.  $$var = $elem->attr('VALUE');  
  152. }
  153.  
  154. sub IMAGE
  155. {
  156.  my ($form,$elem) = @_;
  157.  my $h = $form->Owner;
  158.  my $n = $elem->attr('NAME');
  159.  if($elem->attr('name') && $elem->attr('src')) 
  160.   {
  161.    $elem->attr(image => $form);
  162.    $h->img($form,$elem);
  163.   }
  164. }
  165.  
  166. sub OptionValue
  167. {
  168.  my ($mb,$var) = @_;
  169.  my $val = $$var;
  170.  if (exists $mb->{FORM_MAP})
  171.   {
  172.    $val = $mb->{FORM_MAP}{$val} if (exists $mb->{FORM_MAP}{$val});
  173.   }
  174.  return $val;
  175. }
  176.  
  177. sub MultipleValue
  178. {
  179.  my ($lb,$name) = @_;
  180.  my $index;
  181.  my @val = ();
  182.  foreach $index ($lb->curselection)
  183.   {
  184.    if (exists $lb->{FORM_MAP} && defined $lb->{FORM_MAP}[$index])
  185.     {
  186.      push(@val, $lb->{FORM_MAP}[$index]);
  187.     }
  188.    else
  189.     {
  190.      push(@val, $lb->get($index));
  191.     }
  192.   }
  193.  return @val;
  194. }
  195.  
  196. sub Submit
  197. {
  198.  my($f) = shift;
  199.  my @query = @_;
  200.  my $h = $f->Owner;
  201.  my $w = $h->Widget;
  202.  my $action = $f->attr('action');
  203.  my $method = $f->attr('method');
  204.  $method = 'GET' unless (defined $method);
  205.  $action = ''    unless (defined $action);
  206.  my $what;
  207.  foreach $what (@{$f->{'Values'}})
  208.   {
  209.    my ($a,$b) = @$what;
  210.    my @val = (ref $b) ? $b->Call : $b;
  211.    foreach $b (@val)
  212.     {
  213.      push(@query,"$a=" . $f->encode($b)) if (defined $b); 
  214.     }
  215.   }
  216.  my $query = join('&',@query); 
  217.  if ($method eq "POST") 
  218.   {
  219.    $w->HREF($action,$method,$query);
  220.   } 
  221.  else 
  222.   {
  223.    $w->HREF("$action?$query",$method);
  224.   }
  225. }
  226.  
  227. 1;
  228. __END__
  229.  
  230.  
  231.