File Coverage

blib/lib/SRS/EPP/Response/Greeting.pm
Criterion Covered Total %
statement 15 29 51.7
branch 0 10 0.0
condition 0 6 0.0
subroutine 5 6 83.3
pod n/a
total 20 51 39.2


line stmt bran cond sub pod time code
1             # vim: filetype=perl:noexpandtab:ts=3:sw=3
2             #
3             # Copyright (C) 2009 NZ Registry Services
4             #
5             # This program is free software: you can redistribute it and/or modify
6             # it under the terms of the Artistic License 2.0 or later. You should
7             # have received a copy of the Artistic License the file COPYING.txt.
8             # If not, see <http://www.perlfoundation.org/artistic_license_2_0>
9              
10 2     2   3823 use strict;
  2         4  
  2         75  
11 2     2   12 use warnings;
  2         4  
  2         114  
12              
13             package SRS::EPP::Response::Greeting;
14             {
15             $SRS::EPP::Response::Greeting::VERSION = '0.22';
16             }
17 2     2   947 use Moose;
  2         533197  
  2         20  
18             extends 'SRS::EPP::Response';
19              
20 2     2   18622 use MooseX::TimestampTZ qw(gmtimestamptz);
  2         101023  
  2         24  
21              
22             has "+message" =>
23             lazy => 1,
24             default => \&make_greeting,
25             ;
26              
27             has "+code" =>
28             required => 0,
29             ;
30              
31             sub make_greeting {
32 0     0     my $self = shift;
33 0           my $proxy = eval { SRS::EPP::Proxy->new };
  0            
34              
35             # create the "Data Collection Policy"
36 0           my $dcp = eval { $proxy->dcp };
  0            
37 0 0         my $access = $dcp ? $dcp->access : undef;
38 0   0       $access ||= "personalAndOther";
39 0 0         my $statements = $dcp ? $dcp->statements : undef;
40 0   0       $statements ||= [];
41 0 0         if ( !@$statements) {
42              
43             # must have something...
44 0           push @$statements, {
45             purpose => [qw(admin prov)],
46             recipient => [qw(ours)],
47              
48             retention => "business",
49             };
50             }
51 0 0         my $expiry = $dcp ? $dcp->expiry : undef;
52              
53             # let coerce rules do the magic here...
54 0 0         my $DCP = XML::EPP::DCP->new(
55             access => $access,
56             statement => $statements,
57             ( defined $expiry ? (expiry => $expiry) : () ),
58             );
59              
60             return XML::EPP->new(
61             message => XML::EPP::Greeting->new(
62 0   0       server_name => eval { $proxy->server_name }
63             || "localhost",
64             server_time => gmtimestamptz,
65             services => "auto",
66             dcp => $DCP,
67             ),
68             );
69             }
70              
71 2     2   2607 no Moose;
  2         6  
  2         30  
72             __PACKAGE__->meta->make_immutable;
73              
74             1;
75              
76             __END__
77              
78             =head1 NAME
79              
80             SRS::EPP::Message::Greeting - EPP XML Greeting message
81              
82             =head1 SYNOPSIS
83              
84             return SRS::EPP::Message::Greeting->new;
85              
86             =head1 DESCRIPTION
87              
88             This module handles generating the EPP XML greeting
89              
90             =head1 SEE ALSO
91              
92             L<SRS::EPP::Message>
93              
94             =cut
95              
96             # Local Variables:
97             # mode:cperl
98             # indent-tabs-mode: t
99             # cperl-continued-statement-offset: 8
100             # cperl-brace-offset: 0
101             # cperl-close-paren-offset: 0
102             # cperl-continued-brace-offset: 0
103             # cperl-continued-statement-offset: 8
104             # cperl-extra-newline-before-brace: nil
105             # cperl-indent-level: 8
106             # cperl-indent-parens-as-block: t
107             # cperl-indent-wrt-brace: nil
108             # cperl-label-offset: -8
109             # cperl-merge-trailing-else: t
110             # End: