package LinuxIsdn::Info::ChannelProp;
use strict;
use warnings;
use fields qw(idmap chmap drmap usage flags phone);

my @line_fields;
my %line_fields;
{
    %line_fields = %{fields::new(__PACKAGE__)->[0]};
    @line_fields[values %line_fields] = keys %line_fields;
    shift(@line_fields);
}

my $global_changes;

package LinuxIsdn::Info::Channel;
use strict;
use warnings;
use WeakRef;
use fields qw(index driver usage facility disabled exclusive outgoing online
              phone mark);

# Map low 3 bits of usage to facility
my @usage = qw(none raw modem net voice fax);

sub new {
    my $class = shift;
    $class = ref($class) || $class;
    # print STDERR "new $class\n";
    my LinuxIsdn::Info::Channel $channel = [];
    weaken($channel->{driver} = shift);
    $channel->{"index"} = shift;
    $channel->{usage} = -1;
    return bless $channel, $class;
}

# Remember old state
sub mark {
    my LinuxIsdn::Info::Channel $self = shift;
    # print STDERR "$self $self->{index}->mark(@_)\n";
    return $self->{mark} = { facility	=> $self->{facility},
                             disabled	=> $self->{disabled},
                             exclusive	=> $self->{exclusive},
                             outgoing	=> $self->{outgoing},
                             online	=> $self->{online},
                             phone	=> $self->{phone}};
}

sub unmark {
    my LinuxIsdn::Info::Channel $self = shift;
    $self->{mark} = undef;
}

sub index {
    my LinuxIsdn::Info::Channel $self = shift;
    return $self->{"index"};
}

sub phone {
    my LinuxIsdn::Info::Channel $self = shift;
    $self->{phone} = shift if @_;
    return $self->{phone};
}

sub online {
    my LinuxIsdn::Info::Channel $self = shift;
    if (@_) {
        $self->{online} = $_[0] ? 1 : 0;
    }
    return $self->{online};
}

sub facilities {
    return @usage;
}

sub facility {
    my LinuxIsdn::Info::Channel $self = shift;
    return $self->{facility};
}

sub disabled {
    my LinuxIsdn::Info::Channel $self = shift;
    return $self->{disabled};
}

sub outgoing {
    my LinuxIsdn::Info::Channel $self = shift;
    return $self->{outgoing};
}

sub exclusive {
    my LinuxIsdn::Info::Channel $self = shift;
    return $self->{exclusive};
}

sub usage {
    my LinuxIsdn::Info::Channel $self = shift;
    if (@_ && $self->{usage} != $_[0]) {
        $self->{usage} = shift;
        defined($self->{facility} = $usage[$self->{usage} & 0x07]) ||
            die "Unknown facility for usage $self->{usage} & 0x07";
        $self->{disabled}  = ($self->{usage} &  32) ? 1 : 0;
        $self->{exclusive} = ($self->{usage} &  64) ? 1 : 0;
        $self->{outgoing}  = ($self->{usage} & 128) ? 1 : 0;
    }
    return $self->{usage};
}

sub driver {
    my LinuxIsdn::Info::Channel $self = shift;
    return $self->{driver};
}

sub info {
    my LinuxIsdn::Info::Channel $self = shift;
    return $self->{driver}->info();
}

sub print {
    my LinuxIsdn::Info::Channel $self = shift;
    my $fh = shift || \*STDERR;
    printf $fh ("    Channel %3s: online %s facility %s disabled %s exclusive %s outgoing %s phone %s\n",
                $self->{"index"}, $self->{online}, $self->{facility},
                $self->{disabled}, $self->{exclusive}, $self->{outgoing},
                $self->{phone} eq "" ? "none" : $self->{phone});
}

sub _changed {
    my LinuxIsdn::Info::Channel $self = shift;
    # print STDERR "$self->_changed($self->{index})\n";
    my $mark = $self->{mark};
    my $new  = $self->mark();

    my $changed = 0;
    for (keys %{$new}) {
        if ($mark->{$_} eq $new->{$_}) {
            # print STDERR "$_ stayed $new->{$_}\n";
            delete $new->{$_};
        } else {
            # print STDERR "$_ went from $mark->{$_} to $new->{$_}\n";
            $new->{$_} = [$mark->{$_}, $new->{$_}];
            $changed++;
        }
    }
    return $changed;
}

sub changes {
    my LinuxIsdn::Info::Channel $self = shift;
    return $self->{mark};
}

package LinuxIsdn::Info::Driver;
use strict;
use warnings;
use WeakRef;
use fields qw(index info id flags channels mark sub_changes);

sub new {
    my $class = shift;
    $class = ref($class) || $class;
    # print STDERR "new $class\n";
    my LinuxIsdn::Info::Driver $driver = [];
    weaken($driver->{info} = shift);
    $driver->{channels} = {};
    $driver->{"index"} = shift;
    $driver->{flags} = -1;
    return bless $driver, $class;
}

