common/rules/db_info.rules

#  Copyright (c) 1997-2021
#  Ewgenij Gawrilow, Michael Joswig, and the polymake team
#  Technische Universität Berlin, Germany
#  https://polymake.org
#
#  This program is free software; you can redistribute it and/or modify it
#  under the terms of the GNU General Public License as published by the
#  Free Software Foundation; either version 2, or (at your option) any
#  later version: http://www.gnu.org/licenses/gpl.txt.
#
#  This program is distributed in the hope that it will be useful,
#  but WITHOUT ANY WARRANTY; without even the implied warranty of
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#  GNU General Public License for more details.
#-------------------------------------------------------------------------------
#
#  This file is part of the polymake database interface polyDB.
#
#   @author Silke Horn, Andreas Paffenholz
#   http://www.mathematik.tu-darmstadt.de/~paffenholz
#

CREDIT polyDB

package PolyDB::Client;
use Term::ANSIColor;
use Term::ReadKey;
use Text::Wrap;

# @category Database Access
# Get a list of all collection names
# @param String section only return names of collections from the given section
# @option String filter regular expression for more complex filtering of collection names
#  Think of correct escaping of special characters: \\. for a literal dot, \\w for a name character.
user_method list_collections(;$ { filter => undef }) {
   $_[2]->{recursive} = -1;
   &get_collection_names;
}

# @category Database Access
# Get a list of section names
# @param String section return names of sub-sections of the given section;
#   by default, names of top-level sections are returned
# @option Bool recursive return names of sub-sections  on all levels
# @option String filter regular expression for more complex filtering of section names
#  Think of correct escaping of special characters: \\. for a literal dot, \\w for a name character.
user_method list_sections(;$ { filter => undef, recursive => false }) {
   &get_collection_names;
}

# @category Database Administration
# Common options for writing section doc
options %doc_options = (
   # String section section name
   section => $PolyDB::default::db_section_name,
   # Bool update default false
   update => false,
   # Bool verbose default false
   verbose => false,
   # Bool replace default false
   replace => false
);

# @category Database Administration
# Set documentation for a section
# @param HASH doc the documentation
# @options %doc_options
user_method set_section_doc($; %doc_options) {
   my ($self, $doc, $options) = @_;

   my $version = $doc->{polydb_version} // $PolyDB::default::db_polydb_version;
   $doc->{"_id"} = $options->{section}.".$version";
   $doc->{section} = split /\./, $options->{section};
   $doc->{sectionDepth} = scalar($doc->{section});

   my $db = $self->SUPER::get_database($default::db_name);
   my $col = $db->get_collection("_sectionInfo.".$options->{section});

   if ( $options->{replace} ) { $options->{update} = true; }
   my $output = $col->find_one({'_id' => $doc->{id}});
   die "documentation already set but neither option update nor replace given\n" if ( $output && !$options->{update} );
   if ( !$output ) { $options->{update} = false; }

   if ( !$options->{update} ) {
      $output = $col->insert_one($doc);
   } else {
      if ( $options->{replace} ) {
         $output = $col->replace_one({'_id' => $doc->{id}}, $doc);
      } else {
         $output = $col->update_one({'_id' => $doc->{id}}, {'$set' => $doc});
      }
   }
   if ($options->{verbose}) {
      if ($output->acknowledged) {
         print "successfully set documentation for $options->{section}\n"
      } else {
         print "an error occurred when trying to set the documentation for $options->{section}:\n$output\n";
      }
   }
}

# @category Database Access
# Print information about available databases and collections.
# @option String section name of the database, default: all available databases
# @option String collection name of the collection, default: all available collections
# @option Int info_level 0: only names,
#                        1: short description (default if no collection is given),
#                        2: description,
#                        3: description, authors, maintainers,
#                        4: full info
# @option Bool colored
user_method info(; {section => undef, collection => undef, info_level => undef, colored => true}) {
   my ($self, $options) = @_;
   $options->{info_level} = defined($options->{collection}) ? 5 : 1;
   if ( !defined($options->{section}) && defined($options->{collection}) ) {
      ($options->{section}, $options->{collection}) = $options->{collection} =~ /([\w.]+)\.([\w]+)/;
   }

   print "===============\navailable polydb collections\n===============\n";

   $self->print_sections_at_level($options->{section}, $options->{collection}, $self, $options->{info_level}, 0, $options->{colored});
}

sub print_formatted {
   my ($indent, $text, $colored) = @_;
   state $in_terminal = ( -t STDIN &&  $PolyDB::default::pretty_print_doc ) ? true : false;

   if ( $in_terminal ) {
      my $initial_tab = "\t"x$indent;
      my $subsequent_tab = "\t"x$indent;
      $subsequent_tab .= "  ";
      my ($w) = GetTerminalSize();
      local($Text::Wrap::columns) = $w;

      if ( $colored ) {
         if ( $text =~ /SECTION/ ) {
            print color($PolyDB::default::db_section_color);
         } elsif ($text =~ /COLLECTION/) {
            print color($PolyDB::default::db_collection_color);
         } else {
            print color('reset');
         }
      }
      print wrap($initial_tab, $subsequent_tab, $text);
      print color('reset');
   } else {
      print $text;
   }
   print "\n";
}

sub print_name_with_info {
   my ($name) = @_;
   my $ret = "  ".$name->{name};
   for my $tag (("affiliation", "email")) {
      $ret .= ", ".$name->{$tag} if defined($name->{$tag});
   }
   $ret .= " (".$name->{remark}.")" if defined($name->{remark});
   return $ret;
}

