[Bio] / FigKernelPackages / WikiTools.pm Repository:
ViewVC logotype

View of /FigKernelPackages/WikiTools.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.5 - (download) (as text) (annotate)
Fri Jul 11 01:00:54 2008 UTC (11 years, 7 months ago) by parrello
Branch: MAIN
CVS Tags: rast_rel_2008_12_18, rast_2008_0924, rast_rel_2008_09_30, mgrast_rel_2008_0924, mgrast_rel_2008_1110_v2, mgrast_rel_2008_0625, rast_rel_2008_10_09, rast_release_2008_09_29, mgrast_rel_2008_0806, mgrast_rel_2008_0923, mgrast_rel_2008_0919, mgrast_rel_2008_1110, rast_rel_2008_09_29, mgrast_rel_2008_0917, rast_rel_2008_10_29, rast_rel_2008_11_24, rast_rel_2008_08_07
Changes since 1.4: +8 -2 lines
Fixed table generator to remove line-feeds that would break the table.

#!/usr/bin/perl -w

#
# Copyright (c) 2003-2006 University of Chicago and Fellowship
# for Interpretations of Genomes. All Rights Reserved.
#
# This file is part of the SEED Toolkit.
#
# The SEED Toolkit is free software. You can redistribute
# it and/or modify it under the terms of the SEED Toolkit
# Public License.
#
# You should have received a copy of the SEED Toolkit Public License
# along with this program; if not write to the University of Chicago
# at info@ci.uchicago.edu or the Fellowship for Interpretation of
# Genomes at veronika@thefig.info or download a copy from
# http://www.theseed.org/LICENSE.TXT.
#

package WikiTools;

    require Exporter;
    @ISA = ('Exporter');
    @EXPORT = qw(WikiUse);
    use strict;
    use Tracer;
    use LWP::UserAgent;
    use FIG_Config;

=head1 Wiki-Handling Methods

=head2 Introduction

This package handles functions related to the NMPDR Wiki. At one time its
purpose was to provide independence from the specific Wiki tool in use;
however, we are now firmly wedded to TWiki, so most of the methods are
no longer useful. Notable exceptions are the ones for reading and writing
wiki pages, and the L</WikiUse> method.

The fields in this object are as follows.

=over 4

=item userAgent

An LWP object that can be used to send requests to the Wiki server.

=item username

User name for logging on to the wiki server.

=item password

Password for logging on to the wiki server.

=item url

URL of the wiki server access script.

=back

=cut

=head2 Public Methods

=head3 new

   my $wiki = WikiTools->new();

Construct a new Wiki object.

=cut

sub new {
    # Get the parameters.
    my ($class, %options) = @_;
    # Create the Wiki-Handling Methods object.
    my $retVal = {
                    username => $FIG_Config::nmpdr_wiki->{username},
                    password => $FIG_Config::nmpdr_wiki->{password},
                    url => $FIG_Config::nmpdr_wiki->{url}
                };
    # Add the user agent.
    $retVal->{userAgent} = LWP::UserAgent->new();
    # Bless and return it.
    bless $retVal, $class;
    return $retVal;
}

=head3 Bar

    my $line = WikiTools::Bar;

Return the wiki text for a horizontal bar.

=cut

sub Bar {
    return "---";
}

=head3 Heading

    my $line = WikiTools::Heading($level, $text);

Return the wiki text for a heading line at the specified level.

=over 4

=item level

Desired heading level.

=item text

Title for the heading's section.

=item RETURN

Returns a formatted heading line.

=back

=cut

sub Heading {
    # Get the parameters.
    my ($level, $text) = @_;
    # Create the heading line.
    my $retVal = "---" . ("+" x $level) . " $text";
    # Return the result.
    return $retVal;
}


=head3 HeadParse

    my ($level, $name) = WikiTools::HeadParse($line);

Determine whether or not the specified line is a wiki heading. If it is,
return the heading level and the heading name. If it is not, return 0
and C<undef>

=over 4

=item line

Wiki line to parse.

=item RETURN

