Newer
Older
Digital_Repository / OARiNZ / DIY / deb_package / eprints-3.0 / perl_lib / EPrints / MetaField / Compound.pm
######################################################################
#
# EPrints::MetaField::Compound;
#
######################################################################
#
#  This file is part of GNU EPrints 2.
#  
#  Copyright (c) 2000-2004 University of Southampton, UK. SO17 1BJ.
#  
#  EPrints 2 is free software; you can redistribute it and/or modify
#  it under the terms of the GNU General Public License as published by
#  the Free Software Foundation; either version 2 of the License, or
#  (at your option) any later version.
#  
#  EPrints 2 is distributed in the hope that it will be useful,
#  but WITHOUT ANY WARRANTY; without even the implied warranty of
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#  GNU General Public License for more details.
#  
#  You should have received a copy of the GNU General Public License
#  along with EPrints 2; if not, write to the Free Software
#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
######################################################################

=pod

=head1 NAME

B<EPrints::MetaField::Compound> - Magic type of field which actually 
combines several other fields into a data structure.

=head1 DESCRIPTION

not done

=over 4

=cut

package EPrints::MetaField::Compound;

use strict;
use warnings;

BEGIN
{
	our( @ISA );
	
	@ISA = qw( EPrints::MetaField );
}

use EPrints::MetaField::Text;


sub render_value
{
	my( $self, $session, $value, $alllangs, $nolink, $object ) = @_;

	if( defined $self->{render_value} )
	{
		return $self->call_property( "render_value",
			$session, 
			$self, 
			$value, 
			$alllangs, 
			$nolink );
	}

	my $table = $session->make_element( "table", border=>1, cellspacing=>0, cellpadding=>2 );
	my $tr = $session->make_element( "tr" );
	$table->appendChild( $tr );
	my $f = $self->get_property( "fields_cache" );
	foreach my $field_conf ( @{$f} )
	{
		my $fieldname = $field_conf->{name};
		my $field = $self->{dataset}->get_field( $fieldname );
		my $th = $session->make_element( "th" );
		$tr->appendChild( $th );
		$th->appendChild( $field->render_name( $session ) );
	}

	foreach my $row ( @{$value} )
	{
		$table->appendChild( $self->render_single_value_row( $session, $row, $object ) );
	}
	return $table;
}

sub render_single_value_row
{
	my( $self, $session, $value, $object ) = @_;

	my $f = $self->get_property( "fields_cache" );

	if( !defined $object ) { EPrints::abort( "Object not defined in Metafield Compound render_single_value_row!" ); }

	my %fieldname_to_alias = $self->get_fieldname_to_alias;
	my $tr = $session->make_element( "tr" );
	foreach my $field_conf ( @{$f} )
	{
		my $name = $field_conf->{name};
		my $td = $session->make_element( "td" );
		$tr->appendChild( $td );
		my $field = $object->get_dataset->get_field( $name );
		$td->appendChild( 
			$field->render_single_value( 
				$session, 
				$value->{$fieldname_to_alias{$name}}, 
				$object ) );
	}

	return $tr;
}

sub render_single_value
{
	my( $self, $session, $value, $object ) = @_;

	my $table = $session->make_element( "table", border=>1 );
	$table->appendChild( $self->render_single_value_row( $session, $value, $object ) );
	return $table;
}

sub to_xml_basic
{
	my( $self, $session, $value, $dataset ) = @_;

	my $r = $session->make_doc_fragment;
	if( !EPrints::Utils::is_set( $value )  )
	{
		return $r;
	}
	my $f = $self->get_property( "fields_cache" );
	my %fieldname_to_alias = $self->get_fieldname_to_alias;
	foreach my $field_conf ( @{$f} )
	{
		my $name = $field_conf->{name};
		my $field = $dataset->get_field( $name );
		my $alias = $fieldname_to_alias{$name};
		my $v = $value->{$alias};
		my $tag = $session->make_element( $alias );
		$tag->appendChild( $field->to_xml_basic( $session, $v, $dataset ) );
		$r->appendChild( $tag );
	}
	return $r;
}

# This type of field is virtual.
sub is_virtual
{
	my( $self ) = @_;

	return 1;
}

sub get_sql_type
{
	my( $self, $notnull ) = @_;

	return undef;
}

sub get_alias_to_fieldname
{
	my( $self ) = @_;

	my %addr = ();

	my $f = $self->get_property( "fields_cache" );
	foreach my $sub_field ( @{$f} )
	{
		$addr{$sub_field->{sub_name}} = $sub_field->{name};
	}

	return %addr;
}

sub get_fieldname_to_alias
{
	my( $self ) = @_;

	my %addr = $self->get_alias_to_fieldname;
	my %raddr = ();
	foreach( keys %addr )
	{
		$raddr{$addr{$_}} = $_;
	}
	return %raddr;
}

