File Coverage

blib/lib/Net/DRI/Data/Raw.pm
Criterion Covered Total %
statement 30 54 55.5
branch 4 20 20.0
condition 1 2 50.0
subroutine 9 13 69.2
pod 1 8 12.5
total 45 97 46.3


line stmt bran cond sub pod time code
1             ## Domain Registry Interface, Encapsulating raw data
2             ##
3             ## Copyright (c) 2005-2010,2013 Patrick Mevzek . All rights reserved.
4             ##
5             ## This file is part of Net::DRI
6             ##
7             ## Net::DRI is free software; you can redistribute it and/or modify
8             ## it under the terms of the GNU General Public License as published by
9             ## the Free Software Foundation; either version 2 of the License, or
10             ## (at your option) any later version.
11             ##
12             ## See the LICENSE file that comes with this distribution for more details.
13             #########################################################################################
14              
15             package Net::DRI::Data::Raw;
16              
17 74     74   38805 use strict;
  74         85  
  74         1745  
18 74     74   225 use warnings;
  74         79  
  74         1388  
19              
20 74     74   38471 use Data::Dumper ();
  74         428122  
  74         1535  
21 74     74   355 use Net::DRI::Exception;
  74         84  
  74         1439  
22              
23 74     74   223 use base qw(Class::Accessor::Fast);
  74         79  
  74         34608  
24             __PACKAGE__->mk_ro_accessors(qw(type data hint));
25              
26             =pod
27              
28             =head1 NAME
29              
30             Net::DRI::Data::Raw - Encapsulating raw data for Net::DRI
31              
32             =head1 DESCRIPTION
33              
34             Please see the README file for details.
35              
36             =head1 SUPPORT
37              
38             For now, support questions should be sent to:
39              
40             Enetdri@dotandco.comE
41              
42             Please also see the SUPPORT file in the distribution.
43              
44             =head1 SEE ALSO
45              
46             Ehttp://www.dotandco.com/services/software/Net-DRI/E
47              
48             =head1 AUTHOR
49              
50             Patrick Mevzek, Enetdri@dotandco.comE
51              
52             =head1 COPYRIGHT
53              
54             Copyright (c) 2005-2010,2013 Patrick Mevzek .
55             All rights reserved.
56              
57             This program is free software; you can redistribute it and/or modify
58             it under the terms of the GNU General Public License as published by
59             the Free Software Foundation; either version 2 of the License, or
60             (at your option) any later version.
61              
62             See the LICENSE file that comes with this distribution for more details.
63              
64             =cut
65              
66             ####################################################################################################
67              
68             sub new
69             {
70 12     12 1 16 my ($class,$type,$data,$hint)=@_;
71              
72             ## type=1, data=ref to array
73             ## type=2, data=string
74             ## type=3, data=ref to string NOTIMPL
75             ## type=4, data=path to local file NOTIMPL
76             ## type=5, data=object with a as_string method
77             ## type=6, data=complex object in a ref array
78              
79 12   50     58 my $self={type => $type,
80             data => $data,
81             hint => $hint || '',
82             };
83              
84 12         18 bless($self,$class);
85 12         21 return $self;
86             }
87              
88              
89             sub new_from_array
90             {
91 0     0 0 0 my ($class,@args)=@_;
92 0 0       0 my @a=map { my $f=$_; $f=~s/[\r\n\s]+$//; $f; } (ref $args[0] ? @{$args[0]} : @args);
  0         0  
  0         0  
  0         0  
  0         0  
93 0         0 return $class->new(1,\@a);
94             }
95              
96 12     12 0 55 sub new_from_string { return shift->new(2,@_); } ## no critic (Subroutines::RequireArgUnpacking)
97 0     0 0 0 sub new_from_xmlstring { return shift->new(2,$_[0],'xml'); } ## no critic (Subroutines::RequireArgUnpacking)
98 0     0 0 0 sub new_from_object { return shift->new(5,@_); } ## no critic (Subroutines::RequireArgUnpacking)
99              
100             ####################################################################################################
101              
102             sub as_string
103             {
104 10     10 0 11 my $self=shift;
105 10         22 my $data=$self->data();
106              
107 10 50       38 if ($self->type()==1)
108             {
109 0         0 return join("\n",@$data)."\n";
110             }
111 10 50       38 if ($self->type()==2)
112             {
113 10         57 $data=~s/\r\n/\n/g;
114 10         58 return $data;
115             }
116 0 0       0 if ($self->type()==5)
117             {
118 0 0       0 Net::DRI::Exception::method_not_implemented('as_string',ref $data) unless $data->can('as_string');
119 0         0 return $data->as_string();
120             }
121 0 0       0 if ($self->type()==6)
122             {
123 0         0 return Data::Dumper->new($data)->Indent(2)->Varname('')->Quotekeys(0)->Sortkeys(1)->Dump();
124             }
125             }
126              
127             sub last_line
128             {
129 0     0 0 0 my $self=shift;
130              
131 0 0       0 if ($self->type()==1)
132             {
133 0         0 my $data=$self->data();
134 0         0 return $data->[-1]; ## see above
135             }
136 0 0       0 if ($self->type()==2)
137             {
138 0         0 my @a=$self->as_array();
139 0         0 return $a[-1];
140             }
141             }
142              
143             sub as_array
144             {
145 12     12 0 9 my $self=shift;
146              
147 12 50       27 if ($self->type()==1)
148             {
149 0         0 return @{$self->data()};
  0         0  
150             }
151              
152 12 50       59 if ($self->type()==2)
153             {
154 12         51 return split(/\r?\n/,$self->data());
155             }
156             }
157              
158             ####################################################################################################
159             1;