Returns a two-element list. The first element indicates the heading level, and is
C<0> for a non-heading. The second contains the heading name, or C<undef> for a
non-heading.

=back

=cut

sub HeadParse {
    # Get the parameters.
    my ($line) = @_;
    # Assume this is not a heading line.
    my ($level, $name) = (0, undef);
    # Check for the heading format.
    if ($line =~ /^\s*---(\++)\s*(.+)\s*$/) {
        # Here we have a heading line. The heading level is the number of plus
        # signs matched, which is also the length of $1.
        $level = length $1;
        $name = $2;
    }
    # Return the result.
    return ($level, $name);
}

=head3 HeadLevel

    my $level = WikiTools::HeadLevel($line);

Return the heading level of the specified line, or 0 if it is not a
heading.

=over 4

=item line

Wiki line to parse.

=item RETURN

Returns C<0> if the line is not a heading, and the heading level otherwise.

=back

=cut

sub HeadLevel {
    # Get the parameters.
    my ($line) = @_;
    # Parse the header. We keep the heading level and throw away the text.
    my ($retVal) = WikiTools::HeadParse($line);
    # Return the result.
    return $retVal;
}


=head3 Save

    my $rc = $wiki->Save($title, $web, $category, $content);

Store text for the specified page. If successful, return TRUE. If an
error occurs, return FALSE. In this last case, an error message will be
in the member C<$wiki->{error}>.

=over 4

=item title

Page title, consisting of one or more words. The title will be converted
to the format required by the particular Wiki in use.

=item web

Namespace for this page.

=item category (optional)

Category to contain the page.

=item content

New content for the page.

=item RETURN

Returns TRUE if successful, else FALSE. If FALSE is returned, an error message
will be stashed in the C<error> member.

=back

=cut

sub Save {
    # Get the parameters.
    my ($self, $title, $web, $category, $content) = @_;
    # The first task is to create the real page title. First, we separate the incoming
    # title into words.
    my @words = split /\s+|_+/, $title;
    # Form them into a WikiWord with a web name prefix.
    my $wordTitle = join("", map { ucfirst $_ } @words);
    my $realTitle = "$web.$wordTitle";
    # Set up the parent information (if any).
    my @parentData = ();
    if ($category) {
        push @parentData, parent => $category;
    }
    # Send a request to the wiki server.
    my $ua = $self->{userAgent};
    my $response = $ua->post($self->{url}, { username => $self->{username},
                                             password => $self->{password},
                                             topic    => $realTitle,
                                             text     => $content,
                                             @parentData });
    # Declare the return variable. We assume failure. If we succeed, we'll change
    # the value.
    my $retVal = 0;
    # Save the response content.
    my $message = $response->content;
    # Check for a response error.
    if (! $response->is_success()) {
        # Denote failure, and save the content as the error message.
        if ($message =~ /<p>(.+)<\/p>/si) {
            # Here the message is formatted as HTML. We return the meat.
            $self->{error} = $1;
            $self->{error} =~ s/\n/ /gs;
        } else {
            $self->{error} = $message;
        }
    } elsif ($message =~ /^ERROR:\s*(.*)/) {
        # Here we have an error detected by the plugin script. We get the
        # meat of the message error field.
        $self->{error} = $1;
    } else {
        # Denote success.
        $retVal = 1;
    }
    # Return the result.
    return $retVal;
}

=head3 Prolog

    my @lines = WikiTools::Prolog();

Returns a set of text lines to put at the beginning of a typical Wiki
output stream.

=cut

sub Prolog {
    # Return the result.
    return ('<noautolink>', '%TOC%');
}

=head3 Epilog

    my @lines = WikiTools::Epilog();

Returns a set of text lines to put at the end of a typical Wiki
output stream.

=cut

sub Epilog {
    # Return the result.
    return ('</noautolink>');
}

=head3 BoldCode

    my $boldCode = WikiTools::BoldCode();

Returns the Wiki code for bold text.

=cut

sub BoldCode {
    # Return the result.
    return "*";
}