# Get the value of this field from the object. In this case this
# is quite complicated.
sub get_value
{
	my( $self, $object ) = @_;

	my $values = {};
	my %alias_to_fieldname = $self->get_alias_to_fieldname;
	foreach my $as ( keys %alias_to_fieldname )
	{
		$values->{$as} = $object->get_value_raw( $alias_to_fieldname{$as} );
	}

	if( !$self->get_property( "multiple" ) )
	{
		return $values;
	}

	my $lists = {};
	my $len = 0;
	foreach my $as ( keys %alias_to_fieldname )
	{
		$lists->{$as} = [];
		next unless defined $values->{$as};
		if( scalar @{$values->{$as}} > $len )
		{
			$len = scalar @{$values->{$as}};
		}
	}

	my $list = [];
	for( my $i=0; $i<$len; ++$i )
	{
		my $v = {};
		foreach my $as ( keys %alias_to_fieldname )
		{
			next if( !defined $values->{$as} );
			next if( !defined $values->{$as}->[$i] );
			$v->{$as} = $values->{$as}->[$i];
		}
		push @{$list}, $v;
	}

	return $list;
}


sub set_value
{
	my( $self, $object, $value ) = @_;

	my %alias_to_fieldname = $self->get_alias_to_fieldname;
	my %fieldname_to_alias = $self->get_fieldname_to_alias;
	my $f = $self->get_property( "fields_cache" );
	my $values = {};
	foreach my $as ( keys %alias_to_fieldname )
	{
		$values->{$as} = [];
	}
	foreach my $row ( @{$value} )
	{
		foreach my $as ( keys %alias_to_fieldname )
		{
			push @{$values->{$alias_to_fieldname{$as}}}, $row->{$as};
		}
	}
	foreach my $fieldname ( keys %fieldname_to_alias )
	{
		my $field = $object->get_dataset->get_field( $fieldname );
		$field->set_value( $object, $values->{$fieldname} );
	}
}

sub get_input_col_titles
{
	my( $self, $session, $staff ) = @_;

	my @r  = ();
	my $f = $self->get_property( "fields_cache" );
	foreach my $field_conf ( @{$f} )
	{
		my $fieldname = $field_conf->{name};
		my $field = $self->{dataset}->get_field( $fieldname );
		my $sub_r = $field->get_input_col_titles( $session, $staff );

		if( !defined $sub_r )
		{
			$sub_r = [ $field->render_name( $session ) ];
		}

		push @r, @{$sub_r};
	}
	
	return \@r;
}

# assumes all basic input elements are 1 high, x wide.
sub get_basic_input_elements
{
	my( $self, $session, $value, $basename, $staff, $object ) = @_;

	if( !defined $object ) { EPrints::abort( "Object not defined in Metafield Compound get_basic_input_elements!" ); }

	my $f = $self->get_property( "fields_cache" );
	my $grid_row = [];

	my %fieldname_to_alias = $self->get_fieldname_to_alias;
	foreach my $field_conf ( @{$f} )
	{
		my $fieldname = $field_conf->{name};
		my $alias = $fieldname_to_alias{$fieldname};
		my $field = $object->get_dataset->get_field( $fieldname );
		my $part_grid = $field->get_basic_input_elements( 
					$session, 
					$value->{$fieldname_to_alias{$fieldname}}, 
					$basename."_".$alias, 
					$staff, 
					$object );
		my $top_row = $part_grid->[0];
		push @{$grid_row}, @{$top_row};
	}

	return [ $grid_row ];
}

sub get_basic_input_ids
{
	my( $self, $session, $basename, $staff, $obj ) = @_;

	my @ids = ();

	my $f = $self->get_property( "fields_cache" );
	my %fieldname_to_alias = $self->get_fieldname_to_alias;
	foreach my $field_conf ( @{$f} )
	{
		my $fieldname = $field_conf->{name};
		my $alias = $fieldname_to_alias{$fieldname};
		my $field = $obj->get_dataset->get_field( $fieldname );
		push @ids, $field->get_basic_input_ids( 
					$session, 
					$basename."_".$alias, 
					$staff, 
					$obj );
	}

	return( @ids );
}


sub form_value_basic
{
	my( $self, $session, $basename, $object ) = @_;
	
	if( !defined $object ) { EPrints::abort( "Object not defined in Metafield Compound form_value_basic!" ); }

	my $value = {};

	my $f = $self->get_property( "fields_cache" );
	my %fieldname_to_alias = $self->get_fieldname_to_alias;
	foreach my $field_conf ( @{$f} )
	{
		my $fieldname = $field_conf->{name};
		my $alias = $fieldname_to_alias{$fieldname};
		my $field = $object->get_dataset->get_field( $fieldname );
		my $v = $field->form_value_basic( $session, $basename."_".$alias, $object );
		$value->{$alias} = $v;
	}

	return undef if( !EPrints::Utils::is_set( $value ) );

	return $value;
}

sub validate
{
	my( $self, $session, $value, $object ) = @_;

	my $f = $self->get_property( "fields_cache" );
	my @problems;
	foreach my $field_conf ( @{$f} )
	{
		push @problems, $object->validate_field( $field_conf->{name} );
	}
	return @problems;
}

sub is_browsable
{
	return( 0 );
}


# don't index
sub get_index_codes
{
	my( $self, $session, $value ) = @_;

	return( [], [], [] );
}

sub get_property_defaults
{
	my( $self ) = @_;
	my %defaults = $self->SUPER::get_property_defaults;
	$defaults{fields} = $EPrints::MetaField::REQUIRED;
	$defaults{fields_cache} = $EPrints::MetaField::REQUIRED;
	$defaults{show_in_fieldlist} = 0;
	$defaults{export_as_xml} = 1;
	$defaults{text_index} = 0;
	return %defaults;
}

######################################################################

######################################################################
1;