Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Tidy up all .pm and .t #203

Open
wants to merge 3 commits into
base: master
Choose a base branch
from
Open

Tidy up all .pm and .t #203

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
3 commits
Select commit Hold shift + click to select a range
8dc5646
Tidy up all .pm and .t
yoshikazusawa Oct 30, 2024
b6d8da0
Untab manually in comments
yoshikazusawa Oct 30, 2024
3bcaa63
Fix perltidyrc path error on CONTRIBUTING.md
yoshikazusawa Oct 30, 2024
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
4 changes: 2 additions & 2 deletions CONTRIBUTING.md
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -37,7 +37,7 @@ You can run tests directly using the `prove` tool:

## Code style and tidying

This distribution contains a `.perltidyrc` file in the root of the repository.
This distribution contains a `perltidyrc` file in the root of the repository.
Please install Perl::Tidy and use `perltidy` before submitting patches. However,
as this is an old distribution and styling has changed somewhat over the years,
please keep your tidying constrained to the portion of code or function in which
Expand All @@ -48,7 +48,7 @@ you're patching.
$ rm my_tidy_copy.pm

The above command, for example, would provide you with a copy of `Status.pm`
that has been cleaned according to our `.perltidyrc` settings. You'd then look
that has been cleaned according to our `perltidyrc` settings. You'd then look
at the newly created `my_tidy_copy.pm` in the dist root and replace your work
with the cleaned up copy if there are differences.

Expand Down
120 changes: 63 additions & 57 deletions lib/HTTP/Config.pm
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -23,137 +23,139 @@ sub empty {
}

