Permalink
Browse files

Fix delete for sigle value attribute

  • Loading branch information...
1 parent 8990480 commit 35483c8997d7e565a5add8bfd0fe686ab542dcc6 @arhuman committed May 30, 2013
Showing with 60 additions and 4 deletions.
  1. +55 −3 lib/Net/Whois/Object.pm
  2. +5 −1 t/03-objects.t
@@ -726,13 +726,65 @@ Generic setter/getter for singlevalue attribute.
sub _single_attribute_setget {
my ( $self, $attribute, $value ) = @_;
+ my $mode = 'replace';
+
+ if ( ref $value eq 'HASH' ) {
+ my %options = %$value;
+
+ if ( $options{mode} ) {
+ $mode = $options{mode};
+ }
+
+ if ( $options{value} ) {
+ $value = $options{value};
+ } else {
+ croak "Unable to determine attribute $attribute value";
+ }
+
+ }
if ( defined $value ) {
- # Store attribute order for dump, unless this attribute as already been set
- push @{ $self->{order} }, $attribute unless $self->{$attribute} or $attribute eq 'class';
+ if ( $mode eq 'replace' ) {
+ # Store attribute order for dump, unless this attribute as already been set
+ push @{ $self->{order} }, $attribute unless $self->{$attribute} or $attribute eq 'class';
+
+ $self->{$attribute} = $value;
+ } elsif ( $mode eq 'delete' ) {
+ if ( ref $value ne 'HASH' or !$value->{old} ) {
+ croak " {old=>...} expected as value for $attribute update in delete mode";
+ } else {
+ my $old = $value->{old};
+ my @lines;
+
+ if ($self->{$attribute} =~ /$old/) {
+
+ for my $a ( @{ $self->{order} } ) {
+ my $val = ref $self->{$a} ? shift @{ $self->{$a} } : $self->{$a};
+ push @lines, [ $a, $val ];
+ }
+
+ @lines = grep {$attribute ne $_->[0] or $_->[1] !~ /$old/} @lines;
+ delete $self->{$attribute} if $self->{$attribute} =~ /$old/;
+
+ $self->{order} = [];
+ for my $l (@lines) {
+ $self->{ $l->[0] } = [] if ref( $self->{ $l->[0] } ) ;
+ }
+
+ for my $i ( 0 .. $#lines ) {
+ push @{ $self->{order} }, $lines[$i]->[0];
+ if ( $self->attribute_is( $lines[$i]->[0], 'multiple' ) ) {
+ push @{ $self->{ $lines[$i]->[0] } }, $lines[$i]->[1];
+ } else {
+ $self->{ $lines[$i]->[0] } = $lines[$i]->[1];
- $self->{$attribute} = $value;
+ }
+
+ }
+ }
+ }
+ }
}
return $self->{$attribute};
}
View
@@ -88,7 +88,11 @@ $clone->mnt_by({mode => 'delete', value => { old => '.'}});
is_deeply($clone->mnt_by,[],'Array properly emptyed through delete wildcard');
like($clone->dump,qr/as-block:\s+AS30720 - AS30895\ndescr:\s+RIPE NCC ASN block\n/,"Dump of deleted attributes ok");
my $delete_clone = $full_clone->clone({remove=>['remarks']});
-like($full_clone->dump,qr/as-block:\s+AS30720 - AS30895\ndescr:\s+RIPE NCC ASN block\n/,"Added org ok");
+like($full_clone->dump,qr/as-block:\s+AS30720 - AS30895\ndescr:\s+RIPE NCC ASN block\nremarks:\s+These AS Numbers are further assigned to network\nremarks:\s+operators in the RIPE NCC service region. AS\nremarks:\s+assignment policy is documented in:\nremarks:\s+<http:\/\/www.ripe.net\/ripe\/docs\/asn-assignment.html>\nremarks:\s+RIPE NCC members can request AS Numbers using the\nremarks:\s+form available in the LIR Portal or at:\nremarks:\s+<http:\/\/www.ripe.net\/ripe\/docs\/asnrequestform.html>\norg:\s+ORG-NCC1-RIPE\nadmin-c:\s+CREW-RIPE\ntech-c:\s+RD132-RIPE\nmnt-by:\s+RIPE-DBM-MNT\nmnt-lower:\s+RIPE-NCC-HM-MNT\nsource:\s+RIPE # Filtered\n/,"org full clone stil ok");
+$full_clone->mnt_lower({mode=>'delete', value => {old => 'RIPE-NCC-HM-MNT'}});
+like($full_clone->dump,qr/as-block:\s+AS30720 - AS30895\ndescr:\s+RIPE NCC ASN block\nremarks:\s+These AS Numbers are further assigned to network\nremarks:\s+operators in the RIPE NCC service region. AS\nremarks:\s+assignment policy is documented in:\nremarks:\s+<http:\/\/www.ripe.net\/ripe\/docs\/asn-assignment.html>\nremarks:\s+RIPE NCC members can request AS Numbers using the\nremarks:\s+form available in the LIR Portal or at:\nremarks:\s+<http:\/\/www.ripe.net\/ripe\/docs\/asnrequestform.html>\norg:\s+ORG-NCC1-RIPE\nadmin-c:\s+CREW-RIPE\ntech-c:\s+RD132-RIPE\nmnt-by:\s+RIPE-DBM-MNT\nsource:\s+RIPE # Filtered\n$/,"non last attribute deletion ok");
+$full_clone->source({mode=>'delete', value => {old => 'RIPE'}});
+like($full_clone->dump,qr/as-block:\s+AS30720 - AS30895\ndescr:\s+RIPE NCC ASN block\nremarks:\s+These AS Numbers are further assigned to network\nremarks:\s+operators in the RIPE NCC service region. AS\nremarks:\s+assignment policy is documented in:\nremarks:\s+<http:\/\/www.ripe.net\/ripe\/docs\/asn-assignment.html>\nremarks:\s+RIPE NCC members can request AS Numbers using the\nremarks:\s+form available in the LIR Portal or at:\nremarks:\s+<http:\/\/www.ripe.net\/ripe\/docs\/asnrequestform.html>\norg:\s+ORG-NCC1-RIPE\nadmin-c:\s+CREW-RIPE\ntech-c:\s+RD132-RIPE\nmnt-by:\s+RIPE-DBM-MNT\n$/,"last attribute deletion ok");
my @objects;
eval { @objects = Net::Whois::Object->query('AS30781', {attribute => 'remarks'}) };

0 comments on commit 35483c8

Please sign in to comment.