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::Concept*
##

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::Concept;
use Pangloss::Application;

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

my %cats = (test => 'test cat', to_remove => 'remove me!');
foreach my $code (keys %cats) {
    my $cat = Pangloss::Concept->new()
      ->name($code)
      ->notes($cats{$code})
      ->creator($user->id)
      ->date(1);
    $ed->add( $cat );
}

## load concept from request
if (use_ok("Pangloss::Segment::LoadConcept")) {
    $req->arguments({ new_concept_name     => 'a test',
		      new_concept_category => 'test cat',
		      new_concept_notes    => 'some notes...' });
    my $seg = new Pangloss::Segment::LoadConcept();
    my $pt  = test_seg( $seg, $req, $sess );
    my $concept = $pt->pipe->store->get('Pangloss::Concept');
    if (ok( $concept, 'load concept' )) {
	is( $concept->creator, 'test', ' concept->creator set' );
    }
    $req->arguments({});
}

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

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

## add concept
if (use_ok("Pangloss::Segment::AddConcept")) {
    my $concept = new Pangloss::Concept()
      ->name( 'te' )
      ->notes( 'another test' )
      ->creator( 'test' )
      ->category( 'test category' );
    $req->arguments({ add_concept => 1 });
    my $seg  = new Pangloss::Segment::AddConcept();
    my $view = test_and_get_view( $seg, $app, $req, $sess, $concept );
    if (isa_ok( $view->{concept}, 'Pangloss::Concept', 'add view->concept' )) {
	ok( $view->{concept}->{added}, 'view->concept->added' );
    }
    $req->arguments({});
}

## get concept
if (use_ok("Pangloss::Segment::GetConcept")) {
    $req->arguments({ get_concept      => 1,
		      selected_concept => 'test' });
    my $seg  = new Pangloss::Segment::GetConcept();
    my $view = test_and_get_view( $seg, $app, $req );
    isa_ok( $view->{concept}, 'Pangloss::Concept', 'get view->concept' );
    $req->arguments({});
}

## modify concept
if (use_ok("Pangloss::Segment::ModifyConcept")) {
    my $concept = new Pangloss::Concept()
      ->name( 'tset' )
      ->notes( 'test backwards' )
      ->category( 'test category' );
    $req->arguments({ modify_concept   => 1,
		      selected_concept => 'test' });
    my $seg  = new Pangloss::Segment::ModifyConcept();
    my $view = test_and_get_view( $seg, $app, $req, $sess, $concept );
    if (isa_ok( $view->{concept}, 'Pangloss::Concept', 'mod view->concept' )) {
	ok( $view->{concept}->{modified}, 'view->concept->modified' );
    }
    $req->arguments({});
}

## remove concept
if (use_ok("Pangloss::Segment::RemoveConcept")) {
    $req->arguments({ remove_concept   => 1,
		      selected_concept => 'to_remove' });
    my $seg  = new Pangloss::Segment::RemoveConcept();
    my $view = test_and_get_view( $seg, $app, $req );
    if (isa_ok( $view->{concept}, 'Pangloss::Concept', 'rm view->concept' )) {
	ok( $view->{concept}->{removed}, 'remove concept' );
    }
    $req->arguments({});
}

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

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

# request - get concept
test_request_setter( 'Pangloss::Segment::Request::GetConcept', 'get_concept' );

# request - list concepts
test_request_setter( 'Pangloss::Segment::Request::ListConcepts', 'list_concepts' );