File Coverage

blib/lib/Attean/Literal.pm
Criterion Covered Total %
statement 47 47 100.0
branch 4 4 100.0
condition n/a
subroutine 17 17 100.0
pod 2 2 100.0
total 70 70 100.0


line stmt bran cond sub pod time code
1 50     50   636 use v5.14;
  50         165  
2 50     50   260 use warnings;
  50         107  
  50         2593  
3              
4             =head1 NAME
5              
6             Attean::Literal - RDF Literals
7              
8             =head1 VERSION
9              
10             This document describes Attean::Literal version 0.032
11              
12             =head1 SYNOPSIS
13              
14             use v5.14;
15             use Attean;
16             my $langterm = Attean::Literal->new(value => 'foo', language => 'en-US');
17             $langterm->ntriples_string; # "foo"@en-US
18              
19             my $typeterm = Attean::Literal->new(value => '123', datatype => 'http://www.w3.org/2001/XMLSchema#integer');
20             $langterm->ntriples_string; # "123"^^<http://www.w3.org/2001/XMLSchema#integer>
21              
22             =head1 DESCRIPTION
23              
24             The Attean::Literal class represents RDF literals.
25             It conforms to the L<Attean::API::Literal|Attean::API::Term> role.
26              
27             =head1 ATTRIBUTES
28              
29             The following attributes exist:
30              
31             =over 4
32              
33             =item C<< value >>
34              
35             =item C<< language >>
36              
37             =item C<< datatype >>
38              
39             =back
40              
41             =head1 METHODS
42              
43             =over 4
44              
45             =item C<< has_language >>
46              
47             Returns true if the literal has a language tag, false otherwise.
48              
49             =cut
50              
51             use Moo;
52 50     50   294 use Types::Standard qw(Str Maybe InstanceOf);
  50         121  
  50         311  
53 50     50   15944 use Attean::API::Term;
  50         110  
  50         375  
54 50     50   34047 use IRI;
  50         120  
  50         1225  
55 50     50   290 use Sub::Install;
  50         124  
  50         1159  
56 50     50   275 use Sub::Util qw(set_subname);
  50         96  
  50         440  
57 50     50   2473 use Scalar::Util qw(blessed);
  50         117  
  50         2457  
58 50     50   329 use namespace::clean;
  50         125  
  50         2073  
59 50     50   292
  50         98  
  50         367  
60             my $XSD_STRING = IRI->new(value => 'http://www.w3.org/2001/XMLSchema#string');
61             has 'value' => (is => 'ro', isa => Str, required => 1);
62             has 'language' => (is => 'ro', isa => Maybe[Str], predicate => 'has_language');
63             has 'datatype' => (
64             is => 'ro',
65             isa => InstanceOf['Attean::IRI'],
66             required => 1,
67             coerce => sub {
68             my $dt = shift;
69             if (blessed($dt) and $dt->isa('Attean::IRI')) {
70             return $dt;
71             } else {
72             return blessed($dt) ? Attean::IRI->new($dt->as_string) : Attean::IRI->new($dt)
73             }
74             },
75             default => sub { $XSD_STRING }
76             );
77             has 'ntriples_string' => (is => 'ro', isa => Str, lazy => 1, builder => '_ntriples_string');
78              
79             with 'Attean::API::Literal';
80              
81             around BUILDARGS => sub {
82             my $orig = shift;
83             my $class = shift;
84             return $class->$orig(@_) if (scalar(@_) == 1 and ref($_[0]) eq "HASH");
85             if (scalar(@_) == 1) {
86             my $dt = IRI->new('http://www.w3.org/2001/XMLSchema#string');
87             return $class->$orig(value => shift, datatype => $dt);
88             }
89             return $class->$orig(@_);
90             };
91            
92             around 'datatype' => sub {
93             my $orig = shift;
94             my $self = shift;
95             if ($self->has_language) {
96             return Attean::IRI->new(value => 'http://www.w3.org/1999/02/22-rdf-syntax-ns#langString');
97             } else {
98             return $self->$orig(@_);
99             }
100             };
101            
102             my $self = shift;
103             my $value = $self->value;
104 88     88   2005 $value =~ s/\\/\\\\/g;
105 88         238 $value =~ s/\n/\\n/g;
106 88         190 $value =~ s/\r/\\r/g;
107 88         160 $value =~ s/"/\\"/g;
108 88         171 if ($self->has_language) {
109 88         131 return sprintf('"%s"@%s', $value, $self->language);
110 88 100       248 } else {
111 15         906 my $dt = $self->datatype->as_string;
112             if ($dt eq 'http://www.w3.org/2001/XMLSchema#string') {
113 73         1153 return sprintf('"%s"', $value);
114 73 100       16795 } else {
115 72         1428 return sprintf('"%s"^^<%s>', $value, $dt);
116             }
117 1         20 }
118             }
119              
120             =item C<< true >>
121              
122             The xsd:true term.
123              
124             =cut
125              
126             state $v = Attean::Literal->new( value => 'true', datatype => 'http://www.w3.org/2001/XMLSchema#boolean' );
127             return $v;
128             }
129 1491     1491 1 3507
130 1491         45711 =item C<< false >>
131              
132             The xsd:false term.
133              
134             =cut
135              
136             state $v = Attean::Literal->new( value => 'false', datatype => 'http://www.w3.org/2001/XMLSchema#boolean' );
137             return $v;
138             }
139            
140 130     130 1 217 {
141 130         528 for my $method (qw(integer decimal float double)) {
142             my $code = sub {
143             my $class = shift;
144             return $class->new( value => shift, datatype => "http://www.w3.org/2001/XMLSchema#$method" );
145             };
146             Sub::Install::install_sub({
147 43     43   16748 code => set_subname("${method}", $code),
        43      
        43      
        43      
148 43         842 as => "${method}"
149             });
150             }
151             }
152              
153             }
154              
155             1;
156              
157              
158             =back
159              
160             =head1 BUGS
161              
162             Please report any bugs or feature requests to through the GitHub web interface
163             at L<https://github.com/kasei/attean/issues>.
164              
165             =head1 SEE ALSO
166              
167              
168              
169             =head1 AUTHOR
170              
171             Gregory Todd Williams C<< <gwilliams@cpan.org> >>
172              
173             =head1 COPYRIGHT
174              
175             Copyright (c) 2014--2022 Gregory Todd Williams.
176             This program is free software; you can redistribute it and/or modify it under
177             the same terms as Perl itself.
178              
179             =cut