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   10013 use 5.014;
  18         65  
4 18     18   106 use strict;
  18         37  
  18         436  
5 18     18   138 use warnings;
  18         48  
  18         570  
6 18     18   98 use Moo::Role;
  18         47  
  18         138  
7 18     18   7767 use GraphQL::MaybeTypeCheck;
  18         73  
  18         146  
8 18     18   130 use Types::Standard -all;
  18         45  
  18         184  
9 18     18   854836 use JSON::MaybeXS;
  18         55  
  18         5198  
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   6550 my ($self, $key) = @_;
34 2835 100       9263 return if $self->_fields_deprecation_applied;
35 321         843 $self->_fields_deprecation_applied(1);
36 321         560 my $v = $self->{$key} = { %{$self->{$key}} }; # copy on write
  321         1673  
37 321         1455 for my $name (keys %$v) {
38 1181 100       2903 if (defined $v->{$name}{deprecation_reason}) {
39 12         34 $v->{$name} = { %{$v->{$name}}, is_deprecated => 1 }; # copy on write
  12         60  
40             }
41             }
42             };
43              
44             method _from_ast_field_deprecate(
45             Str $key,
46             HashRef $values,
47 128 50   128   315 ) {
  128 50       247  
  128 50       213  
  128 50       232  
  128         255  
  128         1220  
  128         808  
48 128         177 my $value = +{ %{$values->{$key}} };
  128         409  
49 128         265 my $directives = delete $value->{directives}; # ok as copy
50 128 100 66     591 return $values unless $directives and @$directives;
51 9         39 my ($deprecated) = grep $_->{name} eq 'deprecated', @$directives;
52 9 100       35 return $values unless $deprecated;
53             my $reason = $deprecated->{arguments}{reason}
54 4   66     66 // $GraphQL::Directive::DEPRECATED->args->{reason}{default_value};
55             +{
56 4         492 %$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   239 ) {
  99 50       202  
  99 50       153  
  99 50       183  
  99         224  
  99         1087  
  99         696  
65 99 100       480 return $line if !$value->{is_deprecated};
66 4         10 $line .= ' @deprecated';
67             $line .= '(reason: ' . $JSON_noutf8->encode($value->{deprecation_reason}) . ')'
68             if $value->{deprecation_reason} ne
69 4 100       81 $GraphQL::Directive::DEPRECATED->args->{reason}{default_value};
70 4         145 $line;
71             }
72              
73             __PACKAGE__->meta->make_immutable();
74              
75             1;