view release on metacpan or  search on metacpan

lib/AddressBook/DB/HTML.pm  view on Meta::CPAN

=back

=cut

use strict;
use AddressBook;
use Carp;
use File::Basename;
use vars qw($VERSION @ISA);
use CGI qw(:standard);

$VERSION = '0.14';

@ISA = qw(AddressBook);

sub new {
  my $class = shift;
  my $self = {};
  bless ($self,$class);
  my %args = @_;
  foreach (keys %args) {
    $self->{$_} = $args{$_};
  }
  unless ($self->{write_format}) {$self->{write_format} = 'table(Tr({-valign=>"TOP"},[map{td(["$_:",$attributes{$_}])} keys %attributes]))'}
  unless ($self->{form_format}) {$self->{form_format} = 'table(Tr({-valign=>"TOP"},[map{td([$_,$attributes{$_}])} keys %attributes]))'}
  unless ($self->{intra_attr_sep}) {$self->{intra_attr_sep} = '<br>'}
  return $self;
}

sub write {
  my $self = shift;
  my $class = ref $self || croak "Not a method call";
  my $entry = shift;
  my ($format,$ret,%attributes,$key,$url,$desc);
  $entry->calculate;
  my $attr = $entry->get(db=>$self->{db_name});
  foreach $key (keys %{$attr}) {
    if ($attr->{$key}->{meta}->{type} =~ /^(text|textblock|boolean|date|phone)$/) {
      $attributes{$key} = join ($self->{intra_attr_sep},@{$attr->{$key}->{value}});
    } elsif ($attr->{$key}->{meta}->{type} eq "url") {
      $attributes{$key} = join ($self->{intra_attr_sep},
			      map {a({-href=>$_},$_)} @{$attr->{$key}->{value}});
    } elsif ($attr->{$key}->{meta}->{type} eq "lurl") {
      $attributes{$key} = join ($self->{intra_attr_sep},
			      map {
				($url,$desc) = split (/\s+/, $_, 2);
				$desc ||= $url;
				a({-href=>$url},$desc)} @{$attr->{$key}->{value}});
    } elsif ($attr->{$key}->{meta}->{type} eq "email") {
      $attributes{$key} = join ($self->{intra_attr_sep},
			      map {a({-href=>"mailto:$_"},$_)} @{$attr->{$key}->{value}});
    }
  }
  $format = $self->{write_format};
  foreach (values %{$self->{config}->{db2generic}->{$self->{db_name}}}) {
    $format =~ s/\$($_)/\$attributes{$1}/g;
  }
  my @attributes = (sort {$attr->{$a}->{meta}->{order} <=> $attr->{$b}->{meta}->{order}} (keys %attributes));
  $format =~ s'keys %attributes'@attributes'g;
  eval qq{\$ret = $format}; warn "Syntax error in HTML backend \"write_format\": $@" if $@;
  return $ret;
}

