#!/usr/bin/perl -w
# Test the attribute system, especially gettin, setting attributes
# on objects and classes:
use Test::More;
use strict;
BEGIN
   {
   plan tests => 120;
   chdir 't' if -d 't';
   use lib '../lib';
   use_ok ("Graph::Easy::Attributes") or die($@);
   use_ok ("Graph::Easy") or die($@);
   };
can_ok ("Graph::Easy", qw/
  color_as_hex
  color_name
  color_value
  _remap_attributes
  valid_attribute
  /);
#############################################################################
# color_as_hex:
my $att = 'Graph::Easy';
is ($att->color_as_hex( 'red' ), '#ff0000', 'color red');
is ($att->color_as_hex( '#0000ff' ), '#0000ff', 'color #0000ff');
is ($att->color_as_hex( '#f0c' ), '#ff00cc', 'color #f0c');
is ($att->color_as_hex( 'rgb(128,255,0)' ), '#80ff00', 'color rgb(128,255,0)');
is ($att->color_as_hex('lavender'), '#e6e6fa', 'color lavender');
is ($att->color_as_hex('lavenderblush'), '#fff0f5', 'color lavenderblush');
is ($att->color_as_hex('lavenderbush'), undef, 'color lavenderbush does not exist');
#############################################################################
# color_name:
is ($att->color_name('red'), 'red', 'red => red');
is ($att->color_name('#ff0000'), 'red', '#ff0000 => red');
is ($att->color_name('#ffffff'), 'white', '#ffffff => white');
is ($att->color_name('#808080'), 'gray', '#808080 => gray');
#############################################################################
# color scheme support:
is ($att->color_name('grey', 'x11'), 'grey', 'grey => grey');
is ($att->color_name('#c0c0c0','x11'), 'gray', '#c0c0c0 => gray');
is ($att->color_name('#ffffff','x11'), 'white', '#ffffff => white');
is ($att->color_name('grey23','x11'), 'grey23', 'grey23 => grey23');
     
# 1  => '#ca0020', 2  => '#f4a582', 3  => '#bababa', 4  => '#404040', 
is ($att->color_name('1','rdgy4'), '1', '1 => 1 under rdgy4');
#############################################################################
# color_value:
is ($att->color_value('red'), '#ff0000', 'red => #ff0000');
is ($att->color_value('grey'), '#808080', 'grey => #808080');
is ($att->color_value('grey','x11'), '#c0c0c0', 'grey => #c0c0c0 under x11');
is ($att->color_value('grey23','x11'), '#3b3b3b', 'grey23 => #3b3b3b under x11');
# 1  => '#ca0020', 2  => '#f4a582', 3  => '#bababa', 4  => '#404040', 
is ($att->color_value('1','rdgy4'), '#ca0020', '1 => #ca0020 under rdgy4');
is ($att->color_value('4','rdgy4'), '#404040', '4 => #404040 under rdgy4');
#############################################################################
# valid_attribute:
$att = Graph::Easy->new();
$att->no_fatal_errors(1);
my $new_value = $att->valid_attribute( 'color', 'redbrownish' );
is ($new_value, undef, 'color redbrownish is not valid');
$new_value = $att->valid_attribute( 'border-color', 'redbrownish' );
is ($new_value, undef, 'border-color redbrownish is not valid');
$new_value = $att->valid_attribute( 'border-shape', 'double' );
is (ref($new_value), 'ARRAY', 'border-shape is not valied');
# no class name: 'all' will be tested
for my $name (
    'red','w3c/red','x11/red', 'chocolate4', 'rgb(1,2,3)', 
    'rgb(10%,1%,2%)', 'rgb(8,1%,0.2)', 'w3c/grey',
   )
  {
  for my $class ( undef, 'node', 'node.subclass')
    {
    my $new_value = $att->valid_attribute( 'color', $name, $class );
    is ($new_value, $name, "color $name is valid");
    }
  }
