OGDL::Graph - a class for manipulating a OGDL graph object

ogdl-perl documentation Contained in the ogdl-perl distribution.

Index

Code Index:

NAME

Top

OGDL::Graph - a class for manipulating a OGDL graph object

SYNOPSIS

Top

  use OGDL::Graph;
  $g=OGDL::Graph->new("rootname");
  $g1=$g->addGraph("node1");
  $g2=$g->addGraph("node2");
  $g11=$g1->addGraph("subnode1");
  $g2->addNode($g11)

  #the following prints:
  #node1
  #    subnode1
  #node2
  #    subnode1
  $g->print;

  $q=$g->get("node1");
  #the following prints:
  #subnode1
  $q->print;

  $s=$g->getname("node1.[0]"); #$s eq "subnode1"

  @c=$g->getChildren; #@c now is ($g1, $g2)

  ## Editing the graph with paths
  $g->clear  # unlinks all the children nodes
  $g->gadd("node1.subnode1");
  $g->gadd("node2","subnode1"); #Recreates the above graph
  @nodes=$g->glist("*.subnode1"); #@nodes contains the two subnodes
  $g->remove("*2.*"); 
  $g->print;

  #it prints
  #node1
  #    subnode1
  #node2

DESCRIPTION

Top

OGDL is a human editable alternative to XML. It embeds information in the form of graphs, where the nodes are strings and the arcs or edges are spaces or indentations. This class facilitates the manipulation of ogdl graph.

METHOD

Top

$g=OGDL::Graph->new($rootname) This method creates an empty graph with root node name $rootname.

$child=$g->addGraph($name) This method adds a subnode with name $name to $g as its last children node. It returns the new subnode that is added.

$node=$g->get($path) This method returns the node specified by $path. For the OGDL PATH specification, see: http://ogdl.sourceforge.net.

$str=$g->getname($path) This method returns the name of the node matches $path.

$n=$g->childrencount It returns the number of children nodes of $g.

@nodes=$g->getChildren It returns all the children nodes of $g as an array.

$node->unlink unlinks $node from the graph

$g->glist($path) Returns a list of nodes that matches $path

$g->gremove($path) Unlinks the nodes specified by $path from the graph

$g->gadd($path) Adds nodes to the graph that qualified by $path

$g->print(%print_options) It prints $g into a text stream. It accepts following options: "indentwidth" sets the indent width for each level, defaut is 4; "singlequote" sets whether to put quote around the text if the output only contains a single node, default is not to put quote; "filehandle" sets the filehandle the output goes to. The default goes to STDOUT; "depth" sets how many level of subnodes to print. The default is -1, which prints all subnodes. "group"=>n prints all nodes below level n into one line. The default prints each node in a single line. "noblockquote"=>1 prints all nodes that require quoting with doulble quotes. The default prints it in a '\' block.

SEE ALSO

Top

  OGDL::Parser, http://ogdl.sourceforge.net/
ogdl-perl documentation Contained in the ogdl-perl distribution. 
# Graph.pm
# This class implements a nested named list.
# author 'Rolf Veen'
# license zlib
# date 20030609
# Modified by Hui Zhou <zhouhui@wam.umd.edu>

package OGDL::Graph;

use strict;
use warnings;


use OGDL::Path;

sub new {
   my ($class,$name)=@_;
   my $rec = {
      parent=>undef,
      name => $name,
      list => [ () ]
   };
#   print "New Graph node: [$name]\n";
   return bless $rec,$class;
}

#$g->addGraph($name); append node with name=$name
sub addGraph {
   my ($self,$name) = @_;
   my $n=OGDL::Graph->new($name);
   $self->addNode($n);
   return $n;
}
#$g->addNode($sub); append node to the end 
sub addNode {
   my ($self,$node) = @_;
   my $list = $self->{list};
   my $len = @$list;
   $node->{parent}=$self;
   $self->{list}[$len] = $node;
#   print "Adding node: [",$node->{name},"]\n";
}

