view release on metacpan or  search on metacpan

lib/Net/Brcd.pm  view on Meta::CPAN

sub readline {
    my ($self, $arg_ref) = @_;
    
    croak __PACKAGE__, "Error - readline is a virtual function.\n";
}

sub cfgSave {
    my $self = shift;
    my %args = (
        -verbose => 0,
        @_,
    );
    my @rc   = $self->cmd('cfgSave');
    
    my $rc = '';
    SWITCH: {
        DEBUG && warn "DEBUG:cfgsave", Dumper(\@rc);
        unless (@rc) {
            last SWITCH;
        }
        if ($args{-verbose}) {
            warn join("\n", @rc), "\n";
        }
        $rc   = pop @rc;
        return 1 if ($rc =~ m/Nothing/i); # Pas de modif 
        return 1 if ($rc =~ m/Updating/i); # Update fait
    }
    
    croak "Error - Cannot save current configuration: $rc.\n";
}

sub aliShow {
    my $self=shift;

    my %args=(
          -bywwn    =>  0,
          -byport   =>  0,
          -cache    =>  0,
          -onlywwn  =>  1,
          -filter   =>  '*',
          @_
          );

    my $fab_name = $self->{FABRIC};
    my $fab      = $self->{FABRICS}->{$fab_name};
    $args{-onlywwn} = 0 if $args{-byport};

    my ($alias);
    $fab->{PORTID} = {};
    $fab->{WWN}    = {};
    $fab->{ALIAS}  = {};
    foreach ($self->cmd('aliShow "' . $args{-filter} . '"')) {
        next unless $_;
        if (m/alias:\s+(\w+)/) {
            $alias=$1;
            next;
        }
        if ($alias && m/${_brcd_wwn_re}/) {
            s/^\s*//; # on enleve les blancs de devant
            DEBUG && warn "DEBUG: aliShow: $alias: $_\n";
            my @wwn_for_alias = split m/\s*;\s*/;
            foreach my $wwn (@wwn_for_alias) {
                $fab->{WWN}->{$wwn}     = $alias;
            }
            if (exists $fab->{ALIAS}->{$alias}) {
                my $old_alias_value = $fab->{ALIAS}->{$alias};
                unless (ref $old_alias_value) {
                    $fab->{ALIAS}->{$alias} = [$old_alias_value];
                }
                push @{$fab->{ALIAS}->{$alias}}, @wwn_for_alias;
            } else {
                $fab->{ALIAS}->{$alias} = (@wwn_for_alias == 1) ? $wwn_for_alias[0]
                                                                : \@wwn_for_alias;
            }
           
            next;
        }
        
        next if $args{-onlywwn};
        
        if ($alias && m/(${_brcd_port_id})/) {
            my $port_id = $1;
            $fab->{PORTID}->{$port_id} = $alias;
            $fab->{ALIAS}->{$alias}    = $port_id;
            next;
        }
    }
    #}
    DEBUG && warn "DEBUG:zone.?:", Dumper($fab);

    return ($args{'-bywwn'})  ? (%{$fab->{WWN}})    :
           ($args{'-byport'}) ? (%{$fab->{PORTID}}) :                  
                                (%{$fab->{ALIAS}});
}

sub zoneShow {
    my $self = shift;

    my %args = (
          -bymember => 0,
          -cache    => 0,
          -filter   => '*',
          @_
          );

    my $fab_name = $self->{FABRIC};
    my $fab      = $self->{FABRICS}->{$fab_name};

    my ($zone);
    foreach ($self->cmd('zoneShow "' . $args{-filter} . '"')) {
        DEBUG && warn "DEBUG:CMDDUMP: $_\n";
        if (m/zone:\s+(\w+)/) {
            $zone = $1;
            next;
        }
        if ($zone && m/\s*(\w[:\w\s;]+)/) {
            my $members = $1;
            my @member  = split m/;\s+/, $members;

            foreach my $member (@member) {
                $fab->{ZONE}->{$zone}->{$member}++;
                $fab->{MEMBER}->{$member}->{$zone}++;
            }
        }
    }
    
    unless ($fab->{MEMBER} and $fab->{ZONE}) {
        croak "Warning - Empty zone.\n";
    }

    if (wantarray()) {
        return ($args{'-bymember'})?(%{$fab->{MEMBER}}):(%{$fab->{ZONE}});
    }
}

sub zoneMember {
    my ($self, $zone)=@_;

    my $fab_name = $self->{FABRIC};
    my $fab      = $self->{FABRICS}->{$fab_name};

    return unless exists $fab->{ZONE}->{$zone};

    return sort keys %{$fab->{ZONE}->{$zone}};
}

sub memberZone {
    my ($self,$member)=@_;

    my $fab_name = $self->{FABRIC};
    my $fab      = $self->{FABRICS}->{$fab_name};

    return unless exists $fab->{MEMBER}->{$member};

    return sort keys %{$fab->{MEMBER}->{$member}};
}

sub switchShow {
    my $self=shift;

    my %args=(
          -bywwn        => 0,
          -withportname => 0,
          -byslot       => 0,
          @_
          );

    my $fab_name = $self->{FABRIC};
    my $fab      = $self->{FABRICS}->{$fab_name};

    my (%wwn);
    foreach ($self->cmd("switchShow")) {
        next unless $_;
DEBUG && warn  "SWITCHSHOW   : $_\n";
        if (m/^(\w+):\s+(.+)/) {
            $fab->{$1} = $2;
            next;
        }