PC World Komputer 1999 March B/SCO_CASTOR4RRT.iso/nsfast/root.9/usr/ns-home/install/ObjConf.pm/ObjConf

Text File | 1998-08-19 | 5KB | 206 lines

package ObjConf;

# An ObjConf object represents the data in the file passed in
# objects is an array of objects in the order they were in the file
# names is a hash indexed by object name
# ppaths is a hash indexed by the ppaths
# directives is an array of extra-object information
sub new {
    my    $header = shift;
    my    $self = {};
    my    $curObj = undef;
    my    $nextLine;

    $self->{'file'} = shift;

    open( FILE, $self->{'file'} ) || ( $@ = $!, return undef );
    $nextLine = <FILE>;
    while ( $nextLine ) {
    $_ = $nextLine;
    $nextLine = <FILE>;
    while ( $nextLine && $nextLine =~ /^\s/ ) {
            $_ .= $nextLine;
            $nextLine = <FILE>;
        }
    push( @{$self->{'source'}}, $_ );
    next if ( m'^(#|$)' );    # skip comments and blank lines
    if ( /^<Object\s+/i ) {
        if ( defined( $curObj ) ) {
        $@ = "recursive Object definition in $self->{'file'}, line $.";
        return undef;
        } else {
        $curObj = new ConfObject( $', $#{$self->{'source'}} );
        return undef unless $curObj;
        }
    } elsif ( defined( $curObj ) ) {
        if ( m'^</Object>'i ) {
        push( @{$self->{'objects'}}, $curObj );
        if ( $curObj->{'type'} eq 'name' ) {
            $self->{'names'}->{$curObj->{'name'}} = $curObj;
        } elsif ( $curObj->{'type'} eq 'ppath' ) {
            $self->{'ppaths'}->{$curObj->{'ppath'}} = $curObj;
        } else {
            $@ = "Unknown object type: $curObj->{'type'}";
            return undef;
        }
        undef( $curObj );
        } else {
        $curObj->sourceLine( $_, $#{$self->{'source'}} )
            || return undef;
        }
    } else {
        chomp( $_ );
        push( @{$self->{'directives'}},
          new ConfDirective( $_, $#{$self->{'source'}} ) );
    }
    }
    close( FILE );
    bless $self;
}

sub write {
    my    $self = shift;
    my    $backupPolicy = shift;
    my    $i;

    &main::makeBackup( $self->{'file'}, $backupPolicy ) if $backupPolicy;
    open( FILE, ">$self->{'file'}" ) || ( $@ = $!, return undef );
    for ( $i = 0 ; $i < scalar( @{$self->{'source'}} ) ; ++$i ) {
    print FILE $self->{'source'}[$i] unless $self->{'deletedSource'}->{$i};
    }
    close( FILE ) || ( $@ = $! );
}

sub removeDirective {
    my    $self = shift;
    my    $object = shift;
    my    $directive = shift;

    $self->{'deletedSource'}->{$directive->{'sourceIndex'}} = 1;
    $object->remove( $directive );
}

package ConfDirective;

# conf directive has a type, name, and params
sub new {
    my    $header = shift;
    my    $line = shift;
    my    $self = {};
    my    @params;
    my    $param;
    my    $name;
    my    $value;

    $self->{'sourceIndex'} = shift;
    $self->{'client'} = shift;
    $line =~ /\s+/;
    $self->{'type'} = $`;
    $line = $';
    $self->{'params'} = {};
    while ( $param = &nextExp( \$line ) ) {
    ( $name, $value ) = split( /\s*=\s*/, $param );
    $value =~ s/^"//;    # Trim "s;
    $value =~ s/"$//;    # Trim "s;
    $name = "\L$name";
    if ( $name =~ /^fn$/i ) {
        $self->{'name'} = $value;
    } else {
        $self->{'params'}->{$name} = $value;
    }
    }
    bless $self;
}

sub nextExp {
    my    $string = shift;    # reference, so we can hack it
    my    $result;

    return undef if $$string =~ /^$/;
    if ( $$string =~ /\s+/ ) {
    my    $space = $&;

    $result = $`;
    $$string = $';
    while ( $result =~ m'^\w+\s*=\s*"' &&
            substr( $result, length( $result ) - 1, 1 ) ne '"' ) {
        $result .= $space;
        if ( $$string =~ /\s+/ ) {
        $result .= $`;
        $space = $&;
        $$string = $';
        } else {
        $result .= $$string;
        $$string = '';
        }
    }
    } else {    # last token
    $result = $$string;
    $$string = '';
    }
    return $result;
}

package ConfObject;

sub new {
    my    $header = shift;
    my    $id = shift;
    my    $self = {};

    $self->{'sourceIndex'} = shift;
    chomp( $id );
    if ( $id =~ /^name\s*=\s*/i ) {    # named object
    $self->{'type'} = 'name';
    ( $id = $' ) =~ s/^"//;    # "; Clean off quotes
    $id =~ s/"?\s*>\s*$//;    # "; Clean off quotes and >
    $self->{'name'} = $id;
    } elsif ( $id =~ /^ppath\s*=\s*/i ) {
    $self->{'type'} = 'ppath';
    ( $id = $' ) =~ s/^"//;    # "; Clean off quotes
    $id =~ s/"?\s*>\s*$//;    # "; Clean off quotes and >
    $self->{'ppath'} = $id;
    } else {
    $@ = "Syntax error in Object definition: $id";
    return undef;
    }
    bless $self;
}

sub sourceLine {
    my    $self = shift;
    my    $line = shift;
    my    $sourceIndex = shift;

    chomp( $line );
    if ( $line =~ /<client\s*/i ) {    # new Client
    if ( $self->{'curClient'} ) {
        $@ = "Recursive Client: $.";
        return undef;
    } else {
        ( $self->{'curClient'} = $' ) =~ s/\s*>\s*$//;
    }
    } elsif ( $line =~ m'</client>'i ) {
    delete $self->{'curClient'};
    } else {
    push( @{$self->{'directives'}},
          new ConfDirective( $line, $sourceIndex, $self->{'curClient'} ) );
    }
    1;
}

sub remove {
    my    $self = shift;
    my    $directive = shift;
    my    $i;

    for ( $i = 0 ; $i < scalar( @{$self->{'directives'}} ) ; ++$i ) {
    if ( $self->{'directives'}->[$i] == $directive ) {
        splice( @{$self->{'directives'}}, $i, 1 );
        last;
    }
    }
}

1;