sub merge{
   my ($self,$node)=@_;
   my $list1=$self->{"list"};
   my $list2=$node->{"list"};
   if(!$list2){return;}
   push @$list1, @$list2;
}

sub unlink{
   my $node=shift;
   my $parent=$node->{"parent"};
   $node->{"parent"}=undef;
   my $j=0;
   my $l=$$parent{"list"};
   while($j<=$#$l){
      if($$l[$j]==$node){
	splice @$l,$j,1;
	return;
      }
      $j++;
   }
}

sub getname{
    my $node=get(@_);
    if(!$node){return undef;}
    return $$node{"name"};
}

sub childrencount{
    my  $g=shift;
    my $list=$$g{"list"};
    return scalar @$list;
}

sub getChildren{
    my  $g=shift;
    my $list=$$g{"list"};
    return @$list;
}

sub isempty{
    my $g=shift;
    my $l=$$g{"list"};
    return (! scalar(@$l));
}
 
sub clear{
    my $g=shift;
    my $l=$$g{"list"};
    foreach(@$l){
	$_->{"parent"}=undef;
    }
    $$g{"list"}=[ () ];
}

#Not sure how  to deal with the order
#sub diff{
#    my ($g1,$g2)=@_;
#    my ($pg1,$pg2);
#}

sub listmatch{
    my ($g,$list,$rnum,@path)=@_;
    my $inum=-1; #match all index
    my $namepat;
    my $pat=shift @path;
    if($pat=~/(.*)(\[(\d*)\])/){
	if($3 eq ""){$inum=-1;}
	else{$inum=$3;}
	if($1 eq ""){$namepat="^*\$";}
	else{$namepat="^$1\$";}
    }
    else{
	$inum=-1;
	$namepat="^$pat\$";
    }
    $namepat=~s/\*/\.\*/g;
    $namepat=~s/\?/\./g;
    $inum++;
	
#    print "listmatch ",$$g{"name"},"=~$namepat\n";
    if($$g{"name"}=~/$namepat/){
	$$rnum=$$rnum+1;
#	print "Match: ",$$rnum,", $inum, (",$#path,")\n";
        if($inum>0 && $$rnum!=$inum){ #index doesn't match
	    return undef;
	}
	if($#path==-1){
#	    print "Matched\n";
	    {push @$list,$g;return 1;} #matches finally
	}
	my $n=0;
	my $l=$g->{list};
	foreach(@$l){
	    $_->listmatch($list,\$n,@path);
	}
    }
}

