package GO::Object::BiblioEntry; =head1 NAME GO::Object::BiblioEntry - represents a GO biblio entry =cut use strict; use Data::Dumper; use Exporter; use lib '/Users/gwg/go/scratch/tools'; use GO::Object::Xref; use GO::Object::URL; #use GO::MiniTests qw/:std/; use vars qw(@ISA); use base qw(GO::Object::Generic); #GO::MiniTests); use GO::TestSet qw(dfv_test); sub _specification { my $self = shift; my $list_values = { url_type => [ 'full_text', 'full_text_pdf', 'abstract' ], }; return ( # required "id", { test => dfv_test('is_a_string_p', { this => 1 }), required => 1, }, "title", { test => dfv_test('is_a_string_p', { this => 1 }), required => 1, }, "author", { test => dfv_test('is_a_string_p', { this => 1 }), required => 1, }, "author_etAl", { test => dfv_test('is_true_p', { this => 1 }), }, "year", { test => qr/^\d{4}$/, required => 1, }, "journal", { test => dfv_test('is_a_string_p', { this => 1 }), required => 1, }, "volume_issue_page", { test => dfv_test('is_a_string_p', { this => 1 }), }, "is_epub", { test => dfv_test('is_true_p', { this => 1 }), }, "xref", { type => 'GO::Object::Xref', allow_multiple => 1, test => dfv_test('is_a_subclass_of_p', { class => 'GO::Object::Xref', this => 1 }), }, "url", { type => 'GO::Object::URL', allow_multiple => 1, test => dfv_test('is_a_subclass_of_p', { class => 'GO::Object::URL', this => 1 }), }, "category", { allow_multiple => 1, test => qr/^\d+$/, # [{ constraint => \&GO::TestSet->is_a_number_p, # params => [ undef, 'category' ], # }], }, "comment", { test => dfv_test('is_a_string_p', { this => 1 }), }, # "is_obsolete", { ## test => dfv_test('is_true_p', { this => 1 }), # }, ); } sub transform_parsed_data { my $self = shift; my $arg_h = shift; my $data_h = $arg_h->{data}; my $spec_h; ## do any transformations here if ($data_h->{url}) { if (!$spec_h->{url_spec}) { $spec_h->{url_spec} = GO::Object::URL->get_spec(); $spec_h->{url_dfv_profile} = GO::Object::URL->dfv_profile(); } my $temp; foreach (@{$data_h->{url}}) { my ($url, $url_type) = split(" ", $_, 2); $url_type =~ s/^\[(.+)\]$/$1/; my $results = GO::Object::URL->new({ data => { href => $url , link_type => $url_type }, object_spec => $spec_h->{url_spec}, dfv_profile => $spec_h->{url_dfv_profile}, check_input => $arg_h->{check_input} || undef, return_as => 'success_hash', }); push @$temp, $results->{OBJECT} if $results->{SUCCESS}; if ($results->{ERROR_LIST}) { $self->add_message($results->{ERROR_LIST}); } } delete $data_h->{url}; $data_h->{url} = $temp if $temp && @$temp; } if ($data_h->{xref}) { if (!$spec_h->{xref_spec}) { $spec_h->{xref_spec} = GO::Object::Xref->get_spec(); $spec_h->{xref_dfv_profile} = GO::Object::Xref->dfv_profile(); } my $temp; foreach (@{$data_h->{xref}}) { # create xref objects my $results = GO::Object::Xref->new({ data => { xref => $_, }, object_spec => $spec_h->{xref_spec}, dfv_profile => $spec_h->{xref_dfv_profile}, check_input => $arg_h->{check_input} || undef, return_as => 'success_hash', }); push @$temp, $results->{OBJECT} if $results->{SUCCESS}; if ($results->{ERROR_LIST}) { $self->add_message($results->{ERROR_LIST}); # $self->error_list({ OBJ => $results->{OBJECT}, ERRORS => $results->{ERROR_LIST} }); } } delete $data_h->{xref}; $data_h->{xref} = $temp if $temp && @$temp; } return $data_h; } sub full_xref_list { my $self = shift; return unless $self->xref; my @xrefs = map { $_->xref } @{$self->xref}; return [@xrefs]; } =head2 create_error_message Create an error message from a D::FV::R object input: $self, $arg_h->{results}, # D::FV::R results $arg_h->{input}, # input hash (optional) output: an error message =cut sub create_error_message { my $self = shift; my $arg_h = shift; return if ! defined $arg_h->{results}; my $msg_arr = GO::Utilities::summarize_errors($arg_h->{results}); my $biblio_entry; if ($arg_h->{input}) { foreach my $attrib qw (title author year) { if ($arg_h->{input}{$attrib}) { $biblio_entry .= $attrib . ": " . $arg_h->{input}{$attrib}[0] . "; "; } } unshift @$msg_arr, $biblio_entry if $biblio_entry; } return join "
", @$msg_arr; } sub add_url { my $self = shift; my $arg_h = shift; if (! ref $arg_h) { # we have a string as the argument $arg_h = { data => { href => $arg_h } }; } my $results = GO::Object::URL->new({ %$arg_h, return_as => 'success_hash', }); if ($results->{SUCCESS}) { # hurrah! if (!$arg_h->{add_as}) { $arg_h->{add_as} = 'url'; } push @{$self->{ $arg_h->{add_as} }}, $results->{OBJECT}; } if ($results->{ERROR_LIST}) { $self->add_message($results->{ERROR_LIST}); } } sub add_xref { my $self = shift; my $arg_h = shift; if (! ref $arg_h) { # we have a string as the argument $arg_h = { data => { xref => $arg_h } }; } my $results = GO::Object::Xref->new({ %$arg_h, return_as => 'success_hash', }); if ($results->{SUCCESS}) { # hurrah! if (!$arg_h->{add_as}) { $arg_h->{add_as} = 'xref'; } push @{$self->{ $arg_h->{add_as} }}, $results->{OBJECT}; } if ($results->{ERROR_LIST}) { $self->add_message($results->{ERROR_LIST}); } } 1;