# Remember old state
sub mark {
    my LinuxIsdn::Info::Driver $self = shift;
    # print STDERR "$self $self->{index}->mark(@_)\n";
    $self->{sub_changes} = $self->{channels};
    if (@_) {
        for (values %{$self->{channels}}) {
            $_->mark(@_);
        }
    }
    return $self->{mark} = {
        id => $self->{id},
        # flags => $self->{flags},
    };
}

sub unmark {
    my LinuxIsdn::Info::Driver $self = shift;
    if ($self->{channels}) {
        # being deleted
        for (values %{$self->{channels}}) {
            $_->unmark();
        }
    } else {
        # changed or unchanged old stuff
        my ($same, $changed, undef, $old) = @{$self->{sub_changes}};
        $_->unmark for @{$old};
        $_->unmark for @{$same};
        $_->unmark for @{$changed};
    }
    $self->{mark}        = undef;
    $self->{sub_changes} = undef;
}

sub channels {
    my LinuxIsdn::Info::Driver $self = shift;
    return values %{$self->{channels}};
}

sub index {
    my LinuxIsdn::Info::Driver $self = shift;
    return $self->{"index"};
}

sub new_channel {
    my LinuxIsdn::Info::Driver $self = shift;
    return $self->{info}->new_channel($self, @_);
}

# Typically set drivers BEFORE calling flags !
sub flags {
    my LinuxIsdn::Info::Driver $self = shift;
    if (@_ && $self->{flags} != $_[0]) {
        $self->{flags} = shift;
        my ($index, $channel);
        while (($index, $channel) = each %{$self->{channels}}) {
            $channel->online($self->{flags} & ( 1 << $index));
        }
    }
    return $self->{flags};
}

sub id {
    my LinuxIsdn::Info::Driver $self = shift;
    $self->{id} = shift if @_;
    return $self->{id};
}

sub info {
    my LinuxIsdn::Info::Driver $self = shift;
    return $self->{info};
}

sub print_head {
    my LinuxIsdn::Info::Driver $self = shift;
    my $fh = shift || \*STDERR;
    printf $fh ("  Driver %2s: flags %3s id %s\n",
                   $self->{"index"}, $self->{flags}, $self->{id});
}

sub print {
    my LinuxIsdn::Info::Driver $self = shift;
    my $fh = shift || \*STDERR;
    $self->print_head($fh);
    for (values %{$self->{channels}}) {
        $_->print($fh);
    }
}

sub _changed {
    my LinuxIsdn::Info::Driver $self = shift;
    # print STDERR "$self->_changed($self->{index})\n";
    my $old  = $self->{sub_changes};
    my $mark = $self->{mark};
    my $new  = $self->mark();

    my $changed = 0;
    for (keys %{$new}) {
        if ($mark->{$_} eq $new->{$_}) {
            delete $new->{$_};
        } else {
            $new->{$_} = [$mark->{$_}, $new->{$_}];
            $changed++;
        }
    }

    my ($index, $channel, @new, @same, @changed);
    while (($index, $channel) = each %{$self->{sub_changes}}) {
        if (delete($old->{$index})) {
            if ($channel->_changed()) {
                push(@changed, $channel);
            } else {
                push(@same, $channel);
            }
        } else {
            # Completely new
            push(@new, $channel);
        }
    }
    my @old = keys %{$old};
    $self->{sub_changes} = [\@same, \@changed, \@new, \@old];
    $global_changes = 1 if @new || @old || @changed;
    return $changed;
}

sub changes {
    my LinuxIsdn::Info::Driver $self = shift;
    return $self->{mark};
}

sub sub_changes {
    my LinuxIsdn::Info::Driver $self = shift;
    return @{$self->{sub_changes}};
}

package LinuxIsdn::Info;
use strict;
use warnings;
use Carp;
# will be used for the partly read stuff
use base   qw(LinuxIsdn::Info::ChannelProp);
use fields qw(file file_handle line line_length drivers change_fun
              driver_class channel_class);

sub new {
    my $class = shift;
    $class = ref($class) || $class;
    # print STDERR "new $class\n";
    my LinuxIsdn::Info $self = [];
    my ($option, $loption);
    while (@_) {
        defined($option = shift) || croak "Undefined option to $class->new()";
        $loption = lc($option);
        if ($loption eq "file") {
            defined($self->{"file"} = shift) ||
                croak "No argument to $class->new() $option option";
        } elsif ($loption eq "driver_class") {
            defined($self->{"driver_class"} = shift) ||
                croak "No argument to $class->new() $option option";
            &UNIVERSAL::isa($self->{"driver_class"},
                            "LinuxIsdn::Info::Driver") ||
                croak "The argument to your $class->new() $option option should be derived from LinuxIsdn::Info::Driver";
        } elsif ($loption eq "channel_class") {
            defined($self->{"channel_class"} = shift) ||
                croak "No argument to $class->new() $option option";
            &UNIVERSAL::isa($self->{"channel_class"},
                            "LinuxIsdn::Info::Channel") ||
                croak "The argument to your $class->new() $option option should be derived from LinuxIsdn::Info::Channel";
        } elsif ($loption eq "change_fun") {
            defined($self->{"change_fun"} = shift) ||
                croak "No argument to $class->new() $option option";
        } else {
            croak "Unknown option $option to $class->new()";
        }
    }
    unless (defined($self->{"file"})) {
        for ("/dev/isdn/isdninfo", "/dev/isdninfo") {
            if (-r $_) {
                $self->{"file"} = $_;
                goto FILE;
            }
        }
        croak "$class->new() could not find a readable isdninfo file";
    }
  FILE:
    $self->{line_length} = -1;	# nr of entries on an info line
    $self->{line} = "";		# Unprocessed data read from info file
    $self->{drivers} = {};
    $self->{driver_class} = "LinuxIsdn::Info::Driver" unless
        defined($self->{driver_class});
    $self->{channel_class} = "LinuxIsdn::Info::Channel" unless
        defined($self->{channel_class});

    bless $self, $class;
    $self->open();
    return $self;
}

sub file {
    my LinuxIsdn::Info $self = shift;
    return $self->{"file"};
}

sub open {
    my LinuxIsdn::Info $self = shift;
    my $file = $self->file();
    open(my $fh, "<", $file) || croak "Could not open $file: $!";
    return $self->{"file_handle"} = $fh;
}

sub close {
    my LinuxIsdn::Info $self = shift;
    my $fh = $self->{"file_handle"};
    croak "Filehandle on $self->{file} is not open" unless defined($fh);
    $self->{"file_handle"} = undef;
    return close($fh);
}

sub file_handle {
    my LinuxIsdn::Info $self = shift;
    $self->open() unless defined($self->{"file_handle"});
    return $self->{"file_handle"};
}

sub read {
    my LinuxIsdn::Info $self = shift;
    my $len = length($self->{"line"});
    my $read = sysread($self->{"file_handle"}, $self->{"line"}, 16384, $len);
    if (!defined($read) || $read == 0) {
        # this even closes if we are the last reference
        # A program removing from a select might still need the fileno
        # though, so we don't explicitely close
        $self->{"file_handle"} = undef;
        return $read;
    }
    $self->chunk($len);
    return 1;
}

sub write {
    my LinuxIsdn::Info $self = shift;
    my $len = length($self->{"line"});
    $self->{"line"} .= join("", @_);
    return $self->chunk($len);
}

sub chunk {
    my LinuxIsdn::Info $self = shift;
    my $len = shift || 0;
    my $pos;
    while (-1 != ($pos = index($self->{"line"}, "\n", $len))) {
        my @vals = split(/\s+/, substr($self->{"line"}, 0, $pos));
        substr($self->{"line"}, 0, $pos+1) = "";
        $len = 0;
        @vals || die "Empty line from $self->{file} should never happen";
        my $name = shift(@vals);
        $name =~ /^(\w+):\z/ or die "Index $name has an invalid form";
        my $index = $line_fields{$1} or die "Unknown field $1";
        die "Index $1 already defined" if defined($self->[$index]);
        if ($self->{"line_length"} == -1) {
            $self->{"line_length"} = @vals;
        } elsif ($1 eq "flags") {
            # Ignore for the moment. Seems to be a per driver flag
            # contrary to all others who are per channel
        } elsif ($self->{"line_length"} != @vals) {
            die("Expected $self->{line_length} values for field $1, ",
                "but found ", scalar @vals);
        }
        $self->[$index] = \@vals;
        if ($1 eq $line_fields[-1]) {
            $self->complete();
            $self->{line_length} = -1;	# nr of entries on an info line
            @{$self}[@line_fields{@line_fields}] = ();
        }
    }
    return $self;
}

sub complete {
    my LinuxIsdn::Info $self = shift;
    my ($index, $cindex);
    for (@line_fields) {
        $index = $line_fields{$_};
        defined($self->[$index]) || die "Complete table, but no $_ line";
    }

    $self->mark(1);

    my (%drivers, %channels, %flags, @new);
    for (0..$self->{line_length}-1) {
        if ($self->{"drmap"}[$_] < 0 || $self->{"chmap"}[$_] < 0 ||
            $self->{"idmap"}[$_] eq "-") {
            # all of these seem to indicate an undefined channel

            # Check each indicator explicitely
            $self->{"drmap"}[$_] < 0    ||
                die "drmap[$_] in $self->{file} seems defined on an absent channel";
            $self->{"chmap"}[$_] < 0    ||
                die "chmap[$_] in $self->{file} seems defined on an absent channel";
            $self->{"idmap"}[$_] eq "-" ||
                die "idmap[$_] in $self->{file} seems defined on an absent channel";
            $self->{"phone"}[$_] eq "???" ||
                die "phone[$_] in $self->{file} seems defined on an absent channel";
            next;
        }
        # Ok, this seems like a good Driver
        $index = $self->{"drmap"}[$_];
        my LinuxIsdn::Info::Driver $driver = $self->{"drivers"}{$index} ||
            $drivers{$index};
        unless ($driver) {
            $driver = $self->new_driver($index);
            push(@new, $driver);
        }
        my $id = $driver->id();
        if (defined($id)) {
            $id eq $self->{idmap}[$_] ||
                die "Driver id changed from $id to $self->{idmap}[$_]";
        } else {
            $driver->id($self->{idmap}[$_]);
        }
        $drivers{$index} = $driver;

        # Ok, this seems like a good Channel
        $cindex = $self->{"chmap"}[$_];
        my $phone = $self->{phone}[$_] eq "???" ? "" : $self->{phone}[$_];
        my LinuxIsdn::Info::Driver $channel = $driver->{"channels"}{$cindex} ||
            $channels{$index}{$cindex};
        unless ($channel) {
            $channel = $driver->new_channel($cindex);
        }
        $channel->phone($phone);
        $channel->usage($self->{usage}[$_]);
        $channels{$index}{$cindex} = $channel;
    }

    my LinuxIsdn::Info::Driver $driver;
    my $old = $self->{drivers};
    my (@same, @changed);
    while (($index, $driver) = each %drivers) {
        # Implicitely drops old channels
        $driver->{channels} = $channels{$index} || {};
        $driver->flags($self->{"flags"}[$index]);
        if (delete $old->{$index}) {
            # already existed in the old set. Changed ?
            if ($driver->_changed()) {
                push(@changed, $driver);
            } else {
                push(@same, $driver);
            }
        }
        # already have a list of new drivers
    }
    # Implicitely drops old drivers and their channels
    $self->{drivers} = \%drivers;
    my @old = values %{$old};
    $global_changes = 1 if @changed || @new || @old;
    $self->{change_fun}->($self, \@same, \@changed, \@new, \@old) if
        $self->{change_fun} && $global_changes;
    # Completely new stuff is unmarked
    $_->unmark() for @old;
    $_->unmark() for @same;
    $_->unmark() for @changed;
    # print STDERR "------\n";
    # $self->print();
    # print STDERR "======\n";
    return $self;
}

# Remember old state
sub mark {
    my LinuxIsdn::Info $self = shift;
    for (values %{$self->{drivers}}) {
        $_->mark(@_);
    }
    $global_changes = 0;
}

sub drivers {
    my LinuxIsdn::Info $self = shift;
    return values %{$self->{drivers}};
}

sub new_driver {
    my LinuxIsdn::Info $self = shift;
    my $driver = $self->{"driver_class"}->new($self, @_);
    return $driver;
}

sub new_channel {
    my LinuxIsdn::Info $self = shift;
    my $channel = $self->{"channel_class"}->new(@_);
    return $channel;
}

sub print {
    my LinuxIsdn::Info $self = shift;
    my $fh = shift || \*STDERR;
    my $class = ref($self);
    printf $fh ("$class file %s\n", $self->{file});
    for (values %{$self->{drivers}}) {
        $_->print($fh);
    }
}

1;

__END__

=head1 NAME

LinuxIsdn::Info - Current state of the isdn system

=head1 SYNOPSIS

 $info = LinuxIsdn::Info->new(@options);
 $file = $info->file();
 $fh = $info->open();
 $file = $info->file_handle();
 $rc = $info->close();
 $nr_read = $info->read();
 $info->write(@chunks);
 @drivers = $info->drivers();
 $info->print(?$file_handle?);

 $driver = LinuxIsdn::Info::Driver->new($info, $index);
 @channels = $driver->channels();
 $info = $driver->info();
 $index = $driver->index();
 $flags = $driver->flags();
 $id = $driver->id();
 $changes = $driver->changes();
 ($same, $changed, $new, $old) = $driver->sub_changes();
 $driver->print_head(?$file_handle?);
 $driver->print(?$file_handle?);

 $driver = LinuxIsdn::Info::Channel->new($driver, $index);
 $index = $channel->index();
 $index = $channel->driver();
 $index = $channel->info();
 $index = $channel->phone();
 $usage = $channel->usage();
 @facilities = $channel->facilities();
 @facilities = LinuxIsdn::Info::Channel->facilities();
 $facility   = $channel->facility();
 $disabled   = $channel->disabled();
 $exclusive  = $channel->exclusive();
 $outgoing   = $channel->outgoing();
 $online     = $channel->online();
 $changes    = $channel->changes();
 $channel->print(?$file_handle?);

=head1 DESCRIPTION

B<LinuxIsdn::Info> manages a datastructure that mirrors the contents of
the isdn info device (typically /dev/isdninfo or /dev/isdn/isdninfo).

This avoids needing to understand the precise structure of that file.
The file is a bit uncommon in that you are supposed to keep reading from it,
and each time the device state changes, a new table is output.

We can hardly block the application waiting for a change that might never come,
or not reading data that is available, so the responsibility for reading lines
from the isdn info device is left up to the application (typically will use
something like raw L<select|perlfunc/"select">, L<IO::Select|IO::Select>,
L<Event|Event> or L<Tk::fileevent|Tk::fileevent>). After creating the Info
object, you can write strings to it using L<write|"write">, or do a
L<sysread|perlfunc/"sysread"> from the isdn info device it using the
L<read|"read"> method.

=head1 METHODS

=head2 LinuxIsdn::Info

=over 4

