Fix delete for sigle value attribute

arhuman · May 30, 2013 · 35483c8 · 35483c8
1 parent 8990480
commit 35483c8
Show file tree

Hide file tree

Showing 2 changed files with 60 additions and 4 deletions.
diff --git a/lib/Net/Whois/Object.pm b/lib/Net/Whois/Object.pm
@@ -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};
 }

diff --git a/t/03-objects.t b/t/03-objects.t
@@ -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'}) };