=head3 ItalicCode

    my $italicCode = WikiTools::BoldCode();

Returns the Wiki code for italic text.

=cut

sub ItalicCode {
    # Return the result.
    return "_";
}

=head3 LinkMarkup

    my $boldCode = WikiTools::LinkMarkup($link, $text);

Returns the Wiki code for a link.

=over 4

=item link

URL or topic name referenced by the link.

=item text (optional)

Text of the link.

=back

=cut

sub LinkMarkup {
    # Get the parameters.
    my ($link, $text) = @_;
    # Declare the return variable.
    my $retVal;
    # Check to see if we have text.
    if ($text) {
        # Yes, so we have a two-part link.
        $retVal = "[[$link][$text]]";
    } else {
        # No, so we have a one-part link.
        $retVal = "[[$link]]";
    }
    # Return the result.
    return $retVal;
}

=head3 ListCode

    my $listCode = WikiTools::ListCode();

Returns the Wiki code for a list element.

=cut

sub ListCode {
    # Return the result.
    return "   * ";
}


=head3 Table

    my $wikiText = WikiTools::Table(@rows);

Create a Wiki table. The parameters are all list references. The first
describes the header row, and the remaining rows are presented
sequentially. This is a very simple table, using only default settings
and with everything left-aligned.

=over 4

=item rows

List of table rows. Each table row is a list reference containing the
cells of the row in column order. The first row is used as the header.

=item RETURN

Returns a string that will generate a Wiki table.

=back

=cut

sub Table {
    # Get the parameters.
    my (@rows) = @_;
    # Get the header row.
    my $headers = shift @rows;
    # We put asterisks around the title of each column so that TWiki knows these are headers.
    my $headerRow = "| " . join(" | ", map { "*$_*" } @{$headers}) . " |";
    # Save the header, and build the rest of the rows normally.
    my @rowStrings = $headerRow;
    for my $row (@rows) {
        # Remove line-feeds from the cells.
        my @cells = map { $_ =~ s/\n/ /g; $_ } @{$row};
        # Add them together to make a row.
        push @rowStrings, "| " . join(" | ", @cells) . " |";
    }
    # Put the rows together with blank lines on either side.
    my $retVal = join("\n", "", @rowStrings, "");
    # Return the result.
    return $retVal;
}


=head3 List

    my $wikiText = WikiTools::List(@items);

Create a Wiki list. The parameters are all strings that are put into the
list sequentially.

=over 4

=item items

List of items to be formatted into a wiki list.

=item RETURN

Returns wiki markup text that will display as an unordered list.

=back

=cut

sub List {
    # Get the parameters.
    my (@items) = @_;
    # Format the list.
    my $retVal = join("\n", map { "   * $_" } @items);
    # Return the result.
    return $retVal;
}

=head3 WebApplicationObject

    my $appObject = WikiTools::WebApplicationObject($session);

This method returns a [[WebApplication]] application object for the Wiki.
It is used by the authentication and access control methods to access the
[[WebAppBackend]] database.

=cut

sub WebApplicationObject {
    # Get the parameters.
    my ($session) = @_;
    # Declare the return variable.
    my $retVal = DBMaster->new(%{$FIG_Config::web_app_db});
    # Return the result.
    return $retVal;
}

=head3 ComputeTitle

    my ($title, $project) = WikiTools::ComputeTitle($fileName, $path);

This method computes the project name and Wiki title for a source file.
The specified path must be relative to the distribution directory. So,
for example, the path for the Ajax component would be
C<WebApplication/WebComponent>. For almost every source file, the path
will be a single word (e. g. C<FigKernelPackages>). The project name is
the first directory in the incoming path, and the Wiki title is computed
by converting the file name to capital case and squeezing out the
underscores.

=over 4

=item fileName

Unqualified name of the specified source file (e.g. C<FIG.pm>).

=item path

Path in the source file tree to the specified file.

=item RETURN

Returns a two-element list. The first element is a WikiWord for the file
title and the second is a project name.

=back

=cut