sub print_list_of_names {
   my ($names, $title, $indent) = @_;
   if ( ref($names) eq "ARRAY" ) {
      print_formatted($indent, $title.": ");
      foreach my $name (@{$names}) {
         print_formatted($indent, print_name_with_info($name));
      }
   } else {
      print_formatted($indent, $title.": ".$names);
   }
}

sub print_references {
   my ($res,$indent) = @_;
   foreach my $ref (@$res) {
      print_formatted($indent, "Cite:" );
      if ( ref($ref) eq "HASH" ) {
         print_formatted($indent+1, $ref->{authors}.", ".$ref->{title}.", ".$ref->{bib});
         if ( defined($ref->{links}) ) {
            print_formatted($indent+1, "  obtain at:");
            foreach my $link (@{$ref->{links}}) {
               print_formatted($indent+2,$link->{type}.": ".$link->{link});
            }
         }
      } else {
         print_formatted($indent,$ref);
      }
   }
}

sub print_webpage {
   my ($res,$indent) = @_;

   foreach my $ref (@$res) {
      print_formatted($indent,"Online Resources:");
      if ( ref($ref) eq "HASH" ) {
         print_formatted($indent+1,$ref->{description}.": ".$ref->{address});
      } else {
         print_formatted($indent+1,$ref);
      }
   }
}

sub print_collections_at_level {
   my ($self,$sectionname, $collectionname, $idb, $info_level, $indent, $colored) = @_;

   my $filter = "_collectionInfo.".$sectionname;
   if ( $collectionname eq "" ) {
      $filter .= '\.[\w]+$';
   } else {
      $filter .= "\\.".$collectionname;
   }
   my $db = $self->SUPER::get_database($default::db_name);
   my @collections = map { $_->{name} }
         $db->list_collections({ name => { '$regex' => $filter } }, { authorizedCollections => true, nameOnly => true })->all;
   my $polydb_version = $PolyDB::default::db_polydb_version;

   return if !scalar(@collections);

   foreach my $colname (sort { lc($a) cmp lc($b) } @collections) {
      my $id = $colname.".".$polydb_version;
      $id =~ s/_collectionInfo.//;
      my $icol = $db->get_collection($colname);
      my $res  = $icol->find_one({ "_id" => $id });

      next if !defined($res);
      print "\n";
      print_formatted($indent,"COLLECTION: ".$res->{collection}, $colored);

      next if $info_level < 1;
      print_formatted($indent, $info_level == 1 ? $res->{short_description} : $res->{description}, $colored);

      next if $info_level < 3;
      print_list_of_names($res->{author},     "Author(s)",     $indent) if defined($res->{author});
      print_list_of_names($res->{contributor},"Contributor(s)",$indent) if defined($res->{contributor});
      print_list_of_names($res->{maintainer}, "Maintainer(s)", $indent) if defined($res->{maintainer});

      next if $info_level < 4;
      print_references($res->{references}) if defined($res->{references});
      print_webpage($res->{webpage}, $indent) if defined($res->{webpage});
   }
}

sub print_sections_at_level {
   my ($self, $sectionname, $collectionname, $idb, $info_level, $indent, $colored) = @_;

   my $polydb_version = $PolyDB::default::db_polydb_version;

   foreach my $sectionname (sort { lc($a) cmp lc($b) } $self->list_sections(filter=>$sectionname) ) {
      my $id = "$sectionname.$polydb_version";
      my $db = $self->SUPER::get_database($default::db_name);
      my $icol = $db->get_collection("_sectionInfo.$sectionname");
      my $res  = $icol->find_one({ "_id" => $id });

      print "\n";
      print_formatted($indent, "SECTION: ".$sectionname, $colored);
      if ( $info_level > 0 ) {
         print_formatted($indent, $info_level == 1 ? $res->{short_description} : $res->{description}, $colored);
      }

      $self->print_sections_at_level($sectionname.".", $collectionname, $idb, $info_level,$indent+1, $colored);
      $self->print_collections_at_level($sectionname,  $collectionname, $idb, $info_level,$indent+1, $colored);
   }
}


package PolyDB::Collection;

# @category Database Access
# Get a JSON validation schema for objects stored in the collection
# @return Schema
user_method get_schema() { &get_own_schema }

# @category Database Collection Administration
# Common options for writing collection doc
options %doc_options = (
   # Bool update default false
   update => false,
   # Bool verbose default false
   verbose => false,
   # Bool replace default false
   replace => false
);

# @category Database Collection Administration
# Set documentation for a collection
# @param HASH doc the documentation
# @options %doc_options
user_method set_collection_doc ($; \%doc_options) {
   my ($self, $doc, $options) = @_;
   my $collection = $self->{name};
   my $version = $doc->{version} // $PolyDB::default::db_polydb_version;
   my $id = "$collection.$version";
   $doc->{"_id"} = $id;

   my $col = $self->get_own_info_collection();

   if ( $options->{replace} ) { $options->{update} = true; }
   my $output = $col->find_one({'_id' => $id});
   die "documentation already set but neither option update nor replace given\n" if ( $output && !$options->{update} );
   if ( !$output ) { $options->{update} = false; }

   if ( !$options->{update} ) {
      $output = $col->insert_one($doc);
   } else {
      if ( $options->{replace} ) {
         $output = $col->replace_one({'_id' => $id}, $doc);
      } else {
         $output = $col->update_one({'_id' => $id}, {'$set' => $doc});
      }
   }
   if ($options->{verbose}) {
      if ($output->acknowledged) {
         print "successfully updated documentation for $collection in section $section\n"
      } else {
         print "an error occurred when trying to update the documentation for $collection in section $section:\n$output\n";
      }
   }
}

# Local Variables:
# mode: perl
# cperl-indent-level:3
# indent-tabs-mode:nil
# End: