#!/usr/local/rib/rib-1.0/bin/perl
use lib '/usr/local/rib/rib-1.0/lib';
# NHSE Repository in a Box (RIB)
#
# The authors of this software are Paul McMahan and Jeff Horner.
# Copyright (c) 1997 by the University of Tennessee.
# Permission to use, copy, modify, and distribute this software for any
# purpose without fee is hereby granted, provided that this entire notice
# is included in all copies of any software which is or includes a copy
# or modification of this software and in all copies of the supporting
# documentation for such software.
# THIS SOFTWARE IS BEING PROVIDED "AS IS", WITHOUT ANY EXPRESS OR IMPLIED
# WARRANTY.  IN PARTICULAR, NEITHER THE AUTHORS NOR UNIVERSITY OF TENNESSEE
# MAKE ANY REPRESENTATION OR WARRANTY OF ANY KIND CONCERNING THE
# MERCHANTABILITY OF THIS SOFTWARE OR ITS FITNESS FOR ANY PARTICULAR PURPOSE.
#
# $Id: edit_object.pl,v 1.6 1998/03/17 16:49:10 rib Exp $
#
# $Log: edit_object.pl,v $
# Revision 1.6  1998/03/17 16:49:10  rib
# added link to edit another object after editing was (sucessfully) done
#
# Revision 1.5  1998/02/24 23:34:51  rib
# changed part in edit_object which said that the catalog
# needs to be regenerated to say that it just needs to be
# updated if they changed the Name or Domain attributes.
#
# Revision 1.4  1998/02/24 22:56:58  rib
# changed the button which updates the form (after clicking "add a field
# or "delete a field") to say "Update form" instead of just "Update".
# A button which just said "Update" was misleading, especially when used
# in edit_object.pl
#
# Revision 1.3  1998/01/22 02:50:10  rib
# added the upload and mirroring feature to RIB.  This required
# the addition of several new scripts and the modification of
# admin_repository.
#
# also, removed any use of <a target=whatever href=...>
# from the RIB scripts because this was working out very
# well.
#
# Revision 1.2  1997/12/18 18:08:54  rib
#         - Changed gen_catalog so that the input box for the search on the top level
#           catalog page isn't so wide.  changed to SIZE=45
#
#         - fixed a bug in install_file.pl which caused the header/footer file on
#           the verification page to be encoded in the <input> box but not in the
#           regular body of the page.
#
#         - fixed a bug in gen_catalog which caused the documents in catalog/ to
#           be indexed instead of the documents in catalog/*/
#
#         - added a note to edit_object.pl that tells the user that they need
#           to update the catalog if the object was an asset and if a catalog
#           currently exists.
#
#         - changed add_nonlocal_link.pl to not be so strict in checking the urls
#           before it attempts to add them.  it no longer counts a url that's
#           already in the repository as an error leading towards exit
#
# Revision 1.1.1.1  1997/12/10 15:59:31  jhorner
# RIB pre 1.0
#
# Revision 1.1  1997/05/06 18:17:08  jhorner
# Initial revision
#


use LWP::UserAgent ();
use RIB::Util ();
use RIB::ConfigParser ();
use RIB::DomainParser ();
use RIB::BIDMParser ();
use HTML::Entities ();

my $util = RIB::Util->new();
$util->PrintHeader();
my %in = $util->ReadParse();

$repository = $util->GetRepoName();
if (!$repository) {
  $util->ErrorMessage("repository was not specifed in your input.");
} elsif (!$in{class}) {
  $util->ErrorMessage("class was not specifed in your input.");
}

my $filepath = $util->GetRibDir() . "/repositories/" . $repository;
my $urlpath  = $util->GetRibUrl() . "/repositories/" . $repository;

$back_to_top = $util->BackToTop($repository);

