package ReDIF::Record;

##  Copyright (c) 1997-2001,2003 Ivan Kurmanov. All rights reserved.
##
##  This code is free software; you can redistribute it and/or modify it
##  under the same terms as Perl itself.

$VERSION = "0.1";

=head1 NAME 

ReDIF::Record  -- a future class to store ReDIF templates 

=head1 SYNOPSIS

    use ReDIF::Record;

ReDIF::Parser may return the ReDIF::Record objects if "ReDIF::Record" option
is on:

    $record = ReDIF::Parser::get_next_template();

    my @titles = $record -> get_value( "title" );  ## all the titles
    my $title  = $record -> get_value( "title" );  ## just the first one


XPath-like basic syntax:

    my @n = $record -> get_value( "author/name" );
    my @e = $record -> get_value( "author/email" );

Same in scalar context, will get just the first matches:

    my $n = $record -> get_value( "author/name" );
    my $e = $record -> get_value( "author/email" );


Record construction:

    my $record = ReDIF::Record -> new( "RePEc:wip:abrhce:08", 'ReDIF-Person 1.0' );

    $record -> add_property( "title",  "The Paper" );

    $record -> set_scalar_property( "SPECIAL", { data=>"structure" }  );


=head2 DESCRIPTION

An interface to the ReDIF template data structure. 

=cut
    
    
use strict;

use Carp::Assert;

sub new {
    my $class = shift;

    my $id   = lc shift;
    my $type = shift;

    my $obj = { 
       TYPE => $type, 
       ID => $id, 
    };
    
    bless $obj, $class;
}


sub id { 
   my $self = shift;
   return lc $self->{ID};
}

sub type {
   my $self = shift;
   return $self->{TYPE};
}


sub add_property {
    my $self     = shift;
    my $property = shift;
    my @values   = @_;

#    $self = $self->{_CURRENT_};
    
    if( defined $self->{$property} ) {
        my $array = $self->{$property};
        push @$array, @values;
        return scalar @$array;

    } else {
        $self->{$property} = [ @values ];
        return 1;
    }
}



sub set_scalar_property {
    my $self = shift;
    my $property = shift;
    my $value = shift;

#    $self = $self->{_CURRENT_};
    
    $self->{$property} = $value;
    return 1;
}



sub get_value {
  my $self = shift;
  my @path = @_;


  my @values;

  my $template = $self ;
  
  for ( @path ) {
    my @path_sections;
    if ( @path_sections = split /\// ) {

      # We have a template tree.  It has several levels.  If we look
      # at it from the point of view of roots, first level will be
      # where we have handle and template-type attributes.
      #
      # First we find matching branches of the first level.
      #
      # Then we cut those branches, and take a closer look at them.
      # We check if those branches have next-level branches or the
      # leaves which match the specification.


      # $current will hold an arrayref to the branches we study 
      my $current = [ $self ];

      # this will step through all the attribute specification parts,
      # e.g. if attr spec is 'author/handle', this will go through ['author','handle']
      # e.g. if attr spec is 'author/workplace/handle', this will go 
      # through ['author', 'workplace', 'handle']

      foreach my $path_section ( @path_sections ) {
        my @deep = ();
          
        foreach my $array_item ( @$current ) {
          assert( $array_item );
# disable for speed
#         assert( UNIVERSAL::isa($array_item, "HASH"),
#  "path_section: $path_section  current: $self  array_item: $array_item " .
#  "  deep: ". join( ', ', @deep ) . " ref array_item: " . ref $array_item 
#               );
          my $cur_array = $array_item -> {$path_section};

          if( defined $cur_array ) {
            if( ref $cur_array eq 'ARRAY' ) {
              push @deep, @$cur_array;
            } else {
              push @deep, $cur_array;
            }
          }   
        }
        $current = [ @deep ];
      }
      push @values, @$current;
      
    } else  {
      if ( $self -> {$_} ) {
        my $val = $self->{$_};
        if( ref $val ) {
          push @values, @$val;
        } else {
          push @values, $val;
        }
      }
    }
  }


  my @result;

  ###  filter out empty values
  foreach ( @values ) {
    if ( not $_ ) {
      next;
      die "empty value '$_' among (@values) in $path[0] request";
    }
    push @result, $_;
  }

  # return the found
  if ( wantarray ) {
    return @result;
  } else {
    return $result[0];
  }
}



1;


__END__

old documentation stuff, probably useless, but who knows for certain?

    $template -> open( "/author[0]" );       ###  XPath-like expr
    $template -> open( "author", 1, "name" );   ###  same, but in particles
    $template -> close( );    ###  return one level upper

    $template -> get( "/author[1]/name" );  ###  return name of the 2nd author

    $template -> open( "/author[0]" );  ###  open the 1st author
    my @personal_info = 
          $template -> get_multi( "name", "email", 
                                  "postal", "homepage", "phone", "fax" );



    $template -> open( "/" );

    my $path = $template -> get_current_path();


    ###  record creation and fill-up

    my $template = ReDIF::Record -> new( '-type', 'ReDIF-Person 1.0' );

    $template -> add_property( "title",  "The Paper" );
    $template -> add_property( "handle", "RePEc:wop:aarhec:94-01" );

    $template -> set_scalar_property( "SPECIAL", { data=>"structure" }  );

    $template -> add_root_property( "title", "The Paper" );
    $template -> set_root_scalar_property( "VERYSPECIAL", 
                                           { moredata => "morestructure" }  );


    $template -> open_structured_property( "author", "person cluster" );
    $template -> close_structured_property( );




    my $t_hash = $template -> as_hash();


    ###  record reading  (not implemented yet)

    my $values = $template -> get_property( "title" );
    my @values = $template -> get_property_values( "title" );
    my $the_title = $template -> get_property_value( "title", 0 );



    $template -> open( "/author[0]" );       ###  XPath-like expr
    $template -> open( "author", 1, "name" );   ###  same, but in particles
    $template -> close( );    ###  return one level upper

    $template -> get( "/author[1]/name" );  ###  return name of the 2nd author

    $template -> open( "/author[0]" );  ###  open the 1st author
    my @personal_info = 
          $template -> get_multi( "name", "email", 
                                  "postal", "homepage", "phone", "fax" );



    $template -> open( "/" );

    my $path = $template -> get_current_path();


sub open_structured_property {
    my $self = shift;
    my $property = shift;
    my $type = shift;

    my $value = {};
    
    my $str = $self->{_CURRENT_};
    
    if( defined $str->{$property} ) {
        my $array = $str->{$property};
        push @$array, $value;

    } else {
        $str->{$property} = [ $value ];
    }
    
    my $stack = $self->{_OPENED_STRUCTURED_};
    if( not defined $stack ) {
        $stack = $self->{_OPENED_STRUCTURED_} = [];
    }
    
    push @$stack, $self->{_CURRENT_};
    $self->{_CURRENT_} = $value;

}

sub close_structured_property {
    my $self = shift;

    my $stack = $self->{_OPENED_STRUCTURED_};
    if( not defined $stack or not ( ref( $stack ) eq 'ARRAY' ) ) {
        return undef;
    }
    
    $self->{_CURRENT_} = pop @$stack;
    return 1;

}


sub as_hash { 
    my $self = shift;

    return $self;
}