sub add {
if (@_ == 2) {
if ( @_ == 2 ) {
my $self = shift;
push(@$self, shift);
push( @$self, shift );
return;
}
my($self, %spec) = @_;
push(@$self, \%spec);
my ( $self, %spec ) = @_;
push( @$self, \%spec );
return;
}

sub find2 {
my($self, %spec) = @_;
my ( $self, %spec ) = @_;
my @found;
my @rest;
ITEM:
ITEM:
for my $item (@$self) {
for my $k (keys %spec) {
for my $k ( keys %spec ) {
no warnings 'uninitialized';
if (!exists $item->{$k} || $spec{$k} ne $item->{$k}) {
push(@rest, $item);
if ( !exists $item->{$k} || $spec{$k} ne $item->{$k} ) {
push( @rest, $item );
next ITEM;
}
}
push(@found, $item);
push( @found, $item );
}
return \@found unless wantarray;
return \@found, \@rest;
}

sub find {
my $self = shift;
my $f = $self->find2(@_);
my $f = $self->find2(@_);
return @$f if wantarray;
return $f->[0];
}

sub remove {
my($self, %spec) = @_;
my($removed, $rest) = $self->find2(%spec);
my ( $self, %spec ) = @_;
my ( $removed, $rest ) = $self->find2(%spec);
@$self = @$rest if @$removed;
return @$removed;
}

my %MATCH = (
m_scheme => sub {
my($v, $uri) = @_;
return $uri->_scheme eq $v; # URI known to be canonical
my ( $v, $uri ) = @_;
return $uri->_scheme eq $v; # URI known to be canonical
},
m_secure => sub {
my($v, $uri) = @_;
my $secure = $uri->can("secure") ? $uri->secure : $uri->_scheme eq "https";
my ( $v, $uri ) = @_;
my $secure
= $uri->can("secure") ? $uri->secure : $uri->_scheme eq "https";
return $secure == !!$v;
},
m_host_port => sub {
my($v, $uri) = @_;
my ( $v, $uri ) = @_;
return unless $uri->can("host_port");
return $uri->host_port eq $v, 7;
},
m_host => sub {
my($v, $uri) = @_;
my ( $v, $uri ) = @_;
return unless $uri->can("host");
return $uri->host eq $v, 6;
},
m_port => sub {
my($v, $uri) = @_;
my ( $v, $uri ) = @_;
return unless $uri->can("port");
return $uri->port eq $v;
},
m_domain => sub {
my($v, $uri) = @_;
my ( $v, $uri ) = @_;
return unless $uri->can("host");
my $h = $uri->host;
$h = "$h.local" unless $h =~ /\./;
$v = ".$v" unless $v =~ /^\./;
return length($v), 5 if substr($h, -length($v)) eq $v;
$v = ".$v" unless $v =~ /^\./;
return length($v), 5 if substr( $h, -length($v) ) eq $v;
return 0;
},
m_path => sub {
my($v, $uri) = @_;
my ( $v, $uri ) = @_;
return unless $uri->can("path");
return $uri->path eq $v, 4;
},
m_path_prefix => sub {
my($v, $uri) = @_;
my ( $v, $uri ) = @_;
return unless $uri->can("path");
my $path = $uri->path;
my $len = length($v);
my $len = length($v);
return $len, 3 if $path eq $v;
return 0 if length($path) <= $len;
$v .= "/" unless $v =~ m,/\z,,;
return $len, 3 if substr($path, 0, length($v)) eq $v;
return $len, 3 if substr( $path, 0, length($v) ) eq $v;
return 0;
},
m_path_match => sub {
my($v, $uri) = @_;
my ( $v, $uri ) = @_;
return unless $uri->can("path");
return $uri->path =~ $v;
},
m_uri__ => sub {
my($v, $k, $uri) = @_;
return unless $uri->can($k);
my ( $v, $k, $uri ) = @_;
return unless $uri->can($k);
return 1 unless defined $v;
return $uri->$k eq $v;
},
m_method => sub {
my($v, $uri, $request) = @_;
my ( $v, $uri, $request ) = @_;
return $request && $request->method eq $v;
},
m_proxy => sub {
my($v, $uri, $request) = @_;
return $request && ($request->{proxy} || "") eq $v;
my ( $v, $uri, $request ) = @_;
return $request && ( $request->{proxy} || "" ) eq $v;
},
m_code => sub {
my($v, $uri, $request, $response) = @_;
my ( $v, $uri, $request, $response ) = @_;
$v =~ s/xx\z//;
return unless $response;
return length($v), 2 if substr($response->code, 0, length($v)) eq $v;
return length($v), 2
if substr( $response->code, 0, length($v) ) eq $v;
},
m_media_type => sub { # for request too??
my($v, $uri, $request, $response) = @_;
m_media_type => sub { # for request too??
my ( $v, $uri, $request, $response ) = @_;
return unless $response;
return 1, 1 if $v eq "*/*";
my $ct = $response->content_type;
return 2, 1 if $v =~ s,/\*\z,, && $ct =~ m,^\Q$v\E/,;
return 3, 1 if $v eq "html" && $response->content_is_html;
return 4, 1 if $v eq "xhtml" && $response->content_is_xhtml;
return 2, 1 if $v =~ s,/\*\z,, && $ct =~ m,^\Q$v\E/,;
return 3, 1 if $v eq "html" && $response->content_is_html;
return 4, 1 if $v eq "xhtml" && $response->content_is_xhtml;
return 10, 1 if $v eq $ct;
return 0;
},
m_header__ => sub {
my($v, $k, $uri, $request, $response) = @_;
my ( $v, $k, $uri, $request, $response ) = @_;
return unless $request;
my $req_header = $request->header($k);
return 1 if defined($req_header) && $req_header eq $v;
Expand All @@ -164,7 +166,7 @@ my %MATCH = (
return 0;
},
m_response_attr__ => sub {
my($v, $k, $uri, $request, $response) = @_;
my ( $v, $k, $uri, $request, $response ) = @_;
return unless $response;
return 1 if !defined($v) && exists $response->{$k};
return 0 unless exists $response->{$k};
Expand All @@ -175,45 +177,49 @@ my %MATCH = (

sub matching {
my $self = shift;
if (@_ == 1) {
if ($_[0]->can("request")) {
unshift(@_, $_[0]->request);
unshift(@_, undef) unless defined $_[0];
if ( @_ == 1 ) {
if ( $_[0]->can("request") ) {
unshift( @_, $_[0]->request );
unshift( @_, undef ) unless defined $_[0];
}
unshift(@_, $_[0]->uri_canonical) if $_[0] && $_[0]->can("uri_canonical");
unshift( @_, $_[0]->uri_canonical )
if $_[0] && $_[0]->can("uri_canonical");
}
my($uri, $request, $response) = @_;
my ( $uri, $request, $response ) = @_;
$uri = URI->new($uri) unless ref($uri);

my @m;
ITEM:
ITEM:
for my $item (@$self) {
my $order;
for my $ikey (keys %$item) {
for my $ikey ( keys %$item ) {
my $mkey = $ikey;
my $k;
$k = $1 if $mkey =~ s/__(.*)/__/;
if (my $m = $MATCH{$mkey}) {
if ( my $m = $MATCH{$mkey} ) {

#print "$ikey $mkey\n";
my($c, $o);
my ( $c, $o );
my @arg = (
defined($k) ? $k : (),
$uri, $request, $response
);
my $v = $item->{$ikey};
$v = [$v] unless ref($v) eq "ARRAY";
for (@$v) {
($c, $o) = $m->($_, @arg);
( $c, $o ) = $m->( $_, @arg );

#print " - $_ ==> $c $o\n";
last if $c;
}
next ITEM unless $c;
$order->[$o || 0] += $c;
$order->[ $o || 0 ] += $c;
}
}
$order->[7] ||= 0;
$item->{_order} = join(".", reverse map sprintf("%03d", $_ || 0), @$order);
push(@m, $item);
$item->{_order}
= join( ".", reverse map sprintf( "%03d", $_ || 0 ), @$order );
push( @m, $item );
}
@m = sort { $b->{_order} cmp $a->{_order} } @m;
delete $_->{_order} for @m;
Expand All @@ -224,7 +230,7 @@ sub matching {
sub add_item {
my $self = shift;
my $item = shift;
return $self->add(item => $item, @_);
return $self->add( item => $item, @_ );
}

sub remove_items {
Expand Down
Loading
Loading