[Bps-public-commit] r13606 - in Shipwright/trunk: lib/Shipwright/Script

[sunnavy at bestpractical.com]

Author: sunnavy
Date: Wed Jun 25 20:17:59 2008
New Revision: 13606

Added:
   Shipwright/trunk/lib/Shipwright/Script/Ktf.pm
Modified:
   Shipwright/trunk/   (props changed)

Log:
 r13812 at sunnavys-mb:  sunnavy | 2008-06-26 07:52:45 +0800
 added ktf cmd


Added: Shipwright/trunk/lib/Shipwright/Script/Ktf.pm
==============================================================================
--- (empty file)
+++ Shipwright/trunk/lib/Shipwright/Script/Ktf.pm	Wed Jun 25 20:17:59 2008
@@ -0,0 +1,88 @@
+package Shipwright::Script::Ktf;
+
+use strict;
+use warnings;
+use Carp;
+
+use base qw/App::CLI::Command Class::Accessor::Fast Shipwright::Script/;
+__PACKAGE__->mk_accessors(qw/repository log_level log_file name set delete/);
+
+use Shipwright;
+use List::MoreUtils qw/uniq/;
+
+sub options {
+    (
+        'r|repository=s' => 'repository',
+        'l|log-level=s'  => 'log_level',
+        'log-file=s'     => 'log_file',
+        'd|delete'       => 'delete',
+        's|set=s'        => 'set',
+        'name=s'         => 'name',
+    );
+}
+
+sub run {
+    my $self = shift;
+    my $name = shift;
+
+    $self->name($name) if $name && !$self->name;
+
+    die "need name arg" unless $self->name();
+
+    $name = $self->name;
+
+    my $shipwright = Shipwright->new( repository => $self->repository, );
+
+    my $ktf = $shipwright->backend->ktf;
+
+    if ( $self->delete || defined $self->set ) {
+        if ( $self->delete ) {
+            delete $ktf->{$name};
+        }
+        if ( defined $self->set ) {
+            $ktf->{$name} = $self->set;
+        }
+        $shipwright->backend->ktf($ktf);
+    }
+
+    $self->_show_ktf($ktf);
+}
+
+sub _show_ktf {
+    my $self = shift;
+    my $ktf  = shift;
+    my $name = $self->name;
+
+    if ( $self->delete ) {
+        print "deleted known test failure for $name\n";
+    }
+    else {
+        if ( defined $self->set ) {
+            print "set known test failure condition for $name with success\n";
+        }
+
+        print 'the condition is: ' . ( $ktf->{$name} || 'undef' ) . "\n";
+    }
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Shipwright::Script::Ktf - Maintain a dist's known test failure conditions
+
+=head1 SYNOPSIS
+
+ ktf --name [dist name] --set '$^O eq "darwin"'
+
+=head1 OPTIONS
+
+ -r [--repository] REPOSITORY   : specify the repository of our project
+ -l [--log-level]               : specify the log level
+                                  (info, debug, warn, error, or fatal)
+ --log-file FILENAME            : specify the log file
+ --name NAME                    : specify the dist name
+ --delete conditions            : delete conditions
+ --set conditions               : set conditions