view release on metacpan or  search on metacpan

lib/App/SD/Test.pm  view on Meta::CPAN

require Prophet::Test;
use Test::More;
use File::Spec;
use File::Temp ();
use Test::Script::Run qw(:all);
use base qw/Exporter/;
our @EXPORT = qw(create_ticket_ok update_ticket_ok
    create_ticket_with_editor_ok create_ticket_comment_ok get_uuid_for_luid
    get_luid_for_uuid get_ticket_info run_ok run_output_matches
    run_output_matches_unordered run_script is_script_output);
delete $ENV{'PROPHET_APP_CONFIG'};
$ENV{'EDITOR'} = '/bin/true';

$Prophet::Test::CLI_CLASS = 'App::SD::CLI';

our ($A, $B, $C, $D);

BEGIN {
    # create a blank config file so per-user configs don't break tests
    my $tmp_config = File::Temp->new( UNLINK => 0 );
    print $tmp_config '';
    close $tmp_config;
    print "setting SD_CONFIG to " . $tmp_config->filename . "\n";
    $ENV{'SD_CONFIG'} = $tmp_config->filename;
    $ENV{'PROPHET_EMAIL'} = 'nobody@example.com';
    $ENV{'USER'} ||= 'nobody';
}

=head2 create_ticket_ok ARGS

Creates a new ticket, passing ARGS along to the creation command (after the
props separator).

Returns a list of the luid and uuid of the newly created ticket.

=cut

sub create_ticket_ok {
    my @args = (@_);
    local $Test::Builder::Level = $Test::Builder::Level + 1;
    run_output_matches( 'sd', [ 'ticket', 'create', '--', @args ],
        [qr/Created ticket (.*?)(?{ $A = $1})\s+\((.*)(?{ $B = $2 })\)/]
    );

    my ( $uuid, $luid ) =($B,$A);
    return ( $luid, $uuid );
}

=head2 update_ticket_ok ID ARGS

Updates the ticket #ID, passing ARGS along to the update command.

Returns nothing interesting.

=cut

sub update_ticket_ok {
    my ($id, @args) = (@_);
    local $Test::Builder::Level = $Test::Builder::Level + 1;
    run_output_matches( 'sd', [ 'ticket', 'update', $id, '--', @args ],
        [qr/ticket \d+\s+\([^)]*\)\s+updated\./i]
    );
}

=head2 create_ticket_comment_ok ARGS

Creates a new ticket comment, passing ARGS along to the creation command.

Returns a list of the luid and uuid of the newly created comment.

=cut

sub create_ticket_comment_ok {
    my @args = (@_);
    local $Test::Builder::Level = $Test::Builder::Level + 1;
    run_output_matches(
        'sd',
        [ 'ticket', 'comment', 'create', @args ],
        [qr/Created comment (.*?)(?{ $A = $1})\s+\((.*)(?{ $B = $2 })\)/]
    );
    my ( $uuid, $luid ) = ($B, $A);

    return ( $luid, $uuid );
}

=head2 create_ticket_ok luid

Takes a LUID and returns the corresponding UUID.

Returns undef if none can be found.

=cut

sub get_uuid_for_luid {
        my $luid = shift;
    my ($ok, $out, $err) =  run_script( 'sd', [ 'ticket', 'show', '--batch', '--id', $luid ]);
    if ($out =~ /^id: \d+ \((.*)\)/m) {
            return $1;
    }
    return undef;
}

=head2 get_luid_for_uuid UUID

Takes a UUID and returns the corresponding LUID.

Returns undef if none can be found.

=cut

sub get_luid_for_uuid {
        my $uuid = shift;
    my ($ok, $out, $err) =  run_script( 'sd', [ 'ticket', 'show', '--batch', '--id', $uuid ]);
    if ($out =~ /^id: (\d+)/m) {
            return $1;
    }
    return undef;
}

=head2 create_ticket_with_editor_ok [ '--verbose' ... ]