sub entry_form {
  my $self = shift;
  my $class = ref $self || croak "Not a method call";
  my $entry = shift;
  my $formname = shift;
  my ($format,$ret,$key,$option,@options,%selected,$i,%result,$default);
  #$entry->calculate;
  my $attr = $entry->get(db=>$self->{db_name});
  my %attributes = %{$entry->get(db=>$self->{db_name},values_only=>1)};
  foreach $key (keys %attributes) {
    if ($attr->{$key}->{meta}->{type} =~ /^(text|url|lurl|email|date|phone)$/) {
      if ($attr->{$key}->{meta}->{read_only} =~ /yes/i) {
	$result{$key} = join ($self->{intra_attr_sep}, 
			      @{$attributes{$key}});
      } else {
	$result{$key} = join ($self->{intra_attr_sep}, 
			      map {textfield(-name=>$key,
					     -size=>30,
					     -override=>1,
					     -default=>$_)} @{$attributes{$key}});
      }
    } elsif ($attr->{$key}->{meta}->{type} eq "textblock") {
      if ($attr->{$key}->{meta}->{read_only} =~ /yes/i) {
	$result{$key} = join ($self->{intra_attr_sep}, 
			      @{$attributes{$key}});
      } else {
	$result{$key} = join ($self->{intra_attr_sep}, 
			      map {textarea(-name=>$key,
					     -columns=>30,
					     -rows=>10,
					     -override=>1,
					     -default=>$_)} @{$attributes{$key}});
      }
    } elsif ($attr->{$key}->{meta}->{type} eq "select") {
      if ($attr->{$key}->{meta}->{read_only} =~ /yes/i) {
	$result{$key} = join ($self->{intra_attr_sep}, 
				  @{$attributes{$key}});
      } else {
	foreach (@{$attributes{$key}}) {
	  $selected{$_} = 1;
	}
	@options = split ",",$attr->{$key}->{meta}->{values};
	$result{$key} = "<select name=\"$key\" size=";
	$result{$key} .= $#options + 1;
	if ($attr->{$key}->{meta}->{non_multiple} !~ /yes/i) {
	  $result{$key} .=  " multiple";
	} 
	$result{$key} .= ">";
	foreach $option (@options) {
	  if (exists $selected{$option}) {
	    $result{$key} .= "<option selected>$option";
	  } else {
	    $result{$key} .= "<option>$option";
	  }
	}
	$result{$key} .= "</select>";
      }
    } elsif ($attr->{$key}->{meta}->{type} eq "boolean") {
      @options=();
      for ($i=0;$i<=$#{$attributes{$key}};$i++) {
	if ($attr->{$key}->{meta}->{read_only} =~ /yes/i) {
	  $options[$i] = $attributes{$key}->[$i];
	} else {
	  if ($attributes{$key}->[$i] =~ /yes/i) {
	    $options[$i] = "<input type=checkbox name=\"_${key}_$i\" value=\"yes\" checked>";
	  } else {
	    $options[$i] = "<input type=checkbox name=\"_${key}_$i\" value=\"yes\">";
	  }
	  #$options[$i] = "<table><tr><td>";
	  #$options[$i] .= radio_group(-name=>"_${key}_$i",
				     #-values=>['Yes','No'],
				     #-default=>$attributes{$key}->[$i] || 'empty',
				     #-override=>1,
				     #-columns=>1);
	  #$options[$i] .= "</td>";
	  #if ($formname) {
	    #$options[$i] .= "<td><input type=button value=Clear onClick=\"
                              #document.$formname.elements[\'_${key}_$i\'][0].checked=0;
                              #document.$formname.elements[\'_${key}_$i\'][1].checked=0;\"></td>";
	  #}
	  #$options[$i] .= "</tr></table>";
	}
      }
      $result{$key} = join ($self->{intra_attr_sep},@options);
      $result{$key} .= "<input type=hidden name=\"_${key}_count\" value=$#options>";
    }
  }
  %attributes = %result;
  $format = $self->{form_format};
  foreach (values %{$self->{config}->{db2generic}->{$self->{db_name}}}) {
    $format =~ s/\$($_)/\$attributes{$1}/g;
  }
  my @attributes = (sort {$attr->{$a}->{meta}->{order} <=> $attr->{$b}->{meta}->{order}} (keys %attributes));
  $format =~ s'keys %attributes'@attributes'g;
  eval qq{\$ret = $format}; warn "Syntax error in HTML backend \"form_format\": $@" if $@;
  return $ret;
}

sub read_from_args {
  my $self = shift;
  my $class = ref $self || croak "Not a method call";
  my $query = shift;
  my ($key,$canon_field_name,@value,$i,$key_count);
  my $entry = AddressBook::Entry->new(config=>$self->{config});
  foreach $key (keys %{$self->{config}->{db2generic}->{$self->{db_name}}}) {
    $canon_field_name = $self->{config}->{db2generic}->{$self->{db_name}}->{$key};
    if ($self->{config}->{meta}->{$canon_field_name}->{type} eq "boolean" ) {
      $key_count = $query->param("_${key}_count");
      if ((defined $key_count) && ($key_count >= 0)) {
	for ($i=0;$i<=$key_count;$i++) {
	  if ($query->param("_${key}_$i") =~ /yes/i) {
	    $value[$i] = "Yes";
	  } else {
	    $value[$i] = "No";
	  }
	}
      }
      $entry->add(db=>$self->{db_name},attr=>{$key=>\@value});
    } else {
      foreach ($query->param($key)) {
	$entry->add(db=>$self->{db_name},attr=>{$key=>$_});
      }
    }
  }
  $entry->chop;
  return $entry;
}

1;
__END__

=head1 AUTHOR

Mark A. Hershberger, <mah@everybody.org>
David L. Leigh, <dleigh@sameasiteverwas.net>

=head1 SEE ALSO

L<AddressBook>,
L<AddressBook::Config>,
L<AddressBook::Entry>.

=cut