=item $info = LinuxIsdn::Info->X<new>(@options)

Creates the basic object. Tries to open the isdn info device. Raises an
exception on failure.

@options is processed element by element
(where each option will eat its corresponding arguments). Option names
are compared case-insensitive. Valid options are:

=over 8

=item File

The name of the isdn info file (typically something like /dev/isdninfo).
If not given, the program will look for some typical names and use the first
one found. An exception is raised if no info file is found. This file is than
L<opened|"open"> for read.

=item driver_class

The name of the class that will be created (using new) when a new driver is
seen. Defaults to "LinuxIsdn::Info::Driver".

This is a L<fields|fields> based class, so you can subclass and extend it and
whenever you get a driver. Just declare your variable to be of your own
subclassed type. Effectively this will allow you to use extra fields in the
array beyond the part used by this module. L<change_fun|"change_fun"> will
tell you about create/delete events, so you can put your initialization of the
extra fields there. So unless you need very special semantics, you should not
need this option.

=item channel_class

The name of the class that will be created (using new) when a new channel is
seen. Defaults to "LinuxIsdn::Info::Channel".

This is a L<fields|fields> based class, so you can subclass and extend it and
whenever you get a channel. Just declare your variable to be of your own
subclassed type. Effectively this will allow you to use extra fields in the
array beyond the part used by this module. L<change_fun|"change_fun"> will
tell you to query create/delete events (by calling changes on the driver), so
you can put your initialization of the extra fields there. So unless you need
very special semantics, you should not need this option.

=item change_fun

A reference to a function that will get called each time the isdn info file
indicates a state change.

It will be called as:

  $fun->($info, \@same, \@changed, \@new, \@old)

Where:

=over 12

=item $info

The LinuxIsdn::Info object where the change happened.

=item \@same

All drivers that existed before and after and that B<did not> change state
(changing state means that one of the fields like L<flags|"flags"> changed.
Desctruction of creation of a channel is not considered a change).

Use the L<sub_changes|"sub_changes"> method on these drivers to find out how
the channels evolved.

=item \@changed

All drivers that existed before and after and that B<did> change state
(changing state means that one of the fields like L<flags|"flags"> changed.
Desctruction of creation of a channel is not considered a change).

Use the B<changes> method on these drivers to find out what changed, and
L<sub_changes|"sub_changes"> for how the channels evolved.

=item \@new

All drivers that only just got noticed. All channels in there are implicitely
new too (the effect of calling B<changes> on the drivers and/or channels is
undefined).

=item \@old

All drivers that seem to have gone. All channels in there are implicitely gone
too (the effect of calling B<changes> on the drivers and/or channels these is
undefined).

=back

Only during this call, and only on the drivers in @same or @changed you
can call B<changes>.

=back

=item $file = $info->X<file>()

Returns the objects idea of the name of the isdn info device.

=item $fh = $info->X<open>()

Tries to (re)open the isdn info device, and returns the filehandle. Raises
an exception if the open fails. Is implicitely done by
L<new|"new">, so this is not normally used.

=item $fh = $info->X<file_handle>()

Returns an filehandle open for reading the isdn info device. Will call
L<open|"open"> if no filehandle is open.

=item $rc = $info->X<close>()

Will close the currently open filehandle on the isdn info device (raises an
exception is no open handle is available). Returns the
CORE::L<close|perlfunc/"close"> returncode.

=item $nr_read = $info->X<read>()

Does a L<sysread|perlfunc/"sysread"> on the currently open filehandle. In
case of EOF the method returns 0, and undef on error (just like
L<sysread|perlfunc/"sysread">). The filehandle is not yet closed, since the
caller might still need to remove it from event handlers.

If the method B<does> succeed in getting characters, it will add them to the
internal buffer using L<chunk|"chunk"> (which will do the further processing
if a full set of data is available). It returns the number of characters that
were read.

Typically called when some external file event handler has determined that
the filehandle has become readable.

=item $info->X<write>(@chunks)

Joins all the @chunks together and passes the resulting string to
L<chunk|"chunk"> (which will do the further processing if a full set of data
is available).

Typically used when the caller does its own reading.

=item chunk

An internal method that you should not call directly. It gets new characters
from L<read|"read"> or L<write|"write"> and parses them into lines. Each line
is run through some sanity checks and stored internally.

After a certain number of calls, it will have collected enough lines to
describe the new isdn status. It will then compare the old situation to the
new one, and call L<change_fun|"change_fun"> if that is defined and there
were any changes.

=item @drivers = $info->X<drivers>()

Returns the currently loaded drivers. To get the current channels,
query each driver seperately using the L<channels|"channels"> call.

=item $info->X<print>(?$file_handle?)

A debugging function that outputs a short overview of the current isdn state
to $file_handle (or STDERR if not given).

=back

=head2 LinuxIsdn::Info::Driver

Each driver is represented by a LinuxIsdn::Info::Driver (or subclass) object.
These make a certain number of methods available too:

=over 4

=item $driver = LinuxIsdn::Info::Driver->new($info, $index)

Creates a new LinuxIsdn::Info::Driver, and stores the fact that it's a driver
belonging to LinuxIsdn::Info $info with number $index (will be unique
for each current driver).

=item @channels = $driver->X<channels>()

Returns all channels of this driver. Will be objects of class
LinuxIsdn::Info::Channel or a subclass.

=item $info = $driver->X<info>()

Returns the LinuxIsdn::Info $info this driver belongs to.

=item $index = $driver->X<index>()

Returns the index number of this driver.

=item $flags = $driver->X<flags>()

Queries the current driver flags. Normally not called by the user, since the
parsed value is available as L<online|"online"> on the separate channels.

=item $id = $driver->X<id>()

Queries the current driver id. This is a string supplied to the kernel at
module load time.

=item $changes = $driver->X<changes>()

Only ever call this method during a L<change_fun|"change_fun"> call. It will
return a hash reference mapping all changed state to a two element array
reference the old and the new value of the state variable. For example:

 $changes = { id => ["HiSax", "Teles"] };

means that the old value id was "Hisax" and is now "Teles" (such a change is in
fact impossible as far as I know), while no other property changed (in fact,
there are currently no other properties).

=item ($same, $changed, $new, $old) = $driver->X<sub_changes>()

Only ever call this method during a L<change_fun|"change_fun"> call.
The method return 4 array references describing the evolution of the channels.
@new will contain any new channels that were seen for the first time,
@old refers to the channels that are not there anymore while]
@same and @changed refer to channels that were there both before and after the
call to  L<change_fun|"change_fun">. @changed has the
channels whose state did change (use B<changes> to find out what changed),
while @same describes the unchanged ones (unlike for drivers, there is no
reason to call B<sub_changes> on it, since it has no further subparts that can
have changed (in fact, L<LinuxIsdn::Info::Channel|"LinuxIsdn::Info::Channel">
has no B<sub_changes> method)).

The returned value is also used internally during cleanup, so don't change it.
However, cleanup itself does not change it, so you may store it internally and
can play around with it as much as you want to after the
L<change_fun|"change_fun"> call is finished.

=item $driver->X<print_head>(?$file_handle?)

A debugging function. Prints one line with some internal state of this driver
to $file_handle (STDERR if not given). Does not print any channel info.

=item $driver->X<print>(?$file_handle?)

A debugging function. Prints one line with some internal state of this driver,
followed by a B<print> done on each contained channel.

=back

=head2 LinuxIsdn::Info::Channel

Each channel is represented by a LinuxIsdn::Info::Channel (or subclass) object.
These make a certain number of methods available too:

=over 4

=item $driver = LinuxIsdn::Info::Channel->new($driver, $index)

Creates a new LinuxIsdn::Info::Channel, and stores the fact that it's a driver
belonging to LinuxIsdn::Driver $driver with number $index (will be unique
for each current driver).

=item $index = $channel->X<index>()

Returns the index number of this channel.

=item $index = $channel->X<driver>()

Returns the LinuxIsdn::Info::Driver this channel belongs to.

=item $index = $channel->X<info>()

Convenience function for C<$self-E<gt>driver()-E<gt>info()>, which returns
the LinuxIsdn::Info this channel belongs to.

=item $index = $channel->X<phone>()

Returns the phone number connected to this channel. The empty string if not
connected.

=item $usage = $channel->X<usage>()

Returns the usage flags of this channel. Normally not directly called by the
user, who should prefer the parsed values L<facility|"facility">,
L<disabled|"disabled">, L<exclusive|"exclusive"> and L<outgoing|"outgoing">.

=item @facilities = $channel->X<facilities>()

=item @facilities = LinuxIsdn::Info::Channel->facilities()

Returns the list of currently supported facilities in some none specified
order. This will be qw(none raw modem net voice fax).

=item $facility = $channel->X<facility>()

The kind of isdn connection. Can be any of the values of
L<facilities|"facilities">.

=item $disabled = $channel->X<disabled>()

Returns true if the channel is disabled.

=item $exclusive = $channel->X<exclusive>()

Returns true if the channel is exclusive.

=item $outgoing = $channel->X<outgoing>()

Returns true if the channel is outgoing.

=item $online = $channel->X<online>()

Returns true if the channel is online.

=item $changes = $channel->X<changes>()

Only ever call this method during a L<change_fun|"change_fun"> call, and only
after calling B<changes> on the "same" or "changed" drivers, and again there
only on the "changed" or "same" channels (the "same" channels will always
return {} though).

return a hash reference mapping all changed state to a 2 element array
reference to the old and the new value of the state variable. For example:

