From 8f5544f02c89fea42215047ebd27e7ea42cb2215 Mon Sep 17 00:00:00 2001 From: paulc Date: Mon, 7 Aug 2006 13:18:26 +0000 Subject: [PATCH] Removed old buggy Perl library. git-svn-id: http://voip.null.ro/svn/yate@987 acf43c95-373e-0410-b603-e72c3f656dc1 --- scripts/Yate.pm | 259 ------------------------------------------------ 1 file changed, 259 deletions(-) delete mode 100644 scripts/Yate.pm diff --git a/scripts/Yate.pm b/scripts/Yate.pm deleted file mode 100644 index ee61266b..00000000 --- a/scripts/Yate.pm +++ /dev/null @@ -1,259 +0,0 @@ -####################################################### -# -# Yate.pm gateway interface module for Yate -# Copyright Anthony Minessale II -# This Module is released under the GNU Public License -# If you find this software useful, donations are welcome -# at paypal:anthmct@yahoo.com -# -package Yate; -use Data::Dumper; -use POSIX; - -#disable Buffering -$|=1; - -sub new($;$$) { - my $proto = shift; - my $class = ref($proto) || $proto; - my $name = shift; - my $params = shift; - my $id = (int rand 1000) . time; - my $self = {params => $params , headers => { name => $name , what => "message", id => $id, processed => "false" , time => time} }; - - bless ($self, $class); - -} - -sub warn($;) { - my($self) = shift; - printf STDERR @_; -} - -sub dump($) { - my $self = shift; - $self->warn(Dumper $self); -} - -sub print($$) { - my($self,$buf) = @_; - # replace any % character with %% - $buf =~ s/\%/\%\%/g; - # translate any char with an ascii code < 32 into the escaped form - $buf =~ s/(.)/ord $1 < 32 ? sprintf "%%%s", chr(ord($1) + 64) : sprintf "%s",$1/eg; - $self->warn("DEBUG:OUT: $buf") if($ENV{DEBUGYATE}); - print STDOUT $buf; -} - - -sub handle_install($$) { - my $self = shift; - my ($what,$pri,$driver,$tf) = @_; - if($what eq "install") { - if($tf eq "false") { - $self->warn("Error installing $driver at priority $pri\n"); - delete $self->{funcs}->{$driver}; - } - } - elsif($what eq "uninstall") { - if($tf eq "true") { - $self->warn("Un-installing $driver at priority $pri\n"); - delete $self->{funcs}->{$driver}; - } - } - -} -sub install($$$;$) { - my ($self,$driver,$func,$pri) = @_; - $pri ||= 10; - $self->print("%>install:$pri:$driver\n"); - $self->warn("install $driver priority $pri\n"); - push @{$self->{funcs}->{$driver}},$func if($func); -} - -sub uninstall($$) { - my ($self,$driver) = @_; - $self->print("%>uninstall:$driver\n"); -} - -sub param($$;$) { - my($self,$param,$val) = @_; - if($param and defined $val) { - $self->{params}->{$param} = $val; - } - $self->{params}->{$param}; -} - -sub header($$;$) { - my($self,$header,$val) = @_; - if($header and $val) { - $self->{headers}->{$header} = $val; - } - $self->{headers}->{$header}; -} - -sub params($;$) { - my($self,$params) = @_; - if($params) { - $self->{params} = $params; - } - $self->{params} -} - -sub headers($;$) { - my($self,$headers) = @_; - if($headers) { - $self->{headers} = $headers; - } - $self->{headers} -} - -sub name($;$) { - my ($self,$set) = @_; - $self->{headers}->{name} = $set if(defined $set); - $self->{headers}->{name}; -} - -sub what($;$) { - my ($self,$set) = @_; - $self->{headers}->{what} = $set if(defined $set); - $self->{headers}->{what}; -} - -sub id($;$) { - my ($self,$set) = @_; - $self->{headers}->{id} = $set if(defined $set); - $self->{headers}->{id}; -} - -sub time($;$) { - my $self = shift; - my $fmt = shift; - if($fmt =~ /^\d+$/) { - $self->{headers}->time = $fmt; - $fmt = undef; - } - if($fmt) { - return strftime($fmt,localtime($self->{headers}->{time})); - } - $self->{headers}->time; -} - -sub retvalue($;$) { - my ($self,$set) = @_; - $self->{headers}->{retvalue} = $set if(defined $set); - $self->{headers}->{retvalue}; -} - -sub processed($;$) { - my ($self,$set) = @_; - if($set =~ /^true$|^false$/i) { - $self->{headers}->{processed} = $set; - $self->{headers}->{processed} = $set ? "true" : "false" if(defined $set); - } - $self->{headers}->{processed}; -} - -sub parse($;$) { - my($self,$rawstring) = @_; - my ($params,$headers); - $self->warn("DEBUG:IN: $rawstring") if($ENV{DEBUGYATE}); - $self->{_rawstring} ||= $rawstring; - chomp $self->{_rawstring}; - my @array = split(":",$self->{_rawstring}); - my $header = shift @array; - delete $self->{headers}; - delete $self->{params}; - - # decode any escaped ascii chars - $header =~ s/\%\%/\%/g; - ($headers->{direction},$headers->{what}) = $header =~ /^\%(.)([^:]+)/; - if($headers->{what} =~ /install/) { - $self->handle_install($headers->{what},@array); - return 1; - } - s/\%([^\%])/chr ((ord $1) - 64)/eg for(@array); - $headers->{id} = shift @array; - $headers->{time} = shift @array; - $headers->{name} = shift @array; - $headers->{retvalue} = shift @array; - foreach(@array) { - my($var,$val) = split("=",$_,2); - $params->{$var} = $val; - } - - $self->headers($headers); - $self->params($params); - return 1; -} - -sub error($;) { - my ($self) = shift; - my $fmt = shift; - $fmt .= "\n" if($fmt !~ /\n$/); - $self->warn("Error: {\n$self->{_rawstring}\n$fmt}\n",$self->what,strftime("%d %t",localtime),@_); -} - - -sub dispatch($$) { - my ($self) = shift; - $self->processed(shift); - my @params; - my $paramstr = undef; - foreach(keys %{$self->{params}}) { - push @params,"$_=$self->{params}->{$_}"; - } - $paramstr = join(":",@params) if(@params); - $self->print(sprintf "%%<%s:%s:%s:%s:%s\n", - $self->{headers}->{what}, - $self->{headers}->{id}, - $self->{headers}->{processed}, - $self->{headers}->{name}, - $self->{headers}->{retvalue}, - $paramstr); - -} - -sub exec($;$) { - my $self = shift; - my $ok = shift || 0; - my $exec = 0; - foreach my $func (@{$self->{funcs}->{$self->{headers}->{name}}}) { - my $ret = $func->($self); - if($ret) { - $self->dispatch($ret); - $ok++; - $exec++; - last; - } - } - if(!$ok and $self->what eq "message") { - $self->error("Nobody accepted the request. Returning the message.\n"); - $self->dispatch("false"); - } - $exec; -} - - -sub raw_read($) { - my $self = shift; - $self->{_rawstring} = ; - return $self->{_rawstring}; -} - -sub read_data($) { - my $self = shift; - if($self->raw_read()) { - return $self->parse(); - } - return 0; -} - -sub listen($) { - my $self = shift; - while($self->read_data()) { - $self->exec(); - } -} - -1;