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 some .pm and .t #204

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

Tidy up some .pm and .t #204

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
d231eb5
Fix perltidyrc path error on CONTRIBUTING.md
yoshikazusawa Oct 30, 2024
5228112
Tidy some files that have not been modified in the currently open Pul…
yoshikazusawa Nov 3, 2024
bfa7cc0
Untab manually in comments for lib/HTTP/Headers/ETag.pm
yoshikazusawa Nov 3, 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
138 changes: 69 additions & 69 deletions lib/HTTP/Headers/Auth.pm
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -7,8 +7,7 @@ our $VERSION = '7.01';

use HTTP::Headers;

package
HTTP::Headers;
package HTTP::Headers;

BEGIN {
# we provide a new (and better) implementations below
Expand All @@ -18,83 +17,84 @@ BEGIN {

require HTTP::Headers::Util;

sub _parse_authenticate
{
sub _parse_authenticate {
my @ret;
for (HTTP::Headers::Util::split_header_words(@_)) {
if (!defined($_->[1])) {
# this is a new auth scheme
push(@ret, shift(@$_) => {});
shift @$_;
}
if (@ret) {
# this a new parameter pair for the last auth scheme
while (@$_) {
my $k = shift @$_;
my $v = shift @$_;
$ret[-1]{$k} = $v;
}
}
else {
# something wrong, parameter pair without any scheme seen
# IGNORE
}
for ( HTTP::Headers::Util::split_header_words(@_) ) {
if ( !defined( $_->[1] ) ) {

# this is a new auth scheme
push( @ret, shift(@$_) => {} );
shift @$_;
}
if (@ret) {

# this a new parameter pair for the last auth scheme
while (@$_) {
my $k = shift @$_;
my $v = shift @$_;
$ret[-1]{$k} = $v;
}
}
else {
# something wrong, parameter pair without any scheme seen
# IGNORE
}
}
@ret;
}

sub _authenticate
{
my $self = shift;
sub _authenticate {
my $self = shift;
my $header = shift;
my @old = $self->_header($header);
my @old = $self->_header($header);
if (@_) {
$self->remove_header($header);
my @new = @_;
while (@new) {
my $a_scheme = shift(@new);
if ($a_scheme =~ /\s/) {
# assume complete valid value, pass it through
$self->push_header($header, $a_scheme);
}
else {
my @param;
if (@new) {
my $p = $new[0];
if (ref($p) eq "ARRAY") {
@param = @$p;
shift(@new);
}
elsif (ref($p) eq "HASH") {
@param = %$p;
shift(@new);
}
}
my $val = ucfirst(lc($a_scheme));
if (@param) {
my $sep = " ";
while (@param) {
my $k = shift @param;
my $v = shift @param;
if ($v =~ /[^0-9a-zA-Z]/ || lc($k) eq "realm") {
# must quote the value
$v =~ s,([\\\"]),\\$1,g;
$v = qq("$v");
}
$val .= "$sep$k=$v";
$sep = ", ";
}
}
$self->push_header($header, $val);
}
}
$self->remove_header($header);
my @new = @_;
while (@new) {
my $a_scheme = shift(@new);
if ( $a_scheme =~ /\s/ ) {

# assume complete valid value, pass it through
$self->push_header( $header, $a_scheme );
}
else {
my @param;
if (@new) {
my $p = $new[0];
if ( ref($p) eq "ARRAY" ) {
@param = @$p;
shift(@new);
}
elsif ( ref($p) eq "HASH" ) {
@param = %$p;
shift(@new);
}
}
my $val = ucfirst( lc($a_scheme) );
if (@param) {
my $sep = " ";
while (@param) {
my $k = shift @param;
my $v = shift @param;
if ( $v =~ /[^0-9a-zA-Z]/ || lc($k) eq "realm" ) {

# must quote the value
$v =~ s,([\\\"]),\\$1,g;
$v = qq("$v");
}
$val .= "$sep$k=$v";
$sep = ", ";
}
}
$self->push_header( $header, $val );
}
}
}
return unless defined wantarray;
wantarray ? _parse_authenticate(@old) : join(", ", @old);
wantarray ? _parse_authenticate(@old) : join( ", ", @old );
}


sub www_authenticate { shift->_authenticate("WWW-Authenticate", @_) }
sub proxy_authenticate { shift->_authenticate("Proxy-Authenticate", @_) }
sub www_authenticate { shift->_authenticate( "WWW-Authenticate", @_ ) }
sub proxy_authenticate { shift->_authenticate( "Proxy-Authenticate", @_ ) }

1;
84 changes: 40 additions & 44 deletions lib/HTTP/Headers/ETag.pm
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -8,89 +8,85 @@ our $VERSION = '7.01';
require HTTP::Date;

require HTTP::Headers;
package
HTTP::Headers;
package HTTP::Headers;

sub _etags
{
my $self = shift;
sub _etags {
my $self = shift;
my $header = shift;
my @old = _split_etag_list($self->_header($header));
my @old = _split_etag_list( $self->_header($header) );
if (@_) {
$self->_header($header => join(", ", _split_etag_list(@_)));
$self->_header( $header => join( ", ", _split_etag_list(@_) ) );
}
wantarray ? @old : join(", ", @old);
wantarray ? @old : join( ", ", @old );
}

sub etag { shift->_etags("ETag", @_); }
sub if_match { shift->_etags("If-Match", @_); }
sub if_none_match { shift->_etags("If-None-Match", @_); }
sub etag { shift->_etags( "ETag", @_ ); }
sub if_match { shift->_etags( "If-Match", @_ ); }
sub if_none_match { shift->_etags( "If-None-Match", @_ ); }

sub if_range {

# Either a date or an entity-tag
my $self = shift;
my @old = $self->_header("If-Range");
my @old = $self->_header("If-Range");
if (@_) {
my $new = shift;
if (!defined $new) {
$self->remove_header("If-Range");
}
elsif ($new =~ /^\d+$/) {
$self->_date_header("If-Range", $new);
}
else {
$self->_etags("If-Range", $new);
}
my $new = shift;
if ( !defined $new ) {
$self->remove_header("If-Range");
}
elsif ( $new =~ /^\d+$/ ) {
$self->_date_header( "If-Range", $new );
}
else {
$self->_etags( "If-Range", $new );
}
}
return unless defined(wantarray);
for (@old) {
my $t = HTTP::Date::str2time($_);
$_ = $t if $t;
my $t = HTTP::Date::str2time($_);
$_ = $t if $t;
}
wantarray ? @old : join(", ", @old);
wantarray ? @old : join( ", ", @old );
}


# Split a list of entity tag values. The return value is a list
# consisting of one element per entity tag. Suitable for parsing
# headers like C<If-Match>, C<If-None-Match>. You might even want to
# use it on C<ETag> and C<If-Range> entity tag values, because it will
# normalize them to the common form.
#
# entity-tag = [ weak ] opaque-tag
# weak = "W/"
# opaque-tag = quoted-string
# entity-tag = [ weak ] opaque-tag
# weak = "W/"
# opaque-tag = quoted-string


sub _split_etag_list
{
my(@val) = @_;
sub _split_etag_list {
my (@val) = @_;
my @res;
for (@val) {
while (length) {
my $weak = "";
$weak = "W/" if s,^\s*[wW]/,,;
$weak = "W/" if s,^\s*[wW]/,,;
my $etag = "";
if (s/^\s*(\"[^\"\\]*(?:\\.[^\"\\]*)*\")//) {
push(@res, "$weak$1");
if (s/^\s*(\"[^\"\\]*(?:\\.[^\"\\]*)*\")//) {
push( @res, "$weak$1" );
}
elsif (s/^\s*,//) {
push(@res, qq(W/"")) if $weak;
push( @res, qq(W/"") ) if $weak;
}
elsif (s/^\s*([^,\s]+)//) {
$etag = $1;
$etag =~ s/([\"\\])/\\$1/g;
push(@res, qq($weak"$etag"));
$etag =~ s/([\"\\])/\\$1/g;
push( @res, qq($weak"$etag") );
}
elsif (s/^\s+// || !length) {
push(@res, qq(W/"")) if $weak;
elsif ( s/^\s+// || !length ) {
push( @res, qq(W/"") ) if $weak;
}
else {
die "This should not happen: '$_'";
die "This should not happen: '$_'";
}
}
}
@res;
}
@res;
}

1;
Loading
Loading