File Coverage

blib/lib/Chemistry/File/OPTIMADE.pm
Criterion Covered Total %
statement 58 67 86.5
branch 8 18 44.4
condition 9 26 34.6
subroutine 12 12 100.0
pod 1 1 100.0
total 88 124 70.9


line stmt bran cond sub pod time code
1             package Chemistry::File::OPTIMADE;
2              
3             our $VERSION = '0.11'; # VERSION
4             # $Id$
5              
6 1     1   498 use strict;
  1         3  
  1         28  
7 1     1   8 use warnings;
  1         2  
  1         29  
8              
9 1     1   4 use base 'Chemistry::File';
  1         5  
  1         654  
10              
11 1     1   17726 use Chemistry::Mol;
  1         35613  
  1         55  
12 1     1   677 use JSON;
  1         10408  
  1         6  
13 1     1   138 use List::Util qw( any );
  1         2  
  1         58  
14 1     1   411 use URL::Encode qw( url_params_multi );
  1         4709  
  1         721  
15              
16             my @mandatory_fields = qw( cartesian_site_positions species species_at_sites );
17              
18             =head1 NAME
19              
20             Chemistry::File::OPTIMADE - OPTIMADE reader
21              
22             =head1 SYNOPSIS
23              
24             use Chemistry::File::OPTIMADE;
25              
26             # read a molecule
27             my $file = Chemistry::File::OPTIMADE->new( file => 'myfile.json' );
28             my $mol = $file->read();
29              
30             =cut
31              
32             # Format is not registered, as OPTIMADE does not have proper file extension.
33             # .json is an option, but not sure if it will not clash with anything else.
34              
35             =head1 DESCRIPTION
36              
37             OPTIMADE structure representation reader.
38              
39             =cut
40              
41             sub parse_string {
42 1     1 1 92 my ($self, $s, %opts) = @_;
43              
44 1   50     11 my $mol_class = $opts{mol_class} || 'Chemistry::Mol';
45 1   33     11 my $atom_class = $opts{atom_class} || $mol_class->atom_class;
46 1   33     13 my $bond_class = $opts{bond_class} || $mol_class->bond_class;
47              
48 1         22 my $json = decode_json $s;
49              
50 1 50 33     8 if( $json->{meta} &&
      33        
51             $json->{meta}{api_version} &&
52             $json->{meta}{api_version} =~ /^[^01]\./ ) {
53             warn 'OPTIMADE API version ' . $json->{meta}{api_version} .
54 0         0 ' encountered, this module supports versions 0 and 1, ' .
55             'later versions may not work as expected' . "\n";
56             }
57              
58 1         2 my $required_fields_selected;
59 1 50 33     11 if( $json->{meta} &&
      33        
60             $json->{meta}{query} &&
61             $json->{meta}{query}{representation} ) {
62 1 50       7 if( $json->{meta}{query}{representation} =~ /\?/ ) {
63 1         8 my( $query ) = reverse split /\?/, $json->{meta}{query}{representation};
64 1         6 $query = url_params_multi $query;
65 1 50       86 if( $query->{response_fields} ) {
66 1         5 my @response_fields = split ',', $query->{response_fields}[0];
67             $required_fields_selected =
68 1     1   7 (any { $_ eq 'cartesian_site_positions' } @response_fields) &&
69 3     3   11 (any { $_ eq 'species' } @response_fields) &&
70 1   33 2   10 (any { $_ eq 'species_at_sites' } @response_fields);
  2         8  
71             } else {
72 0         0 $required_fields_selected = ''; # false
73             }
74             } else {
75 0         0 $required_fields_selected = ''; # false
76             }
77             }
78              
79 1 50       6 return () unless $json->{data};
80              
81 1         2 my @molecule_descriptions;
82 1 50 33     8 if( ref $json->{data} eq 'HASH' && $json->{data}{attributes} ) {
    0          
83 1         4 @molecule_descriptions = ( $json->{data} );
84             } elsif( ref $json->{data} eq 'ARRAY' ) {
85 0         0 @molecule_descriptions = @{$json->{data}};
  0         0  
86             } else {
87 0         0 return ();
88             }
89              
90 1         3 my @molecules;
91 1         12 for my $description (@molecule_descriptions) {
92 1         7 my $mol = $mol_class->new( name => $description->{id} );
93 1         96 my $attributes = $description->{attributes};
94              
95             # TODO: Warn about disorder
96              
97 1 50   3   6 if( any { !exists $attributes->{$_} } @mandatory_fields ) {
  3         8  
98             warn 'one or more of the mandatory fields (' .
99 0         0 join( ', ', map { "'$_'" } @mandatory_fields ) .
100             'not found in input for molecule \'' .
101 0         0 $description->{id} . '\', skipping' . "\n";
102             }
103              
104 1         3 my %species = map { $_->{name} => $_ } @{$attributes->{species}};
  1         5  
  1         5  
105 1         2 for my $site (0..$#{$attributes->{cartesian_site_positions}}) {
  1         7  
106 1         2 my $species = $species{$attributes->{species_at_sites}[$site]};
107              
108             # FIXME: For now we are taking the first chemical symol.
109             # PerlMol is not capable to represent mixture sites.
110             my $atom = $mol->new_atom( coords => $attributes->{cartesian_site_positions}[$site],
111 1         7 symbol => $species->{chemical_symbols}[0] );
112 1 50       194 if( exists $species->{mass} ) {
113 0         0 $atom->mass( $species->{mass}[0] );
114             }
115             }
116 1         4 push @molecules, $mol;
117             }
118 1         8 return @molecules;
119             }
120              
121             1;
122              
123             =head1 SOURCE CODE REPOSITORY
124              
125             L
126              
127             =head1 SEE ALSO
128              
129             L, L
130              
131             The OPTIMADE Home Page at https://www.optimade.org
132              
133             =head1 AUTHOR
134              
135             Andrius Merkys
136              
137             =head1 COPYRIGHT
138              
139             Copyright (c) 2022 Andrius Merkys. All rights reserved. This program is
140             free software; you can redistribute it and/or modify it under the same terms as
141             Perl itself.
142              
143             =cut