# $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
) {
"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
){
"lkey: $lkey "
;
}
"\n"
;
"Documentation...\n"
;
$doc
=
$$this
{
'doc'
};
for
$lkey
(
keys
%$doc
) {
"lkey: $lkey\n$$doc{$lkey}\n"
;
}
}
# package return value
1;