The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl

##
## Tests for Pangloss::Segment::Term*
##

use lib 't/lib';
use blib;
use strict;
use warnings;

use Test::More 'no_plan';
use TestSeg qw( test_and_get_view test_request_setter
	        test_seg test_request_decliner );

use Pixie;
use Error qw( :try );

use OpenFrame::Request;
use Pipeline::Segment::Tester;
use OpenFrame::WebApp::Session::MemCache;

use Pangloss::User;
use Pangloss::Term;
use Pangloss::Term::Status;
use Pangloss::Application;

my $req  = new OpenFrame::Request();
my $app  = new Pangloss::Application()->store( new Pixie()->connect('memory') );
my $ed   = $app->term_editor;
my $user = new Pangloss::User()->id('test');
my $sess = new OpenFrame::WebApp::Session::MemCache()->set('user', $user);

my %terms = (test => 'test term', to_remove => 'remove me!');
foreach my $code (keys %terms) {
    my $term = Pangloss::Term->new()
      ->name($code)
      ->notes($terms{$code})
      ->concept(1)
      ->language(1)
      ->creator( $user->id )
      ->date(1);
    $ed->add( $term );
    $terms{$code} = $term->key;
}

## load term from request
if (use_ok("Pangloss::Segment::LoadTerm")) {
    $req->arguments({ new_term_name     => 'a test',
		      new_term_concept  => 'test concept',
		      new_term_language => 'test language',
		      new_term_notes    => 'some notes...' });
    my $seg = new Pangloss::Segment::LoadTerm();
    my $pt  = test_seg( $seg, $req, $sess );
    my $term = $pt->pipe->store->get('Pangloss::Term');
    if (ok( $term, 'load term' )) {
	is( $term->creator, 'test', ' term->creator set' );
    }
    $req->arguments({});
}

## load term status from request
if (use_ok("Pangloss::Segment::LoadTermStatus")) {
    $req->arguments({ new_term_status_code  => 'a test',
		      new_term_status_notes => 'some notes...' });
    my $seg = new Pangloss::Segment::LoadTermStatus();
    my $pt  = test_seg( $seg, $req, $sess );
    my $status = $pt->pipe->store->get('Pangloss::Term::Status');
    if (ok( $status, 'load term status' )) {
	is( $status->creator, 'test', ' status->creator set' );
    }
    $req->arguments({});
}

## list terms
if (use_ok("Pangloss::Segment::ListTerms")) {
    my $seg  = new Pangloss::Segment::ListTerms();
    my $view = test_and_get_view( $seg, $app, $req, $sess );
    is( @{ $view->{terms} }, 2, 'list terms' );
}

test_request_decliner( class => "Pangloss::Segment::Decline::NoListTerms",
		       on    => { list_terms => 1 },
		       off   => {} );

## list term status codes
if (use_ok("Pangloss::Segment::ListStatusCodes")) {
    my $seg  = new Pangloss::Segment::ListStatusCodes();
    my $view = test_and_get_view( $seg, $app, $req, $sess );
    is( keys %{ $view->{status_codes} }, 4, 'list status codes' );
}

test_request_decliner( class => "Pangloss::Segment::Decline::NoListStatusCodes",
		       on    => { list_status_codes => 1 },
		       off   => {} );

## add term
my $term_key;
if (use_ok("Pangloss::Segment::AddTerm")) {
    my $term = new Pangloss::Term()
      ->name( 'te' )
      ->concept( 'test concept' )
      ->language( 'test language' )
      ->creator( 'test' )
      ->notes( 'another test...' );
    $req->arguments({ add_term => 1 });
    my $seg  = new Pangloss::Segment::AddTerm();
    my $view = test_and_get_view( $seg, $app, $req, $sess, $term );
    if (isa_ok( $view->{term}, 'Pangloss::Term', 'add view->term' )) {
	ok( $view->{term}->{added}, ' view->term->added' );
	$term_key = $view->{term}->key;
    }
    $req->arguments({});
}

## get term
if (use_ok("Pangloss::Segment::GetTerm")) {
    $req->arguments({ get_term      => 1,
		      selected_term => $term_key });
    my $seg  = new Pangloss::Segment::GetTerm();
    my $view = test_and_get_view( $seg, $app, $req );
    isa_ok( $view->{term}, 'Pangloss::Term', 'get view->term' );
    $req->arguments({});
}

## modify term status
if (use_ok("Pangloss::Segment::ModifyTermStatus")) {
    my $status = new Pangloss::Term::Status()
      ->code( 'test status' )
      ->creator( 'test' )
      ->notes( 'blah' );
    $req->arguments({ modify_term_status => 1,
		      selected_term      => $term_key });
    my $seg  = new Pangloss::Segment::ModifyTermStatus();
    my $view = test_and_get_view( $seg, $app, $req, $sess, $status );
    if (isa_ok( $view->{term}, 'Pangloss::Term', 'mod status view->term' )) {
	ok( $view->{term}->status->{modified}, ' view->term->status->modified' );
    }
    $req->arguments({});
}

## modify term
if (use_ok("Pangloss::Segment::ModifyTerm")) {
    my $term = new Pangloss::Term()
      ->name( 'tset' )
      ->concept( 'tset concept' )
      ->language( 'tset language' )
      ->notes( 'test backwards...' );
    $req->arguments({ modify_term       => 1,
		      selected_term     => $term_key });
    my $seg  = new Pangloss::Segment::ModifyTerm();
    my $view = test_and_get_view( $seg, $app, $req, $sess, $term );
    if (isa_ok( $view->{term}, 'Pangloss::Term', 'mod view->term' )) {
	ok( $view->{term}->{modified}, ' view->term->modified' );
	$term_key = $view->{term}->key;
    }
    $req->arguments({});
}

## remove term
if (use_ok("Pangloss::Segment::RemoveTerm")) {
    $req->arguments({ remove_term   => 1,
		      selected_term => $terms{to_remove} });
    my $seg  = new Pangloss::Segment::RemoveTerm();
    my $view = test_and_get_view( $seg, $app, $req );
    if (isa_ok( $view->{term}, 'Pangloss::Term', 'rm view->term' )) {
	ok( $view->{term}->{removed}, ' view->term->removed' );
    }
    $req->arguments({});
}

## no selected term
if (use_ok("Pangloss::Segment::Decline::NoSelectedTerm")) {
    $req->arguments({});
    my $seg = new Pangloss::Segment::Decline::NoSelectedTerm();
    my ($pt, $prod) = test_seg( $seg, $req );
    like( $prod, qr/declined/, 'no selected term' );
}

## no term
if (use_ok("Pangloss::Segment::Decline::NoTerm")) {
    $req->arguments({});
    my $seg = new Pangloss::Segment::Decline::NoTerm();
    my ($pt, $prod) = test_seg( $seg, $req );
    like( $prod, qr/declined/, 'no term' );
}

## no term status
if (use_ok("Pangloss::Segment::Decline::NoTermStatus")) {
    $req->arguments({});
    my $seg = new Pangloss::Segment::Decline::NoTermStatus();
    my ($pt, $prod) = test_seg( $seg, $req );
    like( $prod, qr/declined/, 'no term status' );
}

# request - get term
test_request_setter( 'Pangloss::Segment::Request::GetTerm', 'get_term' );

# request - list terms
test_request_setter( 'Pangloss::Segment::Request::ListTerms', 'list_terms' );

# request - list status codes
test_request_setter( 'Pangloss::Segment::Request::ListStatusCodes', 'list_status_codes' );