#############################################################################
# fallback to color scheme 'x11'
$new_value = $att->valid_attribute( 'color', 'chocolate4' );
is ($new_value, 'chocolate4', 'color chocolate4 is valid');
#############################################################################
# valid_attribute for graph only:
$new_value = $att->valid_attribute( 'gid', '123', 'graph' );
is ($new_value, '123', 'gid 123 is valid for graph');
$new_value = $att->valid_attribute( 'gid', '123', 'node' );
is (ref($new_value), 'ARRAY', 'gid is invalid for nodes');
$new_value = $att->valid_attribute( 'gid', '123', 'edge' );
is (ref($new_value), 'ARRAY', 'gid is invalid for edges');
$new_value = $att->valid_attribute( 'output', 'html', 'graph' );
is ($new_value, 'html', 'output "html" is valid for graph');
$new_value = $att->valid_attribute( 'output', 'html', 'node' );
is (ref($new_value), 'ARRAY', 'output is invalid for nodes');
$new_value = $att->valid_attribute( 'output', 'html', 'edge' );
is (ref($new_value), 'ARRAY', 'output is invalid for edges');
#############################################################################
# setting attributes on graphs, nodes and edges
my $graph = Graph::Easy->new();
$graph->no_fatal_errors(1);
my ($n,$m,$e) = $graph->add_edge('A','B');
$n->set_attribute('color','red');
is ($graph->error(),'','no error');
$graph->error('');                   # reset potential error for next test
$n->set_attribute('shape','point');
is ($graph->error(),'','no error');
$graph->error('');                   # reset potential error for next test
$graph->set_attribute('graph', 'shape', 'point');
is ($graph->error(),"Error in attribute: 'shape' is not a valid attribute name for a graph",
  'shape is not a valid attribute');
$graph->error('');                   # reset potential error for next test
$e->no_fatal_errors(1);
$e->set_attribute('shape','point');
is ($graph->error(),"Error in attribute: 'shape' is not a valid attribute name for a edge",
  'shape is not a valid attribute');
$graph->error('');                   # reset potential error for next test
#############################################################################
# Setting an attribute on the graph directly is the same as setting it on
# the class 'graph':
$graph->set_attribute('graph', 'flow', 'south');
is ($graph->attribute('flow'), 'south', 'flow was set to south');
$graph->set_attribute('flow', 'west');
is ($graph->attribute('flow'), 'west', 'flow was set to south');
is ($graph->attribute('label-pos'), 'top', 'label-pos defaults to top');
is ($graph->attribute('labelpos'), 'top', 'label-pos defaults to top');
$graph->set_attribute('graph', 'label-pos', 'bottom');
is ($graph->attribute('label-pos'), 'bottom', 'label-pos was set to bottom');
is ($graph->attribute('labelpos'), 'bottom', 'label-pos was set to bottom');
$graph->del_attribute('label-pos');
is ($graph->attribute('label-pos'), 'top', 'label-pos defaults to top');
is ($graph->attribute('labelpos'), 'top', 'label-pos defaults to top');
$graph->set_attribute('graph', 'labelpos', 'bottom');
is ($graph->attribute('label-pos'), 'bottom', 'label-pos was set to bottom');
is ($graph->attribute('labelpos'), 'bottom', 'label-pos was set to bottom');
#############################################################################
# text-style attribute
for my $class (qw/edge graph node group/)
  {
  $graph->set_attribute($class, 'text-style', 'none');
  is ($graph->error(), '', "could set text-style on $class");
  $graph->error('');                 # reset potential error for next test
  $graph->set_attribute($class, 'text-style', 'bold');
  is ($graph->error(), '', "could set text-style on $class");
  $graph->error('');                 # reset potential error for next test
  $graph->set_attribute($class, 'text-style', 'bold underline');
  is ($graph->error(), '', "could set text-style on $class");
  $graph->error('');                 # reset potential error for next test
  $graph->set_attribute($class, 'text-style', 'bold underline overline italic');
  is ($graph->error(), '', "could set text-style on $class");
  $graph->error('');                 # reset potential error for next test
  }
