# # Copyright (c) 2011-2014 NetApp, Inc., All Rights Reserved # Any use, modification, or distribution is prohibited # without prior written consent from NetApp, Inc. # ## @summary Multiple Volume Task Module ## @author bruce.blinn@netapp.com, dl-nacl-dev ## @status shared ## @pod here package NACL::MTask::VolumeMulti; use strict; use warnings; use base qw(NACL::STask::Volume); use Data::Dumper; use List::Util qw(min max); use NATE::BaseException qw(:try); use NATE::Exceptions::Argument; use NACL::STask::VolumeEfficiency; use NACL::STask::Vserver; use Params::Validate qw(validate SCALAR SCALARREF ARRAYREF BOOLEAN); use Tharn qw( subtest logresult); use NATE::Log qw(log_global); my $Log = log_global(); my $may_enter = $Log->may_enter(); my $may_exit = $Log->may_exit(); =head1 NAME NACL::MTask::VolumeMulti =head1 DESCRIPTION C adds methods to C to make it easier to create or purge multiple volumes in a single method call. This module will be used in tests and utility scripts needed to test very large configurations, such as those being tested in Panamax. =head1 METHODS =head2 create_multi my @vol_names = NACL::MTask::VolumeMulti->create_multi( command_interface => $command_interface, aggregate => $aggregate, vserver => $vserver, volume => $volume, nacltask_compression => $compression_percent, nacltask_compression_inline => $inline_compression_percent, nacltask_efficiency => $efficiency_percent, nacltask_efficiency_policy => $efficiency_policy, nacltask_guarantee_file => $guarantee_file_percent, nacltask_guarantee_volume => $guarantee_volume_percent, nacltask_guarantee_none => $guarantee_none_percent, nacltask_num_subtests => $num_subtests, nacltask_num_vols => $num_volumes, nacltask_start_index => $start_index, nacltask_subtest_delay => $num_seconds, nacltask_subtests_per_second => $num_subtests, %other_options ); or my @vol_objs = NACL::MTask::VolumeMulti->create_multi( nacltask_return_obj => 1, %other_options ); (Class method) Create multiple volumes in a single method call. The standard volume attributes can be passed to this method, in which case, they will be passed through to the create() method when each volume is created. However, the job_component and nacltask_wait attributes are used by this method, and therefore, cannot be used by the caller. The C is automatically assigned by the Volume STask. Currently, it auto-assigns it to "/$volname", however subsequent code should not assume this to be the C, but should always query its value first by using either get_one_state_attribute() or state(). Note that it is possible to disable the automatic assignment of C by passing its value as undef. Passing in a defined value for C is not allowed since multiple volumes on the same vserver cannot have the same C value. Several volume attributes can also be specified via "nacltask" options. These options allow specific attributes to be enabled on a percentage of the volumes, in which case, the volumes that have the attribute enabled will be selected randomly. If this method is called in array context, it will return an array containing the names of the volumes that were created (or started to be created, if there was an error); it cannot return the volume objects because they are created in a separate process. If this method is called in a scalar context, it will return the number of volumes created. In C-mode, if the VServer was created with a default root volume, it will be limited to about 550 files and directories. Since each volume needs a directory for a mount point (junction path), this method will automatically increase the file limit is necessary. =over =item Options =over =item C<< command_interface => $command_interface >> (Required). A component object that represents the host to which to send commands. See L. =item C<< aggregate => $aggregate >> (Required) As C. The name of the aggregate where the volumes will be created. The aggregate must already exist. =item C<< vserver => $vserver >> (Required for C-mode, ignored for 7-mode) As C. The name of the VServer that will contain the volumes. The VServer must already exist. =item C<< volume => $volume >> (Required) As C, except if the number of volumes to create is more than one, it will be appended with an underscore and a 5-digit number to form the name of each volume. For example, if the volume parameter is "my_vol", the name of the first volume will be "my_vol_00000" (see also, the nacltask_start_index option). This parameter also accpets a reference to an array as imput. If this parameter contains a reference to an array, then it contains the actual names of the Volumes that will be created. Therefore, the number of Volumes that will be created is the number of entries in the array. For example, volume => ['vol_east', 'vol_west'], When ARRAYREF is passed to volume parameter, nacltask_num_vols parameter is ignored. =item C<< nacltask_compression => $compression_percent >> (Optional) This is the percentage of volumes that will have compression enabled. (Note: this option requires a 64-bit aggregate). =item C<< nacltask_compression_inline => $compression_inline_percent >> (Optional) This is the percentage of volumes that will have inline compression enabled. (Note: this option requires a 64-bit aggregate). =item C<< nacltask_efficiency => $efficiency_percent >> (Optional) This is the percentage of volumes that will have efficiency enabled. =item C<< nacltask_efficiency_policy => $efficiency_policy >> (Optional) This option is only used if one of the efficiency, compression, or inline-compression options are used. In SierraNevada, the default efficiency policy is "auto", which does not allow you to enable these options. Therefore, if one of these options is used, the efficiency policy will be changed to "-", which allows you to manually start and stop efficiency. If you want to use a different efficiency policy, you can specify it using this parameter. =item C<< nacltask_guarantee_file => $guarantee_file_percent >> (Optional, Discontinued in FS) This is the percentage of volumes that will have the space reservation policy set to "file". =item C<< nacltask_guarantee_volume => $guarantee_volume_percent >> (Optional) This is the percentage of volumes that will have the space reservation policy set to "volume". =item C<< nacltask_guarantee_none => $guarantee_none_percent >> (Optional) This is the percentage of volumes that will have the space reservation policy set to "none". =item C<< nacltask_num_subtests => $num_subtests >> (Optional) This is the number of parallel processes, or subtests, that will be used to create the volumes. The number of subtests that can be used is restricted by the maximum number of RSH or SSH connections that can be made. The default value for this option is 50 subtests in C-mode and 15 subtests in 7-mode. =item C<< nacltask_num_vols => $num_volumes >> (Optional) This is the number of volumes to create. The default is to create one volume. =item C<< nacltask_start_index => $start_index >> (Optional) This is the starting value for the volume number that will be appended to the name of the each volume. The default value is 0. =item C<< nacltask_subtest_delay => $num_seconds >> (Optional) By default, filers are configured to allow a maximum of 10 new SSH connections per second. A separate subtest is used to create each volume, and each subtest starts another SSH connection. This parameter is the number of seconds to wait between every "nacltask_subtests_per_second" subtests that are started. The default is two seconds. Note: A value a one second does not always work because even though the subtests are not started at more than 10 per second, it is possible for more that 10 requests to arrive at the filer in less than one second. Setting this value to two seconds seems to clear up that intermittent failure. This failure shows up in the /mroot/etc/log/mlog/messages.log file as the following error from the xinetd daemon: "Deactivating service ssh due to excessive incoming connections." =item C<< nacltask_subtests_per_second => $num_subtests >> (Optional) This parameter is the number of subtests to start before waiting "nacltask_subtest_delay" seconds. The default is 10 subtests. See also the nacltask_subtest_delay parameter. =item C<< nacltask_return_obj => 0|1 >> (Optional, Defaults to 0) Specifies return types of this method. 1 means to returns the Volume STask Objects which is created. 0 means to returns the Volume names which is created. =back =back =head2 purge_multi my $num_purged = NACL::MTask::VolumeMulti->purge_multi( command_interface => $command_interface, volume => $vol_names, vserver => $vserver, aggregate => $aggregate, nacltask_num_subtests => $num_subtests, nacltask_if_error => $action, nacltask_subtest_delay => $num_seconds, nacltask_subtests_per_second => $num_subtests, %other_options ); (Class method) This method will purge multiple volumes in a single method call. The standard volume attributes can be passed to this method, in which case, they will be passed through to the purge() method when each volume is purged. =over =item Options =over =item C<< command_interface => $command_interface >> (Required) A component object that represents the host to which to send commands. See L. =item C<< volume => $vol_names | $vol_objects >> (Required) This is either a volume name/Object or a reference to an array of volume names/Objects, which are the names of the volumes to purge. The volume name(s) may contain wildcard characters to allow the name to match more than one volume. The wildcard characters are those defined by the filer's command line interpreter. For example, if you pass: volume => ['eng_vols*', 'mkt_vols*'] This method will purge all the volumes with names that begin with the string "eng_vols" or "mkt_vols". Note: The volume parameter may be an empty array of names, or if wildcard characters are used, the name does not need to match any existing volumes. In both of these cases, no volumes will be removed, and the return value will be zero (the number of volumes removed) to indicate this. =item C<< vserver => $vserver >> (Optional) The name of the VServer that the volumes belong to. This parameter can be used to identify the volumes when there is more than one volume with the same name; otherwise, it is not necessary. =item C<< aggregate => $aggregate >> (Optional) The name of the aggregate containing the volumes. This parameter can be used to identify the volumes when there is more than one volume with the same name; otherwise, it is not necessary. =item C<< nacltask_num_subtests => $num_subtests >> (Optional) This is the number of parallel processes, or subtests, that will be used to purge the volumes. The number of subtests that can be used is restricted by the maximum number of RSH or SSH connections that can be made. The default value for this option is 50 subtests in C-mode and 15 subtests in 7-mode. =item C<< nacltask_if_error => $action >> (Optional) This parameter specifies the action to take if there is an error trying to remove one of the volumes. The possible values are "die" or "continue". These strings are not case sensitive. The default is "die". =item C<< nacltask_subtest_delay => $num_seconds >> (Optional) By default, filers are configured to allow a maximum of 10 new SSH connections per second. A separate subtest is used to create each volume, and each subtest starts another SSH connection. This parameter is the number of seconds to wait between every "nacltask_subtests_per_second" subtests that are started. The default is two seconds. Note: A value a one second does not always work because even though the subtests are not started at more than 10 per second, it is possible for more that 10 requests to arrive at the filer in less than one second. Setting this value to two seconds seems to clear up that intermittent failure. This failure shows up in the /mroot/etc/log/mlog/messages.log file as the following error from the xinetd daemon: "Deactivating service ssh due to excessive incoming connections." =item C<< nacltask_subtests_per_second => $num_subtests >> (Optional) This parameter is the number of subtests to start before waiting "nacltask_subtest_delay" seconds. The default is 10 subtests. See also the nacltask_subtest_delay parameter. =back =back =cut sub create_multi { $Log->enter() if $may_enter; my $pkg = shift; my %opts = $pkg->_common_validate_with( params => \@_, additional_spec => { command_interface => { type => SCALAR }, aggregate => { type => SCALAR }, volume => { type => ARRAYREF | SCALAR }, nacltask_compression => { type => SCALAR, default => 0 }, nacltask_compression_inline => { type => SCALAR, default => 0 }, nacltask_efficiency => { type => SCALAR, default => 0 }, nacltask_efficiency_policy => { type => SCALAR, default => '-' }, nacltask_guarantee_file => { type => SCALAR, default => 0 }, nacltask_guarantee_volume => { type => SCALAR, default => 0 }, nacltask_guarantee_none => { type => SCALAR, default => 0 }, nacltask_num_subtests => { type => SCALAR, default => 0 }, nacltask_num_vols => { type => SCALAR, default => 1 }, nacltask_start_index => { type => SCALAR, default => 0 }, nacltask_subtest_delay => { type => SCALAR, default => 2 }, nacltask_subtests_per_second => { type => SCALAR, default => 10 }, nacltask_return_obj => { type => BOOLEAN, default => 0 }, }, allow_extra => 1, ); my $num_subtests = delete $opts{nacltask_num_subtests}; my $num_vols = delete $opts{nacltask_num_vols}; my $start_index = delete $opts{nacltask_start_index}; my $subtest_delay = delete $opts{nacltask_subtest_delay}; my $subtests_per_second = delete $opts{nacltask_subtests_per_second}; my $volume = delete $opts{volume}; my $vserver = $opts{vserver}; my $ci = $opts{command_interface}; my @vol_names; $Log->trace("num_vols = $num_vols"); $Log->trace("num_subtests = $num_subtests"); $Log->trace("start_index = $start_index"); $Log->trace("subtest_delay = $subtest_delay"); $Log->trace("subtests_per_second = $subtests_per_second"); $Log->trace("volume = $volume"); $Log->trace("vserver = $vserver"); $Log->trace("aggregate = $opts{aggregate}"); if (!$vserver && ($ci->is_cmode())) { $Log->exit() if $may_exit; NATE::Exceptions::Argument->throw( "The \"vserver\" is a required option."); } # The following options are used by this subroutine, so make sure they are # not also used by the caller. foreach my $option (qw(job_component junction-path nacltask_wait)) { if (defined $opts{$option}) { $Log->exit() if $may_exit; NATE::Exceptions::Argument->throw("The '$option' argument cannot " . 'be used with this method'); } } # Check for invalid values. foreach my $option (qw(nacltask_compression nacltask_compression_inline nacltask_efficiency nacltask_guarantee_volume nacltask_guarantee_file nacltask_guarantee_none)) { my $val = $opts{$option}; if ($val < 0 || $val > 100) { $Log->exit() if $may_exit; NATE::Exceptions::Argument->throw("The value of the '$option' " . 'argument should have been in the range of 0-100 but was ' . "passed as $val"); } } if ($ci->is_cmode()) { # Make sure the VServer's root volume has enough INODEs. my $vsvr = NACL::STask::Vserver->new( command_interface => $ci, vserver => $vserver, ); _increase_vsvr_root_inodes($vsvr, $num_vols + 500); } # See if the volume parameter is the prefix of the names or an array of # names. if (ref($volume) eq 'ARRAY') { @vol_names = @{$volume}; } elsif ($num_vols == 1) { @vol_names = ($volume); } else { foreach my $i (0..$num_vols - 1) { push(@vol_names, $volume . '_' . sprintf('%05d', $i + $start_index)); } } # @vol_names (when passed as arrayref) list takes precedence # over num_vols param $num_vols = scalar(@vol_names); if ($num_subtests <= 0) { if ($ci->is_cmode()) { $num_subtests = 50; } else { $num_subtests = 15; } } my $vol_id = $start_index; my $last_vol_id = $num_vols + $start_index - 1; my $i = 0; while ($i < $num_vols) { # # Start a batch of subtests. # my $num_left = scalar(@vol_names) - $i; my $batch_size = min($num_left, $num_subtests); my @subtests = (); foreach (1..$batch_size) { my $vol_name = $vol_names[$i]; if (($i++ % $subtests_per_second) == 0) { # By default, filers are configured to allow a maximum of 10 # ssh connections per second. This prevents intermittent # connection failures on fast filers. sleep $subtest_delay; } srand; # Give each subtest a different seed. $Log->trace("Creating $vol_name"); my $subtest = subtest(\&_create_vol, -bg, -runid => "cr_$vol_name", '--', $vol_name, %opts); push(@subtests, $subtest); } # # Wait for the current batch of subtests to finish. # $Log->trace('Waiting for subtests to finish.'); try { Subtest::wait_finish(subtests => \@subtests); } otherwise { my $e = shift; $Log->exit() if $may_exit; if ($e->isa("NATE::BaseException")) { $e->throw(); } else { # Must be a NATE::Result object. NATE::BaseException->throw("@{$e->{messages}}"); } }; } my @vol_objs; if ($opts{nacltask_return_obj}) { foreach (@vol_names) { push (@vol_objs, NACL::STask::Volume->new( command_interface => $opts{command_interface}, volume => $_, vserver => $opts{vserver} ) ); } } my @return_array = $opts{nacltask_return_obj} ? @vol_objs : @vol_names; $Log->exit() if $may_exit; if (wantarray()) { return @return_array; } return scalar(@return_array); } sub purge_multi { $Log->enter() if $may_enter; my $pkg = shift; my %opts = $pkg->_common_validate_with( params => \@_, additional_spec => { command_interface => { type => SCALAR, optional => 0 }, volume => { type => ARRAYREF | SCALAR, optional => 0 }, vserver => { type => SCALAR, optional => 1 }, aggregate => { type => SCALAR, optional => 1 }, nacltask_num_subtests => { type => SCALAR, default => 0 }, nacltask_if_error => { type => SCALAR, default => 'die' }, nacltask_subtest_delay => { type => SCALAR, default => 2 }, nacltask_subtests_per_second => { type => SCALAR, default => 10 }, }, allow_extra => 1, ); my $ci = delete $opts{command_interface}; my $volume = delete $opts{volume}; my $vserver = delete $opts{vserver}; my $aggregate = delete $opts{aggregate}; my $num_subtests = delete $opts{nacltask_num_subtests}; my $if_error = $opts{nacltask_if_error}; # Pass to _purge_vol(). my $subtest_delay = delete $opts{nacltask_subtest_delay}; my $subtests_per_second = delete $opts{nacltask_subtests_per_second}; $Log->trace("volume = $volume"); $Log->trace("vserver = $vserver") if ($vserver); $Log->trace("aggregate = $aggregate") if ($aggregate); $Log->trace("num_subtests = $num_subtests"); $Log->trace("subtest_delay = $subtest_delay"); $Log->trace("subtests_per_second = $subtests_per_second"); $Log->trace("if_error = $if_error"); if ($num_subtests <= 0) { if ($ci->is_cmode()) { $num_subtests = 50; } else { $num_subtests = 15; } } my @vols = _find_volumes($ci, $volume, $vserver, $aggregate); if (scalar(@vols) == 0) { $Log->warn('There are no volumes to remove.'); $Log->exit() if $may_exit; return 0; } $Log->trace('Found ' . scalar(@vols) . ' volumes.'); my $vol_id = 0; my $purged = 0; while (scalar(@vols)) { # # Start a batch of subtests. # my $num_vols = scalar(@vols); my $batch_size = min($num_vols, $num_subtests); my @subtests = (); my $vol; my $vol_name; foreach (1..$batch_size) { $vol = shift(@vols); $vol_name = $vol->volume(); try { if (($vol_id++ % $subtests_per_second) == 0) { # By default, filers are configured to allow a maximum of 10 # ssh connections per second. This prevents intermittent # connection failures on fast filers. sleep $subtest_delay; } $Log->trace("Removing volume $vol_name."); $purged++; my $subtest = subtest(\&_purge_vol, -bg, -runid => "rm_$vol_name", '--', $vol, %opts); my $subtest_info = {}; $subtest_info->{subtest} = $subtest; $subtest_info->{vol_name} = $vol_name; push(@subtests, $subtest_info); } otherwise { if ($if_error =~ /continue/i) { $Log->warn("Purge $vol_name failed while starting; continuing."); $purged--; } else { my $e = shift; $Log->exit() if $may_exit; if ($e->isa("NATE::BaseException")) { $e->throw(); } else { # Must be a NATE::Result object. NATE::BaseException->throw("@{$e->{messages}}"); } } }; } # # Wait for the current batch of subtests to finish. # $Log->trace('Waiting for subtests to finish.'); foreach my $subtest_info (@subtests) { my $subtest = $subtest_info->{subtest}; my $vol_name = $subtest_info->{vol_name}; try { $Log->trace("Waiting for volume $vol_name to be removed."); $subtest->wait_finish(); } otherwise { if ($if_error =~ /continue/i) { $Log->warn("Purge $vol_name failed while waiting; continuing."); $purged--; } else { my $e = shift; $Log->exit() if $may_exit; if ($e->isa("NATE::BaseException")) { $e->throw(); } else { # Must be a NATE::Result object. NATE::BaseException->throw("@{$e->{messages}}"); } } }; } } $Log->exit() if $may_exit; return $purged; } ######################################################################## # P R I V A T E M E T H O D S ######################################################################## sub _create_vol { $Log->enter() if $may_enter; my ($vol_name, %opts) = @_; try { my $compression = delete $opts{nacltask_compression}; my $compression_inline = delete $opts{nacltask_compression_inline}; my $efficiency = delete $opts{nacltask_efficiency}; my $efficiency_policy = delete $opts{nacltask_efficiency_policy}; my $guarantee_volume = delete $opts{nacltask_guarantee_volume}; my $guarantee_file = delete $opts{nacltask_guarantee_file}; my $guarantee_none = delete $opts{nacltask_guarantee_none}; my $return_vol_obj = delete $opts{nacltask_return_obj}; my $vserver = $opts{vserver}; my $ci = $opts{command_interface}; if (rand(100) < $guarantee_volume) { $Log->trace("Volume $vol_name, space reservation = volume"); $opts{'space-guarantee'} = 'volume'; } elsif (rand(100) < $guarantee_none) { $Log->trace("Volume $vol_name, space reservation = none"); $opts{'space-guarantee'} = 'none'; } elsif (rand(100) < $guarantee_file) { $Log->warn("In FullSteam release onwards ONTAP does not support" ." 'file' value for space-guarantee. 'nacltask_guarantee_file' " ."is ignored. Please delete it from the test options"); } # If system is slow, create will time out after 2 minutes. if (!defined($opts{'method-timeout'})) { $opts{'method-timeout'} = 1200; # 20 minutes. } my $vol = NACL::STask::Volume->create( volume => $vol_name, nacltask_wait => 0, %opts, ); my $do_efficiency = 0; my $do_compression = 0; my $do_compression_inline = 0; if (rand(100) < $compression_inline) { $do_efficiency = 1; $do_compression = 1; $do_compression_inline = 1; } elsif (rand(100) < $compression) { $do_efficiency = 1; $do_compression = 1; } elsif (rand(100) < $efficiency) { $do_efficiency = 1; } if ($do_efficiency || $return_vol_obj) { $vol->wait_for_creation(); } if ($do_efficiency) { $Log->trace("Volume $vol_name, efficiency enabled"); # Using linked components/tasks to directly access the # functionality of the VolumeEfficiency STask. # See the Component Layer User's Guide. my $efficiency = $vol->efficiency_on(); $efficiency->config(policy => $efficiency_policy); if ($do_compression) { $Log->trace("Volume $vol_name, compression enabled"); $efficiency->config(compression => 'true'); if ($do_compression_inline) { $Log->trace("Volume $vol_name, compression inline enabled"); $efficiency->config('inline-compression' => 'true'); } } } } catch NATE::BaseException with { my $e = shift; logresult( type => 'FAIL', msg => "Creating volume $vol_name failed: " . $e->text(), ); }; $Log->exit() if $may_exit; return 0; } sub _find_volumes { my ($ci, $volume, $vsvr_name, $aggr_name) = @_; # The $volume can be a scalar or a reference to an array of volume name or # Volume object. # If passed as an array-reference, then we can search for all of them # at once by using the pipe operator. (i.e. a filter of "vol1|vol2" would # return all of these volumes that existed, but by invoking a single # command, rather than needing to run one command per volume) my %filter; my @volumes; my @vol_objects; if (ref $volume eq 'ARRAY') { @volumes = @{$volume}; } else { @volumes = ($volume); } my (@filter_vol); foreach my $vol (@volumes) { if (ref $vol && blessed $vol && $vol->isa('NACL::C::Volume') ) { push(@vol_objects, $vol->cast_component_to_task()); } else { push(@filter_vol, $vol); } } return @vol_objects unless (@filter_vol); $filter{volume} = join '|', @filter_vol; $filter{aggregate} = $aggr_name if ($aggr_name); $filter{vserver} = $vsvr_name if ($vsvr_name); try { push (@vol_objects, NACL::STask::Volume->find( command_interface => $ci, filter => \%filter, ) ); } catch NACL::Exceptions::NoElementsFound with { # Either the aggregate was not found, or no volumes were found. } catch NACL::APISet::Exceptions::InvalidParamValueException with { # VServer not found. }; return @vol_objects; } sub _increase_vsvr_root_inodes { my ($vsvr, $need) = @_; # # Make sure the VServer's root volume has enough free INODEs to create the # number of files and directories specified by the $need parameter. A # default volume is 20Mb and is limited to about 550 files. # my $rootvol_cs = NACL::CS::Volume->fetch( command_interface => $vsvr->command_interface(), filter => { vserver => $vsvr->vserver(), volume => $vsvr->state()->rootvolume() } ); my $max_files = $rootvol_cs->files(); my $files_used = $rootvol_cs->files_used(); my $avail = $max_files - $files_used; $Log->trace('Checking root volume INODEs'); $Log->trace(' VServer = ' . $vsvr->vserver()); $Log->trace(' Root Volume = ' . $rootvol_cs->volume()); $Log->trace(' Max Files = ' . $max_files); $Log->trace(' Files Used = ' . $files_used); $Log->trace(' Files Available = ' . $avail); $Log->trace(' Files Needed = ' . $need); if ($avail < $need) { my $rootvol = $rootvol_cs->get_task_instance(); $rootvol->modify('files' => $need + $files_used); return $need; } return $avail; } sub _purge_vol { $Log->enter() if $may_enter; my ($vol, %opts) = @_; my $if_error = delete $opts{nacltask_if_error}; $Log->trace('Removing volume ' . $vol->volume()); # If system is slow, unmount will time out after 15 seconds. if (!defined($opts{'method-timeout'})) { $opts{'method-timeout'} = 1200; # 20 minutes } # This error occurs when there is a timeout processing a dblade ZAPI. my $m1 = 'An error occurred in the reception and processing of the API ' . 'reply from the appliance'; my $retry = 0; my $done = 0; while (!$done) { try { $vol->purge(%opts); $done = 1; } catch NATE::BaseException with { my $e = shift; if ($if_error =~ /continue/i) { if ($retry++ < 5) { if ($e->text() =~ /$m1/) { $Log->warn("Retry ($retry) purging " . $vol->volume . ' because: ' . $e->text()); sleep 10; } else { # Not a retryable error. $Log->exit() if $may_exit; $e->throw(); } } else { $Log->warn('Too many retries purging ' . $vol->volume); $Log->exit() if $may_exit; $e->throw(); } } else { $Log->exit() if $may_exit; $e->throw(); } }; } $Log->exit() if $may_exit; } 1;