if ($in{filename}) {
  if ($in{filename} =~ /\.\.\//) {
    $util->ErrorMessage("Bad filename (can't contain '../')");
  }

  # instantiate new RIG object
  my $cp = RIB::ConfigParser->new();
  $cp->load_config($filepath."/conf/BIDM.conf");
  my $object = $cp->InstanceOf('',$in{class});

  # get a list of all of the fieldnames that were in
  # this repository's config file for this $in{class}
  my @allfields = $object->Fields();

  # we only want to load the contents of the object file once.
  # thereafter all field values are taken from the %in variable
  # (which is set by the http server).  $in{getfromfile} is set
  # to 1 when they choose the object description file to edit.
  # after that it's not set any more.
  if ($in{getfromfile}) {
    # prepend file:// if local filename 
    if ($in{filename} !~ /^\s*(http|ftp|gopher):\/\//) {
      $url = "file://localhost$filepath/objects/$in{class}/$in{filename}";
      $url .= ".html" unless $in{filename} =~ /\.html/i;
    }
    else {
      $url = $in{filename};

      #make a new filename for this asset.  try to just get the
      #filename from the url.  if that name is already taken in
      #the objects/classname dir then append a sequential numbers to it
      #until there is a winner.
      ($in{filename}) = $in{filename} =~ /\/([^\/]+)\s*$/;
      $in{filename} =~ s/\.html//i;
      unless (opendir (DIR, "$filepath/objects/$in{class}")) {
        Util->ErrorMessage("Couldn't opendir $filepath/objects/$in{class}. "
                         . "<p>Reason : $!");
      }
      my @files = grep (/^[^\.]/,readdir(DIR));
      # save the orignal name.  each time that the filename is taken
      # append the original name with $count
      my $count=1;
      my $original_name = $in{filename};
      while (grep (/$in{filename}/, @files)) {
        $count++;
        $in{filename}=$original_name . $count;
      }
    }

    # make sure url doesn't have any spaces
    $url =~ s/^\s*(\S+).*/$1/;
    # if url is in current repository then make sure it is
    # retrieved via file:// url so that access control can
    # be circumvented
    $url =~ s/\Q$urlpath\E/file:\/\/localhost\/$filepath/i;
    my $ua = LWP::UserAgent->new("RIB/0.1");
    my $req = HTTP::Request->new('GET',$url);
    my $res = $ua->request($req);
    if ($res->is_error){
      $util->ErrorMessage("Couldn't retrieve " . $req->url . ": "
                       . $res->code. " ". $res->message);
    }
    my $bp = RIB::BIDMParser->new();
    $bp->parse($res->content);
    foreach $field (@allfields) {
      my $numvalues = 0;
      foreach $value ($bp->valuesof($field)) {
        if (++$numvalues > 1 && !$object->IsMultiple($field)) {
          last;
        }
        else {
          # Insert newlines into the field if it's datatype is text.
          # Use process of elim to figure out if datatype is text b/c
          # it's the default type of input box.  The reason for
          # inserting newlines is because when a <textarea> box is
          # used in the html form it gets bothersome to have the
          # value end up on 1 line when there are vertical scrollbars
          # available.
          if ($object->DataType($field) ne 'date' &&
              $object->DataType($field) ne 'string') {
            $value = $util->InsertNewlines($value);
          }
          $object->AddEntry($field, $value);
        }
      }
      if (!$numvalues && $object->IsRequired($field)) {
        $object->AddEntry($field, '');
      }
      $numvalues = 0;
    }
  }

  else {
    # sort inputs from the %in variable into arrays.
    foreach $key (keys %in) {
      next unless $key =~ /^\d+(\S+)/;
      my $field = $1;
      $object->AddEntry($field, $in{$key});
    }
  }

#############################################################################

  print "<head>";
  print "<title>Editing description file ";
  print "named &quot;$in{filename}&quot;</title>\n";
  print "</head>\n";
  print "<body bgcolor=#FFFFF0>\n";
  print "<center>\n";
  print "<h1>Editing description file named ";
  print "&quot;$in{filename}&quot;</h1>\n";
  print "</center>\n";
  print "<p><hr><p>\n";

  my @errors = ();
  if ($in{update}) {
    foreach $field (sort @allfields) {
      if ($object->IsRequired($field) && !$object->NumRealEntries($field)) {
        push (@errors, "<a href=#$field>$field</a> needs an input");
      }
      if ($object->IsRelationship($field)) {
        foreach $link ($object->ListEntries($field)) {
          next unless $link;
          if ($link !~ /^(http|ftp|gopher):\/\//) {
            my ($target, $tmp);
            $target = $object->Destination($field);
            ($tmp=$link) =~ s/\.html$//;
            if (!(-f "$filepath/objects/$target/${tmp}.html")) {
              push (@errors,"The value you specified for the "
                           ."<a href=#$field>$field</a> field "
                           ."(&quot;$link&quot;) is neither "
                           ."a valid url nor the name of a file that exists "
                           ."in this repository's "
                           ."<a href=browse_objects.pl?class=$target>"
                           ."$target directory</a>.");
            } else {
              my $oldlink = $link;
              $link = $link . ".html" unless $link =~ /\.html$/;
              my $newlink = $urlpath . "/objects/$target/$link";
              $object->ReplaceEntry($field, $oldlink, $newlink);
            }
          }
        }
      }
    }
  
    if (!@errors) {
      umask 002;
      # now write the file
      unless (open (NEWOBJECT, ">$filepath/objects/$in{class}/$in{filename}.html")) {
        $util->ErrorMessage("Couldn't write to the file "
         . "$filepath/objects/$in{class}/$in{filename}.html"
         . "<br>Reason : $!<p>You cannot save this $in{class} description file"
         . " until this problem is resolved.");
      }
      select NEWOBJECT;
    
      my @names = $object->ListEntries("Name");
      print "<head><title>$names[0]</title>\n";
      foreach $field (sort @allfields) {
        foreach $entry ($object->ListEntries($field)) {
          next unless $entry =~ /\S/m;
          $entry =~ s/\n/ /sg;
          if ($object->IsAttribute($field)) {
            print "<META name=\"BIDM.$in{class}.$field\" ";
            print "content=\"" . HTML::Entities::encode($entry) . "\">\n";
          } else {
            print "<LINK rel=\"BIDM.$in{class}.$field\."
                . $object->Destination($field) . "\" ";
            print "href=\"" . HTML::Entities::encode($entry) . "\">\n";
          }
        }
      }
      print "</head><body>";
      print "<h1>$in{class} description file for $names[0]";
      print "</h1><p><hr><p>\n";
      print "<strong>Contents of this $in{class} file:</strong><p>\n";
      print "<center>\n";
      print "<table border=1>\n";
      print "<tr>\n";
      print "<th>Field Name</th>\n";
      print "<th>Value</th>\n";
      print "<th>HTML Tag Type</th>\n";
      print "</tr>\n";
      foreach $field (sort @allfields) {
        foreach $entry ($object->ListEntries($field)) {
          next unless $entry =~ /\S/m;
          $entry =~ s/\n/ /sg;
          print "<tr>\n";
          print "<td>BIDM.$in{class}.$field";
          if ($object->IsRelationship($field)) {
            print "." , $object->Destination($field);
          }
          print "</td>\n";
          print "<td>";
          my $encoded = HTML::Entities::encode($entry);
          if ($object->IsAttribute($field)) {
            if ($object->DataType($field) eq 'email') {
              print "<a href=\"mailto:$entry\">$encoded</a>";
            }
            elsif ($object->DataType($field) eq 'url') {
              print "<a href=\"$entry\">$encoded</a>";
            }
            else {
              print $encoded;
            }
          } else {
            print "<a href=\"$entry\">$encoded</a>";
          }
          print "</td>\n";
          if ($object->IsAttribute($field)) {
            print "<td align=center>META</td>\n";
          } else {
            print "<td align=center>LINK</td>\n";
          }
          print "</tr>\n";
        }
      }
      print "</table></center></body>\n";
      close (NEWOBJECT);

      # Create the catalog description as well
      #
      my $buf;
      if(!$object->AsHtml(\$buf,$repository,"$in{filename}.html",$cp)){
          $util->ErrorMessage("There were problems creating the catalog"
          . "description file for $in{filename}."
          . "<br>Reason : ". $object->ErrorMsg
          . "<p>This $in{class} description file cannot be saved"
          . " until this problem is resolved.");
  
      } else {
          my $pagepath = $util->GetRibDir."/repositories/$repository/catalog/$in{class}/$in{filename}.html";
          unless (open (PAGE,">$pagepath")) {
              $util->ErrorMessage("Couldn't write to the file "
              . "$filepath/objects/$in{class}/$in{filename}.html"
              . "<br>Reason : $!<p>This $in{class} description file cannot "
              . "be saved until this problem is resolved.");
          }
          print PAGE $util->ClassHeader($in{class});
          print PAGE $buf;
          print PAGE $util->ClassFooter($in{class});
          close(PAGE);
      }
      $buf = '';


      select (STDOUT);
      print "<strong>Success</strong>\n";
      print "<p>\n";
      print "The $in{class} description file was successfully updated.\n";
      if ($in{class} eq 'Asset' && -f "$filepath/catalog/index.html") {
        print "<P>If you changed the Domain or Name attributes of the Asset then ";
        print "note that the new information will not appear in this\n";
        print "repository's <a href=\"", $util->GetRibUrl(),
              "/repositories/$repository/catalog/index.html\">",
              "software catalog</a> until it has been regenerated.<p>\n";
        print "Click <a href=\"generate_catalog.pl\">here</a> to regenerate the software ";
        print "catalog for this repository.\n";
      }
      print $back_to_top;
      print "<a href=edit_object.pl?class=$in{class}>Edit another ", $in{class}, "</a>";
      print "</body>\n";
      exit;
    }
  }

  #############################################################################

  if (@errors) {
    print "Please correct the following error(s) :\n";
    print "<ul>\n";
    foreach $error (@errors) {
      print "<li>$error\n";
    }
    print "</ul>\n";
    print "After making these changes in the form below you can try your ";
    print "submission again.\n<p><hr><p>\n";
  }
  else {
    print "To edit the $in{class} description file please ";
    print "make your changes in this form and press the button at the bottom ";
    print "this page.\n";
    print "<p><hr><p>\n";
  }


  #############################################################################

  if (!$in{update}) {  # if they botched a submission then don't do this
    # if they wanted to add or delete a field then do it here
    foreach $key (keys %in) {
      next if $key eq "filename";
      next if $key eq "repository";
      next if $key eq "class";
      if ($in{$key} eq "delete") {
        $object->RemoveLastEntry($key);
        print "<a href=#$key>Deleted a field from $key</a><br>\n";
      } elsif ($in{$key} eq "add") {
        $object->AddEntry($key,"");
        print "<a href=#$key>Added a field for $key</a><br>\n";
      }
    }
  }
  
  # make a dummy entry for fields that are required
  # and that are currently empty
  foreach $field (@allfields) {
    if (!$object->NumEntries($field)) {
      $object->AddEntry($field,"");
    }
  }
  
  print "<center>\n";
  print "<form method=post action=edit_object.pl>\n";
  print "<input type=hidden name=class value=$in{class}>\n";
  
  foreach $field (sort @allfields) {
  
    $radio_flag = 0;
  
    print "<a name=$field></a>";
    print "<table border=5 width=100%>\n";
    print "<tr bgcolor=#FFFFFF>\n";
    print "<td colspan=4 align=center>\n";
    print "<strong><font size=+2>";
    print "<a href=describe_field.pl?";
    print "field=$field&class=$in{class}>";
    print "$field";
    if ($object->IsRelationship($field)) {
      print " ", $object->Destination($field);
    }
    print "</a></font></strong>";

    if ($object->IsRequired($field)) {
      print " <strong>(required ";
    } else {
      print " <strong>(optional ";
    }
    if ($object->IsRelationship($field)) {
      print "relationship)</strong>";
    } else {
      print "attribute)</strong>";
    }
    print "</td>\n";
    print "</tr>\n";
    if ($object->IsRelationship($field)) {
      my $target = $object->Destination($field);
      print "<tr bgcolor=#FFFFFF>";
      print "<td align=center colspan=2>\n";
      print "<a href=browse_objects.pl?class=$target>";
      print "Browse</a>\n";
      print "</td>\n";
      print "<td align=center colspan=2>\n";
      print "<a href=create_object_choices.pl?class=$target>";
      print "Create</a> ";
      print "</td>\n";
      print "</tr>\n";
    }
  
    print "<tr bgcolor=#FFFFFF>\n";
    print "<td align=center>&nbsp;";
    ### allow addtion of an input box when the field is multiple
    ### or (not xor) when field is currently empty and not required
    if (     $object->IsMultiple($field)
        || (!$object->NumEntries($field) && !$object->IsRequired($field)) ) {
      print "<input type=radio name=$field value=add> Add a Field\n";
      $radio_flag = 1;
    }
    print "</td>\n";
  
    print "<td align=center>&nbsp;\n";
    ### allow the last box on the current form to be deleted when
    ### the field already has more than one entry or (not xor)
    ### when the field is optional and cueently empty
    if (  ($object->NumEntries($field) > 1)
       || (!$object->IsRequired($field) && $object->NumEntries($field) > 1) ) {
      print "<input type=radio name=$field value=delete> Delete last Field\n";
      $radio_flag = 1;
    }
    print "</td>\n";
  
    ### print a radio button which can be used to deselect the
    ### other radio buttons.  This is a hack to get around the
    ### the fact that with Netscape you can't deselect a clicked
    ### radio button
    print "<td align=center>&nbsp;\n";
    if ($radio_flag) {
      print "<input type=radio name=$field value=> Cancel\n";
    }
    print "</td>\n";
  
    ### return this button only if needed
    print "<td align=center>&nbsp;\n";
    if ($radio_flag) {
      print "<input type=submit value=\"Update form\">\n";
    }
    print "</td>\n";
    print "</tr>\n";
  
    ### print input boxes for existing fields
    foreach $entry ($object->ListEntries($field)) {
      print "<tr bgcolor=#FFFFFF>\n";
      print "<td colspan=4 align=center>\n";
      print HtmlInputBox($repository,$object,$field,$entry);
  
      print "</td>\n";
      print "</tr>\n";
    }
  
    print "</table>\n";
    print "<p><br><p>\n";
  }
  print "<input type=hidden name=filename value=$in{filename}>";
  print "<hr><p>\n";
  # next checkbox MUST be reset between every submission.  if it wasn't
  # then trying to update the form would cause the form to be submitted
  # for update
  print "<input type=checkbox name=update value=1> ";
  print "<input type=submit value=\"&lt;--Check that box and then click here ";
  print "to update this $in{class} description file\">";
  print "</form>\n";
  print "</center>\n";
  print $back_to_top;
  exit;
}

