git.gag.com Git - debian/amanda/blob - installcheck/Installcheck/Changer.pm

   1 # vim:ft=perl
   2 # Copyright (c) 2009-2012 Zmanda, Inc.  All Rights Reserved.
   3 #
   4 # This program is free software; you can redistribute it and/or
   5 # modify it under the terms of the GNU General Public License
   6 # as published by the Free Software Foundation; either version 2
   7 # of the License, or (at your option) any later version.
   8 #
   9 # This program is distributed in the hope that it will be useful, but
  10 # WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
  11 # or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  12 # for more details.
  13 #
  14 # You should have received a copy of the GNU General Public License along
  15 # with this program; if not, write to the Free Software Foundation, Inc.,
  16 # 59 Temple Place, Suite 330, Boston, MA  02111-1307 USA
  17 #
  18 # Contact information: Zmanda Inc, 465 S. Mathilda Ave., Suite 300
  19 # Sunnyvale, CA 94086, USA, or: http://www.zmanda.com
  20
  21 package Installcheck::Changer;
  22
  23 =head1 NAME
  24
  25 Installcheck::Changer - utilities for testing changers
  26
  27 =head1 SYNOPSIS
  28
  29   use Installcheck::Changer;
  30
  31   my $res_cb = sub {
  32     my ($err, $res) = @_;
  33     chg_err_like($err,
  34         { message => "expected msg", type => 'failure' },
  35         "operation produces the expected error");
  36     # or, just looking at the message
  37     chg_err_like($err,
  38         qr/expected .*/,
  39         "operation produces the expected error");
  40   };
  41
  42 =head1 USAGE
  43
  44 The function C<chg_err_like> takes an C<Amanda::Changer::Error> object and a
  45 hashref of expected values for that error object, and compares the two.  The
  46 values of this hashref can be regular expressions or strings.  Alternately, the
  47 function can take a regexp which is compared to the error's message.  This
  48 function is exported by default.
  49
  50 =cut
  51
  52 use Test::More;
  53 use Data::Dumper;
  54 use strict;
  55 use warnings;
  56 use vars qw( @ISA @EXPORT );
  57
  58 require Exporter;
  59 @ISA = qw(Exporter);
  60 @EXPORT = qw(chg_err_like);
  61
  62 sub chg_err_like {
  63     my ($err, $expected, $msg) = @_;
  64
  65     if (!defined($err) or !$err->isa("Amanda::Changer::Error")) {
  66         fail($msg);
  67         diag("Expected an Amanda::Changer::Error object; got\n" . Dumper($err));
  68         return;
  69     }
  70
  71     if (ref($expected) eq 'Regexp') {
  72         like($err->{'message'}, $expected, $msg);
  73     } else {
  74         my $ok = 1;
  75         for my $key (qw( type reason message )) {
  76             if (exists $expected->{$key}) {
  77                 if (!exists $err->{$key}) {
  78                     fail($msg) if ($ok);
  79                     $ok = 0;
  80                     diag("expected a '$key' hash elt, but saw none");
  81                     next;
  82                 }
  83
  84                 my ($got, $exp) = ($err->{$key}, $expected->{$key});
  85                 if (ref($exp) eq "Regexp") {
  86                     if ($got !~ $exp) {
  87                         fail($msg) if $ok;
  88                         $ok = 0;
  89                         diag("$key '$got' does not match '$exp'");
  90                     }
  91                 } elsif ($got ne $exp) {
  92                     fail($msg) if ($ok);
  93                     $ok = 0;
  94                     diag("expected $key '$exp'; got $key '$got'");
  95                 }
  96             }
  97         }
  98         pass($msg) if ($ok);
  99     }
 100 }