$changes = { phone => ["0343600421", ""}

means that the connected phone number used to be "0343600421", and is now "",
while "exclusive" seems to have been unchanged (since it's not in $changes).

=item $channel->X<print>(?$file_handle?)

A debugging function. Prints one line with some internal state of this channel.

=back

=head1 EXAMPLES

Here's a simple demo that monitors the isdn info device and reports any
changes it sees (the close/END part will normally never be executed. you
will have to ^C the program).

  #! /usr/bin/perl -w-

  use strict;
  use LinuxIsdn::Info;

  my $info = LinuxIsdn::Info->new(change_fun => \&driver_change);

  END {
      # Global cleanup seems sometimes confused by weak references
      undef $info;
  }

  eval {
     1 while $info->read();
  };
  $info->close();
  print "Died: $@" if $@;

  sub driver_change {
      my (undef, $same, $changed, $new, $old) = @_;

      print STDERR " Driver disappearing:\n";
      $_->print for @{$old};
      print STDERR " Driver freshly created:\n";
      $_->print for @{$new};
      print STDERR " Drivers changed:\n";
      for (@{$changed}) {
          $_->print_head();
          my $changes = $_->changes();
          while (my ($tag, $change) = each %{$changes}) {
              print "  $tag went from $change->[0] to $change->[1]\n";
          }
          channel_change($_->sub_changes());
      }
      print STDERR " Drivers remained unchanged:\n";
      for (@{$same}) {
          $_->print_head();
          channel_change($_->sub_changes());
      }
      print STDERR "----\n";
  }

  sub channel_change {
      my ($same, $changed, $new, $old) = @_;

      print STDERR "   Channel disappearing:\n";
      $_->print for @{$old};
      print STDERR "   Channel freshly created:\n";
      $_->print for @{$new};
      print STDERR "   Channel changed:\n";
      for (@{$changed}) {
          $_->print();
          while (my ($tag, $change) = each %{$_->changes()}) {
              print("    $tag went from $change->[0] to $change->[1]\n");
          }
      }
      print STDERR "   Channel remained unchanged:\n";
      $_->print() for @{$same};
  }

which might output something like:

  Driver disappearing:
  Driver freshly created:
   Driver  0: flags   0 id HiSax
     Channel   0: online 0 facility none disabled 0 exclusive 0 outgoing 0 phone none
     Channel   1: online 0 facility none disabled 0 exclusive 0 outgoing 0 phone none
  Drivers changed:
  Drivers remained unchanged:
 ----
  Driver disappearing:
  Driver freshly created:
  Drivers changed:
  Drivers remained unchanged:
   Driver  0: flags   0 id HiSax
    Channel disappearing:
    Channel freshly created:
    Channel changed:
     Channel   0: online 0 facility net disabled 0 exclusive 0 outgoing 0 phone 0691234567
     facility went from none to net
     phone went from  to 0691234567
    Channel remained unchanged:
     Channel   1: online 0 facility none disabled 0 exclusive 0 outgoing 0 phone none
 ----
  Driver disappearing:
  Driver freshly created:
  Drivers changed:
  Drivers remained unchanged:
   Driver  0: flags   1 id HiSax
    Channel disappearing:
    Channel freshly created:
    Channel changed:
     Channel   0: online 1 facility net disabled 0 exclusive 0 outgoing 1 phone 0691234567
     online went from 0 to 1
     outgoing went from 0 to 1
    Channel remained unchanged:
     Channel   1: online 0 facility none disabled 0 exclusive 0 outgoing 0 phone none
 ----
  Driver disappearing:
  Driver freshly created:
  Drivers changed:
  Drivers remained unchanged:
   Driver  0: flags   1 id HiSax
    Channel disappearing:
    Channel freshly created:
    Channel changed:
     Channel   1: online 0 facility net disabled 0 exclusive 0 outgoing 0 phone 961234567
     facility went from none to net
     phone went from  to 961234567
    Channel remained unchanged:
     Channel   0: online 1 facility net disabled 0 exclusive 0 outgoing 1 phone 0691234567
 ----
  Driver disappearing:
  Driver freshly created:
  Drivers changed:
  Drivers remained unchanged:
   Driver  0: flags   3 id HiSax
    Channel disappearing:
    Channel freshly created:
    Channel changed:
     Channel   1: online 1 facility net disabled 0 exclusive 0 outgoing 0 phone 961234567
     online went from 0 to 1
    Channel remained unchanged:
     Channel   0: online 1 facility net disabled 0 exclusive 0 outgoing 1 phone 0691234567
 ----
  Driver disappearing:
  Driver freshly created:
  Drivers changed:
  Drivers remained unchanged:
   Driver  0: flags   1 id HiSax
    Channel disappearing:
    Channel freshly created:
    Channel changed:
     Channel   1: online 0 facility net disabled 0 exclusive 0 outgoing 0 phone 961234567
     online went from 1 to 0
    Channel remained unchanged:
     Channel   0: online 1 facility net disabled 0 exclusive 0 outgoing 1 phone 0691234567
 ----
  Driver disappearing:
  Driver freshly created:
  Drivers changed:
  Drivers remained unchanged:
   Driver  0: flags   1 id HiSax
    Channel disappearing:
    Channel freshly created:
    Channel changed:
     Channel   1: online 0 facility none disabled 0 exclusive 0 outgoing 0 phone none
     facility went from net to none
     phone went from 961234567 to
    Channel remained unchanged:
     Channel   0: online 1 facility net disabled 0 exclusive 0 outgoing 1 phone 0691234567
 ----
  Driver disappearing:
  Driver freshly created:
  Drivers changed:
  Drivers remained unchanged:
   Driver  0: flags   0 id HiSax
    Channel disappearing:
    Channel freshly created:
    Channel changed:
     Channel   0: online 0 facility none disabled 0 exclusive 0 outgoing 0 phone none
     online went from 1 to 0
     outgoing went from 1 to 0
     facility went from net to none
     phone went from 0691234567 to
    Channel remained unchanged:
    Channel   1: online 0 facility none disabled 0 exclusive 0 outgoing 0 phone none
 ----

Here's a more complete example which duplicates (the important) part of the
functionality of L<isdnmon(1)|isdnmon(1)>. Notice the way channels and
drivers are subclassed and the event handling of the isdn info device is
done.

 #! /usr/bin/perl -w-

 use strict;
 use LinuxIsdn::Info;
 use Sys::Hostname;
 use Tk;

 package Info;
 use base   qw(LinuxIsdn::Info);
 use fields qw(widget);

 # return the widget under which to hang subparts
 sub widget {
     my Info $self = shift;
     return $self->{widget};
 }

 package Driver;
 use base   qw(LinuxIsdn::Info::Driver);
 use fields qw(widget);

 # return the widget under which to hang subparts
 sub widget {
     my Driver $self = shift;
     return $self->{widget};
 }

 sub destroy {
     my Driver $self = shift;
     $_->destroy() for $self->channels();
     $self->{widget}->destroy();
     $self->{widget} = undef;
 }

 sub create {
     my Driver $self = shift;

     my $parent = $self->info()->widget();
     my $frame = $parent->Frame();
     $frame->grid(-row => $self->index(), -column => 0, -sticky => "ew");
     my $label = $frame->Label(-relief => "raised", -text => $self->id());
     $label->grid(-row => 0, -column => 0, -columnspan => 3, -sticky => "ew");
     $self->{widget} = $frame;
     $_->create() for $self->channels();
 }

 package Channel;
 use base qw(LinuxIsdn::Info::Channel);
 use fields qw(online_widget phone_widget facility_widget);

 sub destroy {
     my Channel $self = shift;
     $self->{online_widget}->destroy();
     $self->{online_widget} = undef;
     $self->{phone_widget}->destroy();
     $self->{phone_widget} = undef;
     $self->{facility_widget}->destroy();
     $self->{facility_widget} = undef;
 }

 sub create {
     my Channel $self = shift;

     my $driver = $self->driver();
     my $parent = $driver->widget();
     my $row = 1+$self->index();

     ($self->{online_widget} =
      $parent->Label(-width => 3))->grid(-row => $row, -column => 0);
     ($self->{phone_widget} =
      $parent->Label(-width => 20))->grid(-row => $row, -column => 1);
     ($self->{facility_widget} =
      $parent->Label(-width => 5))->grid(-row => $row, -column => 2);
     $self->online_prop();
     $self->phone_prop();
     $self->facility_prop();
 }

 my @color = (["green", "green"], ["yellow", "red"]);

 sub online_prop {
     my Channel $self = shift;
     my $online = $self->online();
     $self->{online_widget}->configure(-bg =>$color[$online][$self->outgoing()],
                                       -text => $online ? "Yes" : "No");
 }

 sub phone_prop {
     my Channel $self = shift;
     $self->{phone_widget}->configure(-text => $self->phone());
 }

 sub facility_prop {
     my Channel $self = shift;
     $self->{facility_widget}->configure(-text => ucfirst($self->facility()));
 }

 package main;

 sub driver_change {
     my (undef, $same, $changed, $new, $old) = @_;

     $_->destroy  for @{$old};
     $_->create() for @{$new};
     for (@{$changed}) {
         # my $changes = $_->changes();
         # print "  Id went from $changes->{id} to ", $_->id(), "\n" if
         #    exists $changes->{id};
         channel_change($_->sub_changes());
     }
     channel_change($_->sub_changes()) for @{$same};
 }

 sub channel_change {
     my ($same, $changed, $new, $old) = @_;

     $_->destroy() for @{$old};
     $_->create()  for @{$new};
     for (@{$changed}) {
         my $changes = $_->changes();
         $_->phone_prop()    if exists $changes->{phone};
         $_->online_prop()   if
             exists $changes->{online} || exists $changes->{outgoing};
         $_->facility_prop() if exists $changes->{facility};
     }
 }

 my Info $info = Info->new(change_fun => \&driver_change,
                           channel_class => "Channel",
                           driver_class  => "Driver");

 END {
     # Global cleanup seems sometimes confused by weak references
     undef $info;
 }

 my $top = MainWindow->new(title => "ISDN-Status of " . hostname());
 $info->{widget} = $top;
 $top->fileevent($info->file_handle(), "readable", sub { $info->read(); });
 MainLoop();

=head1 BUGS

None known.

=head1 AUTHOR

Ton Hospel (LinuxIsdn-Info@ton.iguana.be)

=head1 SEE ALSO

L<LinuxIsdn>,
L<isdnmon(1)|isdnmon(1)>,
L<pisdnmon>

=cut
