package Zaptel::Xpp::Xpd; # # Written by Oron Peled # Copyright (C) 2007, Xorcom # This program is free software; you can redistribute and/or # modify it under the same terms as Perl itself. # # $Id$ # use strict; use Zaptel::Utils; my $proc_base = "/proc/xpp"; sub blink($$) { my $self = shift; my $on = shift; my $result; my $file = "$proc_base/" . $self->fqn . "/blink"; die "$file is missing" unless -f $file; # First query open(F, "$file") or die "Failed to open $file for reading: $!"; $result = ; chomp $result; close F; if(defined($on) and $on ne $result) { # Now change open(F, ">$file") or die "Failed to open $file for writing: $!"; print F ($on)?"1":"0"; if(!close(F)) { if($! == 17) { # EEXISTS # good } else { undef $result; } } } return $result; } sub zt_registration($$) { my $self = shift; my $on = shift; my $result; my $file = "$proc_base/" . $self->fqn . "/zt_registration"; die "$file is missing" unless -f $file; # First query open(F, "$file") or die "Failed to open $file for reading: $!"; $result = ; chomp $result; close F; if(defined($on) and $on ne $result) { # Now change open(F, ">$file") or die "Failed to open $file for writing: $!"; print F ($on)?"1":"0"; if(!close(F)) { if($! == 17) { # EEXISTS # good } else { undef $result; } } } return $result; } # # Backward compatibility for old drivers # before changeset:5119 # # Newer drivers should directly have $xpd->spanno # sub spanno_of_xpd($) { my $xpd = shift || die; warn "Running on old driver. Keep going...\n"; use Zaptel; my @spans = Zaptel::spans; my ($span) = grep { $_->name eq $xpd->fqn } @spans; return ($span) ? $span->num : 0; } sub new($$) { my $pack = shift or die "Wasn't called as a class method\n"; my $xbus = shift || die; my $procdir = shift || die; my $self = {}; bless $self, $pack; $self->{XBUS} = $xbus; $self->{DIR} = $procdir; local $/ = "\n"; open(F, "$procdir/summary") || die "Missing summary file in $procdir"; my $head = ; chomp $head; # "XPD-00 (BRI_TE ,card present, span 3)" close F; $head =~ s/^(XPD-(\d\d))\s+// || die; $self->{ID} = $2; $self->{FQN} = $xbus->name . "/" . $1; $head =~ s/^.*\(// || die; $head =~ s/\) */, / || die; $head =~ s/\s*,\s*/,/g || die; my ($type,$present,$span,$rest) = split(/,/, $head); #warn "Garbage in '$procdir/summary': rest='$rest'\n" if $rest; if($span =~ s/span\s+(\d+)//) { # since changeset:5119 $self->{SPANNO} = $1; } else { $self->{SPANNO} = $self->spanno_of_xpd; } $self->{TYPE} = $type; $self->{IS_BRI} = ($type =~ /BRI_(NT|TE)/); $self->{IS_PRI} = ($type =~ /[ETJ]1_(NT|TE)/); $self->{IS_DIGITAL} = ( $self->{IS_BRI} || $self->{IS_PRI} ); return $self; } 1;