sub ComputeTitle {
    # Get the parameters.
    my ($fileName, $path) = @_;
    # Compute the project name from the project path.
    my $project = ($path =~ /^(\w+)/ ? $1 : $path);
    # Turn the project name into a wiki word.
    $project = Wikify($project, "Project");
    # Compute the file title from the file name.
    my $title = Wikify($fileName);
    # Return the results.
    return ($title, $project);
}

=head3 Wikify

    my $wikiword = WikiTools::Wikify($string, $suffix);

Convert a string into a [[WikiWord]]. WikiWords are in [[capital case]],
cannot contain underscores, and must have at least two humps (that is,
two transitions from a capital letter to a digit or small letter). To
convert a string to a Wiki Word, we split it on punctuation boundaries
and convert each segment to capital case. There are some glitches in this
process. We need to insure the result starts with a letter, and we need
to convert acronyms to words. For example, C<FIGPm> is not valid, but
C<FigPm> is. To get a valid result, we have to convert C<FIG> to C<Fig>.
Also, we have to make sure we don't end a word with C<Tmpl>.

=over 4

=item string

String to convert.

=item suffix

A suffix to add to the string if it has two few humps.

=item RETURN

Incoming string as a WikiWord, with a minimum loss of meaning.

=back

=cut

sub Wikify {
    # Get the parameters.
    my ($string, $suffix) = @_;
    # Declare the return variable.
    my $retVal;
    # Check to see if there's any work to do.
    if (IsWikiWord($string)) {
        $retVal = $string;
    } else {
        # Here we need to convert what we have into a wiki word. First, bust
        # it into segments. Note that underscore (normally a "word" character)
        # is treated as punctuation.
        my @segments = split /[\W_]+/, $string;
        # Insure each segment is capital case.
        for my $segment (@segments) {
            if ($segment =~ /^[A-Z0-9]+$/) {
                # Here we have a probable acronym. Convert it to capital case.
                $segment = ucfirst lc $segment;
            } elsif ($segment =~ /^[a-z0-9]+$/) {
                # This is a lower-case word. Capitalize it.
                $segment = ucfirst $segment;
            }
        }
        # Paste the segments together.
        $retVal = join("", @segments);
        # See if we're done.
        if (! IsWikiWord($retVal) && $suffix) {
            # We're not a WikiWord, but the caller has supplied a suffix.
            # Tack it on.
            $retVal .= $suffix;
        }
    }
    # Return the result.
    return $retVal;
}


=head3 IsWikiWord

    my $flag = WikiTools::IsWikiWord($string);

Return TRUE if the specified string is a [[TWiki.WikiWord][wiki word]], else FALSE.

=over 4

=item string

String to evaluate.

=item RETURN

Returns TRUE if the string conforms to the allowable format for a Wiki page title,
else FALSE.

=back

=cut

sub IsWikiWord {
    # Get the parameters.
    my ($string) = @_;
    # Test the string.
    return $string =~ /^[A-Z]+[a-z]+(?:[A-Z]+[a-zA-Z0-9]*)$/;
}

=head3 WikiUse

    WikiUse($module);

This method will load a module from the CPAN library of the Wiki code
tree. The module is required, but not imported, so all references to
method in the module must be fully-qualified. Most development sandboxes
do not have the Wiki code installed, so this method is considered at best
a temporary situation until an actual CPAN install can be performed.

=over 4

=item module

Name of the module to require, as it would appear in a C<use> statement.

=back

=cut

sub WikiUse {
    # Get the parameters.
    my ($module) = @_;
    # Convert the module name to a package name.
    my $package = "$module.pm";
    $package =~ s#::#/#g;
    # Only proceed if we haven't tried to load this module before.
    if (! exists $INC{$package}) {
        # Insure we have the Wiki CPAN library in the INC list.
        if (! grep { $_ =~ m#/Wiki/lib/CPAN/lib# } @INC) {
            push @INC, "$FIG_Config::lib/Wiki/lib/CPAN/lib";
        }
        # Require the package.
        require $package;
    }
}


1;

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3