else { # provide a list of object desc. files to choose from
  if (!opendir(DIR,"$filepath/objects/$in{class}")) {
    $util->ErrorMessage("Couldn't open the directory "
                     . "$filepath/objects/$in{class} "
                     . "to check for $in{class} object description files.\n"
                     . "<p>Reason : $!");
  }
  print "<head>";
  print "<title>$in{class} description file ";
  print "editing for &quot;$repository&quot;</title>\n";
  print "</head>\n";
  print "<body bgcolor=FFFFF0>\n";
  print "<center>\n";
  print "<h1>$in{class} description file editing for ";
  print "&quot;$repository&quot;</h1>\n";
  print "</center>\n";
  print "<p><hr><p>\n";
  foreach $file (sort readdir(DIR)) {
    next unless -f "$filepath/objects/$in{class}/$file";
    $file =~ s/\.html$//;
    $options .= "<li><a href=edit_object.pl?"
              . "class=$in{class}&getfromfile=1&filename=$file>$file</a>\n";
  }
  if ($options) {
    print "Please select the $in{class} description file ";
    print "that you wish to edit.<br>\n";
    print "<ul>$options</ul>\n"; 
  } else {
    print "No $in{class} object description files currently exist for ";
    print "&quot;$repository&quot;\n";
  }
  print $back_to_top;
  print "</body>\n";
  exit;
}

# return a string containing the html for an input box.
# the type of box depends on the data type of the field.
# if the field is a domain then present a list of choices
# for that field
sub HtmlInputBox {
  my $repository = shift;
  my $object = shift;
  my $field = shift;
  my $value = shift;

  # in order to allow fields to have more than one
  # entry in the html form, the name of the field must
  # be prepended with a sequence number.  this keeps
  # fields with multiple entries from trying to use
  # the same variable name to describe all of their fields.
  # For example,
  # if there are two "Domain" fields for this object
  # then the html form would need to call the first
  # "1Domain" and the second "2Domain".
  # Of course this means that the config file for this
  # site can't attempt to start attribute or relationship
  # names with a digit.
  $fieldcount{$field}++;

  # if the field is 'Domain' then present a list of choices from
  # the repository's domains.html file, if possible
  if ($field eq 'Domain') {
    local ($options);
    #cache this repository's domains in @domains (must remain global)
    unless (@domains) {
      # try to use the repository's domains.html file to present
      # a list of choices for this field.
      my $file = RIB::Util::GetRibDir() . "/repositories/" . $repository
               . "/conf/domains.html";
      my $p = RIB::DomainParser->new();
      eval { $p->parse_file($file) };
      @domains = $p->list() unless $@;
    }
    foreach $entry (@domains) {
      $options .= "<option";
      if ($entry eq $value) {
        $options .= " selected";
      }
      $options .= ">$entry\n";
    }
    # if domains were successfully gotten then return, else proceed
    if ($options) {
      return "<select name=$fieldcount{$field}Domain>\n"
           . $options . "</select><br>\n";
    }
  } elsif ($field eq 'DateOfInformation') {
    my $date = $util->Date();
    return "<input size=30 name=$fieldcount{$field}$field "
         . "value=\"$date\">";
  } elsif ($object->DataType($field) eq 'string'
            or $object->DataType($field) eq 'url'
            or $object->DataType($field) eq 'email') {
    return "<input size=60 name=$fieldcount{$field}$field "
         . "value=\"$value\">";
  } elsif ($object->DataType($field) eq 'date') {
    return "<input size=30 name=$fieldcount{$field}$field "
         . "value=\"$value\">";
  } elsif ($object->IsRelationship($field)) {
    return "<input size=70 name=$fieldcount{$field}$field "
         . "value=\"$value\">";
  } else {
    return "<textarea cols=60 rows=8 " .
           "name=$fieldcount{$field}$field>$value</textarea>";
  }
}