$graph->set_attribute('graph', 'text-style', 'bold underline overline italic');
my $styles = $graph->text_styles();
is (join(',', sort keys %$styles), 'bold,italic,overline,underline', 'text_styles()');
my $node = $graph->add_node('one');
$node->set_attribute('text-style', 'bold underline overline italic');
$styles = $node->text_styles();
is (join(',', sort keys %$styles), 'bold,italic,overline,underline', 'text_styles() on node');
#############################################################################
# border-style vs. borderstyle
$graph = Graph::Easy->new();
$graph->no_fatal_errors(1);
($n,$m,$e) = $graph->add_edge('A','B');
is ($n->attribute('border-style'),'solid', 'border-style is solid');
is ($n->attribute('borderstyle'),'solid', 'borderstyle is solid');
$n->set_attribute('border-style','dashed');
is ($n->attribute('border-style'),'dashed', 'border-style is now dashed');
is ($n->attribute('borderstyle'),'dashed', 'border-style is now dashed');
#############################################################################
# inheritance of values ('inherit')
$graph = Graph::Easy->new();
($n,$m,$e) = $graph->add_edge('A','B');
$graph->set_attribute('node', 'color', 'red');
$graph->set_attribute('color', 'green');
$n->set_attribute('color', 'inherit');
$n->set_attribute('class', 'foo');
is ($n->attribute('class'), 'foo', 'get_attribute("class") works');
# N inherits from class "node"
is ($n->attribute('color'),'red', 'inherited red from class "node"');
is ($m->attribute('color'),'red', 'inherited red from class "node"');
$graph->set_attribute('node', 'color', 'inherit');
is ($n->attribute('color'),'green', 'inherited green from graph');
is ($m->attribute('color'),'green', 'inherited green from graph');
$m->set_attribute('color', 'blue');
is ($m->attribute('color'),'blue', 'got blue');
#############################################################################
# raw_attribute() and get_raw_attributes()
$graph = Graph::Easy->new();
($n,$m,$e) = $graph->add_edge('A','B');
$graph->set_attribute('node', 'color', 'red');
$graph->set_attribute('color', 'green');
$n->set_attribute('color', 'inherit');
$n->set_attribute('class', 'foo');
$m->set_attribute('color', 'blue');
# N inherits from class "node"
is ($n->raw_attribute('fill'), undef, 'attribute fill not set');
is ($n->raw_attribute('color'), 'red', 
  'attribute color set to inherit, so we inherit red');
is ($graph->raw_attribute('fill'), undef, 'attribute fill not set on graph');
is ($graph->raw_attribute('color'), 'green', 
  'attribute color set to green on graph');
is ($m->raw_attribute('color'), 'blue', 
  'attribute color set to blue on node B');
is ($m->raw_attribute('fill'), undef, 
  'attribute fill not set on node m');
my $str = _att_to_str($n->raw_attributes());
is ($str, 'color=>red;', 'node A has only color set');
$str = _att_to_str($m->raw_attributes());
is ($str, 'color=>blue;', 'node B has only color set');
$str = _att_to_str($graph->raw_attributes());
is ($str, 'color=>green;', 'graph has only color set');
$str = _att_to_str($e->raw_attributes());
is ($str, '', 'edge has no attributes set');
#############################################################################
# virtual attribute 'class'
$graph = Graph::Easy->new();
($n,$m,$e) = $graph->add_edge('Bonn','Berlin');
is ($graph->attribute('class'), '', 'class graph');
is ($n->attribute('class'), '', 'class node');
is ($e->attribute('class'), '', 'class edge');
$n->set_attribute('class', 'anon');
is ($n->attribute('class'), 'anon', 'class anon for node Bonn');
$e->set_attribute('class', 'foo');
is ($e->attribute('class'), 'foo', 'class foo for edge');
#############################################################################
# attribute 'link'
$graph = Graph::Easy->new();
($n,$m,$e) = $graph->add_edge('Bonn','Berlin');
$n->set_attribute('autolink','name');
# default linkbase + autolink from name
is ($n->link(), '/wiki/index.php/Bonn', "link() for 'Bonn'");
is ($graph->link(), '', "no link on graph");
$graph->set_attribute('autolink','name');
# graph doesn't have a name => no link
is ($graph->link(), '', "link() is 'Bonn'");
$graph->set_attribute('link','Berlin');
# default linkbase + link
is ($graph->link(), '/wiki/index.php/Berlin', "link() for graph");
1;
#############################################################################
sub _att_to_str
  {
  my $out = shift;
  my $str = '';
  for my $k (sort keys %$out)
    {
    $str .= $k . '=>' . $out->{$k} . ';';
    }
  $str;
  }