view release on metacpan or  search on metacpan

acebrowser/cgi-bin/generic/tree  view on Meta::CPAN

     end_form;
}

sub display_object {
  my $obj = shift;
  my $name  = $obj->name;
  my $class = $obj->class;
  my ($n,$c) = (escape($name),escape($class));
  my $myimage = ($class =~ /^Picture/ ? $obj->Pick_me_to_call->right->right : 'No_Image') ;
  if ($class eq 'LongText'){
    print $obj->asHTML(sub { pre(shift) });
  }
  else{
    print  $obj->asHTML(\&to_href) || strong('No more text information
     about this object in the database'), "\n";
  }
}

sub to_href {
  my $obj = shift;

  unless ($obj->isObject or $obj->isTag) {
    if ($obj=~/\S{50}/){         # if you have >50 chars without a space
      $obj=~s/(\S{50})/$1\n/g; # add some
      $obj = "<pre>$obj</pre>";# and assume preformatted (e.g. seq)
    } else {
      $obj =~s/\\n/<BR>/g;
    }
    return ($obj,0);
  }

  # if we get here, we're dealing with an object or tag
  my $name = $obj->name;

  # modperl screws up with subroutine references for some reason
  my $page_name = param('name');
  my $page_class = param('class');
  my %squash = map { $_ => 1; } grep($_ ne '',param('squash'));
  my %expand = map { $_ => 1; } grep($_ ne '',param('expand'));

  my ($n,$c) = (escape($name),escape($obj->class));
  my ($pn,$pc) = (escape($page_name),escape($page_class));
  my $cnt = $obj->col;

  # here's a hack case for external images
  if ($obj->isTag && $name eq 'Pick_me_to_call' && $obj->right(2)=~/\.(jpg|jpeg|gif)$/i) {
      return (td({-colspan=>2},img({-src=>AceImageHackURL($obj->right(2))})),1,1);
  }

  my $title = $name;
  if ($cnt > 1) {
    if ($squash{$name} || ($cnt > MAXEXPAND && !$expand{$name})) {
      my $to_squash = join('&squash=',map { escape($_) } grep $name ne $_,keys %squash);
      my $to_expand = join('&expand=',map { escape($_) } (keys %expand,$name));
      return (a({-href=>Url(url(-relative=>1),"name=$pn&class=$pc")
		 . ($to_squash ? "&squash=$to_squash" : '') 
		 . ($to_expand ? "&expand=$to_expand" : '')
		 . "#$name",
		 -name=>"$name",
		 -target=>"_self"},
		b(font({-color=>CLOSEDCOLOR},"$title ($cnt)"))),
	      1);
    } else {
      my $to_squash = join('&squash=',map { escape($_) } (keys %squash,$name));
      my $to_expand = join('&expand=',map { escape($_) } grep $name ne $_,keys %expand);
      return (a({-href=>Url(url(-relative=>1), "name=$pn&class=$pc")
		 . ($to_squash ? "&squash=$to_squash" : '') 
		 . ($to_expand ? "&expand=$to_expand" : '')
		 . "#$name",
		 -name=>"$name",
		 -target=>"_self"},
		b(font({-color=>OPENCOLOR},"$title"))),
	      0);
    }
  }

  return i($title) if $obj->isComment;

  if ($obj->isObject) {
      my $href = Object2URL($obj);
      return (a({ -href=>$href},$title), 0);
  }

  if ($obj->isTag) {
    return ("<B>$title</B>",0);
  }
  # shouldn't ever get here.
}