sub glist{
    my @list;
    my ($g,$pathstr)=@_;
    my @path=splitPath($pathstr);
    if($#path<0){push @list,$g;return @list;}
    unshift @path,"*";
    my $n=0;
#   my $j=0; foreach(@path){print "$j:[$_],";$j++;}print "\n";
    listmatch($g,\@list,\$n,@path);
    return @list;
}

sub removematch{
    my ($g,$list,@path)=@_;
    my $inum=-1; #match all index
    my $namepat;
    my $pat=shift @path;
    if($pat=~/(.*)(\[(\d*)\])/){
	if($3 eq ""){$inum=-1;}
	else{$inum=$3;}
	if($1 eq ""){$namepat="^*\$";}
	else{$namepat="^$1\$";}
    }
    else{
	$inum=-1;
	$namepat="^$pat\$";
    }
    $namepat=~s/\*/\.\*/g;
    $namepat=~s/\?/\./g;
    if($inum>=0){$inum++;}
	
    my $j=0;
    my $num=0;
    my $l=$g->{"list"};
    my $n=$$l[$j];
    while($n){
#        print "removematch ",$$n{"name"},"=~/$namepat/\n";
	if($$n{"name"}=~/$namepat/){
	    $num++;
#	    print "Match :$num, $inum\n";
	    if($inum>=0 && $num!=$inum){ #index doesn't match
		$j++;
	    }
	    else{
   {my $j=0; foreach(@path){print "$j:[$_],";$j++;}print "\n";}
		if($#path==-1){
		    push @$list,$n;
		    splice(@$l,$j,1);
		    if($inum>=0){ last; }
		    else{
			$num++;
		    }
		}
		else{
		    removematch($n,$list,@path);
		    if($inum>=0){last;}
		    $j++;
		}
	    }
	}
	else{
	    $j++;
	}
	$n=$$l[$j];
    }
}

sub gremove{
    my ($g,$pathstr)=@_;
    my @path=splitPath($pathstr);
    if($#path<0){unshift @path,"*";}
    my @list;
    if($#path<0){return $g;}
    removematch($g,\@list,@path);
    return @list;
}

sub gmove{
    my ($g,$from,$to)=@_;
    my @frompath=splitPath($from);
    my @topath=splitPath($to);
    my @remove=gremove($from);
    foreach (@remove){
	addmatch($g,$_,@topath);
    }
}

sub addmatch{
    my ($g,$node,@path)=@_;
    if($#path<0){
	if($node){
	    $g->clear;
	    $g->addNode($node)
	};
	return;
    }
    my $inum=-1; #match all index
    my $uniq=1;
    my $namepat;
    my $pat=shift @path;
    if($pat=~/(.*)(\[(\d*)\])/){
	if($3 eq ""){ $uniq=0;$inum=-1;}
	else{$inum=$3;}
	if($1 eq ""){$namepat="*";}
	else{$namepat="$1";}
    }
    else{
	$namepat="$pat";
    }
    if($namepat=~/[*?]/){
	$namepat=~s/\*/\.\*/g;
	$namepat=~s/\?/\./g;
	$uniq=0;
    }
    if($inum>=0){$inum++;}
	
    my $j=0;
    my $num=0;
    my $n=$g->{list}[$j];
    my $exist=0;
    while($n){
#        print "addmatch ",$$n{"name"},"=~/^$namepat\$/\n";
	if($$n{"name"}=~/^$namepat$/){
	    $num++;
#	    print "Match: $num, $inum\n";
	    if($inum<0 || $num==$inum){ # match
		$exist=1;
		addmatch($n,$node,@path);
	    }
	}
	$j++;
	$n=$g->{list}[$j];
    }
    if(!$exist && $uniq){
#        print "Add $namepat?\n";
        $j=$num;
	if($inum<0){$inum=1;}
	while($j<$inum){
	    $n=OGDL::Graph->new($namepat);
	    $g->addNode($n);
	    $j++;
#	    print "Added node [$namepat]\n";
	}
	addmatch($n,$node,@path);
    }
}

sub gadd{
    my ($g,$pathstr,$str)=@_;
    my @path=splitPath($pathstr);
#    my $j=0;foreach(@path){print "$j:[$_],";$j++;}print "\n";
    my $node=undef;
    if($str){
	$node=OGDL::Graph->new($str);
    }
    addmatch($g,$node,@path);
}

# g->add(path, string)
# doesn't work with numeric indices
sub add
{
    my ($g,$path,$string)=@_;
    my $n=$g->get($path);
    return $n->addGraph($string);
}

#$g->getNode($index); return subnode by index
sub getNode {
   my $self = shift;
   return $self->{list}[$_[0]];
}

sub getNodeByName {
   my $self = shift;
   my $name = shift;
  
   my $list = $self->{list};
   my $i=0;
   
   for (@$list) {  
       if ($_->{name} eq $name)
           { return $i; }
       $i++; 
   }
   return -1;
}

# look for the nth ocurrence of a name

sub getNodeByNameN {
   my $self = shift;
   my $name = shift;
   my $n = shift;

   my $list = $self->{list};
   my $i=0;
   
   for (@$list) {  
       if ($_->{name} eq $name) {
           if ($n-- == 0)
               { return $i; }
       }
       $i++; 
   }
   return -1;
}

# make a new Graph with all nodes with given name.

sub newGraphByName {
   my $self = shift;
   my $name = shift;
   my $list = $self->{list};
   my $i=0;
   my $g = OGDL::Graph->new($name);
   my $list2;
   
   for (@$list) {  
       if ($_->{name} eq $name) {
           $list2=$_->{list};
           for (@$list2) {
               $g->addNode($_);
           }
       }
       $i++; 
   }   
   return $g;
}

sub get
{
    my $self = shift;
    my @path = OGDL::Path::path2list(shift);
    my $node = $self;
    my $i=0;
    my $prev;   # to distinguish between x[n] and x.[n] and hold the
                # previous node
    
    for (@path) {       
        if ( !$_ && $_ ne '0') { last; }     # Whose bug is this ?
        
        if ($_ eq ".") { $prev=""; next; }

        # [n]?
	if(/\[(\d*)\]/){
#        if ( substr($_,0,1) eq '[') {
#            $i = 0 + substr($_,1,100);     # get the numeric index
            if($1 eq ""){$i=0;}
	    else{$i=$1;}
            
            # if prev & i>0 then we must look for ith ocurrence
            # of prev
            
            # if prev & i==0 then we group all nodes with the same name
            # as $node->{name} in a new Graph and continue from there.
            
            if ( $prev ) {
                if ( $i > 0 ) {
                    $i = $prev->getNodeByNameN($node->{name},$i);
                    $node = $prev->getNode($i);
                    $prev = 0;
                    next;
                }
                elsif ( $i == 0 ) {                
                    $node = $prev->newGraphByName($node->{name});
                    $prev = 0;
                    next;
                }
                else { $i = -1; }
            }
        }
        else {
            $i = $node->getNodeByName($_);
        }
        
        if ($i == -1) { return undef; }
        $prev = $node;
        $node = $node->getNode($i);
    }                  
 
    return $node;
}

sub getGraph
{
    return get(@_);
}

sub getScalar
{
    my $node = get(@_);
    if ($node) {
        $node = $node->{list}[0];
        if ($node) 
            { return $node->{name}; }
    }
    return undef;
}


#_print_str($name,$indent,$pending,$blockquote,$noquote,*FILE)
sub _print_str 
{
    my ($s,$n,$pending,$blockquote,$noquote,$sameline,$output)=@_;
    #$pending = $_[2]; #Whether continuing at previous line or starting at begining of new line
    #$blockquote=$_[3]; #Whether use \ quote or " quote
    # see what type of string it is: word, quoted or block
    if ($s =~ /[ \n\r]/) {#block
	if($blockquote && $pending){
	    print $output " \\\n";
	    my $c;
	    my $pend=1;
	    print $output ' ' x $n; $pend = 0;
	    for (my $i=0;$i<length($s);$i++){
	        $c = substr($s,$i,1) ;
#		if(!defined $c) {last;}
		if ( $pend == 1 ) { print $output ' ' x $n; $pend = 0;}
		if ($c eq "\n") {
		    $pend = 1;
		}
		print $output $c;
	    }
	    if($pend){$pending = 0;}
	    else{$pending=1;}
	}
	else{ #use double quote block
	    if($pending){
		if($sameline){print $output ' ';}
		else{
		    print $output "\n";
		    print $output ' ' x $n;
		}
	    }
	    my $c;
	    my $i=0;
	    my $pend=0;
	    if(!$noquote){ print $output '"';$n++;} #Opening quote 
	    for (my $i=0;$i<length($s);$i++){
	        $c = substr($s,$i,1);
		if ( $pend == 1 ) { print $output ' ' x $n; $pend = 0;}
		if ($c eq "\n") {
		    $pend = 1;
		}
		elsif($c eq '"' && !$noquote) { print $output "\\"; } #Quote the quote
		print $output $c;
	    }
	    if(!$noquote){print $output '"'; }#Closing quote
	    $pending = 1;
	}
    }
    else {
        if ($pending == 1) { 
	    if($sameline){
		print $output ' ';
	    }
	    else{
		print $output "\n" ;
		print $output ' ' x $n;
	    }
	}
	else{
		print $output ' ' x $n;
	}
	print $output $s;
        $pending = 1;
    }
    return $pending;
}

#assuming it always start at $indentlevel==0
sub _print {
   use integer;
   my ($self,$output,$indentlevel,$indentwidth,$pending,$single,$singlequote,$noblockquote,$depth, $group)=@_;
   my $list = $self->{list};
   my @l = @$list;

   my $indent=$indentwidth*$indentlevel;
   my $blockquote=0;
   my $noquote=0;
   my $sameline=0;
   if($group==0){$sameline=1;}
   if (!$noblockquote && $single && $#l<0){$blockquote=1;}
   if (!$singlequote && $indentlevel==0 && $single && ($#l<0 ||$depth ==0)){$noquote=1;}#single node output
   $pending = _print_str($self->{name}, $indent, $pending,$blockquote,$noquote,$sameline,$output);
   if($#l==0){ 
	$single=1;
    }
    else{
	$single=0;
    }
   $indentlevel++;
   
   #negative $depth is equivalent to infinity depth
   $depth--;
   if($depth==0 || $#l<0){return $pending;}
   if($group>0){$group--;}
   if($group==0){$sameline=1;}
   if($sameline){
       if($#l>0){print $output " (";}
   }
   my $j=$#l;
   {
       foreach  my $g(@l){
	   $pending=$g->_print($output,$indentlevel,$indentwidth,$pending,$single,$singlequote,$noblockquote,$depth,$group);
	   if($sameline && $j>0){
	       print $output ",";
	       $j--;
	    }
       }
       if($sameline){
	   if($#l>0){print $output " )";}
       }
   }
   return $pending;
}

# arguments: A hash with keys: depth, indentwidth, filehandle, singlequote, printroot, noblockquote
sub print{
   my ($g,%params) = @_;
   my $list = $g->{list};
   my @l = @$list;
   my $singleblock=0;
   my $indentwidth=4;
   my $quote=0;
   my $depth=0;#infinity
   my $pending=0;
   my $noblockquote=0;
   my $output=*STDOUT;
   my $group=-1; #put all nodes after $group depth in one line
   if($params{"indentwidth"}){$indentwidth=$params{"indentwidth"};}
   if($params{"singlequote"}){$quote=$params{"singlequote"};}
   if($params{"filehandle"}){$output=$params{"filehandle"};}
   if($params{"depth"}){$depth=$params{"depth"};}
   if(exists $params{"group"}){$group=$params{"group"};}
   if($params{"noblockquote"}){$noblockquote=$params{"noblockquote"};}
   if(defined $params{printroot} and $params{"printroot"} eq "0"){
	$g=$list->[0];
	foreach my $g2(@$list){
	   my $indent=0;
	   $pending = $g2->_print($output,$indent,$indentwidth,0,1,$quote,$noblockquote,$depth,$group);
	   if ($pending) { print $output  "\n"; }
	}
    }
    else{
       my $indent=0;
       $pending = $g->_print($output,$indent,$indentwidth,0,1,$quote,$noblockquote,$depth,$group);
       if ($pending) { print $output  "\n"; }
    }
}

sub printnodes{
    my ($g,%params)=@_;
    my $list=$g->{list};
    foreach(@$list){
	$_->print(%params);
    }
}

sub dump{
    my ($g,$file,%params)=@_;
    $params{"quote"}=1;
    open my $fh, ">$file" or return 0;
    my $l=$g->{"list"};
    foreach(@$l){
	$_->print(%params,"filehandle"=>$fh);
    }
}


###############Path##############
sub splitPath{
    my $path=shift;
    my @paths;
    if(!defined $path || $path eq "" || $path eq "."){return @paths;}
    my $n=length($path);
    my $j=0;
    my $c;
    my $s="";
    while($j<$n){
	my $c=substr($path,$j,1);$j++;
	if($c eq '.' ){
	    push @paths,$s;
	    $s="";
	}
	elsif($c eq '\\'){
	    if($j==$n){$s=$s.$c;} 
	    else{
		$c=substr($path,$j,1);$j++;
		if($c eq '.'){$s=$s.$c;}
		else{$s=$s."\\$c";}
	    }
	}
	else{
	    $s=$s.$c;
	}
    }
    push @paths,$s;
    return @paths;
}
1;
__END__
# Below is stub documentation for your module. You'd better edit it!