File Coverage

blib/lib/GraphQL/Role/FieldDeprecation.pm
Criterion Covered Total %
statement 55 55 100.0
branch 20 28 71.4
condition 4 6 66.6
subroutine 10 10 100.0
pod n/a
total 89 99 89.9


line stmt bran cond sub pod time code
1             package GraphQL::Role::FieldDeprecation;
2              
3 18     18   10368 use 5.014;
  18         65  
4 18     18   98 use strict;
  18         40  
  18         429  
5 18     18   121 use warnings;
  18         36  
  18         551  
6 18     18   125 use Moo::Role;
  18         52  
  18         157  
7 18     18   7486 use GraphQL::MaybeTypeCheck;
  18         42  
  18         167  
8 18     18   99 use Types::Standard -all;
  18         40  
  18         136  
9 18     18   787063 use JSON::MaybeXS;
  18         52  
  18         5655  
10              
11             our $VERSION = '0.02';
12             my $JSON_noutf8 = JSON::MaybeXS->new->utf8(0)->allow_nonref;
13              
14             =head1 NAME
15              
16             GraphQL::Role::FieldDeprecation - object role implementing deprecation of fields
17              
18             =head1 SYNOPSIS
19              
20             with qw(GraphQL::Role::FieldDeprecation);
21              
22             # or runtime
23             Role::Tiny->apply_roles_to_object($foo, qw(GraphQL::Role::FieldDeprecation));
24              
25             =head1 DESCRIPTION
26              
27             Implements deprecation of fields.
28              
29             =cut
30              
31             has _fields_deprecation_applied => (is => 'rw');
32             sub _fields_deprecation_apply {
33 2835     2835   5908 my ($self, $key) = @_;
34 2835 100       9082 return if $self->_fields_deprecation_applied;
35 321         856 $self->_fields_deprecation_applied(1);
36 321         535 my $v = $self->{$key} = { %{$self->{$key}} }; # copy on write
  321         1620  
37 321         1316 for my $name (keys %$v) {
38 1181 100       2711 if (defined $v->{$name}{deprecation_reason}) {
39 12         25 $v->{$name} = { %{$v->{$name}}, is_deprecated => 1 }; # copy on write
  12         57  
40             }
41             }
42             };
43              
44             method _from_ast_field_deprecate(
45             Str $key,
46             HashRef $values,
47 128 50   128   440 ) {
  128 50       292  
  128 50       228  
  128 50       283  
  128         294  
  128         1241  
  128         829  
48 128         190 my $value = +{ %{$values->{$key}} };
  128         517  
49 128         300 my $directives = delete $value->{directives}; # ok as copy
50 128 100 66     671 return $values unless $directives and @$directives;
51 9         44 my ($deprecated) = grep $_->{name} eq 'deprecated', @$directives;
52 9 100       42 return $values unless $deprecated;
53             my $reason = $deprecated->{arguments}{reason}
54 4   66     134 // $GraphQL::Directive::DEPRECATED->args->{reason}{default_value};
55             +{
56 4         672 %$values,
57             $key => { %$value, deprecation_reason => $reason },
58             };
59             }
60              
61             method _to_doc_field_deprecate(
62             Str $line,
63             HashRef $value,
64 99 50   99   268 ) {
  99 50       246  
  99 50       181  
  99 50       216  
  99         251  
  99         1177  
  99         737  
65 99 100       545 return $line if !$value->{is_deprecated};
66 4         13 $line .= ' @deprecated';
67             $line .= '(reason: ' . $JSON_noutf8->encode($value->{deprecation_reason}) . ')'
68             if $value->{deprecation_reason} ne
69 4 100       91 $GraphQL::Directive::DEPRECATED->args->{reason}{default_value};
70 4         193 $line;
71             }
72              
73             __PACKAGE__->meta->make_immutable();
74              
75             1;