summaryrefslogtreecommitdiff
path: root/beagle/debian-rfs/usr/lib/perl/5.10.1/IO
diff options
context:
space:
mode:
Diffstat (limited to 'beagle/debian-rfs/usr/lib/perl/5.10.1/IO')
-rw-r--r--beagle/debian-rfs/usr/lib/perl/5.10.1/IO/File.pm82
-rw-r--r--beagle/debian-rfs/usr/lib/perl/5.10.1/IO/Handle.pm376
-rw-r--r--beagle/debian-rfs/usr/lib/perl/5.10.1/IO/Pipe.pm160
-rw-r--r--beagle/debian-rfs/usr/lib/perl/5.10.1/IO/Seekable.pm36
-rw-r--r--beagle/debian-rfs/usr/lib/perl/5.10.1/IO/Select.pm233
-rw-r--r--beagle/debian-rfs/usr/lib/perl/5.10.1/IO/Socket.pm357
-rw-r--r--beagle/debian-rfs/usr/lib/perl/5.10.1/IO/Socket/INET.pm311
-rw-r--r--beagle/debian-rfs/usr/lib/perl/5.10.1/IO/Socket/UNIX.pm68
8 files changed, 1623 insertions, 0 deletions
diff --git a/beagle/debian-rfs/usr/lib/perl/5.10.1/IO/File.pm b/beagle/debian-rfs/usr/lib/perl/5.10.1/IO/File.pm
new file mode 100644
index 0000000..bf73876
--- /dev/null
+++ b/beagle/debian-rfs/usr/lib/perl/5.10.1/IO/File.pm
@@ -0,0 +1,82 @@
+#
+
+package IO::File;
+
+use 5.006_001;
+use strict;
+our($VERSION, @EXPORT, @EXPORT_OK, @ISA);
+use Carp;
+use Symbol;
+use SelectSaver;
+use IO::Seekable;
+use File::Spec;
+
+require Exporter;
+
+@ISA = qw(IO::Handle IO::Seekable Exporter);
+
+$VERSION = "1.14";
+
+@EXPORT = @IO::Seekable::EXPORT;
+
+eval {
+ # Make all Fcntl O_XXX constants available for importing
+ require Fcntl;
+ my @O = grep /^O_/, @Fcntl::EXPORT;
+ Fcntl->import(@O); # first we import what we want to export
+ push(@EXPORT, @O);
+};
+
+################################################
+## Constructor
+##
+
+sub new {
+ my $type = shift;
+ my $class = ref($type) || $type || "IO::File";
+ @_ >= 0 && @_ <= 3
+ or croak "usage: new $class [FILENAME [,MODE [,PERMS]]]";
+ my $fh = $class->SUPER::new();
+ if (@_) {
+ $fh->open(@_)
+ or return undef;
+ }
+ $fh;
+}
+
+################################################
+## Open
+##
+
+sub open {
+ @_ >= 2 && @_ <= 4 or croak 'usage: $fh->open(FILENAME [,MODE [,PERMS]])';
+ my ($fh, $file) = @_;
+ if (@_ > 2) {
+ my ($mode, $perms) = @_[2, 3];
+ if ($mode =~ /^\d+$/) {
+ defined $perms or $perms = 0666;
+ return sysopen($fh, $file, $mode, $perms);
+ } elsif ($mode =~ /:/) {
+ return open($fh, $mode, $file) if @_ == 3;
+ croak 'usage: $fh->open(FILENAME, IOLAYERS)';
+ } else {
+ return open($fh, IO::Handle::_open_mode_string($mode), $file);
+ }
+ }
+ open($fh, $file);
+}
+
+################################################
+## Binmode
+##
+
+sub binmode {
+ ( @_ == 1 or @_ == 2 ) or croak 'usage $fh->binmode([LAYER])';
+
+ my($fh, $layer) = @_;
+
+ return binmode $$fh unless $layer;
+ return binmode $$fh, $layer;
+}
+
+1;
diff --git a/beagle/debian-rfs/usr/lib/perl/5.10.1/IO/Handle.pm b/beagle/debian-rfs/usr/lib/perl/5.10.1/IO/Handle.pm
new file mode 100644
index 0000000..140e793
--- /dev/null
+++ b/beagle/debian-rfs/usr/lib/perl/5.10.1/IO/Handle.pm
@@ -0,0 +1,376 @@
+package IO::Handle;
+
+use 5.006_001;
+use strict;
+our($VERSION, @EXPORT_OK, @ISA);
+use Carp;
+use Symbol;
+use SelectSaver;
+use IO (); # Load the XS module
+
+require Exporter;
+@ISA = qw(Exporter);
+
+$VERSION = "1.28";
+$VERSION = eval $VERSION;
+
+@EXPORT_OK = qw(
+ autoflush
+ output_field_separator
+ output_record_separator
+ input_record_separator
+ input_line_number
+ format_page_number
+ format_lines_per_page
+ format_lines_left
+ format_name
+ format_top_name
+ format_line_break_characters
+ format_formfeed
+ format_write
+
+ print
+ printf
+ say
+ getline
+ getlines
+
+ printflush
+ flush
+
+ SEEK_SET
+ SEEK_CUR
+ SEEK_END
+ _IOFBF
+ _IOLBF
+ _IONBF
+);
+
+################################################
+## Constructors, destructors.
+##
+
+sub new {
+ my $class = ref($_[0]) || $_[0] || "IO::Handle";
+ @_ == 1 or croak "usage: new $class";
+ my $io = gensym;
+ bless $io, $class;
+}
+
+sub new_from_fd {
+ my $class = ref($_[0]) || $_[0] || "IO::Handle";
+ @_ == 3 or croak "usage: new_from_fd $class FD, MODE";
+ my $io = gensym;
+ shift;
+ IO::Handle::fdopen($io, @_)
+ or return undef;
+ bless $io, $class;
+}
+
+#
+# There is no need for DESTROY to do anything, because when the
+# last reference to an IO object is gone, Perl automatically
+# closes its associated files (if any). However, to avoid any
+# attempts to autoload DESTROY, we here define it to do nothing.
+#
+sub DESTROY {}
+
+################################################
+## Open and close.
+##
+
+sub _open_mode_string {
+ my ($mode) = @_;
+ $mode =~ /^\+?(<|>>?)$/
+ or $mode =~ s/^r(\+?)$/$1</
+ or $mode =~ s/^w(\+?)$/$1>/
+ or $mode =~ s/^a(\+?)$/$1>>/
+ or croak "IO::Handle: bad open mode: $mode";
+ $mode;
+}
+
+sub fdopen {
+ @_ == 3 or croak 'usage: $io->fdopen(FD, MODE)';
+ my ($io, $fd, $mode) = @_;
+ local(*GLOB);
+
+ if (ref($fd) && "".$fd =~ /GLOB\(/o) {
+ # It's a glob reference; Alias it as we cannot get name of anon GLOBs
+ my $n = qualify(*GLOB);
+ *GLOB = *{*$fd};
+ $fd = $n;
+ } elsif ($fd =~ m#^\d+$#) {
+ # It's an FD number; prefix with "=".
+ $fd = "=$fd";
+ }
+
+ open($io, _open_mode_string($mode) . '&' . $fd)
+ ? $io : undef;
+}
+
+sub close {
+ @_ == 1 or croak 'usage: $io->close()';
+ my($io) = @_;
+
+ close($io);
+}
+
+################################################
+## Normal I/O functions.
+##
+
+# flock
+# select
+
+sub opened {
+ @_ == 1 or croak 'usage: $io->opened()';
+ defined fileno($_[0]);
+}
+
+sub fileno {
+ @_ == 1 or croak 'usage: $io->fileno()';
+ fileno($_[0]);
+}
+
+sub getc {
+ @_ == 1 or croak 'usage: $io->getc()';
+ getc($_[0]);
+}
+
+sub eof {
+ @_ == 1 or croak 'usage: $io->eof()';
+ eof($_[0]);
+}
+
+sub print {
+ @_ or croak 'usage: $io->print(ARGS)';
+ my $this = shift;
+ print $this @_;
+}
+
+sub printf {
+ @_ >= 2 or croak 'usage: $io->printf(FMT,[ARGS])';
+ my $this = shift;
+ printf $this @_;
+}
+
+sub say {
+ @_ or croak 'usage: $io->say(ARGS)';
+ my $this = shift;
+ local $\ = "\n";
+ print $this @_;
+}
+
+sub getline {
+ @_ == 1 or croak 'usage: $io->getline()';
+ my $this = shift;
+ return scalar <$this>;
+}
+
+*gets = \&getline; # deprecated
+
+sub getlines {
+ @_ == 1 or croak 'usage: $io->getlines()';
+ wantarray or
+ croak 'Can\'t call $io->getlines in a scalar context, use $io->getline';
+ my $this = shift;
+ return <$this>;
+}
+
+sub truncate {
+ @_ == 2 or croak 'usage: $io->truncate(LEN)';
+ truncate($_[0], $_[1]);
+}
+
+sub read {
+ @_ == 3 || @_ == 4 or croak 'usage: $io->read(BUF, LEN [, OFFSET])';
+ read($_[0], $_[1], $_[2], $_[3] || 0);
+}
+
+sub sysread {
+ @_ == 3 || @_ == 4 or croak 'usage: $io->sysread(BUF, LEN [, OFFSET])';
+ sysread($_[0], $_[1], $_[2], $_[3] || 0);
+}
+
+sub write {
+ @_ >= 2 && @_ <= 4 or croak 'usage: $io->write(BUF [, LEN [, OFFSET]])';
+ local($\) = "";
+ $_[2] = length($_[1]) unless defined $_[2];
+ print { $_[0] } substr($_[1], $_[3] || 0, $_[2]);
+}
+
+sub syswrite {
+ @_ >= 2 && @_ <= 4 or croak 'usage: $io->syswrite(BUF [, LEN [, OFFSET]])';
+ if (defined($_[2])) {
+ syswrite($_[0], $_[1], $_[2], $_[3] || 0);
+ } else {
+ syswrite($_[0], $_[1]);
+ }
+}
+
+sub stat {
+ @_ == 1 or croak 'usage: $io->stat()';
+ stat($_[0]);
+}
+
+################################################
+## State modification functions.
+##
+
+sub autoflush {
+ my $old = new SelectSaver qualify($_[0], caller);
+ my $prev = $|;
+ $| = @_ > 1 ? $_[1] : 1;
+ $prev;
+}
+
+sub output_field_separator {
+ carp "output_field_separator is not supported on a per-handle basis"
+ if ref($_[0]);
+ my $prev = $,;
+ $, = $_[1] if @_ > 1;
+ $prev;
+}
+
+sub output_record_separator {
+ carp "output_record_separator is not supported on a per-handle basis"
+ if ref($_[0]);
+ my $prev = $\;
+ $\ = $_[1] if @_ > 1;
+ $prev;
+}
+
+sub input_record_separator {
+ carp "input_record_separator is not supported on a per-handle basis"
+ if ref($_[0]);
+ my $prev = $/;
+ $/ = $_[1] if @_ > 1;
+ $prev;
+}
+
+sub input_line_number {
+ local $.;
+ () = tell qualify($_[0], caller) if ref($_[0]);
+ my $prev = $.;
+ $. = $_[1] if @_ > 1;
+ $prev;
+}
+
+sub format_page_number {
+ my $old;
+ $old = new SelectSaver qualify($_[0], caller) if ref($_[0]);
+ my $prev = $%;
+ $% = $_[1] if @_ > 1;
+ $prev;
+}
+
+sub format_lines_per_page {
+ my $old;
+ $old = new SelectSaver qualify($_[0], caller) if ref($_[0]);
+ my $prev = $=;
+ $= = $_[1] if @_ > 1;
+ $prev;
+}
+
+sub format_lines_left {
+ my $old;
+ $old = new SelectSaver qualify($_[0], caller) if ref($_[0]);
+ my $prev = $-;
+ $- = $_[1] if @_ > 1;
+ $prev;
+}
+
+sub format_name {
+ my $old;
+ $old = new SelectSaver qualify($_[0], caller) if ref($_[0]);
+ my $prev = $~;
+ $~ = qualify($_[1], caller) if @_ > 1;
+ $prev;
+}
+
+sub format_top_name {
+ my $old;
+ $old = new SelectSaver qualify($_[0], caller) if ref($_[0]);
+ my $prev = $^;
+ $^ = qualify($_[1], caller) if @_ > 1;
+ $prev;
+}
+
+sub format_line_break_characters {
+ carp "format_line_break_characters is not supported on a per-handle basis"
+ if ref($_[0]);
+ my $prev = $:;
+ $: = $_[1] if @_ > 1;
+ $prev;
+}
+
+sub format_formfeed {
+ carp "format_formfeed is not supported on a per-handle basis"
+ if ref($_[0]);
+ my $prev = $^L;
+ $^L = $_[1] if @_ > 1;
+ $prev;
+}
+
+sub formline {
+ my $io = shift;
+ my $picture = shift;
+ local($^A) = $^A;
+ local($\) = "";
+ formline($picture, @_);
+ print $io $^A;
+}
+
+sub format_write {
+ @_ < 3 || croak 'usage: $io->write( [FORMAT_NAME] )';
+ if (@_ == 2) {
+ my ($io, $fmt) = @_;
+ my $oldfmt = $io->format_name(qualify($fmt,caller));
+ CORE::write($io);
+ $io->format_name($oldfmt);
+ } else {
+ CORE::write($_[0]);
+ }
+}
+
+sub fcntl {
+ @_ == 3 || croak 'usage: $io->fcntl( OP, VALUE );';
+ my ($io, $op) = @_;
+ return fcntl($io, $op, $_[2]);
+}
+
+sub ioctl {
+ @_ == 3 || croak 'usage: $io->ioctl( OP, VALUE );';
+ my ($io, $op) = @_;
+ return ioctl($io, $op, $_[2]);
+}
+
+# this sub is for compatability with older releases of IO that used
+# a sub called constant to detemine if a constant existed -- GMB
+#
+# The SEEK_* and _IO?BF constants were the only constants at that time
+# any new code should just chech defined(&CONSTANT_NAME)
+
+sub constant {
+ no strict 'refs';
+ my $name = shift;
+ (($name =~ /^(SEEK_(SET|CUR|END)|_IO[FLN]BF)$/) && defined &{$name})
+ ? &{$name}() : undef;
+}
+
+# so that flush.pl can be deprecated
+
+sub printflush {
+ my $io = shift;
+ my $old;
+ $old = new SelectSaver qualify($io, caller) if ref($io);
+ local $| = 1;
+ if(ref($io)) {
+ print $io @_;
+ }
+ else {
+ print @_;
+ }
+}
+
+1;
diff --git a/beagle/debian-rfs/usr/lib/perl/5.10.1/IO/Pipe.pm b/beagle/debian-rfs/usr/lib/perl/5.10.1/IO/Pipe.pm
new file mode 100644
index 0000000..a8723cd
--- /dev/null
+++ b/beagle/debian-rfs/usr/lib/perl/5.10.1/IO/Pipe.pm
@@ -0,0 +1,160 @@
+# IO::Pipe.pm
+#
+# Copyright (c) 1996-8 Graham Barr <gbarr@pobox.com>. All rights reserved.
+# This program is free software; you can redistribute it and/or
+# modify it under the same terms as Perl itself.
+
+package IO::Pipe;
+
+use 5.006_001;
+
+use IO::Handle;
+use strict;
+our($VERSION);
+use Carp;
+use Symbol;
+
+$VERSION = "1.13";
+
+sub new {
+ my $type = shift;
+ my $class = ref($type) || $type || "IO::Pipe";
+ @_ == 0 || @_ == 2 or croak "usage: new $class [READFH, WRITEFH]";
+
+ my $me = bless gensym(), $class;
+
+ my($readfh,$writefh) = @_ ? @_ : $me->handles;
+
+ pipe($readfh, $writefh)
+ or return undef;
+
+ @{*$me} = ($readfh, $writefh);
+
+ $me;
+}
+
+sub handles {
+ @_ == 1 or croak 'usage: $pipe->handles()';
+ (IO::Pipe::End->new(), IO::Pipe::End->new());
+}
+
+my $do_spawn = $^O eq 'os2' || $^O eq 'MSWin32';
+
+sub _doit {
+ my $me = shift;
+ my $rw = shift;
+
+ my $pid = $do_spawn ? 0 : fork();
+
+ if($pid) { # Parent
+ return $pid;
+ }
+ elsif(defined $pid) { # Child or spawn
+ my $fh;
+ my $io = $rw ? \*STDIN : \*STDOUT;
+ my ($mode, $save) = $rw ? "r" : "w";
+ if ($do_spawn) {
+ require Fcntl;
+ $save = IO::Handle->new_from_fd($io, $mode);
+ my $handle = shift;
+ # Close in child:
+ unless ($^O eq 'MSWin32') {
+ fcntl($handle, Fcntl::F_SETFD(), 1) or croak "fcntl: $!";
+ }
+ $fh = $rw ? ${*$me}[0] : ${*$me}[1];
+ } else {
+ shift;
+ $fh = $rw ? $me->reader() : $me->writer(); # close the other end
+ }
+ bless $io, "IO::Handle";
+ $io->fdopen($fh, $mode);
+ $fh->close;
+
+ if ($do_spawn) {
+ $pid = eval { system 1, @_ }; # 1 == P_NOWAIT
+ my $err = $!;
+
+ $io->fdopen($save, $mode);
+ $save->close or croak "Cannot close $!";
+ croak "IO::Pipe: Cannot spawn-NOWAIT: $err" if not $pid or $pid < 0;
+ return $pid;
+ } else {
+ exec @_ or
+ croak "IO::Pipe: Cannot exec: $!";
+ }
+ }
+ else {
+ croak "IO::Pipe: Cannot fork: $!";
+ }
+
+ # NOT Reached
+}
+
+sub reader {
+ @_ >= 1 or croak 'usage: $pipe->reader( [SUB_COMMAND_ARGS] )';
+ my $me = shift;
+
+ return undef
+ unless(ref($me) || ref($me = $me->new));
+
+ my $fh = ${*$me}[0];
+ my $pid;
+ $pid = $me->_doit(0, $fh, @_)
+ if(@_);
+
+ close ${*$me}[1];
+ bless $me, ref($fh);
+ *$me = *$fh; # Alias self to handle
+ $me->fdopen($fh->fileno,"r")
+ unless defined($me->fileno);
+ bless $fh; # Really wan't un-bless here
+ ${*$me}{'io_pipe_pid'} = $pid
+ if defined $pid;
+
+ $me;
+}
+
+sub writer {
+ @_ >= 1 or croak 'usage: $pipe->writer( [SUB_COMMAND_ARGS] )';
+ my $me = shift;
+
+ return undef
+ unless(ref($me) || ref($me = $me->new));
+
+ my $fh = ${*$me}[1];
+ my $pid;
+ $pid = $me->_doit(1, $fh, @_)
+ if(@_);
+
+ close ${*$me}[0];
+ bless $me, ref($fh);
+ *$me = *$fh; # Alias self to handle
+ $me->fdopen($fh->fileno,"w")
+ unless defined($me->fileno);
+ bless $fh; # Really wan't un-bless here
+ ${*$me}{'io_pipe_pid'} = $pid
+ if defined $pid;
+
+ $me;
+}
+
+package IO::Pipe::End;
+
+our(@ISA);
+
+@ISA = qw(IO::Handle);
+
+sub close {
+ my $fh = shift;
+ my $r = $fh->SUPER::close(@_);
+
+ waitpid(${*$fh}{'io_pipe_pid'},0)
+ if(defined ${*$fh}{'io_pipe_pid'});
+
+ $r;
+}
+
+1;
+
+__END__
+
diff --git a/beagle/debian-rfs/usr/lib/perl/5.10.1/IO/Seekable.pm b/beagle/debian-rfs/usr/lib/perl/5.10.1/IO/Seekable.pm
new file mode 100644
index 0000000..025b89f
--- /dev/null
+++ b/beagle/debian-rfs/usr/lib/perl/5.10.1/IO/Seekable.pm
@@ -0,0 +1,36 @@
+#
+
+package IO::Seekable;
+
+use 5.006_001;
+use Carp;
+use strict;
+our($VERSION, @EXPORT, @ISA);
+use IO::Handle ();
+# XXX we can't get these from IO::Handle or we'll get prototype
+# mismatch warnings on C<use POSIX; use IO::File;> :-(
+use Fcntl qw(SEEK_SET SEEK_CUR SEEK_END);
+require Exporter;
+
+@EXPORT = qw(SEEK_SET SEEK_CUR SEEK_END);
+@ISA = qw(Exporter);
+
+$VERSION = "1.10";
+$VERSION = eval $VERSION;
+
+sub seek {
+ @_ == 3 or croak 'usage: $io->seek(POS, WHENCE)';
+ seek($_[0], $_[1], $_[2]);
+}
+
+sub sysseek {
+ @_ == 3 or croak 'usage: $io->sysseek(POS, WHENCE)';
+ sysseek($_[0], $_[1], $_[2]);
+}
+
+sub tell {
+ @_ == 1 or croak 'usage: $io->tell()';
+ tell($_[0]);
+}
+
+1;
diff --git a/beagle/debian-rfs/usr/lib/perl/5.10.1/IO/Select.pm b/beagle/debian-rfs/usr/lib/perl/5.10.1/IO/Select.pm
new file mode 100644
index 0000000..2a18c7d
--- /dev/null
+++ b/beagle/debian-rfs/usr/lib/perl/5.10.1/IO/Select.pm
@@ -0,0 +1,233 @@
+# IO::Select.pm
+#
+# Copyright (c) 1997-8 Graham Barr <gbarr@pobox.com>. All rights reserved.
+# This program is free software; you can redistribute it and/or
+# modify it under the same terms as Perl itself.
+
+package IO::Select;
+
+use strict;
+use warnings::register;
+use vars qw($VERSION @ISA);
+require Exporter;
+
+$VERSION = "1.17";
+
+@ISA = qw(Exporter); # This is only so we can do version checking
+
+sub VEC_BITS () {0}
+sub FD_COUNT () {1}
+sub FIRST_FD () {2}
+
+sub new
+{
+ my $self = shift;
+ my $type = ref($self) || $self;
+
+ my $vec = bless [undef,0], $type;
+
+ $vec->add(@_)
+ if @_;
+
+ $vec;
+}
+
+sub add
+{
+ shift->_update('add', @_);
+}
+
+sub remove
+{
+ shift->_update('remove', @_);
+}
+
+sub exists
+{
+ my $vec = shift;
+ my $fno = $vec->_fileno(shift);
+ return undef unless defined $fno;
+ $vec->[$fno + FIRST_FD];
+}
+
+sub _fileno
+{
+ my($self, $f) = @_;
+ return unless defined $f;
+ $f = $f->[0] if ref($f) eq 'ARRAY';
+ ($f =~ /^\d+$/) ? $f : fileno($f);
+}
+
+sub _update
+{
+ my $vec = shift;
+ my $add = shift eq 'add';
+
+ my $bits = $vec->[VEC_BITS];
+ $bits = '' unless defined $bits;
+
+ my $count = 0;
+ my $f;
+ foreach $f (@_)
+ {
+ my $fn = $vec->_fileno($f);
+ next unless defined $fn;
+ my $i = $fn + FIRST_FD;
+ if ($add) {
+ if (defined $vec->[$i]) {
+ $vec->[$i] = $f; # if array rest might be different, so we update
+ next;
+ }
+ $vec->[FD_COUNT]++;
+ vec($bits, $fn, 1) = 1;
+ $vec->[$i] = $f;
+ } else { # remove
+ next unless defined $vec->[$i];
+ $vec->[FD_COUNT]--;
+ vec($bits, $fn, 1) = 0;
+ $vec->[$i] = undef;
+ }
+ $count++;
+ }
+ $vec->[VEC_BITS] = $vec->[FD_COUNT] ? $bits : undef;
+ $count;
+}
+
+sub can_read
+{
+ my $vec = shift;
+ my $timeout = shift;
+ my $r = $vec->[VEC_BITS];
+
+ defined($r) && (select($r,undef,undef,$timeout) > 0)
+ ? handles($vec, $r)
+ : ();
+}
+
+sub can_write
+{
+ my $vec = shift;
+ my $timeout = shift;
+ my $w = $vec->[VEC_BITS];
+
+ defined($w) && (select(undef,$w,undef,$timeout) > 0)
+ ? handles($vec, $w)
+ : ();
+}
+
+sub has_exception
+{
+ my $vec = shift;
+ my $timeout = shift;
+ my $e = $vec->[VEC_BITS];
+
+ defined($e) && (select(undef,undef,$e,$timeout) > 0)
+ ? handles($vec, $e)
+ : ();
+}
+
+sub has_error
+{
+ warnings::warn("Call to deprecated method 'has_error', use 'has_exception'")
+ if warnings::enabled();
+ goto &has_exception;
+}
+
+sub count
+{
+ my $vec = shift;
+ $vec->[FD_COUNT];
+}
+
+sub bits
+{
+ my $vec = shift;
+ $vec->[VEC_BITS];
+}
+
+sub as_string # for debugging
+{
+ my $vec = shift;
+ my $str = ref($vec) . ": ";
+ my $bits = $vec->bits;
+ my $count = $vec->count;
+ $str .= defined($bits) ? unpack("b*", $bits) : "undef";
+ $str .= " $count";
+ my @handles = @$vec;
+ splice(@handles, 0, FIRST_FD);
+ for (@handles) {
+ $str .= " " . (defined($_) ? "$_" : "-");
+ }
+ $str;
+}
+
+sub _max
+{
+ my($a,$b,$c) = @_;
+ $a > $b
+ ? $a > $c
+ ? $a
+ : $c
+ : $b > $c
+ ? $b
+ : $c;
+}
+
+sub select
+{
+ shift
+ if defined $_[0] && !ref($_[0]);
+
+ my($r,$w,$e,$t) = @_;
+ my @result = ();
+
+ my $rb = defined $r ? $r->[VEC_BITS] : undef;
+ my $wb = defined $w ? $w->[VEC_BITS] : undef;
+ my $eb = defined $e ? $e->[VEC_BITS] : undef;
+
+ if(select($rb,$wb,$eb,$t) > 0)
+ {
+ my @r = ();
+ my @w = ();
+ my @e = ();
+ my $i = _max(defined $r ? scalar(@$r)-1 : 0,
+ defined $w ? scalar(@$w)-1 : 0,
+ defined $e ? scalar(@$e)-1 : 0);
+
+ for( ; $i >= FIRST_FD ; $i--)
+ {
+ my $j = $i - FIRST_FD;
+ push(@r, $r->[$i])
+ if defined $rb && defined $r->[$i] && vec($rb, $j, 1);
+ push(@w, $w->[$i])
+ if defined $wb && defined $w->[$i] && vec($wb, $j, 1);
+ push(@e, $e->[$i])
+ if defined $eb && defined $e->[$i] && vec($eb, $j, 1);
+ }
+
+ @result = (\@r, \@w, \@e);
+ }
+ @result;
+}
+
+sub handles
+{
+ my $vec = shift;
+ my $bits = shift;
+ my @h = ();
+ my $i;
+ my $max = scalar(@$vec) - 1;
+
+ for ($i = FIRST_FD; $i <= $max; $i++)
+ {
+ next unless defined $vec->[$i];
+ push(@h, $vec->[$i])
+ if !defined($bits) || vec($bits, $i - FIRST_FD, 1);
+ }
+
+ @h;
+}
+
+1;
+__END__
+
diff --git a/beagle/debian-rfs/usr/lib/perl/5.10.1/IO/Socket.pm b/beagle/debian-rfs/usr/lib/perl/5.10.1/IO/Socket.pm
new file mode 100644
index 0000000..7c196f9
--- /dev/null
+++ b/beagle/debian-rfs/usr/lib/perl/5.10.1/IO/Socket.pm
@@ -0,0 +1,357 @@
+# IO::Socket.pm
+#
+# Copyright (c) 1997-8 Graham Barr <gbarr@pobox.com>. All rights reserved.
+# This program is free software; you can redistribute it and/or
+# modify it under the same terms as Perl itself.
+
+package IO::Socket;
+
+require 5.006;
+
+use IO::Handle;
+use Socket 1.3;
+use Carp;
+use strict;
+our(@ISA, $VERSION, @EXPORT_OK);
+use Exporter;
+use Errno;
+
+# legacy
+
+require IO::Socket::INET;
+require IO::Socket::UNIX if ($^O ne 'epoc' && $^O ne 'symbian');
+
+@ISA = qw(IO::Handle);
+
+$VERSION = "1.31";
+
+@EXPORT_OK = qw(sockatmark);
+
+sub import {
+ my $pkg = shift;
+ if (@_ && $_[0] eq 'sockatmark') { # not very extensible but for now, fast
+ Exporter::export_to_level('IO::Socket', 1, $pkg, 'sockatmark');
+ } else {
+ my $callpkg = caller;
+ Exporter::export 'Socket', $callpkg, @_;
+ }
+}
+
+sub new {
+ my($class,%arg) = @_;
+ my $sock = $class->SUPER::new();
+
+ $sock->autoflush(1);
+
+ ${*$sock}{'io_socket_timeout'} = delete $arg{Timeout};
+
+ return scalar(%arg) ? $sock->configure(\%arg)
+ : $sock;
+}
+
+my @domain2pkg;
+
+sub register_domain {
+ my($p,$d) = @_;
+ $domain2pkg[$d] = $p;
+}
+
+sub configure {
+ my($sock,$arg) = @_;
+ my $domain = delete $arg->{Domain};
+
+ croak 'IO::Socket: Cannot configure a generic socket'
+ unless defined $domain;
+
+ croak "IO::Socket: Unsupported socket domain"
+ unless defined $domain2pkg[$domain];
+
+ croak "IO::Socket: Cannot configure socket in domain '$domain'"
+ unless ref($sock) eq "IO::Socket";
+
+ bless($sock, $domain2pkg[$domain]);
+ $sock->configure($arg);
+}
+
+sub socket {
+ @_ == 4 or croak 'usage: $sock->socket(DOMAIN, TYPE, PROTOCOL)';
+ my($sock,$domain,$type,$protocol) = @_;
+
+ socket($sock,$domain,$type,$protocol) or
+ return undef;
+
+ ${*$sock}{'io_socket_domain'} = $domain;
+ ${*$sock}{'io_socket_type'} = $type;
+ ${*$sock}{'io_socket_proto'} = $protocol;
+
+ $sock;
+}
+
+sub socketpair {
+ @_ == 4 || croak 'usage: IO::Socket->socketpair(DOMAIN, TYPE, PROTOCOL)';
+ my($class,$domain,$type,$protocol) = @_;
+ my $sock1 = $class->new();
+ my $sock2 = $class->new();
+
+ socketpair($sock1,$sock2,$domain,$type,$protocol) or
+ return ();
+
+ ${*$sock1}{'io_socket_type'} = ${*$sock2}{'io_socket_type'} = $type;
+ ${*$sock1}{'io_socket_proto'} = ${*$sock2}{'io_socket_proto'} = $protocol;
+
+ ($sock1,$sock2);
+}
+
+sub connect {
+ @_ == 2 or croak 'usage: $sock->connect(NAME)';
+ my $sock = shift;
+ my $addr = shift;
+ my $timeout = ${*$sock}{'io_socket_timeout'};
+ my $err;
+ my $blocking;
+
+ $blocking = $sock->blocking(0) if $timeout;
+ if (!connect($sock, $addr)) {
+ if (defined $timeout && ($!{EINPROGRESS} || $!{EWOULDBLOCK})) {
+ require IO::Select;
+
+ my $sel = new IO::Select $sock;
+
+ undef $!;
+ if (!$sel->can_write($timeout)) {
+ $err = $! || (exists &Errno::ETIMEDOUT ? &Errno::ETIMEDOUT : 1);
+ $@ = "connect: timeout";
+ }
+ elsif (!connect($sock,$addr) &&
+ not ($!{EISCONN} || ($! == 10022 && $^O eq 'MSWin32'))
+ ) {
+ # Some systems refuse to re-connect() to
+ # an already open socket and set errno to EISCONN.
+ # Windows sets errno to WSAEINVAL (10022)
+ $err = $!;
+ $@ = "connect: $!";
+ }
+ }
+ elsif ($blocking || !($!{EINPROGRESS} || $!{EWOULDBLOCK})) {
+ $err = $!;
+ $@ = "connect: $!";
+ }
+ }
+
+ $sock->blocking(1) if $blocking;
+
+ $! = $err if $err;
+
+ $err ? undef : $sock;
+}
+
+# Enable/disable blocking IO on sockets.
+# Without args return the current status of blocking,
+# with args change the mode as appropriate, returning the
+# old setting, or in case of error during the mode change
+# undef.
+
+sub blocking {
+ my $sock = shift;
+
+ return $sock->SUPER::blocking(@_)
+ if $^O ne 'MSWin32';
+
+ # Windows handles blocking differently
+ #
+ # http://groups.google.co.uk/group/perl.perl5.porters/browse_thread/thread/b4e2b1d88280ddff/630b667a66e3509f?#630b667a66e3509f
+ # http://msdn.microsoft.com/library/default.asp?url=/library/en-us/winsock/winsock/ioctlsocket_2.asp
+ #
+ # 0x8004667e is FIONBIO
+ #
+ # which is used to set blocking behaviour.
+
+ # NOTE:
+ # This is a little confusing, the perl keyword for this is
+ # 'blocking' but the OS level behaviour is 'non-blocking', probably
+ # because sockets are blocking by default.
+ # Therefore internally we have to reverse the semantics.
+
+ my $orig= !${*$sock}{io_sock_nonblocking};
+
+ return $orig unless @_;
+
+ my $block = shift;
+
+ if ( !$block != !$orig ) {
+ ${*$sock}{io_sock_nonblocking} = $block ? 0 : 1;
+ ioctl($sock, 0x8004667e, pack("L!",${*$sock}{io_sock_nonblocking}))
+ or return undef;
+ }
+
+ return $orig;
+}
+
+sub close {
+ @_ == 1 or croak 'usage: $sock->close()';
+ my $sock = shift;
+ ${*$sock}{'io_socket_peername'} = undef;
+ $sock->SUPER::close();
+}
+
+sub bind {
+ @_ == 2 or croak 'usage: $sock->bind(NAME)';
+ my $sock = shift;
+ my $addr = shift;
+
+ return bind($sock, $addr) ? $sock
+ : undef;
+}
+
+sub listen {
+ @_ >= 1 && @_ <= 2 or croak 'usage: $sock->listen([QUEUE])';
+ my($sock,$queue) = @_;
+ $queue = 5
+ unless $queue && $queue > 0;
+
+ return listen($sock, $queue) ? $sock
+ : undef;
+}
+
+sub accept {
+ @_ == 1 || @_ == 2 or croak 'usage $sock->accept([PKG])';
+ my $sock = shift;
+ my $pkg = shift || $sock;
+ my $timeout = ${*$sock}{'io_socket_timeout'};
+ my $new = $pkg->new(Timeout => $timeout);
+ my $peer = undef;
+
+ if(defined $timeout) {
+ require IO::Select;
+
+ my $sel = new IO::Select $sock;
+
+ unless ($sel->can_read($timeout)) {
+ $@ = 'accept: timeout';
+ $! = (exists &Errno::ETIMEDOUT ? &Errno::ETIMEDOUT : 1);
+ return;
+ }
+ }
+
+ $peer = accept($new,$sock)
+ or return;
+
+ return wantarray ? ($new, $peer)
+ : $new;
+}
+
+sub sockname {
+ @_ == 1 or croak 'usage: $sock->sockname()';
+ getsockname($_[0]);
+}
+
+sub peername {
+ @_ == 1 or croak 'usage: $sock->peername()';
+ my($sock) = @_;
+ ${*$sock}{'io_socket_peername'} ||= getpeername($sock);
+}
+
+sub connected {
+ @_ == 1 or croak 'usage: $sock->connected()';
+ my($sock) = @_;
+ getpeername($sock);
+}
+
+sub send {
+ @_ >= 2 && @_ <= 4 or croak 'usage: $sock->send(BUF, [FLAGS, [TO]])';
+ my $sock = $_[0];
+ my $flags = $_[2] || 0;
+ my $peer = $_[3] || $sock->peername;
+
+ croak 'send: Cannot determine peer address'
+ unless(defined $peer);
+
+ my $r = defined(getpeername($sock))
+ ? send($sock, $_[1], $flags)
+ : send($sock, $_[1], $flags, $peer);
+
+ # remember who we send to, if it was successful
+ ${*$sock}{'io_socket_peername'} = $peer
+ if(@_ == 4 && defined $r);
+
+ $r;
+}
+
+sub recv {
+ @_ == 3 || @_ == 4 or croak 'usage: $sock->recv(BUF, LEN [, FLAGS])';
+ my $sock = $_[0];
+ my $len = $_[2];
+ my $flags = $_[3] || 0;
+
+ # remember who we recv'd from
+ ${*$sock}{'io_socket_peername'} = recv($sock, $_[1]='', $len, $flags);
+}
+
+sub shutdown {
+ @_ == 2 or croak 'usage: $sock->shutdown(HOW)';
+ my($sock, $how) = @_;
+ ${*$sock}{'io_socket_peername'} = undef;
+ shutdown($sock, $how);
+}
+
+sub setsockopt {
+ @_ == 4 or croak '$sock->setsockopt(LEVEL, OPTNAME, OPTVAL)';
+ setsockopt($_[0],$_[1],$_[2],$_[3]);
+}
+
+my $intsize = length(pack("i",0));
+
+sub getsockopt {
+ @_ == 3 or croak '$sock->getsockopt(LEVEL, OPTNAME)';
+ my $r = getsockopt($_[0],$_[1],$_[2]);
+ # Just a guess
+ $r = unpack("i", $r)
+ if(defined $r && length($r) == $intsize);
+ $r;
+}
+
+sub sockopt {
+ my $sock = shift;
+ @_ == 1 ? $sock->getsockopt(SOL_SOCKET,@_)
+ : $sock->setsockopt(SOL_SOCKET,@_);
+}
+
+sub atmark {
+ @_ == 1 or croak 'usage: $sock->atmark()';
+ my($sock) = @_;
+ sockatmark($sock);
+}
+
+sub timeout {
+ @_ == 1 || @_ == 2 or croak 'usage: $sock->timeout([VALUE])';
+ my($sock,$val) = @_;
+ my $r = ${*$sock}{'io_socket_timeout'};
+
+ ${*$sock}{'io_socket_timeout'} = defined $val ? 0 + $val : $val
+ if(@_ == 2);
+
+ $r;
+}
+
+sub sockdomain {
+ @_ == 1 or croak 'usage: $sock->sockdomain()';
+ my $sock = shift;
+ ${*$sock}{'io_socket_domain'};
+}
+
+sub socktype {
+ @_ == 1 or croak 'usage: $sock->socktype()';
+ my $sock = shift;
+ ${*$sock}{'io_socket_type'}
+}
+
+sub protocol {
+ @_ == 1 or croak 'usage: $sock->protocol()';
+ my($sock) = @_;
+ ${*$sock}{'io_socket_proto'};
+}
+
+1;
+
+__END__
+
diff --git a/beagle/debian-rfs/usr/lib/perl/5.10.1/IO/Socket/INET.pm b/beagle/debian-rfs/usr/lib/perl/5.10.1/IO/Socket/INET.pm
new file mode 100644
index 0000000..308a16a
--- /dev/null
+++ b/beagle/debian-rfs/usr/lib/perl/5.10.1/IO/Socket/INET.pm
@@ -0,0 +1,311 @@
+# IO::Socket::INET.pm
+#
+# Copyright (c) 1997-8 Graham Barr <gbarr@pobox.com>. All rights reserved.
+# This program is free software; you can redistribute it and/or
+# modify it under the same terms as Perl itself.
+
+package IO::Socket::INET;
+
+use strict;
+our(@ISA, $VERSION);
+use IO::Socket;
+use Socket;
+use Carp;
+use Exporter;
+use Errno;
+
+@ISA = qw(IO::Socket);
+$VERSION = "1.31";
+
+my $EINVAL = exists(&Errno::EINVAL) ? Errno::EINVAL() : 1;
+
+IO::Socket::INET->register_domain( AF_INET );
+
+my %socket_type = ( tcp => SOCK_STREAM,
+ udp => SOCK_DGRAM,
+ icmp => SOCK_RAW
+ );
+my %proto_number;
+$proto_number{tcp} = Socket::IPPROTO_TCP() if defined &Socket::IPPROTO_TCP;
+$proto_number{udp} = Socket::IPPROTO_UDP() if defined &Socket::IPPROTO_UDP;
+$proto_number{icmp} = Socket::IPPROTO_ICMP() if defined &Socket::IPPROTO_ICMP;
+my %proto_name = reverse %proto_number;
+
+sub new {
+ my $class = shift;
+ unshift(@_, "PeerAddr") if @_ == 1;
+ return $class->SUPER::new(@_);
+}
+
+sub _cache_proto {
+ my @proto = @_;
+ for (map lc($_), $proto[0], split(' ', $proto[1])) {
+ $proto_number{$_} = $proto[2];
+ }
+ $proto_name{$proto[2]} = $proto[0];
+}
+
+sub _get_proto_number {
+ my $name = lc(shift);
+ return undef unless defined $name;
+ return $proto_number{$name} if exists $proto_number{$name};
+
+ my @proto = getprotobyname($name);
+ return undef unless @proto;
+ _cache_proto(@proto);
+
+ return $proto[2];
+}
+
+sub _get_proto_name {
+ my $num = shift;
+ return undef unless defined $num;
+ return $proto_name{$num} if exists $proto_name{$num};
+
+ my @proto = getprotobynumber($num);
+ return undef unless @proto;
+ _cache_proto(@proto);
+
+ return $proto[0];
+}
+
+sub _sock_info {
+ my($addr,$port,$proto) = @_;
+ my $origport = $port;
+ my @serv = ();
+
+ $port = $1
+ if(defined $addr && $addr =~ s,:([\w\(\)/]+)$,,);
+
+ if(defined $proto && $proto =~ /\D/) {
+ my $num = _get_proto_number($proto);
+ unless (defined $num) {
+ $@ = "Bad protocol '$proto'";
+ return;
+ }
+ $proto = $num;
+ }
+
+ if(defined $port) {
+ my $defport = ($port =~ s,\((\d+)\)$,,) ? $1 : undef;
+ my $pnum = ($port =~ m,^(\d+)$,)[0];
+
+ @serv = getservbyname($port, _get_proto_name($proto) || "")
+ if ($port =~ m,\D,);
+
+ $port = $serv[2] || $defport || $pnum;
+ unless (defined $port) {
+ $@ = "Bad service '$origport'";
+ return;
+ }
+
+ $proto = _get_proto_number($serv[3]) if @serv && !$proto;
+ }
+
+ return ($addr || undef,
+ $port || undef,
+ $proto || undef
+ );
+}
+
+sub _error {
+ my $sock = shift;
+ my $err = shift;
+ {
+ local($!);
+ my $title = ref($sock).": ";
+ $@ = join("", $_[0] =~ /^$title/ ? "" : $title, @_);
+ $sock->close()
+ if(defined fileno($sock));
+ }
+ $! = $err;
+ return undef;
+}
+
+sub _get_addr {
+ my($sock,$addr_str, $multi) = @_;
+ my @addr;
+ if ($multi && $addr_str !~ /^\d+(?:\.\d+){3}$/) {
+ (undef, undef, undef, undef, @addr) = gethostbyname($addr_str);
+ } else {
+ my $h = inet_aton($addr_str);
+ push(@addr, $h) if defined $h;
+ }
+ @addr;
+}
+
+sub configure {
+ my($sock,$arg) = @_;
+ my($lport,$rport,$laddr,$raddr,$proto,$type);
+
+ $arg->{LocalAddr} = $arg->{LocalHost}
+ if exists $arg->{LocalHost} && !exists $arg->{LocalAddr};
+
+ ($laddr,$lport,$proto) = _sock_info($arg->{LocalAddr},
+ $arg->{LocalPort},
+ $arg->{Proto})
+ or return _error($sock, $!, $@);
+
+ $laddr = defined $laddr ? inet_aton($laddr)
+ : INADDR_ANY;
+
+ return _error($sock, $EINVAL, "Bad hostname '",$arg->{LocalAddr},"'")
+ unless(defined $laddr);
+
+ $arg->{PeerAddr} = $arg->{PeerHost}
+ if exists $arg->{PeerHost} && !exists $arg->{PeerAddr};
+
+ unless(exists $arg->{Listen}) {
+ ($raddr,$rport,$proto) = _sock_info($arg->{PeerAddr},
+ $arg->{PeerPort},
+ $proto)
+ or return _error($sock, $!, $@);
+ }
+
+ $proto ||= _get_proto_number('tcp');
+
+ $type = $arg->{Type} || $socket_type{lc _get_proto_name($proto)};
+
+ my @raddr = ();
+
+ if(defined $raddr) {
+ @raddr = $sock->_get_addr($raddr, $arg->{MultiHomed});
+ return _error($sock, $EINVAL, "Bad hostname '",$arg->{PeerAddr},"'")
+ unless @raddr;
+ }
+
+ while(1) {
+
+ $sock->socket(AF_INET, $type, $proto) or
+ return _error($sock, $!, "$!");
+
+ if (defined $arg->{Blocking}) {
+ defined $sock->blocking($arg->{Blocking})
+ or return _error($sock, $!, "$!");
+ }
+
+ if ($arg->{Reuse} || $arg->{ReuseAddr}) {
+ $sock->sockopt(SO_REUSEADDR,1) or
+ return _error($sock, $!, "$!");
+ }
+
+ if ($arg->{ReusePort}) {
+ $sock->sockopt(SO_REUSEPORT,1) or
+ return _error($sock, $!, "$!");
+ }
+
+ if ($arg->{Broadcast}) {
+ $sock->sockopt(SO_BROADCAST,1) or
+ return _error($sock, $!, "$!");
+ }
+
+ if($lport || ($laddr ne INADDR_ANY) || exists $arg->{Listen}) {
+ $sock->bind($lport || 0, $laddr) or
+ return _error($sock, $!, "$!");
+ }
+
+ if(exists $arg->{Listen}) {
+ $sock->listen($arg->{Listen} || 5) or
+ return _error($sock, $!, "$!");
+ last;
+ }
+
+ # don't try to connect unless we're given a PeerAddr
+ last unless exists($arg->{PeerAddr});
+
+ $raddr = shift @raddr;
+
+ return _error($sock, $EINVAL, 'Cannot determine remote port')
+ unless($rport || $type == SOCK_DGRAM || $type == SOCK_RAW);
+
+ last
+ unless($type == SOCK_STREAM || defined $raddr);
+
+ return _error($sock, $EINVAL, "Bad hostname '",$arg->{PeerAddr},"'")
+ unless defined $raddr;
+
+# my $timeout = ${*$sock}{'io_socket_timeout'};
+# my $before = time() if $timeout;
+
+ undef $@;
+ if ($sock->connect(pack_sockaddr_in($rport, $raddr))) {
+# ${*$sock}{'io_socket_timeout'} = $timeout;
+ return $sock;
+ }
+
+ return _error($sock, $!, $@ || "Timeout")
+ unless @raddr;
+
+# if ($timeout) {
+# my $new_timeout = $timeout - (time() - $before);
+# return _error($sock,
+# (exists(&Errno::ETIMEDOUT) ? Errno::ETIMEDOUT() : $EINVAL),
+# "Timeout") if $new_timeout <= 0;
+# ${*$sock}{'io_socket_timeout'} = $new_timeout;
+# }
+
+ }
+
+ $sock;
+}
+
+sub connect {
+ @_ == 2 || @_ == 3 or
+ croak 'usage: $sock->connect(NAME) or $sock->connect(PORT, ADDR)';
+ my $sock = shift;
+ return $sock->SUPER::connect(@_ == 1 ? shift : pack_sockaddr_in(@_));
+}
+
+sub bind {
+ @_ == 2 || @_ == 3 or
+ croak 'usage: $sock->bind(NAME) or $sock->bind(PORT, ADDR)';
+ my $sock = shift;
+ return $sock->SUPER::bind(@_ == 1 ? shift : pack_sockaddr_in(@_))
+}
+
+sub sockaddr {
+ @_ == 1 or croak 'usage: $sock->sockaddr()';
+ my($sock) = @_;
+ my $name = $sock->sockname;
+ $name ? (sockaddr_in($name))[1] : undef;
+}
+
+sub sockport {
+ @_ == 1 or croak 'usage: $sock->sockport()';
+ my($sock) = @_;
+ my $name = $sock->sockname;
+ $name ? (sockaddr_in($name))[0] : undef;
+}
+
+sub sockhost {
+ @_ == 1 or croak 'usage: $sock->sockhost()';
+ my($sock) = @_;
+ my $addr = $sock->sockaddr;
+ $addr ? inet_ntoa($addr) : undef;
+}
+
+sub peeraddr {
+ @_ == 1 or croak 'usage: $sock->peeraddr()';
+ my($sock) = @_;
+ my $name = $sock->peername;
+ $name ? (sockaddr_in($name))[1] : undef;
+}
+
+sub peerport {
+ @_ == 1 or croak 'usage: $sock->peerport()';
+ my($sock) = @_;
+ my $name = $sock->peername;
+ $name ? (sockaddr_in($name))[0] : undef;
+}
+
+sub peerhost {
+ @_ == 1 or croak 'usage: $sock->peerhost()';
+ my($sock) = @_;
+ my $addr = $sock->peeraddr;
+ $addr ? inet_ntoa($addr) : undef;
+}
+
+1;
+
+__END__
+
diff --git a/beagle/debian-rfs/usr/lib/perl/5.10.1/IO/Socket/UNIX.pm b/beagle/debian-rfs/usr/lib/perl/5.10.1/IO/Socket/UNIX.pm
new file mode 100644
index 0000000..d2d0fd8
--- /dev/null
+++ b/beagle/debian-rfs/usr/lib/perl/5.10.1/IO/Socket/UNIX.pm
@@ -0,0 +1,68 @@
+# IO::Socket::UNIX.pm
+#
+# Copyright (c) 1997-8 Graham Barr <gbarr@pobox.com>. All rights reserved.
+# This program is free software; you can redistribute it and/or
+# modify it under the same terms as Perl itself.
+
+package IO::Socket::UNIX;
+
+use strict;
+our(@ISA, $VERSION);
+use IO::Socket;
+use Carp;
+
+@ISA = qw(IO::Socket);
+$VERSION = "1.23";
+$VERSION = eval $VERSION;
+
+IO::Socket::UNIX->register_domain( AF_UNIX );
+
+sub new {
+ my $class = shift;
+ unshift(@_, "Peer") if @_ == 1;
+ return $class->SUPER::new(@_);
+}
+
+sub configure {
+ my($sock,$arg) = @_;
+ my($bport,$cport);
+
+ my $type = $arg->{Type} || SOCK_STREAM;
+
+ $sock->socket(AF_UNIX, $type, 0) or
+ return undef;
+
+ if(exists $arg->{Local}) {
+ my $addr = sockaddr_un($arg->{Local});
+ $sock->bind($addr) or
+ return undef;
+ }
+ if(exists $arg->{Listen} && $type != SOCK_DGRAM) {
+ $sock->listen($arg->{Listen} || 5) or
+ return undef;
+ }
+ elsif(exists $arg->{Peer}) {
+ my $addr = sockaddr_un($arg->{Peer});
+ $sock->connect($addr) or
+ return undef;
+ }
+
+ $sock;
+}
+
+sub hostpath {
+ @_ == 1 or croak 'usage: $sock->hostpath()';
+ my $n = $_[0]->sockname || return undef;
+ (sockaddr_un($n))[0];
+}
+
+sub peerpath {
+ @_ == 1 or croak 'usage: $sock->peerpath()';
+ my $n = $_[0]->peername || return undef;
+ (sockaddr_un($n))[0];
+}
+
+1; # Keep require happy
+
+__END__
+
generated by cgit v1.2.3 (git 2.46.0) at 2025-12-10 10:14:47 +0000