#
# This file is part of StorageDisplay
#
# This software is copyright (c) 2020 by Vincent Danjean.
#
# This is free software; you can redistribute it and/or modify it under
# the same terms as the Perl 5 programming language system itself.
#
use strict;
use warnings;
use 5.14.0;

package StorageDisplay;
# ABSTRACT: Collect and display storages on linux machines

our $VERSION = '1.0.6'; # VERSION

1;

package StorageDisplay::Moose::Cached;

use Carp;

our %orig_has;  # save original 'has' sub routines here

sub import {
    my $callpkg = caller 0;
    {
        no strict 'refs'; ## no critic
        no warnings 'redefine';
        $orig_has{$callpkg} = *{$callpkg."::has"}{CODE};
        *{$callpkg."::has"} = \&cached_has;
    }
    return;
}

sub cached_has {
    my ($attr, %args) = @_;

    my $callpkg = caller 0;
    if (exists $args{cached_hash} ) {
        my $compute = $args{compute};
        my $type = $args{cached_hash};
        croak "'compute' attribute required" if not exists  $args{compute};
        my $cache_set = '_cached_set_'.$attr;
        my $cache_has = '_cached_has_'.$attr;
        my $cache_get = '_cached_get_'.$attr;
        $args{handles}->{$cache_set} = 'set';
        $args{handles}->{$cache_has} = 'exists';
        $args{handles}->{$cache_get} = 'get';
        %args = (
            is       => 'bare',
            required => 1,
            default  => sub { return {}; },
            lazy     => 1,
            init_arg => undef, # prevent from being set by constructor
            %args,
            traits   => [ 'Hash' ],
            isa      => "HashRef[$type]",
        );
        delete $args{cached_hash};
        delete $args{compute};
        #print STDERR "My cached arg $attr\n";
        $callpkg->meta->add_method(
            $attr => sub {
                my $self = shift;
                my $name = shift;

                if ($self->$cache_has($name)) {
                    return $self->$cache_get($name);
                }
                my $elem = $compute->($self, $name, @_);
                if (defined($elem)) {
                    $self->$cache_set($name, $elem);
                }
                return $elem;

            });
    }
    $orig_has{$callpkg}->($attr, %args);
}

BEGIN {
    # Mark current package as loaded;
    my $p = __PACKAGE__;
    $p =~ s,::,/,g;
    chomp(my $cwd = `pwd`);
    $INC{$p.'.pm'} = $cwd.'/'.__FILE__;#k"current file";
}

1;

##################################################################
package StorageDisplay::Role::Iterable;

use MooseX::Role::Parameterized;

use Carp;

parameter iterable => (
    isa      => 'Str',
    required => 1,
    );

role {
    my $p = shift;

    my $iterable = $p->iterable;
    my $iterator = $iterable.'::Iterator';
    my $iteratorframe = $iterator.'::Frame';

    has 'name' => (
        is       => 'ro',
        isa      => 'Str',
        required => 1,
        );

    has '_parents' => (
        traits   => [ 'Hash' ],
        is       => 'ro',
        isa      => "HashRef[$iterable]",
        required => 1,
        default  => sub { return {}; },
        handles  => {
            '_add_parents' => 'set',
                'hasParent' => 'exists',
                '_getParent' => 'get',
        }
        );

    has '_parents_tab' => (
        traits   => [ 'Array' ],
        is       => 'ro',
        isa      => "ArrayRef[$iterable]",
        required => 1,
        default  => sub { return []; },
        handles  => {
            '_add_parents_tab' => 'push',
                'parents' => 'elements',
        }
        );

    method "_addParent" => sub {
        my $self = shift;
        my $parent = shift;
        my $parent_name = $parent->name;
        if ($self->hasParent($parent_name)) {
            if ($parent != $self->_getParent($parent_name)) {
                croak "Two different parents with name $parent_name for ".$self->name;
            }
        } else {
            $self->_add_parents($parent_name, $parent);
            $self->_add_parents_tab($parent);
        }
    };

    has '_children' => (
        traits   => [ 'Hash' ],
        is       => 'ro',
        isa      => "HashRef[$iterable]",
        required => 1,
        default  => sub { return {}; },
        handles  => {
            '_addChild' => 'set',
                'hasChild' => 'exists',
                '_getChild' => 'get',
        }
        );

    has '_children_tab' => (
        traits   => [ 'Array' ],
        is       => 'ro',
        isa      => "ArrayRef[$iterable]",
        required => 1,
        default  => sub { return []; },
        handles  => {
        '_addChild_tab' => 'push',
            'children' => 'elements',
        }
        );

    method "addChild" => sub {
        my $self = shift;
        my $child = shift;
        my $child_name = $child->name;
        if ($self->hasChild($child_name)) {
            if ($child != $self->_getChild($child_name)) {
                croak "Two different children with name $child_name for ".$self->name;
            }
        } else {
            $self->_addChild($child_name, $child);
            $self->_addChild_tab($child);
        }
        $child->_addParent($self);
        return $child;
    };

    method "iterator" => sub {
        my $self = shift;

        return "$iterator"->new(
            $self,
            @_,
            );
    };
    ######################################################
    ######################################################
    # ::Iterator class
    my $iteratorclass = Moose::Meta::Class->create(
        $iterator,
        #attributes => [],
        #roles => [],
        #methods => {},
        superclasses => ["Moose::Object"],
        );

    $iteratorclass->add_attribute(
        'recurse' => (
            is  => 'ro',
            isa => 'Bool',
            required => 1,
            default => 1,
        ));
    $iteratorclass->add_attribute(
        'with-self' => (
            is  => 'bare',
            reader => 'with_self',
            isa => 'Bool',
            required => 1,
            default => 0,
        ));
    $iteratorclass->add_attribute(
        '_seen' => (
            traits => [ 'Hash' ],
            is  => 'ro',
            isa => 'HashRef[Bool]',
            required => 1,
            default => sub { return {}; },
            handles  => {
                '_found' => 'exists',
                    '_mark' => 'set',
            }
        ));
    $iteratorclass->add_attribute(
        'uniq' => (
            is  => 'ro',
            isa => 'Bool',
            required => 1,
            default => 0,
        ));
    $iteratorclass->add_attribute(
        'postfix' => (
            is => 'ro',
            isa => 'Bool',
            required => 1,
            default => 0,
        ));
    $iteratorclass->add_attribute(
        '_stack_frame' => (
            traits => [ 'Array' ],
            is  => 'ro',
            isa => "ArrayRef[$iteratorframe]",
            required => 1,
            default => sub { return []; },
            handles  => {
                '_push_frame' => 'push',
                    '_pop_frame' => 'pop',
            }
        ));
    $iteratorclass->add_attribute(
        '_init_block' => (
            is  => 'ro',
            isa => $iterable,
            required => 1,
        ));
    $iteratorclass->add_attribute(
        '_cur_frame' => (
            is  => 'rw',
            isa => "Maybe[$iteratorframe]",
            required => 1,
            lazy => 1,
            default => sub {
                my $self = shift;
                return $iteratorframe->new(
                    $self->_init_block,
                    $self,
                    );
            },
        ));
    $iteratorclass->add_attribute(
        '_next_computed' => (
            is  => 'rw',
            isa => 'Bool',
            required => 0,
            default => 0,
        ));
    $iteratorclass->add_attribute(
        '_next' => (
            is  => 'rw',
            isa => "Maybe[$iterable]",
            required => 0,
            default => undef,
        ));
    $iteratorclass->add_method(
        'has_next' => sub {
            my $self = shift;
            if (! $self->_next_computed) {
                $self->_compute_next;
            }
            return defined($self->_next);
        });
    $iteratorclass->add_method(
        'next' => sub {
            my $self = shift;
            if (! $self->_next_computed) {
                $self->_compute_next;
            }
            $self->_next_computed(0);
            return $self->_next;
        });
    $iteratorclass->add_attribute(
        'filter' => (
            traits  => ['Code'],
            is      => 'ro',
            isa     => 'CodeRef',
            default => sub {
                sub { 1; }
            },
            handles => {
                do_filter => 'execute',
            },
        ));
    $iteratorclass->add_method(
        '_compute_next' => sub {
            my $self = shift;

            $self->_next_computed(1);
            if (!defined($self->_cur_frame)) {
                $self->_next(undef);
                return;
            }
            #print STDERR "****\nBegin compute: ", $self->_cur_frame->dump, "\n";
            do {
                do {
                    my $n = $self->_cur_frame->next_child;
                    while (! defined($n)) {
                        # nothing more in this frame. Poping it.
                        my $cur_frame = $self->_cur_frame;
                        $self->_cur_frame($self->_pop_frame);
                        if ($self->postfix) {
                            $n=$cur_frame->current;
                            #print STDERR "Poping frame and found: ", $n->name, "\n";
                            if ($n == $self->_init_block) {
                                $self->_next(undef);
                                return;
                            }
                            $self->_next($n);
                            $n=undef;
                            last;
                        } else {
                            if (!defined($self->_cur_frame)) {
                                $self->_next(undef);
                                return;
                            }
                            #print STDERR "Poping frame: ", $self->_cur_frame->dump, "\n";
                            $n = $self->_cur_frame->next_child;
                        }
                    }
                    while (defined($n)) {
                        # $n : next in _cur_frame
                        my @children = ($n->children);
                        if (! $self->recurse || scalar(@children) == 0) {
                            # no children for current node (or no recursion), just using it and go
                            $self->_next($n);
                            #print STDERR "Found no children: ", $n->name, "\n";
                            last;
                        } else {
                            # Building new frame
                            my $new_frame = $iteratorframe->new(
                                $n,
                                $self,
                                );
                            #print STDERR "Building new frame: ", $new_frame->dump, "\n";
                            $self->_push_frame($self->_cur_frame);
                            $self->_cur_frame($new_frame);
                            if (! $self->postfix) {
                                $self->_next($n);
                                last;
                            } else {
                                $n = $new_frame->next_child;
                            }
                        }
                    }
                } while ($self->uniq && $self->_found($self->_next));
                $self->_mark($self->_next, 1);
                #FIXME# if not a real bloc, accept it
                #last if not $self->_next->isa($iterable);
            } while (
                ($self->with_self || $self->_next != $self->_init_block)
                && !$self->do_filter($self->_next)
                );


            #if ($self->has_next) {
            #    print STDERR "Found: ", $self->_next->name, "\n";
            #}
            #use Data::Dumper;
            #$Data::Dumper::Maxdepth = 3;
            #print STDERR Dumper($self);
        });
    $iteratorclass->add_around_method_modifier(
        'BUILDARGS' => sub {
            my $orig  = shift;
            my $class = shift;
            my $init_block = shift;
            my %args = (@_);

            $args{'_init_block'}=$init_block;
            return $class->$orig(
                %args,
                );
        });
    ######################################################
    ######################################################
    # ::Iterator::Frame class
    my $iteratorframeclass = Moose::Meta::Class->create(
        $iteratorframe,
        #attributes => [],
        #roles => [],
        #methods => {},
        superclasses => ["Moose::Object"],
        );
    $iteratorframeclass->add_attribute(
        'current' => (
            is  => 'ro',
            isa => $iterable,
            required => 1,
        ));
    $iteratorframeclass->add_attribute(
        '_children' => (
            traits => [ 'Array' ],
            is  => 'ro',
            isa => "ArrayRef[$iterable]",
            required => 1,
            handles  => {
                'next_child' => 'shift',
                    '_all_children' => 'elements',
            }
        ));
    $iteratorframeclass->add_attribute(
        'it' => (
            is  => 'ro',
            isa => $iterator,
            required => 1,
        ));
    $iteratorframeclass->add_around_method_modifier(
        'BUILDARGS' => sub {
            my $orig  = shift;
            my $class = shift;
            my $current = shift;
            my $it = shift;

            return $class->$orig(
                'current' => $current,
                'it' => $it,
                '_children' => [ $current->children ],
                );
        });
};

##################################################################
package StorageDisplay;

## Main object

use Moose;
use namespace::sweep;
use Carp;

has 'blocks' => (
    is       => 'ro',
    isa      => 'HashRef[StorageDisplay::Block]',
    traits   => [ 'Hash' ],
    default  => sub { return {}; },
    lazy     => 1,
    handles  => {
	'addBlock'  => 'set',
	    'has_block' => 'exists',
	    '_block'     => 'get',
            'allBlocks' => 'values'
    },
    );

has 'blocksRoot' => (
    is     => 'ro',
    isa    => 'StorageDisplay::BlockTreeElement',
    lazy   => 1,
    builder => '_loadAllBlocks',
    );

has 'infos' => (
    is     => 'ro',
    isa    => 'HashRef',
    required => 1,
    traits   => [ 'Hash' ],
#    handles  => {
#	'get_info'  => 'get',
#    }
    );

sub get_info {
    my $self = shift ;
    my @keys=@_;

    my $infos=$self->infos;

    while (defined(my $k = shift @keys)) {
        return if not defined($infos->{$k});
        $infos = $infos->{$k};
    }
    return $infos;
}

#has 'connect' => (
#    is       => 'ro',
#    isa      => 'StorageDisplay::Connect',
#    required => 0,
#    );

sub _allocateBlock {
    my $self=shift;
    my $name=shift;
    my $alloc=shift;

    my $block=$alloc->();
    foreach my $n ($block->names_str()) {
        if ($self->has_block($n)) {
            print STDERR "W: duplicate block name '$n' for ".$block->name.
                " and ".$self->_block($n)->name."\n";
        } else {
            #print STDERR "I: Registering block name '$n' for ".$block->name."\n";
        }
        $self->addBlock($n, $block);
    }
}

