sdf 2.001+1-3 / usr / share / perl5 / sdf / sdfget.pl

# $Id$
$VERSION{''.__FILE__} = '$Revision$';
#
# >>Title::     SDFGET Support Library
#
# >>Copyright::
# Copyright (c) 1992-1997, Ian Clatworthy (ianc@mincom.com).
# You may distribute under the terms specified in the LICENSE file.
#
# >>History::
# -----------------------------------------------------------------------
# Date      Who     Change
# 04-Oct-97 ianc    Fixed bug with * in reports
# 10-Jul-97 marks   Initial writing
# -----------------------------------------------------------------------
#
# >>Purpose::
# This library provides support for document extraction via
# {{CMD:sdfget}}. 
#
# >>Description::
# 
# This module is a collection of subroutines that are used for the
# processsing of special {{CMD:sdfget}} directives.
#
# >>Note::
# These directives are quite distinct and separate from{{CMD:sdf}}
# directives. 
# 
#
# >>!use Package; scope=PUBLIC
# >>Name::
# Sdfget
# 
# >>Description::
# The {{B:Sdfget}} package describes the interface to the data
# structures used in the extraction, storage and regeneration of
# embedded documentation within source code.
# 
package Sdfget;

# constants for the Sdfget package
%_ScopeList = (
'PUBLIC',    1,
'PROTECTED', 2,
'PRIVATE',   3
);

# >>!use Methods.new
# >>Name::
# new
# 
# >>Synopsis::
# create an instance of the {{B:Sdfget}} class
# 
# >>Description::
# {{Y:new}} creates an instance of the {{B:Sdfget}} class.
# 
# >>Return Values::
# returns a reference to the created {{B:Sdfget}} instance
# 
sub new {
    my $class = shift;
    my $this = {};
    bless $this;
}

# >>!use Methods.addText
# >>Name::
# addText
# 
# >>Parameters::
# {{B:$section}} - the section this text belongs to
# 
# {{B:@buffers}} - the list of buffers to which this key will apply
# 
# >>Description::
# 
sub addText {
    my ($this, $section, $textref, @buflist) = @_;
    my ($bufname, $bufref, $docref);

    for $bufname (@buflist) {
	if (!defined ($$this{$bufname})) {
	    $$this{$bufname} = new Sdfbuffer;
	}
	$bufref = $$this{$bufname};
	$bufref->Sdfbuffer::addText($section, @$textref);
    }
}

sub getScope {
    my ($this, $scope) = @_;
    return $_ScopeList{$scope};
}

sub getKeysDocs {
    my ($this, $bufname) = @_;
    my $bufref;

    $bufref = $$this{$bufname};
    return $$bufref{'key'}, $$bufref{'doc'};
}

sub printDict {
    my $this = shift;
    my $buf;
    my $bufref;

    for $buf (keys %$this) {
	print "Buffer: $buf...";
	$bufref = $$this{$buf};
	$bufref->Sdfbuffer::printBuffer();
    }
}



#
# >>!use main
# 
# >>Description::
# {{Y:UseArgs}} extracts the buffer names and the documentation
# scope from the {{E:!use}} directive line.
# 
# >>Parameter::
# {{B:$directive}} - the directive line to be parsed
# 
# >>Return Values::
# {{B:$doc_scope}} - the scope to which this documentation segment is
# applicable. 
# 
# {{B:@buffers}} - array of buffer names to which the documentation
# can be applied.
# 
sub UseArgs {
    local($directive) = @_; # the directive line being parsed
    local ($bufpart, $scopepart);
    local(@buffers) = ();
    local($buffers) = '';
    local($doc_scope) = 0;

    ($bufpart, $scopepart) = split (/;/, $directive);
    $bufpart =~ /^.*!use (.+)$/;
    $buffers = $1;
    @buffers = split(/,/, $buffers);
    if ($directive =~ /scope=(.+)$/){
	$doc_scope = $_ScopeList{$1};
    }
    else {
	$doc_scope = $_ScopeList{'PUBLIC'};
    }

    return ($doc_scope, @buffers);
}

# >>!use NextSection
# >>Description::
# {{Y:NextSection}} consume lines from the input stream up to
# the next {{E:"!use ..."}} entry.  When found, parse the line
# returning any found scope and buffer names.  Otherwise return a Null
# scope string and an empty buffer name list.
# 
sub NextSection {
    local($this, $istream) = @_;    # the input stream
    local($key);

    while (<$istream>) {
	if (/^!use (.+)/) {
	    return &UseArgs($_);
	}
    }

    # nothing found so return the set of the Null string
    # and an empty array
    return 0, ();
}

# >>!use main
# >>Description::
# {{Y:TrimDesc}} trims the newline characters from each description
# field in the buffers list
# 
sub TrimDesc {
    my ($this) = @_;
    my ($bufref, $buffer);

    for $buffer (keys %$this) {
	$bufref = $$this{$buffer};
	$bufref->Sdfbuffer::TrimDesc ();
    }
}


#### new package #####
package Sdfbuffer;

##### constants #####
$KeyIndex = 0;
$HashIndex = 1;

sub new {
    my $class = shift;
    my $this = {};
    bless $this;
}

sub addText {
    my ($this, $section, @desc) = @_;

    # If this is the first time this key has occurred,
    # append it to the "order found" list.
    if (!defined $this->{'doc'}{$section}) {
        push (@{ $this->{'key'} }, $section);
    }

    $this->{'doc'}{$section} .= join ('', @desc);
}

sub TrimDesc {
    my ($this) = @_;
    my ($docref, $section, $ch);

    $docref = $$this{'doc'};
    for $section (keys %$docref) {
	do {
	    $ch = chop($$docref{$section});
	} while $ch eq "\n";
	$$docref{$section} .= $ch;
    }
}

sub printBuffer {
    my $this = shift;
    my $lkey;
    my $keys = $$this{'key'};
    my $doc;
    
    for $lkey (@$keys){
	print "lkey: $lkey ";
    }
    print "\n";

    print "Documentation...\n";
    $doc = $$this{'doc'};
    for $lkey (keys %$doc) {
	print "lkey: $lkey\n$$doc{$lkey}\n";
    }
}

# package return value
1;