From Code to Community: Sponsoring The Perl and Raku Conference 2025 Learn more

AKALINUX / URI-ws_Punix-0.002 / lib / URI / ws_Punix.pm 

            

              
1
2
3
4
—
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
—
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
—
69
70
71
72
73
74
75
76
77
78
79
80
—
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
—
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
—
116
117
118
119
120
121
122
123

              
package URI::ws_Punix;
our $VERSION=.002;
our %KNOWN;
=head1 NAME
URI::ws_Punix - URI for ws+unix
=head1 SYNOPSIS
  use URI;
  my $url='ws+unix://unix%2F:%2Ftest%2Fsocket.sock/testing';
  my $uri=new URI($url);
  # will output: ws+unix
  print $uri->scheme,"\n";
  # will output: unix/
  print $uri->host,"\n";
  # will output: /test/socket.sock
  print $uri->port
  # some classes don't yet understand the scheme ws+unix, so here is a work around
  $uri->set_false_scheme('ws');
  print $uri->scheme,"\n"; # now prints "ws"
=head1 DESCRIPTION
This class acts as a parser layer for URI, and adds support for handling the rare WebSocket URI using a "Unix Domain Socket.  The scheme expected is "ws+unix".  Since most modules don't understand this just yet, the fake scheme or $uri->set_false_scheme('ws') was added. 
=cut
use strict;
use warnings;
use parent q(URI::_server);
use URI::Escape qw(uri_unescape);
=head1 METHODS
=head2 URI::ws_Punix-E<gt>default_port
Returns the default port /tmp/unix.sock
=cut
sub default_port { '/tmp/unix.sock' }
sub _port {
  my $self=shift;
  return $self->SUPER::_port(@_) if $#_ >-1;
  if($$self=~ m,^ws+\+unix://unix%2F:?([^/]+),is) {
    return uri_unescape($1);
  }
  return $self->SUPER::_port(@_);
}
sub host {
  my $self=shift;
  return $self->SUPER::host('unix/') if $#_ >-1;
  if($$self=~ m,^ws+\+unix://unix%2F:?.*$,is) {
    return 'unix/';
  }
  return $self->SUPER::host(@_);
}
=head2 $uri->set_false_scheme('ws')
Used to overload the default behavior.. sometimes you may want to say "ws" in place of "ws+unix".  Some modules expect ws, this method lets you overload the default of $uri->scheme.
=cut
sub set_false_scheme {
  my ($self,$scheme)=@_;
  $KNOWN{$self}=$scheme;
}
=head2 URI::ws_Punix-E<gt>scheme
Normally follows the defaults unless $uri->set_false_scheme('value') was called on this instance.
=cut
sub scheme {
  my $self=shift;
  if($#_ >-1) {
    return $self->SUPER::scheme(@_);
  }
  if(exists $KNOWN{$self}) {
    return $KNOWN{$self};
  }
  return $self->SUPER::scheme;
}
=head2 URI::ws_Punix-E<gt>secure
Returns false
=cut
sub secure { 0 } 
our %KNWON=();
sub DESTROY {
  my $self=shift;
  delete $KNOWN{$self};
}
=head1 AUTHOR
Michael Shipper <AKALINUX@CPAN.ORG>
=cut
1;