#
#    May 17/99 - F.Majaess (Revised for installation as a standard CCCma module)
#
#id  cccma_perl_functions - Used by CCCma perl based scripts.
#
#    AUTHOR  -  Damin Liu
#
#hd PURPOSE  - "cccma_perl_functions.pm" module defines functions used by CCCma
#hd            perl based scripts.
#hd

package cccma_perl_functions;

require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(Display_help0 Display_help Unique_array);

# Function to display "help" documentations.

sub Display_help0
{
    my($doc)=@_;
    my($help,$flag);

    open(HELP,"<$doc");                 # open the doc containing help info
    while (<HELP>) {
                                        # look for line starting with 'Purpose'.
        if ( $flag=/^#hd *PURPOSE / .. !/^#/ ) {
            print "\n" if $flag==1;
            if ($flag=~/E0/) {          # exclude last line in the range. exit.
                close(HELP);
                return;
            }
            ($help)=/^#[phe]?[rdx]? (.*)/; # filter out the '#' character.
            print "$help\n";            # print
        }
    }
    close(HELP);                        # if nothing found in the range, alse exit.
    return;
}

# Earlier version to display "help" documentations.

sub Display_help
{
    my($doc)=@_;
    my($help,$flag);

    open(HELP,"<$doc");                # open the doc containing help info
    while (<HELP>) {
                                       # look for line starting with 'Purpose'.
        if ( $flag=/^# Purpose/ .. !/^#/ ) {
            print "\n" if $flag==1;
            if ($flag=~/E0/) {         # exclude last line in the range. exit.
                close(HELP);
                return;
            }
            ($help)=/^#(.*)/;          # filter out the '#' character.
            print "$help\n";           # print
        }
    }
    close(HELP);                       # if nothing found in the range, alse exit.
    return;
}

# Remove duplicate elements of array. Argument is reference to array.

sub Unique_array
{
    my($ref)=@_;
    my(@tmp,$elem);
    
    @tmp=@$ref;
    for $elem (@tmp) {
        @$ref=grep(!/^$elem$/,@$ref);
        @$ref=(@$ref,$elem);
    }
}

1;