sub systemBlock {
    my $self=shift;
    my $name=shift;

    if (! $self->has_block($name)) {
        $self->_allocateBlock(
            $name, sub {
                return StorageDisplay::Block::System->new(
                    $name,
                    $self);
            });
    }
    return $self->_block($name);
}

sub block {
    my $self=shift;
    my $name=shift;

    if ($name =~m,^/dev/(.*)$,) {
        $name=$1;
    }
    if (! $self->has_block($name)) {
        $self->_allocateBlock(
            $name, sub {
                return StorageDisplay::Block::NoSystem->new(
                    'name' => $name,
                    );
            });
    }
    return $self->_block($name);
}

sub _loadAllBlocks {
    my $self=shift;

    use JSON::MaybeXS qw(decode_json);
    my $blocks=$self->get_info('lsblk-hierarchy');

    my $handle_bloc;
    $handle_bloc = sub {
        my $jcur = shift;
        my $bparent = shift;
        my @children = (@{$jcur->{'children'}//[]});
        #print STDERR Dumper($jcur);
        my $bcur = $self->systemBlock($jcur->{'kname'});
        $bparent->addChild($bcur);
        foreach my $jchild (@children) {
            my $bchild = $handle_bloc->($jchild, $bcur);
        }
        return $bcur;
    };

    my $root=StorageDisplay::BlockTreeElement->new('name' => 'Root');

    foreach my $b (values %$blocks) {
        $handle_bloc->($b, $root);
    }
    return $root;
}

sub dumpBlocks {
    my $self = shift;

    foreach my $b ($self->allBlocks) {
        print $b->name, "\n";
    }
}

sub _log {
    my $self = shift;
    my $opts = shift;
    my $info = shift;

    if (ref($info) =~ /^HASH/) {
        $opts = { %{$opts}, %{$info} };
        $info = shift;
    }

    print STDERR $opts->{type}, ': ', ('  'x$opts->{level}), $info, "\n";
    foreach my $line (@_) {
        print STDERR '   ', ('  'x$opts->{level}), $line, "\n";
    }
}


sub log {
    my $self = shift;

    return $self->_log(
        {
            'level' => 0,
                'type' => 'I',
                'verbose' => 1,
        }, @_);
}

sub warn {
    my $self = shift;

    return $self->_log(
        {
            'level' => 0,
                'type' => 'W',
                'verbose' => 1,
        }, @_);
}

sub error {
    my $self = shift;

    return $self->_log(
        {
            'level' => 0,
                'type' => 'E',
                'verbose' => 1,
        }, @_);
}

###################
has '_providedBlocks' => (
    is       => 'ro',
    isa      => 'HashRef[StorageDisplay::Elem]',
    traits   => [ 'Hash' ],
    default  => sub { return {}; },
    lazy     => 1,
    handles  => {
	'_addProvidedBlock' => 'set',
            '_provideBlock' => 'exists',
    }
    );

has 'elemsRoot' => (
    is       => 'ro',
    isa      => 'StorageDisplay::Root',
    default  => sub {
        return StorageDisplay::Root->new(); #FIXME add host
    },
    lazy     => 1,
    );

sub _registerElement {
    my $self = shift;
    my $elem = shift;
    my @providedBlockNames = map {
        StorageDisplay::Block::asname($_)
    } $elem->allProvidedBlocks;

    foreach my $bn (@providedBlockNames) {
        if ($self->provide($bn)) {
            carp "Duplicate provider for $bn";
            return 0;
        }
    }
    foreach my $bn (@providedBlockNames) {
        $self->_addProvidedBlock($bn, $elem);
    }
    #use Data::Dumper;
    #print STDERR Dumper($elem);
    #print STDERR $elem->isa("StorageDisplay::Elem"), " DONE\n";
    $self->elemsRoot->addChild($elem);
    return 1;
}

sub provide {
    my $self = shift;
    my $block = shift;
    my $blockname = StorageDisplay::Block::asname($block);

    return $self->_provideBlock($blockname);
}

sub createElems {
    my $self = shift;
    my $root=$self->blocksRoot();
    $self->removeVMsPartitions;
    $self->createPartitionTables;
    $self->createLVMs;
    $self->createLUKSs;
    $self->createMDs;
    $self->createLSIMegaclis;
    $self->createLSISASIrcus;
    $self->createFSs;
    $self->createVMs;
    $self->computeUsedBlocks;
}

sub removeVMsPartitions {
    my $self = shift;
    my $partitions = $self->get_info('partitions')//{};
    my $vms = $self->get_info('libvirt')//{};
    my $vmblocks={};
    $self->log("Removing partitions of virtual machines disks");
    foreach my $vm (values %$vms) {
        foreach my $bname (keys %{$vm->{blocks}//{}}) {
            my $b = $self->block($bname);
            foreach my $n ($b->names_str) {
                $vmblocks->{$n} = $vm->{name}//1;
            }
        }
    }
    foreach my $p (keys %$partitions) {
        my $b = $self->block($p);
        if (exists($vmblocks->{$b->name})) {
            $self->log({level=>1}, "Removing ".$b->dname." (in VM ".$vmblocks->{$b->name}.")");
            delete($partitions->{$p});
        }
    }
}

sub createPartitionTables {
    my $self = shift;
    $self->log("Creating partition tables");
    if (defined($self->get_info('partitions'))) {
	foreach my $p (sort keys %{$self->get_info('partitions')}) {
	    next if defined($self->get_info('partitions', $p, 'dos-extended'));
	    $self->createPartitionTable($p);
	}
    }
}

sub createPartitionTable {
    my $self = shift;
    my $dev = shift;
    my $block = $self->block($dev);
    my $elem;

    if ($block->blk_info("PTTYPE") eq "gpt") {
        $elem = StorageDisplay::Partition::GPT->new($block, $self);
    } elsif ($block->blk_info("PTTYPE") eq "dos") {
        $elem = StorageDisplay::Partition::MSDOS->new($block, $self);
    } else {
        $self->warn("Unknown partition type ".$block->blk_info("PTTYPE")." for ".$block->name);
        return;
    }
    if (!$self->_registerElement($elem)) {
        $self->error("Cannot register partition table for ".$block->name);
        return;
    }
}

sub createLVMs {
    my $self = shift;
    $self->log('Creating LVM volume groups');
    for my $vgname (sort keys %{$self->get_info('lvm') // {}}) {
        my $elem;
        if ($vgname eq '') {
            $elem = StorageDisplay::LVM::OnlyPV->new($vgname, $self);
        } else {
            $elem = StorageDisplay::LVM->new($vgname, $self);
        }
        if (!$self->_registerElement($elem)) {
            $self->error("Cannot register LVM vg ".$vgname);
            return;
        }
    }
}

sub createLUKSs {
    my $self = shift;
    $self->log("Creating LUKS devices");
    for my $devname (sort keys %{$self->get_info('luks') // {}}) {
        my $elem = StorageDisplay::LUKS->new($devname, $self);
        if (!$self->_registerElement($elem)) {
            $self->error("Cannot register LUKS device ".$devname);
            return;
        }
    }
}

sub createMDs {
    my $self = shift;
    $self->log("Creating MD devices");
    for my $devname (sort keys %{$self->get_info('md') // {}}) {
        my $elem = StorageDisplay::RAID::MD->new($devname, $self);
        if (!$self->_registerElement($elem)) {
            $self->error("Cannot register MD device ".$devname);
            return;
        }
    }
}

sub createLSIMegaclis {
    my $self = shift;
    $self->log("Creating Megacli controllers");
    for my $cnum (sort keys %{$self->get_info('lsi-megacli') // {}}) {
        my $elem = StorageDisplay::RAID::LSI::Megacli->new($cnum, $self);
        if (!$self->_registerElement($elem)) {
            $self->error("Cannot register Megacli controller #".$cnum);
            return;
        }
    }
}

sub createLSISASIrcus {
    my $self = shift;
    $self->log("Creating SAS LSI controllers");
    for my $cnum (sort keys %{$self->get_info('lsi-sas-ircu') // {}}) {
        my $elem = StorageDisplay::RAID::LSI::SASIrcu->new($cnum, $self);
        if (!$self->_registerElement($elem)) {
            $self->error("Cannot register SAS LSI controller #".$cnum);
            return;
        }
    }
}

sub createFSs {
    my $self = shift;
    my $elem = StorageDisplay::FS->new($self);
    if (!$self->_registerElement($elem)) {
        print STDERR "Cannot register FS\n";
        return;
    }
}

sub createVMs {
    my $self = shift;
    my $elem = StorageDisplay::Libvirt->new($self);
    if (!$self->_registerElement($elem)) {
        print STDERR "Cannot register Libvirt\n";
        return;
    }
}

sub computeUsedBlocks {
    my $self = shift;

    my $it = $self->elemsRoot->iterator(recurse => 1);
    while (defined(my $e=$it->next)) {
        my @blocks = grep {
            $_->provided
        } $e->consumedBlocks;

        if (scalar(@blocks)>0) {
            foreach my $block (@blocks) {
                $block->state("used");
            }
        }
    }

}

sub display {
    my $self = shift;
    print join("\n", $self->dotNode), "\n";
}

sub dotNode {
    my $self = shift;
    return $self->elemsRoot->dotNode("\t");
}

1;

##################################################################
package StorageDisplay::Role::HasBlock;

use Moose::Role;

has 'block' => (
    is       => 'ro',
    isa      => 'StorageDisplay::Block',
    required => 1,
    );

1;

##################################################################
package StorageDisplay::Role::Style::Base;

use Moose::Role;

1;

##################################################################
package StorageDisplay::Role::Style::Base::Elem;

use Moose::Role;

use Carp;

sub dotJoinStyle {
    my $self = shift;
    my $t = shift // "\t";

    return join(';', grep { defined($_) } @_);
}

sub dotIndent {
    my $self = shift;
    my $t = shift // "\t";

    return map { $t.$_ } @_;
}

sub dotLabel {
    my $self = shift;
    return ($self->_dotDefaultLabel(@_));
}

sub dotFullLabel {
    my $self = shift;
    return $self->_dotDefaultFullLabel(@_);
}

sub dotNode {
    my $self = shift;
    #print STDERR "dotNode in ".__PACKAGE__." for ".$self->name."\n";
    return $self->_dotDefaultNode(@_);
}

sub dotStyleNode {
    my $self = shift;
    return $self->_dotDefaultStyleNode(@_);
}

sub dotStyleNodeState {
    my $self = shift;

    return $self->_dotDefaultStyleNodeState;
}

sub dotFormatedFullLabel {
    my $self = shift;
    my $t = shift;

    return join($self->_dotLabelNL,
                $self->dotFullLabel);
}

# default implementations

# will be overrided when a Table is generated
sub _dotTableLabel {
    my $self = shift;
    return $self->dotFormatedFullLabel(@_);
}

sub _dotDefaultLabel {
    my $self = shift;
    return ($self->name);
}

sub _dotDefaultStyleNodeState {
    my $self = shift;

    return ();
}

sub _dotDefaultStyleNode {
    my $self = shift;
    my @style = grep { $_ !~ m/[node]/ } $self->dotStyle(@_);

    push @style, $self->dotStyleNodeState(@_);
    return @style;
}

sub _dotLabelNL {
    my $self = shift;
    return '\n';
}

# will be overrided with Size, Used, Free infos
sub _dotDefaultFullLabel {
    my $self = shift;

    return ($self->dotLabel(@_));
}

# will be overrided for HTML
sub _dotDefaultLabelLine {
    my $self = shift;
    my @label = $self->dotFormatedFullLabel(@_);
    confess "Multiline formated label!" if scalar(@label) > 1;
    return 'label="";' if scalar(@label) == 0;

    return ('label="'.$label[0].'";');
}

# will be overrided when another node kind is selected
sub _dotDefaultNode {
    my $self = shift;
    my $t = shift // "\t";

    #print STDERR "coucou2 from ".$self->name."\n";
    my @text = (
        "{ ".'"'.$self->name.'" [',
        $self->dotIndent(
            $t,
            $self->_dotDefaultLabelLine($t, @_),
            $self->dotStyleNode(),
        ),
        ']; }',
        );
    return @text;
}

1;

##################################################################
package StorageDisplay::Role::Style::Base::HTML;

use Moose::Role;

around '_dotLabelNL' => sub {
    my $orig = shift;
    my $self = shift;
    return '<BR/>';
};

around '_dotDefaultLabelLine' => sub {
    my $orig = shift;
    my $self = shift;
    my $t = shift;

    my @text=$self->dotIndent($t, $self->_dotTableLabel($t, @_));

    if (scalar(@text) == 0) {
        return ('label=<>;')
    }

    $text[0] =~ s/^\s+//;
    $text[0] = 'label=<'.$text[0];
    push @text, '>;';

    return @text;
};

1;

##################################################################
package StorageDisplay::Role::Style::IsLabel;

use Moose::Role;

with (
    'StorageDisplay::Role::Style::Base',
    );

around '_dotDefaultNode' => sub {
    my $orig = shift;
    my $self = shift;

    #print STDERR "coucou from ".$self->name."\n";
    return $self->_dotTableLabel(@_);
};

1;

##################################################################
package StorageDisplay::Role::Style::IsSubGraph;

use Moose::Role;

sub dotSubGraph {
    my $self = shift;
    return $self->_dotDefaultSubGraph(@_);
}

sub _dotDefaultSubGraph {
    my $self = shift;
    my $t = shift;

    my @text;
    my $it = $self->iterator(recurse => 0);
    while (defined(my $e = $it->next)) {
        push @text, $e->dotNode($t, @_);
    }
    return @text;
}

around '_dotDefaultNode' => sub {
    my $orig = shift;
    my $self = shift;
    my $t = shift // "\t";

    my @text = (
        'subgraph "cluster_'.$self->name.'" {',
        $self->dotIndent(
            $t,
            $self->dotStyle($t, @_),
            $self->dotSubGraph($t, @_),
            $self->_dotDefaultLabelLine($t, @_),
            $self->dotStyleNode(),
        ),
        '}',
        );
    return @text;
};

around '_dotDefaultStyleNode' => sub {
    my $orig = shift;
    my $self = shift;

    return ();
};

with (
    'StorageDisplay::Role::Style::Base',
    );

1;

##################################################################
package StorageDisplay::Role::Style::Label::HTML;

use Moose::Role;

with (
    'StorageDisplay::Role::Style::Base::HTML',
    'StorageDisplay::Role::Style::Base',
    );

1;

##################################################################
package StorageDisplay::Role::Style::Label::HTML::Table;

use Moose::Role;

sub dotStyleTable {
    return '';
};

around '_dotTableLabel' => sub {
    my $orig = shift;
    my $self = shift;
    my $t = shift;
    my $it = $self->iterator(recurse => 0);

    return ('<TABLE '.$self->dotStyleTable(@_).'>',
            $self->dotIndent(
                $t,
                $self->dotTable($t, $it, @_),
            ),
            '</TABLE>',
        );
};

sub dotTable {
    my $self=shift;

    return $self->_dotDefaultTable(@_);
}

sub _dotDefaultTable {
    my $self=shift;
    my $t = shift;
    my $it = shift;

    my @text;
    while (defined(my $e = $it->next)) {
        push @text, '<TR><TD>',
            $self->dotIndent($t, $e->dotNode($t, @_)),
            '</TD></TR>'
    }

    return @text;
}

with (
    'StorageDisplay::Role::Style::Base::HTML',
    'StorageDisplay::Role::Style::Base',
    );

1;

##################################################################
package StorageDisplay::Role::Style::Plain;

use Moose::Role;

sub dotStyle {
    my $orig  = shift;
    my $self = shift;

    return ( );
};

with (
    'StorageDisplay::Role::Style::Base',
    );

1;

##################################################################
package StorageDisplay::Role::Style::WithSize;

use Moose::Role;

has 'size' => (
    is       => 'ro',
    isa      => 'Int',
    required => 1,
    );

sub dotStyle {
    my $orig  = shift;
    my $self = shift;

    return (
        "style=filled;",
        "color=lightgrey;",
        "fillcolor=lightgrey;",
        "node [style=filled,color=lightgrey,fillcolor=lightgrey,shape=rectangle];",
        );
};

around '_dotDefaultFullLabel' => sub {
    my $orig  = shift;
    my $self = shift;

    return (
        $self->$orig(@_),
        "Size: ".$self->disp_size($self->size),
        );
};

with (
    'StorageDisplay::Role::Style::Base',
    );

1;

##################################################################
package StorageDisplay::Role::Style::WithFree;

use Moose::Role;

with 'StorageDisplay::Role::Style::WithSize';

has 'free' => (
    is       => 'ro',
    isa      => 'Int',
    required => 1,
    );

around _dotDefaultStyleNode => sub {
    my $orig  = shift;
    my $self = shift;

    my $fillcolor='"green"';
    if ($self->size != $self->free) {
        $fillcolor=
            '"pink;'.
                       sprintf("%f.2", ($self->size - $self->free) / $self->size).
                       ':green"';
    }

    return $self->dotJoinStyle(
        $self->$orig(@_),
        'shape=rectangle',
        'style=striped',
        'fillcolor='.$fillcolor,
        );
};

around '_dotDefaultFullLabel' => sub {
    my $orig  = shift;
    my $self = shift;

    return (
        $self->$orig(@_),
        "Free: ".$self->disp_size($self->free),
        );
};

1;

##################################################################
package StorageDisplay::Role::Style::WithUsed;

use Moose::Role;

with 'StorageDisplay::Role::Style::WithFree';

has 'used' => (
    is       => 'ro',
    isa      => 'Int',
    required => 1,
    );

sub dotStyle {
    my $orig  = shift;
    my $self = shift;

    return (
        "style=filled;",
        "color=lightgrey;",
        "fillcolor=lightgrey;",
        "node [style=filled,color=lightgrey,fillcolor=lightgrey,shape=rectangle];",
        );
};

around '_dotDefaultFullLabel' => sub {
    my $orig  = shift;
    my $self = shift;

    my $label = $self->$orig(@_);
    return (
        $self->$orig(@_),
        "Used: ".$self->disp_size($self->used),
        );
};

1;

##################################################################
package StorageDisplay::Role::Style::SubInternal;

use Moose::Role;

sub dotStyle {
    my $self = shift;
    my $t = shift // "\t";

    return (
		#"style=filled;",
		"color=white;",
		"fillcolor=white;",
		#"node [style=filled,color=lightgrey,fillcolor=lightgrey,shape=rectangle];",
        );
}

with (
    'StorageDisplay::Role::Style::Base',
    );

1;

##################################################################
package StorageDisplay::Role::Style::Grey;

use Moose::Role;

sub dotStyle {
    my $self = shift;
    my $t = shift // "\t";

    return (
        "style=filled;",
        "color=lightgrey;",
        "fillcolor=lightgrey;",
        "node [style=filled,color=white,fillcolor=lightgrey,shape=rectangle];",
        );
}

with (
    'StorageDisplay::Role::Style::Base',
    );

1;

##################################################################
package StorageDisplay::Role::Style::FromBlockState;

use Moose::Role;

sub _dotDefaultStyleNodeState {
    my $self = shift;

    my $state = "unknown";
    if (defined($self->block)) {
        $state = $self->block->state;
    }

    return 'fillcolor="'.$self->statecolor($state).'"';
}

##################################################################
##################################################################
package StorageDisplay::BlockTreeElement;

## Base package for block device DAG

use Moose;
use namespace::sweep;

use Carp;

with "StorageDisplay::Role::Iterable"
    => { iterable => "StorageDisplay::BlockTreeElement" };

sub dname {
    my $self;
    return $self->name;
}

1;

##################################################################
package StorageDisplay::Block;
use Moose;
use namespace::sweep;

extends 'StorageDisplay::BlockTreeElement';

use Path::Class::Dir;

use Carp;

has 'names' => (
    traits   => [ 'Hash' ],
    is       => 'ro',
    isa      => 'HashRef[Path::Class::Dir]',
    required => 1,
    handles  => {
        'addname' => 'set',
        'names_str' => 'keys',
    }
    );

has 'path' => (
    is       => 'rw',
    isa      => 'Path::Class::Dir',
    required => 1,
    );

has 'state' => (
    is       => 'rw',
    isa      => 'Str',
    default  => 'unknown',
    lazy     => 1,
    );

has 'elem' => (
    is       => 'ro',
    isa      => 'StorageDisplay::Elem',
    writer   => '_elem',
    required => 0,
    );

sub provided {
    my $self = shift;

    return defined($self->elem);
}

sub providedBy {
    my $self = shift;
    my $elem = shift;
    my $name = shift;

    if ($self->provided) {
        croak "Duplicate provider for ".$self->name.": ".$self->elem." and ".$elem;
    }
    $self->_elem($elem);
}

sub dname {
    my $self = shift;
    my $best_name=$self->name;
    my $score = 0;
    #print STDERR "name for ", $self->name, "\n";
    #use Data::Dumper;
    #print STDERR Dumper($self->names), "\n";
     foreach my $n ($self->names_str) {
        my $s=0;
        if ($n =~ m,^disk/,) {
            $s = 20;
        } elsif ($n =~ m,^dm-,) {
            $s = 30;
        } elsif ($n =~ m,^mapper/,) {
            $s = 40;
        } elsif ($n =~ m,/,) {
            $s = 60;
        } else {
            $s = 50;
        }
        if ($s > $score) {
            #print STDERR "  prefer ", $n, "\n";
            $score = $s;
            $best_name = $n;
        }
    }

    return '/dev/'.
         $best_name;
}

has 'size' => (
    is => 'rw',
    isa => 'Int',
    default => -1,
    );

## function, not method
sub asname {
    my $block = shift;
    my $blockname;

    if (blessed($block) && $block->isa("StorageDisplay::BlockTreeElement")) {
        $blockname = $block->name;
    } else {
        $blockname = $block;
    }
    return $blockname;
}

##################################################################
package StorageDisplay::Block::NoSystem;
use Moose;
use namespace::sweep;

extends 'StorageDisplay::Block';

has 'parent' => (
    is       => 'ro',
    isa      => 'StorageDisplay::Block',
    required => 0,
    );

has 'id' => (
    is       => 'ro',
    isa      => 'Str',
    required => 0,
    );

has 'dname' => (
    is       => 'ro',
    isa      => 'Str',
    required => 1,
    );

use Carp;

around BUILDARGS => sub {
    my $orig  = shift;
    my $class = shift;
    my %args = (@_);

    my $name = $args{'name'} // $args{'parent'}->name.'@'.$args{'id'};

    my $dname = $args{'name'} // $args{'parent'}->dname.'@'.$args{'id'};

    return $class->$orig(
        'name' => $name,
        'dname' => $dname,
        'names' => { $name => Path::Class::Dir->new() },
        'path' => Path::Class::Dir->new(),
        %args,
        );
};

##################################################################
package StorageDisplay::Block::System;
use Moose;
use namespace::sweep;
use JSON::MaybeXS qw(decode_json);

extends 'StorageDisplay::Block';

use Carp;

has '_blk_infos' => (
    is       => 'ro',
    isa      => 'HashRef',
    traits   => [ 'Hash' ],
    required => 1,
    handles  => {
        'blk_info' => 'get',
    }
    );
has '_udev_infos' => (
    is       => 'ro',
    isa      => 'HashRef[Str]',
    traits   => [ 'Hash' ],
    required => 1,
    handles  => {
        'udev_info' => 'get',
    }
    );

around BUILDARGS => sub {
    my $orig  = shift;
    my $class = shift;
    my $name = shift;
    my $st = shift;
    my $blk_info = $st->get_info('lsblk', $name);
    my %args;

    if ( @_ != 0 || ref $name ) {
        croak "Invalid call to new";
    }
    my $f;

    my $udev_info = $st->get_info('udev', $name);
    foreach my $k (keys %{$udev_info}) {
        if ($k eq 'path') {
            $args{$k}=Path::Class::Dir->new($udev_info->{$k});
        } elsif ($k eq 'names') {
            $args{$k} = { map { $_ => Path::Class::Dir->new($_) } @{$udev_info->{$k}} };
        } else {
            $args{$k}=$udev_info->{$k};
        }
    }

    if (defined($blk_info)) {
        my %hash;
        %hash = map {
            if (defined($blk_info->{$_})) {
                uc $_ => $blk_info->{$_}
            } else {
                ()
            }
        } keys %$blk_info;
        $args{'_blk_infos'}=\%hash;
    } else {
        croak "coucou";
    }

    return $class->$orig(
        %args,
        );
};

##################################################################
##################################################################
##################################################################

##################################################################
package StorageDisplay::Elem;

use Moose;
use namespace::sweep;

use Object::ID;

with (
    "StorageDisplay::Role::Iterable"
    => { iterable => "StorageDisplay::Elem" },
    "StorageDisplay::Role::Style::Base::Elem"
    );

has 'consume' => (
    is       => 'ro',
    isa      => 'ArrayRef[StorageDisplay::Block]',
    traits   => [ 'Array' ],
    default  => sub { return []; },
    lazy     => 1,
    handles  => {
	'consumeBlock' => 'push',
            'consumedBlocks' => 'elements',
    }
    );

has 'provide' => (
    is       => 'ro',
    isa      => 'ArrayRef[StorageDisplay::Block]',
    traits   => [ 'Array' ],
    default  => sub { return []; },
    lazy     => 1,
    handles  => {
	'provideBlock' => 'push',
            'allProvidedBlocks' => 'elements',
    },
    init_arg => undef,
    );

around 'provideBlock' => sub {
      my $orig = shift;
      my $self = shift;

      for my $b (@_) {
          $b->providedBy($self);
      }
      return $self->$orig(@_);
  };

has 'label' => (
    is => 'rw',
    isa => 'Str',
    required => 0,
    default => "NO LABEL",
    );

sub disp_size {
    my $self = shift;
    my $size = shift;
    my $unit = 'B';
    my $d=2;

    {
        use bigint;
        my $divide = 1;
        if ($size >= 1024) { $unit = 'kiB'; }
        if ($size >= 1048576) { $unit = 'MiB'; $divide *= 1024; }
        if ($size >= 1073741824) { $unit = 'GiB'; $divide *= 1024; }
        if ($size >= 1099511627776) { $unit = 'TiB'; $divide *= 1024; }
        if ($size >= 1125899906842624) { $unit = 'PiB'; $divide *= 1024; }
        if ($size >= 1152921504606846976) { $unit = 'EiB'; $divide *= 1024; }

        if ($unit eq 'B') {
            return "$size B";
        } else {
            $size /= $divide;
        }
        $size = $size * 1000 / 1024;
        if ($size >= 10000) { $d = 1;}
        if ($size >= 100000) { $d = 0;}
    }
    return sprintf("%.$d"."f $unit", $size/1000);
}

sub statecolor {
    my $self = shift;
    my $state = shift;

    if ($state eq "free") {
        return "green";
    } elsif ($state eq "ok") {
        return "green";
    } elsif ($state eq "used") {
        return "yellow";
    } elsif ($state eq "busy") {
        return "pink";
    } elsif ($state eq "unused") {
        return "white";
    } elsif ($state eq "unknown") {
        return "lightgrey";
    } elsif ($state eq "special") {
        return "mediumorchid1";
    } elsif ($state eq "warning") {
        return "orange";
    } elsif ($state eq "error") {
        return "red";
    } else {
        return "red";
    }
}

sub dname {
    my $self = shift;
    return $self->name;
}

sub linkname {
    my $self = shift;
    return '"'.$self->name.'"';
}

sub pushDotText {
    my $self = shift;
    my $text = shift;
    my $t = shift // "\t";

    my @pushed = map { $t.$_ } @_;
    push @{$text}, @pushed;
}

sub dotSubNodes {
    my $self = shift;
    my $t = shift // "\t";
    my @text=();
    my $it = $self->iterator(recurse => 0);
    while (defined(my $e=$it->next)) {
        push @text, $e->dotNode($t);
    }
    return @text;
}

sub dotLinks {
    my $self = shift;
    return ();
}

1;

###################################################################
#################################################################
package StorageDisplay::Root;

use Moose;
use namespace::sweep;
extends 'StorageDisplay::Elem';

has 'host' => (
    is       => 'ro',
    isa      => 'Str',
    required => 1,
    );

sub dotNode {
    my $self = shift;

    my $t = shift // "\t";
    my @text = (
        'digraph "'.$self->host.'"{',
        $t."rankdir=LR;",
        );

    my @subnodes=$self->dotSubNodes($t);
    $self->pushDotText(\@text, $t,
                       $self->dotSubNodes($t));

    my $it = $self->iterator(recurse => 1);
    while (defined(my $e=$it->next)) {
        my @links = $e->dotLinks($t);
        if (scalar(@links)>0) {
            $self->pushDotText(
                \@text, $t,
                '// Links from '.$e->dname,
                $e->dotLinks($t, @_),
                );
        }
    }
    $it = $self->iterator(recurse => 1);
    while (defined(my $e=$it->next)) {
        my @blocks = grep {
            $_->provided
        } $e->consumedBlocks;

        if (scalar(@blocks)>0) {
            $self->pushDotText(
                \@text, $t,
                '// Links for '.$e->dname,
                (map { $_->elem->linkname.' -> '.$e->linkname } @blocks),
                );
        }
    }
    push @text, "}";
    return @text;
}

around BUILDARGS => sub {
    my $orig  = shift;
    my $class = shift;
    my $host = shift // 'machine';

    return $class->$orig(
        'name' => '@'.$host,
        'host' =>  $host,
        @_
        );
};

###################################################################
#################################################################
package StorageDisplay::Partition;

use Moose;
use namespace::sweep;
extends 'StorageDisplay::Elem';

with (
    'StorageDisplay::Role::HasBlock',
    'StorageDisplay::Role::Style::Label::HTML::Table',
    'StorageDisplay::Role::Style::WithSize',
    );

sub disk {
    my $self = shift;
    return $self->block(@_);
}

has 'kind' => (
    is    => 'ro',
    isa   => 'Str',
    required => 1,
    );

around BUILDARGS => sub {
    my $orig  = shift;
    my $class = shift;
    my $block = shift;
    my $st = shift;

    $st->log({level=>1}, 'Partition table on '.$block->dname);

    return $class->$orig(
        'name' => '@Part: '.$block->name,
        'part_infos' => $st->get_info('partitions', $block->name),
        'block' => $block,
        'consume' => [$block],
        @_
        );
};

has 'table' => (
    is    => 'ro',
    isa   => 'StorageDisplay::Partition::Table',
    required => 1,
    default  => sub {
        my $self = shift;
        return $self->addChild(
            StorageDisplay::Partition::Table->new(
                'name' => $self->name.'@@table',
                'partition' => $self,
            ));
    },
    lazy => 1,
    );

sub dotStyleNode {
    my $self=shift;
    my $t=shift;

    my $fc='';
    my $it = $self->table->iterator(
        recurse => 1,
        filter => sub {
            my $part = shift;
            return ! $part->isa('StorageDisplay::Partition::Table::Part::SubTable');
        },
        );
    while (defined(my $part = $it->next)) {
        my $state="free";
        if (! $part->isa("StorageDisplay::Partition::Table::Part::Free")) {
            $state = "busy";#$part->block->state;
        }
        my $color=$self->statecolor($state);
        $fc .= ':' if $fc ne '';
        $fc .= "$color;".sprintf("%.6f", $part->size/$self->size);
    }
    return (
        $self->_dotDefaultStyleNode($t, @_),
        "// Style node",
        "color=white;",
        "fillcolor=lightgrey;",
        'shape="rectangle";',
        #'gradientangle="270";',
        'style=striped;',
        'fillcolor="'.$fc.'";',
        );
}

sub dotStyleTable {
    my $self=shift;

    return "BORDER=\"0\" CELLPADDING=\"0\" CELLSPACING=\"0\"";
}

sub dotLabel {
    my $self = shift;
    return (
        $self->disk->dname,
        'Label: '.$self->kind,
        );
}

sub dotTable {
    my $self = shift;
    my $t = shift // "\t";
    my $it = shift;

    my @tablecontents = (
        "<TR> <TD COLSPAN=\"2\">".$self->label."</TD> </TR>".
        "<TR><TD >".$self->dotFormatedFullLabel($t, @_)."</TD>".
        "    <TD BGCOLOR=\"lightgrey\">",
        $self->table->dotNode($t, @_),
        "</TD> </TR>".
        "<TR> <TD COLSPAN=\"2\"> </TD> </TR>");

    return @tablecontents;
}

1;

##################
package StorageDisplay::Partition::Table;

use Moose;
use namespace::sweep;

use Carp;

extends 'StorageDisplay::Elem';

with (
    'StorageDisplay::Role::Style::IsLabel',
    'StorageDisplay::Role::Style::Label::HTML::Table',
    );

has 'disk' => (
    is       => 'ro',
    isa      => 'StorageDisplay::Block',
    default  => sub {
        my $self = shift;
        return $self->elem->disk;
    },
    lazy     => 1,
    required => 1,
    );

has 'partition' => (
    is       => 'ro',
    isa      => 'StorageDisplay::Partition',
    required => 1,
    );

sub elem {
    my $self = shift;
    return $self->partition(@_);
}

sub addPart {
    my $self = shift;
    my $part = shift;

    if ($part->isa('StorageDisplay::Partition::Table::Part::SubTable')) {
        $part->block->state("special");
    } elsif ($part->isa('StorageDisplay::Partition::Table::Part::Data')) {
        if ($part->label =~ /efi|grub/i || $part->flags =~ /boot/i) {
            $part->block->state("special");
        }
    } elsif ($part->isa('StorageDisplay::Partition::Table::Part::Free')) {

    } else {
        carp "W: unsupported part ".$part->name." (".$part.")\n";
    }
    return $self->addChild($part);
}

sub dotTable {
    my $self = shift;
    return $self->partDotTable(@_);
}

sub partDotTable {
    my $self = shift;
    my $t = shift;
    my $it = shift;

    my @text;
    #print STDERR "dotTable in ".$self->name." (".$self.")\n";
    while (defined(my $e = $it->next)) {
        push @text, '<TR>',
            $self->dotIndent($t, $e->dotNode($t, @_)),
            '</TR>';
    }
    #use Data::Dumper;
    #print STDERR "RES: ", Dumper(\@text);
    return @text;
}

1;

##################
package StorageDisplay::Partition::Table::Part;

use Moose;
use namespace::sweep;

extends 'StorageDisplay::Elem';

with (
    'StorageDisplay::Role::Style::Label::HTML',
    'StorageDisplay::Role::Style::IsLabel',
    'StorageDisplay::Role::Style::WithSize',
    );

has 'table' => (
    is    => 'ro',
    isa   => 'StorageDisplay::Partition::Table',
    required => 1,
    );

has 'start' => (
    is    => 'ro',
    isa   => 'Int',
    required => 1,
    );

has 'label' => (
    is    => 'ro',
    isa   => 'Str',
    required => 0,
    );

sub BUILD {
    my $self = shift;

    #print STDERR "BUILD in ".__PACKAGE__."\n";
    $self->table->addPart($self);
}

sub partStyle {
    my $self = shift;

    return '';
}

sub dotNode {
    my $self = shift;
    return  (
        "<TD ".$self->partStyle(@_).">",
        $self->_dotDefaultNode(@_),
        "</TD>",
        );
}

1;

##################
package StorageDisplay::Partition::Table::Part::Data;

use Moose;
use namespace::sweep;
extends 'StorageDisplay::Partition::Table::Part';

has 'id' => (
    is    => 'ro',
    isa   => 'Int',
    required => 1,
    );

has 'flags' => (
    is    => 'ro',
    isa   => 'Str',
    required => 0,
    );


use Carp;
around BUILDARGS => sub {
    my $orig  = shift;
    my $class = shift;
    my $args = { @_ };

    my $block;

    #print STDERR "BUILDARGS in ".__PACKAGE__."\n";
    my $part_id = $args->{id};
    my $table = $args->{table};
    my $it = $table->disk->iterator(
        'recurse' => 0,
        'uniq' => 1,
        );
    while(defined(my $b=$it->next)) {
        # PARTN does not exists for kpartx mapped partitions
        my $num = $b->udev_info("ID_PART_ENTRY_NUMBER") // -1;
        next if $num != $part_id;
        $block = $b;
        last;
    }
    if (! defined($block)) {
        my $b = StorageDisplay::Block::NoSystem->new(
            'parent' => $table->disk,
            'id' => $part_id,
            );
        $block=$b;
    }

    return $class->$orig(
        'name' => $block->name,
        'block' => $block,
        %{$args},
        );
};

sub BUILD {
    my $self = shift;

    #print STDERR "BUILD in ".__PACKAGE__."\n";
    #print STDERR "Looking for ", $self->id, " into ", $self->table->disk->name, "\n";
    $self->provideBlock($self->block);
}

sub linkname {
    my $self = shift;

    return $self->table->elem->linkname.':"'.$self->id.'"';
}

sub partStyle {
    my $self = shift;

    my $state = "unknown";
    if (defined($self->block)) {
        $state = $self->block->state;
    }

    return 'PORT="'.$self->id.'"'.
        ' BGCOLOR="'.$self->statecolor($state).'"';
}

sub dotLabel {
    my $self = shift;
    my $dev;
    if (defined($self->block)) {
        $dev = $self->block->dname;
    } else {
        $dev = $self->name;
    }
    if ($self->label) {
        return ($dev, $self->label);
    } else {
        return $dev;
    }
}

with (
    'StorageDisplay::Role::HasBlock',
    );

1;

##################
package StorageDisplay::Partition::Table::Part::SubTable;

use Moose;
use namespace::sweep;

# keep Table::Part::Data first to pick its dotNode redefinition
extends
    'StorageDisplay::Partition::Table::Part::Data',
    'StorageDisplay::Partition::Table';

sub dotNode {
    my $self = shift;
    my $t = shift;
    #print STDERR "BUILD in ".__PACKAGE__."\n";
    return (
        '<TD>',
        $self->dotIndent(
            $t,
            '<TABLE BORDER="0" CELLPADDING="0" CELLSPACING="0"><TR>',
            '<TD '.$self->partStyle($t, @_).'>',
            #$self->dotLabel($t, @_),
            $self->dotFormatedFullLabel($t, @_),
            '</TD></TR><TR><TD>',
            $self->_dotDefaultNode(@_),
            '</TD></TR></TABLE>',
        ),
        '</TD>',
        );
}

sub dotTable {
    my $self = shift;
    return $self->partDotTable(@_);
}

with (
    'StorageDisplay::Role::Style::IsLabel',
    'StorageDisplay::Role::Style::Label::HTML::Table',
    );

1;

##################
package StorageDisplay::Partition::Table::Part::Free;

use Moose;
use namespace::sweep;
extends 'StorageDisplay::Partition::Table::Part';

sub block {
    my $self = shift;
    return
}

sub dotLabel {
    my $self = shift;
    return "Free";
}

sub partStyle {
    my $self = shift;
    return 'bgcolor="green"';
}

1;

##################################################################
package StorageDisplay::Partition::GPT;

use Moose;
use namespace::sweep;
extends 'StorageDisplay::Partition';

use Carp;

around BUILDARGS => sub {
    my $orig  = shift;
    my $class = shift;
    my $block = shift;
    my $st = shift;

    return $class->$orig(
        $block,
        $st,
        'kind' => 'gpt',
        %{$st->get_info('partitions', $block->name) // {} }, # size, label, parts
        @_
        );
};

sub BUILD {
    my $self = shift;
    my $args = shift;

    #print STDERR "Managing ".$self->disk->dname." (".($self->disk).")\n";

    my $id_free = 1;

    foreach my $part (@{$args->{'parts'}}) {
        #print STDERR "*******************\n";

        if ($part->{kind} eq 'free') {
            delete($part->{kind});
            StorageDisplay::Partition::Table::Part::Free->new(
                'name' => $self->name.'@@Free@'.$id_free,
                'table' => $self->table,
                %{$part},
                );
            $id_free ++;
        } elsif ($part->{kind} eq 'part') {
            delete($part->{kind});
            StorageDisplay::Partition::Table::Part::Data->new(
                'table' => $self->table,
                %{$part},
                );
        } else {
            use Data::Dumper;
            print STDERR Dumper($part);
            croak "ARghh for ".$self->disk->dname;
        }
    }
}

1;

##################################################################
package StorageDisplay::Partition::MSDOS;

use Moose;
use namespace::sweep;
extends 'StorageDisplay::Partition';

use Carp;

around BUILDARGS => sub {
    my $orig  = shift;
    my $class = shift;
    my $block = shift;
    my $st = shift;

    my $info = $st->get_info('partitions', $block->name) // {};

    return $class->$orig(
        $block,
        $st,
        'kind' => 'msdos',
        (map { $_ => $info->{$_} } ("size", "label", "parts")),
        'extended_num' => $info->{'extended'},
        @_
        );
};

has 'extended' => (
    is    => 'rw',
    isa   => 'StorageDisplay::Partition::Table',
    required => 0,
    );

sub BUILD {
    my $self = shift;
    my $args = shift;

    my $extended = $args->{'extended_num'} // '';
    my $id_free = 1;

    foreach my $part (@{$args->{'parts'}}) {
        if ($part->{kind} eq 'free') {
            delete($part->{kind});
            StorageDisplay::Partition::Table::Part::Free->new(
                'name' => $self->name.'@@Free@'.$id_free,
                'table' => $self->table,
                %{$part},
                );
            $id_free ++;
        } elsif ($part->{kind} eq 'part') {
            delete($part->{kind});
            if ($part->{id} eq $extended) {
                $self->extended(
                    StorageDisplay::Partition::Table::Part::SubTable->new(
                        'table' => $self->table,
                        'partition' => $self,
                        %{$part},
                    ));
            } elsif ($part->{id} <= 4) {
                StorageDisplay::Partition::Table::Part::Data->new(
                    'table' => $self->table,
                    %{$part},
                    );
            } else {
                confess if not defined($self->extended);
                StorageDisplay::Partition::Table::Part::Data->new(
                    'table' => $self->extended,
                    %{$part},
                    );
            }
        } else {
            croak "ARghh";
        }
    }
}

1;

##################################################################
##################################################################
package StorageDisplay::LVM::Group;

use Moose;
use namespace::sweep;
extends 'StorageDisplay::Elem';

with ('StorageDisplay::Role::Style::IsSubGraph');

has 'vg' => (
    is    => 'ro',
    isa   => 'StorageDisplay::Block',
    required => 1,
    );

has 'pvs' => (
    is    => 'ro',
    isa   => 'StorageDisplay::LVM::PVs::Base',
    writer => '_pvs',
    required => 0,
    );

sub dname {
    my $self=shift;
    return 'LVM VG: '.$self->name;
}

sub dotLabel {
    my $self = shift;
    return 'LVM: '.$self->name;
}

sub _xv {
    my $self = shift;
    my $kind = shift;
    my $name = shift;

    my $it = $self->$kind->iterator(recurse => 0);
    while (defined(my $e=$it->next)) {
        return $e if $e->lvmname eq $name;
    }
    #print STDERR "E: no $kind with name $name\n";
    return;
}

use StorageDisplay::Moose::Cached;

has 'pv' => (
    cached_hash => "StorageDisplay::LVM::PV",
    compute => sub {
        my $self = shift;
        my $name = shift;
        return $self->_xv("pvs", $name);
    },
    );

##################################################################
package StorageDisplay::LVM::OnlyPV;

use Moose;
use namespace::sweep;
extends 'StorageDisplay::LVM::Group';

with (
    'StorageDisplay::Role::Style::Grey',
    );

around BUILDARGS => sub {
    my $orig  = shift;
    my $class = shift;
    my $vgname = shift;
    my $st = shift;

    $st->log({level=>1}, 'Unassigned PVs');

    my $vgblock = StorageDisplay::Block::NoSystem->new(
        'name' => '@LVM@UnassignedPVs',
        );

    my $info = $st->get_info('lvm', $vgname);

    return $class->$orig(
        'name' => 'Unassigned PVs',
        'vg' => $vgblock,
        'consume' => [],
        'lvm-info' => $info,
        'st' => $st,
        @_
        );
};

sub BUILD {
    my $self=shift;
    my $args=shift;
    my $st = $args->{st};

    $self->_pvs(StorageDisplay::LVM::OnlyPV::PVs->new($self, $st, $args->{'lvm-info'}));
    $self->addChild($self->pvs);
    return $self;
};

1;

##################################################################
package StorageDisplay::LVM;

use Moose;
use namespace::sweep;
extends 'StorageDisplay::LVM::Group';

with (
    'StorageDisplay::Role::Style::WithFree',
    );

has 'lvs' => (
    is    => 'ro',
    isa   => 'StorageDisplay::LVM::LVs',
    writer => '_lvs',
    required => 0,
    );

has '_pv_lv_links' => (
    traits   => [ 'Array' ],
    is       => 'ro',
    isa      => "ArrayRef",
    required => 1,
    default  => sub { return []; },
    handles  => {
        '_add_link' => 'push',
            'internal_links' => 'elements',
    }
    );

around BUILDARGS => sub {
    my $orig  = shift;
    my $class = shift;
    my $vgname = shift;
    my $st = shift;

    $st->log({level=>1}, 'VG '.$vgname);

    my $vgblock = StorageDisplay::Block::NoSystem->new(
        'name' => $vgname,
        );

    my $info = $st->get_info('lvm', $vgname);

    return $class->$orig(
        'name' => $vgname,
        'vg' => $vgblock,
        'consume' => [],
        'lvm-info' => $info,
        'st' => $st,
        'size' => ($info->{'vgs-vg'}->{'vg_size'} =~ s/B$//r),
        'free' => ($info->{'vgs-vg'}->{'vg_free'} =~ s/B$//r),
        @_
        );
};

sub BUILD {
    my $self=shift;
    my $args=shift;
    my $st = $args->{st};

    $self->_pvs(StorageDisplay::LVM::PVs->new($self, $st, $args->{'lvm-info'}));
    $self->addChild($self->pvs);
    if ($args->{'name'} ne '') {
        #print STDERR "name: ", $args->{'name'}, "\n";
        $self->_lvs(StorageDisplay::LVM::LVs->new($self, $st, $args->{'lvm-info'}));
        $self->addChild($self->lvs);
        #my $links = $args->{'lvm-info'}->{'pvs'};
        #foreach my $l (@{$links}) {
        #    if ($l->{segtype} ne "free"
        #        && $l->{lv_role} ne "private,pool,spare"
        #        && $l->{lv_role} ne "private,thin,pool,metadata"
        #        && $l->{lv_role} ne "private,thin,pool,data") {
        #        $self->_add_link({pv => $l->{pv_name},
        #                          lv => $l->{lv_name}});
        #    }
        #}
        my $links = $args->{'lvm-info'}->{'lvs'};
        foreach my $l (@{$links}) {
            if ($l->{'pool_lv'} ne '') {
                $self->_add_link({source_name => $l->{'pool_lv'},
                                  source_type => 'lv',
                                  lv => $l->{lv_name}});
            }
            if ($l->{'lv_parent'} ne '') {
                $self->_add_link({source_name => $l->{lv_name},
                                  source_type => 'lv',
                                  lv => $l->{lv_parent}});
            }
            foreach my $devpos (split(/,/, $l->{'seg_le_ranges'})) {
                if ($devpos !~ m/^(.*):[0-9]+-[0-9]+$/) {
                    $st->warn("Cannot parse seg_le_ranges $devpos for ".$l->{lv_name});
                } else {
                    my $source_name = $1;
                    #$st->warn("Parsing seg_pe_ranges $devpos for ".$l->{lv_name});
                    my $type = 'pv';
                    if (index($l->{'seg_pe_ranges'},$devpos) == -1) {
                        $type = 'lv';
                        #$st->warn("switching to LV for $devpos for ".$l->{lv_name});
                    #} else {
                    #    $st->warn("ok : $devpos in ".$l->{'seg_pe_ranges'});
                    }
                    $self->_add_link({source_name => $source_name,
                                      source_type => $type,
                                      lv => $l->{lv_name}});
                }
            }
        }
    }
    return $self;
};

use StorageDisplay::Moose::Cached;

has 'lv' => (
    cached_hash => "StorageDisplay::LVM::LV",
    compute => sub {
        my $self = shift;
        my $name = shift;
        return $self->_xv("lvs", $name);
    },
    );

sub dotLinks {
    my $self = shift;
    my $source = sub {
        my $name = shift;
        my $type = shift;
        my $source =  $self->$type($name);
        if (defined($source)) {
            return $source->linkname;
        }
        print STDERR "E: FIXME: No source for $name ($type)\n";
        return "''";
    };
    return map {
        $source->($_->{source_name}, $_->{source_type}).' -> '.$self->lv($_->{lv})->linkname
    } $self->internal_links;
}

1;

##################################################################
package StorageDisplay::LVM::Elem;

use Moose;
use namespace::sweep;
extends 'StorageDisplay::Elem';

has 'vg' => (
    is    => 'ro',
    isa   => 'StorageDisplay::LVM::Group',
    required => 1,
    );

around BUILDARGS => sub {
    my $orig  = shift;
    my $class = shift;
    my $vg = shift;
    my $st = shift;
    my $info = shift;

    return $class->$orig(
        'vg' => $vg,
        'st' => $st,
        'lvm-info' => $info,
        @_
        );
};

1;

##################################################################
package StorageDisplay::LVM::PVs::Base;

use Moose;
use namespace::sweep;
extends 'StorageDisplay::LVM::Elem';

with (
    'StorageDisplay::Role::Style::IsSubGraph',
    'StorageDisplay::Role::Style::SubInternal',
    );

1;

##################################################################
package StorageDisplay::LVM::PVs;

use Moose;
use namespace::sweep;
extends 'StorageDisplay::LVM::PVs::Base';

around BUILDARGS => sub {
    my $orig  = shift;
    my $class = shift;
    my $vg = shift;

    return $class->$orig(
        $vg,
        @_,
        'name' => join('@', $vg->name,"PV"),
        'consume' => [],
        );
};

sub BUILD {
    my $self=shift;
    my $args=shift;
    my @pvnames = sort keys %{$args->{'lvm-info'}->{'vgs-pv'}};
    if (scalar(@pvnames) == 0) {
        # PV without a VG
        @pvnames = map { $_->{'pv_name'} } @{$args->{'lvm-info'}->{'pvs'}};
    }
    foreach my $pv_name (sort keys %{$args->{'lvm-info'}->{'vgs-pv'}}) {
        $self->addChild(
            StorageDisplay::LVM::PV->new(
                $pv_name, $self->vg, $args->{st}, $args->{'lvm-info'}
            ));
    }
    return $self;
};

sub dotLabel {
    my $self = shift;
    return ($self->vg->name.'\'s PVs');
}

1;

##################################################################
package StorageDisplay::LVM::OnlyPV::PVs;

use Moose;
use namespace::sweep;
extends 'StorageDisplay::LVM::PVs::Base';

around BUILDARGS => sub {
    my $orig  = shift;
    my $class = shift;
    my $vg = shift;

    return $class->$orig(
        $vg,
        @_,
        'name' => join('@', $vg->name,"PV"),
        'consume' => [],
        );
};

sub BUILD {
    my $self=shift;
    my $args=shift;
    foreach my $pv_name (sort map { $_->{'pv_name'} } @{$args->{'lvm-info'}->{'pvs'}}) {
        $self->addChild(
            StorageDisplay::LVM::PV->new(
                $pv_name, $self->vg, $args->{st}, $args->{'lvm-info'}
            ));
    }
    return $self;
};

sub dotLabel {
    my $self = shift;
    return ();
}

1;

##################################################################
package StorageDisplay::LVM::LVs;

use Moose;
use namespace::sweep;
extends 'StorageDisplay::LVM::Elem';

with (
    'StorageDisplay::Role::Style::IsSubGraph',
    'StorageDisplay::Role::Style::SubInternal',
    );

around BUILDARGS => sub {
    my $orig  = shift;
    my $class = shift;
    my $vg = shift;

    return $class->$orig(
        $vg,
        @_,
        'name' => join('@', $vg->name,"LV"),
        'consume' => [],
        );
};

sub BUILD {
    my $self=shift;
    my $args=shift;

    foreach my $lv_name (sort keys %{$args->{'lvm-info'}->{'vgs-lv'}}) {
        $self->addChild(
            StorageDisplay::LVM::LV->new(
                $lv_name, $self->vg, $args->{st}, $args->{'lvm-info'}
            ));
    }
    return $self;
};

sub dotLabel {
    my $self = shift;
    return ($self->vg->name.'\'s LVs');
}
1;

##################################################################
package StorageDisplay::LVM::XV;

use Moose;
use namespace::sweep;
extends 'StorageDisplay::LVM::Elem';

with (
    'StorageDisplay::Role::HasBlock',
    );

has 'lvmname' => (
    is    => 'ro',
    isa   => 'Str',
    required => 1,
    );

around BUILDARGS => sub {
    my $orig  = shift;
    my $class = shift;
    my $vg = shift;
    my $st = shift;
    my $info = shift;
    my $lvmname = shift;
    my $block = shift;

    return $class->$orig(
        $vg, $st, $info,
        'lvmname' => $lvmname,
        'block' => $block,
        @_
        );
};

1;

##################################################################
package StorageDisplay::LVM::PV;

use Moose;
use namespace::sweep;
extends 'StorageDisplay::LVM::XV';

with (
    'StorageDisplay::Role::Style::WithUsed',
    );

around BUILDARGS => sub {
    my $orig  = shift;
    my $class = shift;
    my $pvblockname = shift;
    my $vg = shift;
    my $st = shift;
    my $info = shift;

    my $pvblock = $st->block($pvblockname);

    my $pvinfo = $info->{'vgs-pv'}->{$pvblockname};

    if (not defined($pvinfo)) {
        # only PV, no assigned VG
        my @pv = grep { $_->{'pv_name'} eq $pvblockname } @{$info->{'pvs'}};
        $pvinfo = $pv[0];
    }

    return $class->$orig(
        $vg, $st, $info, $pvblockname, $pvblock,
        'name' => join('@', 'LVM', $vg->name,"PV",$pvblock->name),
        'consume' => [$pvblock],
        'size' => ($pvinfo->{'pv_size'} =~ s/B$//r),
        'free' => ($pvinfo->{'pv_free'} =~ s/B$//r),
        'used' => ($pvinfo->{'pv_used'} =~ s/B$//r),
        @_
        );
};

sub dotLabel {
    my $self = shift;
    return ('PV: '.$self->block->dname);
}

1;

##################################################################
package StorageDisplay::LVM::LV;

use Moose;
use namespace::sweep;
extends 'StorageDisplay::LVM::XV';

with (
    'StorageDisplay::Role::Style::WithSize',
    'StorageDisplay::Role::Style::FromBlockState',
    );

around BUILDARGS => sub {
    my $orig  = shift;
    my $class = shift;
    my $lvname = shift;
    my $vg = shift;
    my $st = shift;
    my $info = shift;

    my $lvblock = $st->block($vg->name.'/'.$lvname);

    my $lvinfo = $info->{'vgs-lv'}->{$lvname};

    return $class->$orig(
        $vg, $st, $info, $lvname, $lvblock,
        'name' => $lvblock->name,
        'consume' => [],
         'size' => ($lvinfo->{'lv_size'} =~ s/B$//r),
        @_
        );
};

sub BUILD {
    my $self = shift;
    $self->provideBlock($self->block);
}

sub dotLabel {
    my $self = shift;
    return ('LV: '.$self->lvmname);
}

1;

##################################################################
##################################################################
package StorageDisplay::FS;

use Moose;
use namespace::sweep;
extends 'StorageDisplay::Elem';

with (
    'StorageDisplay::Role::Style::IsSubGraph',
    'StorageDisplay::Role::Style::Grey',
    );

around BUILDARGS => sub {
    my $orig  = shift;
    my $class = shift;
    my $st = shift;

    $st->log('Creating FS');
    my $info = $st->get_info('fs')//{};

    return $class->$orig(
        'name' => '@FS',
        'consume' => [],
        'st' => $st,
        @_
        );
};

sub BUILD {
    my $self=shift;
    my $args=shift;

    my $st = $args->{'st'};
    my $allfs = $st->get_info('fs')//{};

    foreach my $dev (sort keys %{$allfs}) {
        my $fs = $allfs->{$dev};
        $self->addChild(
            StorageDisplay::FS::FS->new($dev, $st, $fs),
            );
    }
}

sub dotLabel {
    my $self = shift;
    return "Mounted FS and swap";
}

1;

##################################################################
package StorageDisplay::FS::FS;

use Moose;
use namespace::sweep;
extends 'StorageDisplay::Elem';

with (
    'StorageDisplay::Role::HasBlock',
    'StorageDisplay::Role::Style::WithUsed',
    );

has 'mountpoint' => (
    is => 'ro',
    isa => 'Str',
    );

has 'fstype' => (
    is => 'ro',
    isa => 'Str',
    );

around BUILDARGS => sub {
    my $orig  = shift;
    my $class = shift;
    my $dev = shift;
    my $st = shift;
    my $fs = shift;

    my $block = $st->block($dev);
    $st->log({level=>1}, ($fs->{mountpoint}//$dev));

    my $name = '@FS@'.($fs->{mountpoint}//$block->name);

    return $class->$orig(
        'name' => $name,
        'consume' => [$block],
        'provide' => $st->block($name),
        'st' => $st,
        'block' => $block,
        %{$fs},
        @_
        );
};

sub BUILD {
    my $self=shift;
    my $args=shift;
    $self->provideBlock($args->{'provide'});
}

sub dotLabel {
    my $self = shift;
    return (
        $self->mountpoint,
        "Device: ".$self->block->dname,
        $self->fstype,
        );
}

1;

##################################################################
##################################################################
package StorageDisplay::LUKS;

use Moose;
use namespace::sweep;
extends 'StorageDisplay::Elem';

with (
    'StorageDisplay::Role::HasBlock',
    'StorageDisplay::Role::Style::IsSubGraph',
    'StorageDisplay::Role::Style::Grey',
    );

has 'encrypted' => (
    is    => 'ro',
    isa   => 'StorageDisplay::LUKS::Encrypted',
    writer => '_encrypted',
    required => 0,
    );

has 'decrypted' => (
    is    => 'ro',
    isa   => 'StorageDisplay::LUKS::Decrypted',
    writer => '_decrypted',
    required => 0,
    );

has 'luks_version' => (
    is    => 'ro',
    isa   => 'Str',
    required => 1,
    );

around BUILDARGS => sub {
    my $orig  = shift;
    my $class = shift;
    my $devname = shift;
    my $st = shift;

    #$st->get_infos
    $st->log({level=>1}, 'LUKS for device '.$devname);

    my $info = $st->get_info('luks', $devname);
    my $block = $st->block($devname);

    return $class->$orig(
        'name' => join('@','@LUKS',$block->name),
        'block' => $block,
        'consume' => [],
        'st' => $st,
        'luks-info' => $info,
        'luks_version' => $info->{VERSION},
        @_
        );
};

sub BUILD {
    my $self=shift;
    my $args=shift;
    my $st = $args->{st};

    $self->_encrypted(StorageDisplay::LUKS::Encrypted->new($self, $st, $args->{'luks-info'}));
    $self->addChild($self->encrypted);
    if (defined($args->{'luks-info'}->{decrypted})) {
        $self->_decrypted(StorageDisplay::LUKS::Decrypted::Present->
                          new($self, $st, $args->{'luks-info'}));
    } else {
        $self->_decrypted(StorageDisplay::LUKS::Decrypted::None->
                          new($self, $st, $args->{'luks-info'}));
    }
    $self->addChild($self->decrypted);
    return $self;
};

sub dname {
    my $self=shift;
    return 'LUKS: '.$self->block->dname;
}

sub dotLabel {
    my $self = shift;
    return (
        $self->block->dname,
        'LUKS version '.$self->luks_version,
        );
}

sub dotLinks {
    my $self = shift;
    return (
        $self->encrypted->linkname.' -> '.$self->decrypted->linkname
    );
}

1;

##################################################################
package StorageDisplay::LUKS::Encrypted;

use Moose;
use namespace::sweep;
extends 'StorageDisplay::Elem';

with (
    'StorageDisplay::Role::HasBlock',
    'StorageDisplay::Role::Style::WithSize',
    'StorageDisplay::Role::Style::FromBlockState',
    );

around BUILDARGS => sub {
    my $orig  = shift;
    my $class = shift;
    my $luks = shift;
    my $st = shift;
    my $info = shift;

    my $block = $luks->block;

    return $class->$orig(
        'name' => join('@', $luks->name, $block->name),
        'consume' => [$block],
        'block' => $block,
        'size' => $st->get_info('lsblk', $block->name, 'size'),
        @_,
        );
};

sub dotLabel {
    my $self = shift;
    return ($self->block->dname);
}

1;

##################################################################
package StorageDisplay::LUKS::Decrypted;

use Moose;
use namespace::sweep;
extends 'StorageDisplay::Elem';

1;

##################################################################
package StorageDisplay::LUKS::Decrypted::Present;

use Moose;
use namespace::sweep;
extends 'StorageDisplay::LUKS::Decrypted';

with (
    'StorageDisplay::Role::HasBlock',
    'StorageDisplay::Role::Style::WithSize',
    'StorageDisplay::Role::Style::FromBlockState',
    );

around BUILDARGS => sub {
    my $orig  = shift;
    my $class = shift;
    my $luks = shift;
    my $st = shift;
    my $info = shift;

    my $block = $st->block($info->{'decrypted'}//($luks->name."none"));

    return $class->$orig(
        'name' => $block->name,
        'consume' => [],
        'block' => $block,
        'size' => $st->get_info('lsblk', $block->name, 'size'),
        @_,
        );
};

sub BUILD {
    my $self = shift;
    $self->provideBlock($self->block);
}

sub dotLabel {
    my $self = shift;
    return ($self->block->dname);
}

1;

##################################################################
package StorageDisplay::LUKS::Decrypted::None;

use Moose;
use namespace::sweep;
extends 'StorageDisplay::LUKS::Decrypted';

with (
    'StorageDisplay::Role::Style::Plain',
    );

around BUILDARGS => sub {
    my $orig  = shift;
    my $class = shift;
    my $luks = shift;
    my $st = shift;
    my $info = shift;

    return $class->$orig(
        'name' => $luks->name."@@",
        'consume' => [],
        @_,
        );
};

sub BUILD {
    my $self = shift;
}

sub dotLabel {
    my $self = shift;
    return ('Not decrypted');
}

1;

##################################################################
##################################################################
package StorageDisplay::RAID;

use Moose;
use namespace::sweep;
extends 'StorageDisplay::Elem';

with (
    'StorageDisplay::Role::Style::IsSubGraph',
    'StorageDisplay::Role::Style::Grey',
    );

has '_devices' => (
    traits   => [ 'Array' ],
    is    => 'ro',
    isa   => 'ArrayRef[StorageDisplay::RAID::Device]',
    required => 1,
    default  => sub { return []; },
    handles  => {
        '_add_device' => 'push',
            'devices' => 'elements',
    }
    );

has 'raid-devices' => (
    traits   => [ 'Array' ],
    is    => 'ro',
    isa   => 'ArrayRef[StorageDisplay::RAID::RaidDevice]',
    required => 1,
    default  => sub { return []; },
    handles  => {
        '_add_raid_device' => 'push',
            'raid_devices' => 'elements',
    }
    );

around '_add_raid_device' => sub {
    my $orig  = shift;
    my $self = shift;
    my $raid_device = shift;
    my $state = shift;
    die "Invalid state" if $state->raid_device != $raid_device;
    $raid_device->_state($state);
    $self->addChild($state);
    return $self->$orig($raid_device);
};



1;

###########################################################################
package StorageDisplay::RAID::Elem;

use Moose;
use namespace::sweep;
extends 'StorageDisplay::Elem';

has 'raid' => (
    is    => 'ro',
    isa   => 'StorageDisplay::RAID',
    required => 1,
    );

around BUILDARGS => sub {
    my $orig  = shift;
    my $class = shift;
    my $raid = shift;
    my $st = shift;

    return $class->$orig(
        'raid' => $raid,
        'st' => $st,
        @_
        );
};

1;

###########################################################################
package StorageDisplay::RAID::State;

use Moose;
use namespace::sweep;
extends 'StorageDisplay::RAID::Elem';

with (
    'StorageDisplay::Role::Style::Plain',
    'StorageDisplay::Role::Style::IsSubGraph',
    );

has 'state' => (
    is    => 'ro',
    isa   => 'Str',
    required => 1,
    );

has 'extra-info' => (
    is    => 'ro',
    isa   => 'Str',
    required => 0,
    predicate => 'has_extra_info',
    reader => 'extra_info',
    );

has 'raid_device' => (
    is    => 'ro',
    isa   => 'StorageDisplay::RAID::RaidDevice',
    required => 1,
    );

around BUILDARGS => sub {
    my $orig  = shift;
    my $class = shift;
    my $raid_device = shift;
    my $st = shift;

    return $class->$orig(
        $raid_device->raid, $st,
        'name' => join('@@',$raid_device->name,'state'),
        'consume' => [],
        'raid_device' => $raid_device,
        @_
        );
};

sub dotStyleNode {
    my $self = shift;
    my $color = 'special';
    my $state = $self->state;

    if ($state =~ /degraded|DGD/i) {
        $color = 'warning';
    } elsif ($state =~ /failed|offline/i) {
        $color = 'error';
    } elsif ($state =~ /clean|active|active-idle|optimal|OKY/i) {
        $color = 'ok';
    }

    return (
        "shape=oval",
        "fillcolor=".$self->statecolor($color),
        );
}

sub dotLabel {
    my $self = shift;
    my @label=('state: '.$self->state);
    if ($self->has_extra_info) {
        push @label, $self->extra_info;
    }

    return @label;
}

1;

###########################################################################
package StorageDisplay::RAID::RaidDevice;

use Moose;
use namespace::sweep;
extends 'StorageDisplay::RAID::Elem';

with (
    'StorageDisplay::Role::HasBlock',
    'StorageDisplay::Role::Style::FromBlockState',
    'StorageDisplay::Role::Style::WithSize',
    );

has 'state' => (
    is    => 'ro',
    isa   => 'StorageDisplay::RAID::State',
    writer => '_state',
    required => 0,
    );

has 'raid-level' => (
    is    => 'ro',
    isa   => 'Str',
    reader => 'raid_level',
    required => 1,
    );

around '_state' => sub {
    my $orig  = shift;
    my $self = shift;
    my $ret = $self->$orig(@_);
    $self->state->addChild($self);
    return $ret;
};

around BUILDARGS => sub {
    my $orig  = shift;
    my $class = shift;
    my $raid = shift;
    my $st = shift;
    my $block = shift;

    return $class->$orig(
        $raid, $st,
        'block' => $block,
        'name' => $block->name,
        'consume' => [],
        @_
        );
};

sub BUILD {
    my $self = shift;
    my $args = shift;

    $self->block->providedBy($self);
}

sub dotLabel {
    my $self = shift;

    return (
        $self->block->dname,
        $self->raid_level,
        );
}

1;

###########################################################################
package StorageDisplay::RAID::Device;

use Moose;
use namespace::sweep;
extends 'StorageDisplay::RAID::Elem';

with (
    'StorageDisplay::Role::HasBlock',
    'StorageDisplay::Role::Style::Plain',
    );

has 'state' => (
    is    => 'ro',
    isa   => 'Str',
    required => 1,
    );

has 'raiddevice' => (
    is    => 'ro',
    isa   => 'Str',
    required => 1,
    );

around BUILDARGS => sub {
    my $orig  = shift;
    my $class = shift;
    my $raid = shift;
    my $st = shift;
    my $devname = shift;
    my $info = shift;

    my $block = $st->block($devname);

    return $class->$orig(
        $raid, $st,
        'block' => $block,
        'name' => join('@dev@',$raid->name,$block->name),
        'consume' => [$block],
        'state' => $info->{state},
        'raiddevice' => $info->{raiddevice},
        @_
        );
};

around 'dotStyleNode' => sub {
    my $orig = shift;
    my $self = shift;
    my @text = $self->$orig(@_);

    my $state = $self->state;
    my $s;

    if ($state =~ /active|Online, Spun Up|OPT/i) {
        $s = 'used';
    } elsif ($state =~ /rebuild|RBLD/i) {
        $s = 'warning';
    } elsif ($state =~ /spare|HSP/i) {
        $s = 'free';
    } elsif ($state =~ /faulty|error|FLD|MIS|bad|offline/i) {
        $s = 'error';
    } elsif ($state =~ /Unconfigured.*good|AVL/i) {
        $s = 'unused';
    } elsif ($state =~ /JBOD/i) {
        $s = $self->block->state;
    } else {
        $s = 'warning';
    }
    my $color = $self->statecolor($s);

    push @text, "fillcolor=$color";
    return @text;
};

sub dotLabel {
    my $self = shift;

    return (
        $self->raiddevice.': '.$self->block->dname,
        $self->state,
        );
}

1;

###########################################################################
package StorageDisplay::RAID::RawDevice;

use Moose;
use namespace::sweep;
extends 'StorageDisplay::RAID::Device';
with(
    'StorageDisplay::Role::Style::WithSize',
    );

has 'model' => (
    is    => 'ro',
    isa   => 'Str',
    required => 1,
    );

has 'slot' => (
    is    => 'ro',
    isa   => 'Str',
    required => 1,
    );

sub dotLabel {
    my $self = shift;

    return (
        $self->model,
        $self->raiddevice.': slot '.$self->slot,
        $self->state,
        );
}

1;

##################################################################
package StorageDisplay::RAID::MD;

use Moose;
use namespace::sweep;
extends 'StorageDisplay::RAID';

with(
    'StorageDisplay::Role::HasBlock',
    );

around BUILDARGS => sub {
    my $orig  = shift;
    my $class = shift;
    my $devname = shift;
    my $st = shift;

    #$st->get_infos
    $st->log({level=>1}, 'MD Raid for device '.$devname);

    my $info = $st->get_info('md', $devname);
    my $block = $st->block($devname);

    return $class->$orig(
        'name' => join('@','@MD',$block->name),
        'block' => $block,
        'consume' => [],
        'st' => $st,
        %{$info},
        @_
        );
};

sub BUILD {
    my $self=shift;
    my $args=shift;
    my $st = $args->{st};

    my $raid_device = StorageDisplay::RAID::RaidDevice->new($self, $st,
                                                            $self->block,
                                                            'raid-level' => $args->{'raid-level'},
                                                            'size' => $args->{'array-size'});
    my $state = StorageDisplay::RAID::State->new($raid_device, $st,
                                                 'state' => $args->{'raid-state'});
    $self->_add_raid_device($raid_device, $state);

    foreach my $dev (sort keys %{$args->{'devices'}}) {
        my $d = StorageDisplay::RAID::Device->new($self, $st, $dev, $args->{'devices'}->{$dev});
        $self->_add_device($d);
        $self->addChild($d);
    }

    return $self;
};

has 'used-dev-size' => (
    is    => 'ro',
    isa   => 'Int',
    required => 1,
    reader => 'used_dev_size',
    );

has 'raid-name' => (
    is    => 'ro',
    isa   => 'Str',
    required => 1,
    reader => 'raid_name',
    );

sub dname {
    my $self=shift;
    return 'MD: '.$self->block->dname;
}

sub dotLabel {
    my $self = shift;
    return (
        $self->raid_name,
        $self->disp_size($self->used_dev_size).' used per device',
        );
}

sub dotLinks {
    my $self = shift;
    # Always one raid device for MD RAID
    my $raidlinkname = ($self->raid_devices)[0]->linkname;
    return (
        map {
            $_->linkname.' -> '.$raidlinkname
        } $self->devices
    );
}

1;

##################################################################
package StorageDisplay::RAID::LSI::Megacli::RaidDevice;

use Moose;
use namespace::sweep;
extends 'StorageDisplay::RAID::RaidDevice';

has 'lsi-id' => (
    is    => 'ro',
    isa   => 'Str',
    init_arg => 'ID',
    reader=> 'lsi_id',
    required => 1,
    );

around 'dotLabel' => sub {
    my $orig  = shift;
    my $self = shift;
    my @ret = $self->$orig(@_);
    $ret[0] .= " (".$self->lsi_id.")";
    return @ret;
};


##################################################################
package StorageDisplay::RAID::LSI::Megacli::BBU::Status;

use Moose;
use namespace::sweep;
extends 'StorageDisplay::RAID::Elem';

has 'status' => (
    is    => 'ro',
    isa   => 'Str',
    required => 1,
    );

around BUILDARGS => sub {
    my $orig  = shift;
    my $class = shift;
    my $raid = shift;
    my $st = shift;

    return $class->$orig(
        $raid, $st,
        'name' => join('@@',$raid->name,'BBUStatus'),
        'consume' => [],
        @_
        );
};

sub dotStyleNode {
    my $self = shift;
    my $color = 'special';
    my $status = $self->status;

    if ($status =~ /REPL|error/i) {
        $color = 'red';
    } elsif ($status =~ /missing/i || $status eq '') {
        $color = 'warning';
    } elsif ($status =~ /absent/i) {
        $color = 'unused';
    } elsif ($status =~ /good/i) {
        $color = 'ok';
    }

    return (
        "shape=oval",
        "fillcolor=".$self->statecolor($color),
        );
}

sub dotLabel {
    my $self = shift;

    return (
        'BBU Status: '.$self->status,
        );
}

1;

##################################################################
package StorageDisplay::RAID::LSI::Megacli;

use Moose;
use namespace::sweep;
extends 'StorageDisplay::RAID';

has 'controller' => (
    is    => 'ro',
    isa   => 'Num',
    required => 1,
    );

has 'hw_model' => (
    is    => 'ro',
    isa   => 'Str',
    init_arg => 'H/W Model',
    required => 1,
    );

has 'ID' => (
    is    => 'ro',
    isa   => 'Str',
    required => 1,
    );

has 'named-raid-devices' => (
    traits   => [ 'Hash' ],
    is    => 'ro',
    isa   => 'HashRef[StorageDisplay::RAID::RaidDevice]',
    required => 1,
    default  => sub { return {}; },
    handles  => {
        '_add_named_raid_device' => 'set',
            'raid_device' => 'get',
    }
    );

around BUILDARGS => sub {
    my $orig  = shift;
    my $class = shift;
    my $controller = shift;
    my $st = shift;

    #$st->get_infos
    $st->log({level=>1}, 'Megacli Raid controller '.$controller);

    my $info = $st->get_info('lsi-megacli', $controller);

    return $class->$orig(
        'name' => join('@','@LSIMegacli',$controller),
        'controller' => $controller,
        'consume' => [],
        'st' => $st,
        %{$info->{'Controller'}->{'c'.$controller}},
        %{$info},
        @_
        );
};

sub BUILD {
    my $self=shift;
    my $args=shift;
    my $st = $args->{st};

    #my $state = StorageDisplay::RAID::State->new($self, $st,
    #                                             'state' => $args->{'raid-state'});
    #$self->addChild($state);

    #$self->_add_raid_device(StorageDisplay::RAID::RaidDevice->new($self, $st,
    #                                                              $self->block,
    #                                                              $state,
    #                                                              'size' => $args->{'array-size'}));
    my $cid = $self->controller;

    #use Data::Dumper;
    #print STDERR Dumper($st);
    $self->addChild(StorageDisplay::RAID::LSI::Megacli::BBU::Status->new(
                        $self, $st, 'status' => $args->{'BBU'}));

    use bignum qw/hex/;
    foreach my $dev (sort { $a->{'LSI ID'} <=> $b->{'LSI ID'} }
                     (values %{$args->{'Disk'}})) {
	my $devname = $dev->{'Path'} // '';
        my $devpath = 'LSIMegaCli@'.$dev->{'Slot ID'};
        if ($dev->{'ID'} !~ /^c[0-9]+uXpY$/) {
            $devpath = 'LSIMegaCli@'.$dev->{'ID'};
        }
	my $block;
	my @block;
	if ($devname ne '' && $devname ne 'N/A') {
		$block = $st->block($devname);
		@block = ('block' => $block);
	}
        my $d = StorageDisplay::RAID::RawDevice->new(
            $self, $st, $devpath, $dev,
            'raiddevice' => $dev->{'ID'},
            'state' => $dev->{'Status'},
            'model' => $dev->{'Drive Model'},
            'slot' => $dev->{'Slot ID'},
            'size' => (hex($dev->{'# sectors'}) * ($dev->{'sector size'} // 512))->numify(),
	    @block,
            );
        $self->_add_device($d);
        $self->addChild($d);
	if ($block) {
		$d->provideBlock($block);
	}
    }
    foreach my $dev (sort { $a->{'ID'} cmp $b->{'ID'} }
                     (values %{$args->{'Array'}})) {
        my $devname = $dev->{'OS Path'};
        my $block = $st->block($devname);
        my $raid_device = StorageDisplay::RAID::LSI::Megacli::RaidDevice->new(
            $self, $st, $block,
            'size' => $block->blk_info("SIZE"),
            'raid-level' => $dev->{'Type'},
            %{$dev},
            );
        my %inprogress=();
        if ($dev->{'InProgress'} ne 'None') {
            %inprogress=('extra-info' => $dev->{'InProgress'});
        }
        my $state = StorageDisplay::RAID::State->new($raid_device, $st,
                                                     'state' => $dev->{'Status'},
                                                     %inprogress);

        $self->_add_raid_device($raid_device, $state);
        $self->_add_named_raid_device($dev->{'ID'}, $raid_device);
    }

    return $self;
};

sub dname {
    my $self=shift;
    return 'MegaCli: Controller '.$self->ID;
}

sub dotLabel {
    my $self = shift;
    return (
        $self->hw_model,
        "Controller: ".$self->ID,
        #$self->raid_level.': '.$self->raid_name,
        #$self->disp_size($self->used_dev_size).' used per device',
        );
}

sub dotLinks {
    my $self = shift;
    return (
        map {
            if ($_->raiddevice =~ /^(c[0-9]+u[0-9]+)p([0-9]+|Y)$/) {
                my $raid_device = $self->raid_device($1);
                $_->linkname.' -> '.$raid_device->linkname;
            }
        } $self->devices
    );
}

1;

##################################################################
package StorageDisplay::RAID::LSI::SASIrcu::MissingRawDevice;

use Moose;
use namespace::sweep;
extends 'StorageDisplay::RAID::RawDevice';

#with (
#    'StorageDisplay::Role::Style::WithSize',
#    );

has 'volume' => (
    is       => 'rw',
    isa      => 'StorageDisplay::RAID::RaidDevice',
    required => 0,
    predicate => 'has_volume',
    );

has 'phyid' => (
    is       => 'rw',
    isa      => 'Num',
    required => 0,
    predicate => 'has_phyid',
    );

around 'dotLabel' => sub {
    my $orig  = shift;
    my $self = shift;
    my @ret = $self->$orig(@_);
    if ($self->has_phyid) {
        $ret[1] = $self->phyid.": enc/slot: ".$self->slot;
    } else {
        $ret[1] = "enc/slot: ".$self->slot;
    }
    return @ret;
};

1;

##################################################################
package StorageDisplay::RAID::LSI::SASIrcu::RawDevice;

use Moose;
use namespace::sweep;
extends 'StorageDisplay::RAID::RawDevice';

has 'volume' => (
    is       => 'rw',
    isa      => 'StorageDisplay::RAID::RaidDevice',
    required => 0,
    predicate => 'has_volume',
    );

has 'phyid' => (
    is       => 'rw',
    isa      => 'Num',
    required => 0,
    predicate => 'has_phyid',
    );

around 'dotLabel' => sub {
    my $orig  = shift;
    my $self = shift;
    my @ret = $self->$orig(@_);
    if ($self->has_phyid) {
        $ret[1] = $self->phyid.": enc/slot: ".$self->slot;
    } else {
        $ret[1] = "enc/slot: ".$self->slot;
    }
    return @ret;
};

1;

##################################################################
package StorageDisplay::RAID::LSI::SASIrcu;

use Moose;
use namespace::sweep;
extends 'StorageDisplay::RAID';

my $missing_count=0;

has 'controller' => (
    is    => 'ro',
    isa   => 'Num',
    init_arg => 'controllerID',
    required => 1,
    );

has 'hw_model' => (
    is    => 'ro',
    isa   => 'Str',
    init_arg => 'controller-type',
    required => 1,
    );

has 'named-raw-devices' => (
    traits   => [ 'Hash' ],
    is    => 'ro',
    isa   => 'HashRef[StorageDisplay::RAID::RawDevice]',
    required => 1,
    default  => sub { return {}; },
    handles  => {
        '_add_named_raw_device' => 'set',
            'raw_device' => 'get',
    }
    );

around BUILDARGS => sub {
    my $orig  = shift;
    my $class = shift;
    my $controller = shift;
    my $st = shift;

    #$st->get_infos
    $st->log({level=>1}, 'LSI Raid controller (SAS2Ircu) '.$controller);

    my $info = $st->get_info('lsi-sas-ircu', $controller);

    return $class->$orig(
        'name' => join('@','@LSISASIrcu',$controller),
        'controllerID' => $controller,
        'consume' => [],
        'st' => $st,
        %{$info->{'controller'}},
        %{$info},
        @_
        );
};



sub BUILD {
    my $self=shift;
    my $args=shift;
    my $st = $args->{st};

    my $cid = $self->controller;
    my $cur_missing_count = $missing_count;
    foreach my $dev (sort { $a->{'enclosure'} <=> $b->{'enclosure'}
                            or $a->{'slot'} <=> $b->{'slot'}
                     }
                     @{$args->{'devices'}}) {
        my ($id,$d);
        if ($dev->{'state'} =~ /MIS/) {
            # disk missing
            $id = $dev->{'enclosure'}.":".$dev->{'slot'}." (".($missing_count++).")";
            my $devpath = 'LSISASIrcu@'.$id;
            $d = StorageDisplay::RAID::LSI::SASIrcu::MissingRawDevice->new(
                $self, $st, $devpath, $dev,
                'raiddevice' => $id,
                'state' => $dev->{'state'},
                'model' => 'Disk missing',
                'size' => 0,
                'slot' => 'none',
                );
        } else {
            $id=$dev->{'enclosure'}.":".$dev->{'slot'};
            my $devpath = 'LSISASIrcu@'.$id;
            $d = StorageDisplay::RAID::LSI::SASIrcu::RawDevice->new(
                $self, $st, $devpath, $dev,
                'raiddevice' => $id,
                'state' => $dev->{'state'},
                'model' => join(' ', $dev->{'manufacturer'}, $dev->{'model-number'}, $dev->{'serial-no'}),
                'size' => $dev->{'size'},
                'slot' => $id,
                );
        }
        $self->_add_device($d);
        $self->addChild($d);
        $self->_add_named_raw_device($id, $d);
    }
    foreach my $dev (sort { $a->{'id'} cmp $b->{'id'} }
                     @{$args->{'volumes'}}) {
        my $devname = $args->{'wwid'}->{$dev->{'wwid'}};
        my $block = $st->block($devname);
        my $raid_device = StorageDisplay::RAID::RaidDevice->new(
            $self, $st, $block,
            'size' => $block->blk_info("SIZE"),
            'raid-level' => $dev->{'Type'},
            %{$dev},
            );
        my $state = StorageDisplay::RAID::State->new($raid_device, $st,
                                                     'state' => $dev->{'status'});

        $self->_add_raid_device($raid_device, $state);
        foreach my $phyid (keys %{$dev->{'PHY'} // {}}) {
            my $phy = $dev->{'PHY'}->{$phyid};
            my $id = $phy->{'enclosure'}.":".$phy->{'slot'};
            if ($id eq '0:0') {
                $id .= ' ('.($cur_missing_count++).')';
            }
            my $rdsk = $self->raw_device($id);
            $rdsk->volume($raid_device);
            $rdsk->phyid($phyid);
        }
    }

    return $self;
};

sub dname {
    my $self=shift;
    return 'MegaCli: Controller '.$self->controller;
}

sub dotLabel {
    my $self = shift;
    return (
        $self->hw_model,
        #$self->ID,
        #$self->raid_level.': '.$self->raid_name,
        #$self->disp_size($self->used_dev_size).' used per device',
        );
}

sub dotLinks {
    my $self = shift;
    return (
        map {
            if ($_->has_volume) {
                $_->linkname.' -> '.$_->volume->linkname;
            }
        } $self->devices
    );
}

1;

##################################################################
##################################################################
package StorageDisplay::Libvirt;

use Moose;
use namespace::sweep;
extends 'StorageDisplay::Elem';

with (
    'StorageDisplay::Role::Style::IsSubGraph',
    'StorageDisplay::Role::Style::Grey',
    );

around BUILDARGS => sub {
    my $orig  = shift;
    my $class = shift;
    my $st = shift;

    #$st->get_infos
    $st->log('Creating libvirt virtual machines');

    my $info = $st->get_info('libvirt');

    return $class->$orig(
        'name' => '@libvirt',
        'consume' => [],
        'st' => $st,
        'vms' => [ sort keys %{$info} ],
        @_
        );
};

sub BUILD {
    my $self=shift;
    my $args=shift;
    my $st = $args->{st};

    foreach my $vm (@{$args->{'vms'}}) {
        my $d = StorageDisplay::Libvirt::VM->new($self, $st, $vm);
        $self->addChild($d);
    }

    return $self;
};

sub dname {
    my $self=shift;
    return 'Libvirt Virtual Machines';
}

sub dotLabel {
    my $self = shift;
    return 'Libvirt Virtual Machines';
}

1;

##################################################################
package StorageDisplay::Libvirt::VM;

use Moose;
use namespace::sweep;
extends 'StorageDisplay::Elem';

with (
    'StorageDisplay::Role::Style::IsSubGraph',
    'StorageDisplay::Role::Style::SubInternal',
    );

has 'vmname' => (
    is    => 'ro',
    isa   => 'Str',
    required => 1,
    );

has 'state' => (
    is    => 'ro',
    isa   => 'Maybe[Str]',
    required => 1,
    );

around BUILDARGS => sub {
    my $orig  = shift;
    my $class = shift;
    my $parent = shift;
    my $st = shift;
    my $vm = shift;

    my $vminfo = $st->get_info('libvirt', $vm) // {};

    $st->log({level=>1}, $vm);

    return $class->$orig(
        @_,
        'name' => join('@', $parent->name,$vm),
        'vmname' => $vm,
        'consume' => [],
        'st' => $st,
        'vm-info' => $vminfo,
        'state' => $vminfo->{state},
        );
};

sub BUILD {
    my $self=shift;
    my $args=shift;
    my $blocks=$args->{'vm-info'}->{'blocks'} // {};

    foreach my $disk (sort keys %{$blocks}) {
        $self->addChild(
            StorageDisplay::Libvirt::VM::Block->new(
                $self, $args->{'st'}, $disk, $blocks->{$disk}
            ));
    }
    return $self;
};

around 'dotStyleNode' => sub {
    my $orig = shift;
    my $self = shift;
    my @text = $self->$orig(@_);

    if ($self->state // '' eq 'running') {
        my $color = $self->statecolor('used');
        push @text, "fillcolor=$color";
    }

    return @text;
};

sub dotLabel {
    my $self = shift;
    return ($self->vmname);
}

1;

##################################################################
package StorageDisplay::Libvirt::VM::Block;

use Moose;
use namespace::sweep;
extends 'StorageDisplay::Elem';

with (
    'StorageDisplay::Role::HasBlock',
    'StorageDisplay::Role::Style::Grey',
    );

has 'target' => (
    is    => 'ro',
    isa   => 'Str',
    required => 1,
    );

has 'mountpoint' => (
    is    => 'ro',
    isa   => 'Str',
    required => 0,
    predicate => 'has_mountpoint',
    );

has 'type' => (
    is    => 'ro',
    isa   => 'Str',
    required => 1,
    );

has 'vm' => (
    is    => 'ro',
    isa   => 'StorageDisplay::Libvirt::VM',
    required => 1,
    );


around BUILDARGS => sub {
    my $orig  = shift;
    my $class = shift;
    my $vm = shift;
    my $st = shift;
    my $bname = shift;
    my $binfo = shift;

    my $block = $st->block($bname);

    my @mountpoint;
    my $consumename=$bname;
    if ($binfo->{'type'} eq 'file') {
        my $mountpoint=$binfo->{'mount-point'};
        if (defined($mountpoint)) {
            @mountpoint=('mountpoint' => $mountpoint);
        }
        $consumename='@FS@'.($mountpoint // '@none@');
    }

    return $class->$orig(
        @_,
        'name' => join('@', $vm->name,$block->name),
        'block' => $block,
        'vm' => $vm,
        'consume' => [$st->block($consumename)],
        @mountpoint,
        'st' => $st,
        'target' => $binfo->{'target'},
        'type' => $binfo->{'type'},
        );
};

around 'dotStyleNode' => sub {
    my $orig = shift;
    my $self = shift;
    my @text = $self->$orig(@_);

    for my $i (1) { # just to be able to call 'last'
        if ($self->type ne 'block') {
            my $color = $self->statecolor('special');
            if ($self->type eq 'file') {
                if ($self->has_mountpoint) {
                    last;
                }
            }
            push @text, "fillcolor=$color";
        }
    };

    return @text;
};

sub BUILD {
    my $self=shift;
    my $args=shift;

    return $self;
};

sub dotLabel {
    my $self = shift;
    return (
        $self->block->dname,
        '('.($self->target//'').')',
        );
}

1;

###########################################################################
###########################################################################
###########################################################################
###########################################################################
###########################################################################
###########################################################################
package StorageDisplay::Collect::CMD::Remote;

# FIXME
use lib qw(.);
use StorageDisplay::Collect;
use Net::OpenSSH;
use Term::ReadKey;
END {
    ReadMode('normal');
}
use Moose;
use MooseX::NonMoose;
extends 'StorageDisplay::Collect::CMD';

has 'ssh' => (
    is    => 'ro',
    isa   => 'Net::OpenSSH',
    required => 1,
    );


sub open_cmd_pipe {
    my $self = shift;
    my $ssh = $self->ssh;
    my @cmd = @_;
    print STDERR "[SSH]Running: ", join(' ', @cmd), "\n";
    my ($dh, $pid) = $ssh->pipe_out(@cmd) or
    die "pipe_out method failed: " . $ssh->error." for '".join("' '", @cmd)."'\n";
    return $dh;
}

sub open_cmd_pipe_root {
    my $self = shift;
    my @cmd = (qw(sudo -S -p), 'sudo password:'."\n", '--', @_);
    ReadMode('noecho');
    my $dh = $self->open_cmd_pipe(@cmd);
    my $c = ord($dh->getc);
    $dh->ungetc($c);
    ReadMode('normal');
    return $dh;
}

around BUILDARGS => sub {
    my $orig  = shift;
    my $class = shift;
    my $remote = shift;

    my $ssh = Net::OpenSSH->new($remote);
    $ssh->error and
    die "Couldn't establish SSH connection: ". $ssh->error;

    return $class->$orig(
        'ssh' => $ssh,
        );
};

1;

###########################################################################
package StorageDisplay::Collect::CMD::Replay;

use parent -norequire => "StorageDisplay::Collect::CMD";
use Scalar::Util 'blessed';
use Data::Dumper;
use Data::Compare;

sub new {
    my $class = shift;
    my %args = ( @_ );
    if (not exists($args{'replay-data'})) {
        die 'replay-data argument required';
    }
    my $self = $class->SUPER::new(@_);
    $self->{'_attr_replay_data'} = $args{'replay-data'};
    $self->{'_attr_replay_data_nextid'}=0;
    return $self;
}

sub _replay {
    my $self = shift;
    my $args = shift;
    my $ignore_keys = shift;
    my $msgerr = shift;

    my $entry = $self->{'_attr_replay_data'}->[$self->{'_attr_replay_data_nextid'}++];
    if (not defined($entry)) {
        print STDERR "E: no record for $msgerr\n";
        die "No records anymore\n";
    }
    foreach my $k (keys %{$args}) {
        if (not exists($entry->{$k})) {
            print STDERR "E: no record for $msgerr\n";
            die "Missing '$k' in record:\n".Data::Dumper->Dump([$entry], ['record'])."\n";
        }
    }
    if (! Compare($entry, $args, { ignore_hash_keys => $ignore_keys })) {
        print STDERR "E: record for different arguments\n";
        foreach my $k (@{$ignore_keys}) {
            delete($entry->{$k});
        }
        die "Bad record:\n".
            Data::Dumper->Dump([$args, $entry], ['requested', 'recorded'])."\n";
    }
    return $entry;
}

sub _replay_cmd {
    my $self = shift;
    my $args = { @_ };
    my $cmd = $self->_replay(
        $args,
        ['stdout', 'root'],
        "command ".$self->cmd2str(@{$args->{'cmd'}}),
        );
    my $cmdrequested = $self->cmd2str(@{$args->{'cmd'}});
    if ($args->{'root'} != $cmd->{'root'}) {
        print STDERR "W: Root mode different for $cmdrequested\n";
    }
    print STDERR "Replaying".($cmd->{'root'}?' (as root)':'')
        .": ", $cmdrequested, "\n";
    my @infos = @{$cmd->{'stdout'}};
    my $infos = join("\n", @infos);
    if (scalar(@infos)) {
        # will add final endline
        $infos .= "\n";
    }
    open(my $fh, "<",  \$infos);
    return $fh;
}

sub open_cmd_pipe {
    my $self = shift;
    return $self->_replay_cmd(
        'root' => 0,
        'cmd' => [ @_ ],
        );
}

sub open_cmd_pipe_root {
    my $self = shift;
    return $self->_replay_cmd(
        'root' => 1,
        'cmd' => [ @_ ],
        );
}

sub has_file {
    my $self = shift;
    my $filename = shift;
    my $fileaccess = $self->_replay(
        {
            'filename' => $filename,
        },
        [ 'value' ],
        "file access check to '$filename'");
    return $fileaccess->{'value'};
}

1;

__END__

=pod

=encoding UTF-8

=head1 NAME

StorageDisplay - Collect and display storages on linux machines

=head1 VERSION

version 1.0.6

Replay commands

=head1 AUTHOR

Vincent Danjean <Vincent.Danjean@ens-lyon.org>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2020 by Vincent Danjean.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut
