p147685/CardiacPhase
1
0 Fork 0
Code Issues Pull Requests Releases Wiki Activity

Initial class construction

Browse Source
This commit is contained in:
João Narciso committed 2019-05-06 16:34:28 +02:00
1 parent 67f2d57e03
commit 431ff5f7d4
5813 files changed
+1622108
Download Patch File Download Diff File Expand all files Collapse all files

No files matched your search

Git/usr/lib/perl5/vendor_perl/HTML/Entities.pm
+483
View File
@@ -0,0 +1,483 @@
package HTML::Entities;
=encoding utf8
=head1 NAME
HTML::Entities - Encode or decode strings with HTML entities
=head1 SYNOPSIS
use HTML::Entities;
$a = "Våre norske tegn bør &#230res";
decode_entities($a);
encode_entities($a, "\200-\377");
For example, this:
$input = "vis-à-vis Beyoncé's naïve\npapier-mâché résumé";
print encode_entities($input), "\n"
Prints this out:
vis-à-vis Beyoncé's naïve
papier-mâché résumé
=head1 DESCRIPTION
This module deals with encoding and decoding of strings with HTML
character entities. The module provides the following functions:
=over 4
=item decode_entities( $string, ... )
This routine replaces HTML entities found in the $string with the
corresponding Unicode character. Unrecognized entities are left alone.
If multiple strings are provided as argument they are each decoded
separately and the same number of strings are returned.
If called in void context the arguments are decoded in-place.
This routine is exported by default.
=item _decode_entities( $string, \%entity2char )
=item _decode_entities( $string, \%entity2char, $expand_prefix )
This will in-place replace HTML entities in $string. The %entity2char
hash must be provided. Named entities not found in the %entity2char
hash are left alone. Numeric entities are expanded unless their value
overflow.
The keys in %entity2char are the entity names to be expanded and their
values are what they should expand into. The values do not have to be
single character strings. If a key has ";" as suffix,
then occurrences in $string are only expanded if properly terminated
with ";". Entities without ";" will be expanded regardless of how
they are terminated for compatibility with how common browsers treat
entities in the Latin-1 range.
If $expand_prefix is TRUE then entities without trailing ";" in
%entity2char will even be expanded as a prefix of a longer
unrecognized name. The longest matching name in %entity2char will be
used. This is mainly present for compatibility with an MSIE
misfeature.
$string = "foo&nbspbar";
_decode_entities($string, { nb => "@", nbsp => "\xA0" }, 1);
print $string; # will print "foo bar"
This routine is exported by default.
=item encode_entities( $string )
=item encode_entities( $string, $unsafe_chars )
This routine replaces unsafe characters in $string with their entity
representation. A second argument can be given to specify which characters to
consider unsafe. The unsafe characters is specified using the regular
expression character class syntax (what you find within brackets in regular
expressions).
The default set of characters to encode are control chars, high-bit chars, and
the C<< < >>, C<< & >>, C<< > >>, C<< ' >> and C<< " >> characters. But this,
for example, would encode I<just> the C<< < >>, C<< & >>, C<< > >>, and C<< "
>> characters:
$encoded = encode_entities($input, '<>&"');
and this would only encode non-plain ascii:
$encoded = encode_entities($input, '^\n\x20-\x25\x27-\x7e');
This routine is exported by default.
=item encode_entities_numeric( $string )
=item encode_entities_numeric( $string, $unsafe_chars )
This routine works just like encode_entities, except that the replacement
entities are always C<&#xI<hexnum>;> and never C<&I<entname>;>. For
example, C<encode_entities("r\xF4le")> returns "r&ocirc;le", but
C<encode_entities_numeric("r\xF4le")> returns "r&#xF4;le".
This routine is I<not> exported by default. But you can always
export it with C<use HTML::Entities qw(encode_entities_numeric);>
or even C<use HTML::Entities qw(:DEFAULT encode_entities_numeric);>
=back
All these routines modify the string passed as the first argument, if
called in a void context. In scalar and array contexts, the encoded or
decoded string is returned (without changing the input string).
If you prefer not to import these routines into your namespace, you can
call them as:
use HTML::Entities ();
$decoded = HTML::Entities::decode($a);
$encoded = HTML::Entities::encode($a);
$encoded = HTML::Entities::encode_numeric($a);
The module can also export the %char2entity and the %entity2char
hashes, which contain the mapping from all characters to the
corresponding entities (and vice versa, respectively).
=head1 COPYRIGHT
Copyright 1995-2006 Gisle Aas. All rights reserved.
This library is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
=cut
use strict;
use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION);
use vars qw(%entity2char %char2entity);
require 5.004;
require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(encode_entities decode_entities _decode_entities);
@EXPORT_OK = qw(%entity2char %char2entity encode_entities_numeric);
$VERSION = "3.69";
sub Version { $VERSION; }
require HTML::Parser; # for fast XS implemented decode_entities
%entity2char = (
# Some normal chars that have special meaning in SGML context
amp => '&', # ampersand
'gt' => '>', # greater than
'lt' => '<', # less than
quot => '"', # double quote
apos => "'", # single quote
# PUBLIC ISO 8879-1986//ENTITIES Added Latin 1//EN//HTML
AElig => chr(198), # capital AE diphthong (ligature)
Aacute => chr(193), # capital A, acute accent
Acirc => chr(194), # capital A, circumflex accent
Agrave => chr(192), # capital A, grave accent
Aring => chr(197), # capital A, ring
Atilde => chr(195), # capital A, tilde
Auml => chr(196), # capital A, dieresis or umlaut mark
Ccedil => chr(199), # capital C, cedilla
ETH => chr(208), # capital Eth, Icelandic
Eacute => chr(201), # capital E, acute accent
Ecirc => chr(202), # capital E, circumflex accent
Egrave => chr(200), # capital E, grave accent
Euml => chr(203), # capital E, dieresis or umlaut mark
Iacute => chr(205), # capital I, acute accent
Icirc => chr(206), # capital I, circumflex accent
Igrave => chr(204), # capital I, grave accent
Iuml => chr(207), # capital I, dieresis or umlaut mark
Ntilde => chr(209), # capital N, tilde
Oacute => chr(211), # capital O, acute accent
Ocirc => chr(212), # capital O, circumflex accent
Ograve => chr(210), # capital O, grave accent
Oslash => chr(216), # capital O, slash
Otilde => chr(213), # capital O, tilde
Ouml => chr(214), # capital O, dieresis or umlaut mark
THORN => chr(222), # capital THORN, Icelandic
Uacute => chr(218), # capital U, acute accent
Ucirc => chr(219), # capital U, circumflex accent
Ugrave => chr(217), # capital U, grave accent
Uuml => chr(220), # capital U, dieresis or umlaut mark
Yacute => chr(221), # capital Y, acute accent
aacute => chr(225), # small a, acute accent
acirc => chr(226), # small a, circumflex accent
aelig => chr(230), # small ae diphthong (ligature)
agrave => chr(224), # small a, grave accent
aring => chr(229), # small a, ring
atilde => chr(227), # small a, tilde
auml => chr(228), # small a, dieresis or umlaut mark
ccedil => chr(231), # small c, cedilla
eacute => chr(233), # small e, acute accent
ecirc => chr(234), # small e, circumflex accent
egrave => chr(232), # small e, grave accent
eth => chr(240), # small eth, Icelandic
euml => chr(235), # small e, dieresis or umlaut mark
iacute => chr(237), # small i, acute accent
icirc => chr(238), # small i, circumflex accent
igrave => chr(236), # small i, grave accent
iuml => chr(239), # small i, dieresis or umlaut mark
ntilde => chr(241), # small n, tilde
oacute => chr(243), # small o, acute accent
ocirc => chr(244), # small o, circumflex accent
ograve => chr(242), # small o, grave accent
oslash => chr(248), # small o, slash
otilde => chr(245), # small o, tilde
ouml => chr(246), # small o, dieresis or umlaut mark
szlig => chr(223), # small sharp s, German (sz ligature)
thorn => chr(254), # small thorn, Icelandic
uacute => chr(250), # small u, acute accent
ucirc => chr(251), # small u, circumflex accent
ugrave => chr(249), # small u, grave accent
uuml => chr(252), # small u, dieresis or umlaut mark
yacute => chr(253), # small y, acute accent
yuml => chr(255), # small y, dieresis or umlaut mark
# Some extra Latin 1 chars that are listed in the HTML3.2 draft (21-May-96)
copy => chr(169), # copyright sign
reg => chr(174), # registered sign
nbsp => chr(160), # non breaking space
# Additional ISO-8859/1 entities listed in rfc1866 (section 14)
iexcl => chr(161),
cent => chr(162),
pound => chr(163),
curren => chr(164),
yen => chr(165),
brvbar => chr(166),
sect => chr(167),
uml => chr(168),
ordf => chr(170),
laquo => chr(171),
'not' => chr(172), # not is a keyword in perl
shy => chr(173),
macr => chr(175),
deg => chr(176),
plusmn => chr(177),
sup1 => chr(185),
sup2 => chr(178),
sup3 => chr(179),
acute => chr(180),
micro => chr(181),
para => chr(182),
middot => chr(183),
cedil => chr(184),
ordm => chr(186),
raquo => chr(187),
frac14 => chr(188),
frac12 => chr(189),
frac34 => chr(190),
iquest => chr(191),
'times' => chr(215), # times is a keyword in perl
divide => chr(247),
( $] > 5.007 ? (
'OElig;' => chr(338),
'oelig;' => chr(339),
'Scaron;' => chr(352),
'scaron;' => chr(353),
'Yuml;' => chr(376),
'fnof;' => chr(402),
'circ;' => chr(710),
'tilde;' => chr(732),
'Alpha;' => chr(913),
'Beta;' => chr(914),
'Gamma;' => chr(915),
'Delta;' => chr(916),
'Epsilon;' => chr(917),
'Zeta;' => chr(918),
'Eta;' => chr(919),
'Theta;' => chr(920),
'Iota;' => chr(921),
'Kappa;' => chr(922),
'Lambda;' => chr(923),
'Mu;' => chr(924),
'Nu;' => chr(925),
'Xi;' => chr(926),
'Omicron;' => chr(927),
'Pi;' => chr(928),
'Rho;' => chr(929),
'Sigma;' => chr(931),
'Tau;' => chr(932),
'Upsilon;' => chr(933),
'Phi;' => chr(934),
'Chi;' => chr(935),
'Psi;' => chr(936),
'Omega;' => chr(937),
'alpha;' => chr(945),
'beta;' => chr(946),
'gamma;' => chr(947),
'delta;' => chr(948),
'epsilon;' => chr(949),
'zeta;' => chr(950),
'eta;' => chr(951),
'theta;' => chr(952),
'iota;' => chr(953),
'kappa;' => chr(954),
'lambda;' => chr(955),
'mu;' => chr(956),
'nu;' => chr(957),
'xi;' => chr(958),
'omicron;' => chr(959),
'pi;' => chr(960),
'rho;' => chr(961),
'sigmaf;' => chr(962),
'sigma;' => chr(963),
'tau;' => chr(964),
'upsilon;' => chr(965),
'phi;' => chr(966),
'chi;' => chr(967),
'psi;' => chr(968),
'omega;' => chr(969),
'thetasym;' => chr(977),
'upsih;' => chr(978),
'piv;' => chr(982),
'ensp;' => chr(8194),
'emsp;' => chr(8195),
'thinsp;' => chr(8201),
'zwnj;' => chr(8204),
'zwj;' => chr(8205),
'lrm;' => chr(8206),
'rlm;' => chr(8207),
'ndash;' => chr(8211),
'mdash;' => chr(8212),
'lsquo;' => chr(8216),
'rsquo;' => chr(8217),
'sbquo;' => chr(8218),
'ldquo;' => chr(8220),
'rdquo;' => chr(8221),
'bdquo;' => chr(8222),
'dagger;' => chr(8224),
'Dagger;' => chr(8225),
'bull;' => chr(8226),
'hellip;' => chr(8230),
'permil;' => chr(8240),
'prime;' => chr(8242),
'Prime;' => chr(8243),
'lsaquo;' => chr(8249),
'rsaquo;' => chr(8250),
'oline;' => chr(8254),
'frasl;' => chr(8260),
'euro;' => chr(8364),
'image;' => chr(8465),
'weierp;' => chr(8472),
'real;' => chr(8476),
'trade;' => chr(8482),
'alefsym;' => chr(8501),
'larr;' => chr(8592),
'uarr;' => chr(8593),
'rarr;' => chr(8594),
'darr;' => chr(8595),
'harr;' => chr(8596),
'crarr;' => chr(8629),
'lArr;' => chr(8656),
'uArr;' => chr(8657),
'rArr;' => chr(8658),
'dArr;' => chr(8659),
'hArr;' => chr(8660),
'forall;' => chr(8704),
'part;' => chr(8706),
'exist;' => chr(8707),
'empty;' => chr(8709),
'nabla;' => chr(8711),
'isin;' => chr(8712),
'notin;' => chr(8713),
'ni;' => chr(8715),
'prod;' => chr(8719),
'sum;' => chr(8721),
'minus;' => chr(8722),
'lowast;' => chr(8727),
'radic;' => chr(8730),
'prop;' => chr(8733),
'infin;' => chr(8734),
'ang;' => chr(8736),
'and;' => chr(8743),
'or;' => chr(8744),
'cap;' => chr(8745),
'cup;' => chr(8746),
'int;' => chr(8747),
'there4;' => chr(8756),
'sim;' => chr(8764),
'cong;' => chr(8773),
'asymp;' => chr(8776),
'ne;' => chr(8800),
'equiv;' => chr(8801),
'le;' => chr(8804),
'ge;' => chr(8805),
'sub;' => chr(8834),
'sup;' => chr(8835),
'nsub;' => chr(8836),
'sube;' => chr(8838),
'supe;' => chr(8839),
'oplus;' => chr(8853),
'otimes;' => chr(8855),
'perp;' => chr(8869),
'sdot;' => chr(8901),
'lceil;' => chr(8968),
'rceil;' => chr(8969),
'lfloor;' => chr(8970),
'rfloor;' => chr(8971),
'lang;' => chr(9001),
'rang;' => chr(9002),
'loz;' => chr(9674),
'spades;' => chr(9824),
'clubs;' => chr(9827),
'hearts;' => chr(9829),
'diams;' => chr(9830),
) : ())
);
# Make the opposite mapping
while (my($entity, $char) = each(%entity2char)) {
$entity =~ s/;\z//;
$char2entity{$char} = "&$entity;";
}
delete $char2entity{"'"}; # only one-way decoding
# Fill in missing entities
for (0 .. 255) {
next if exists $char2entity{chr($_)};
$char2entity{chr($_)} = "&#$_;";
}
my %subst; # compiled encoding regexps
sub encode_entities
{
return undef unless defined $_[0];
my $ref;
if (defined wantarray) {
my $x = $_[0];
$ref = \$x; # copy
} else {
$ref = \$_[0]; # modify in-place
}
if (defined $_[1] and length $_[1]) {
unless (exists $subst{$_[1]}) {
# Because we can't compile regex we fake it with a cached sub
my $chars = $_[1];
$chars =~ s,(?<!\\)([]/]),\\$1,g;
$chars =~ s,(?<!\\)\\\z,\\\\,;
my $code = "sub {\$_[0] =~ s/([$chars])/\$char2entity{\$1} || num_entity(\$1)/ge; }";
$subst{$_[1]} = eval $code;
die( $@ . " while trying to turn range: \"$_[1]\"\n "
. "into code: $code\n "
) if $@;
}
&{$subst{$_[1]}}($$ref);
} else {
# Encode control chars, high bit chars and '<', '&', '>', ''' and '"'
$$ref =~ s/([^\n\r\t !\#\$%\(-;=?-~])/$char2entity{$1} || num_entity($1)/ge;
}
$$ref;
}
sub encode_entities_numeric {
local %char2entity;
return &encode_entities; # a goto &encode_entities wouldn't work
}
sub num_entity {
sprintf "&#x%X;", ord($_[0]);
}
# Set up aliases
*encode = \&encode_entities;
*encode_numeric = \&encode_entities_numeric;
*encode_numerically = \&encode_entities_numeric;
*decode = \&decode_entities;
1;
Git/usr/lib/perl5/vendor_perl/HTML/Filter.pm
+112
View File
@@ -0,0 +1,112 @@
package HTML::Filter;
use strict;
use vars qw(@ISA $VERSION);
require HTML::Parser;
@ISA=qw(HTML::Parser);
$VERSION = "3.72";
sub declaration { $_[0]->output("<!$_[1]>") }
sub process { $_[0]->output($_[2]) }
sub comment { $_[0]->output("<!--$_[1]-->") }
sub start { $_[0]->output($_[4]) }
sub end { $_[0]->output($_[2]) }
sub text { $_[0]->output($_[1]) }
sub output { print $_[1] }
1;
__END__
=head1 NAME
HTML::Filter - Filter HTML text through the parser
=head1 NOTE
B<This module is deprecated.> The C<HTML::Parser> now provides the
functionally of C<HTML::Filter> much more efficiently with the
C<default> handler.
=head1 SYNOPSIS
require HTML::Filter;
$p = HTML::Filter->new->parse_file("index.html");
=head1 DESCRIPTION
C<HTML::Filter> is an HTML parser that by default prints the
original text of each HTML element (a slow version of cat(1) basically).
The callback methods may be overridden to modify the filtering for some
HTML elements and you can override output() method which is called to
print the HTML text.
C<HTML::Filter> is a subclass of C<HTML::Parser>. This means that
the document should be given to the parser by calling the $p->parse()
or $p->parse_file() methods.
=head1 EXAMPLES
The first example is a filter that will remove all comments from an
HTML file. This is achieved by simply overriding the comment method
to do nothing.
package CommentStripper;
require HTML::Filter;
@ISA=qw(HTML::Filter);
sub comment { } # ignore comments
The second example shows a filter that will remove any E<lt>TABLE>s
found in the HTML file. We specialize the start() and end() methods
to count table tags and then make output not happen when inside a
table.
package TableStripper;
require HTML::Filter;
@ISA=qw(HTML::Filter);
sub start
{
my $self = shift;
$self->{table_seen}++ if $_[0] eq "table";
$self->SUPER::start(@_);
}
sub end
{
my $self = shift;
$self->SUPER::end(@_);
$self->{table_seen}-- if $_[0] eq "table";
}
sub output
{
my $self = shift;
unless ($self->{table_seen}) {
$self->SUPER::output(@_);
}
}
If you want to collect the parsed text internally you might want to do
something like this:
package FilterIntoString;
require HTML::Filter;
@ISA=qw(HTML::Filter);
sub output { push(@{$_[0]->{fhtml}}, $_[1]) }
sub filtered_html { join("", @{$_[0]->{fhtml}}) }
=head1 SEE ALSO
L<HTML::Parser>
=head1 COPYRIGHT
Copyright 1997-1999 Gisle Aas.
This library is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
=cut
Git/usr/lib/perl5/vendor_perl/HTML/HeadParser.pm
+315
View File
@@ -0,0 +1,315 @@
package HTML::HeadParser;
=head1 NAME
HTML::HeadParser - Parse <HEAD> section of a HTML document
=head1 SYNOPSIS
require HTML::HeadParser;
$p = HTML::HeadParser->new;
$p->parse($text) and print "not finished";
$p->header('Title') # to access <title>....</title>
$p->header('Content-Base') # to access <base href="http://...">
$p->header('Foo') # to access <meta http-equiv="Foo" content="...">
$p->header('X-Meta-Author') # to access <meta name="author" content="...">
$p->header('X-Meta-Charset') # to access <meta charset="...">
=head1 DESCRIPTION
The C<HTML::HeadParser> is a specialized (and lightweight)
C<HTML::Parser> that will only parse the E<lt>HEAD>...E<lt>/HEAD>
section of an HTML document. The parse() method
will return a FALSE value as soon as some E<lt>BODY> element or body
text are found, and should not be called again after this.
Note that the C<HTML::HeadParser> might get confused if raw undecoded
UTF-8 is passed to the parse() method. Make sure the strings are
properly decoded before passing them on.
The C<HTML::HeadParser> keeps a reference to a header object, and the
parser will update this header object as the various elements of the
E<lt>HEAD> section of the HTML document are recognized. The following
header fields are affected:
=over 4
=item Content-Base:
The I<Content-Base> header is initialized from the E<lt>base
href="..."> element.
=item Title:
The I<Title> header is initialized from the E<lt>title>...E<lt>/title>
element.
=item Isindex:
The I<Isindex> header will be added if there is a E<lt>isindex>
element in the E<lt>head>. The header value is initialized from the
I<prompt> attribute if it is present. If no I<prompt> attribute is
given it will have '?' as the value.
=item X-Meta-Foo:
All E<lt>meta> elements containing a C<name> attribute will result in
headers using the prefix C<X-Meta-> appended with the value of the
C<name> attribute as the name of the header, and the value of the
C<content> attribute as the pushed header value.
E<lt>meta> elements containing a C<http-equiv> attribute will result
in headers as in above, but without the C<X-Meta-> prefix in the
header name.
E<lt>meta> elements containing a C<charset> attribute will result in
an C<X-Meta-Charset> header, using the value of the C<charset>
attribute as the pushed header value.
The ':' character can't be represented in header field names, so
if the meta element contains this char it's substituted with '-'
before forming the field name.
=back
=head1 METHODS
The following methods (in addition to those provided by the
superclass) are available:
=over 4
=cut
require HTML::Parser;
@ISA = qw(HTML::Parser);
use HTML::Entities ();
use strict;
use vars qw($VERSION $DEBUG);
#$DEBUG = 1;
$VERSION = "3.71";
=item $hp = HTML::HeadParser->new
=item $hp = HTML::HeadParser->new( $header )
The object constructor. The optional $header argument should be a
reference to an object that implement the header() and push_header()
methods as defined by the C<HTTP::Headers> class. Normally it will be
of some class that is a or delegates to the C<HTTP::Headers> class.
If no $header is given C<HTML::HeadParser> will create an
C<HTTP::Headers> object by itself (initially empty).
=cut
sub new
{
my($class, $header) = @_;
unless ($header) {
require HTTP::Headers;
$header = HTTP::Headers->new;
}
my $self = $class->SUPER::new(api_version => 3,
start_h => ["start", "self,tagname,attr"],
end_h => ["end", "self,tagname"],
text_h => ["text", "self,text"],
ignore_elements => [qw(script style)],
);
$self->{'header'} = $header;
$self->{'tag'} = ''; # name of active element that takes textual content
$self->{'text'} = ''; # the accumulated text associated with the element
$self;
}
=item $hp->header;
Returns a reference to the header object.
=item $hp->header( $key )
Returns a header value. It is just a shorter way to write
C<$hp-E<gt>header-E<gt>header($key)>.
=cut
sub header
{
my $self = shift;
return $self->{'header'} unless @_;
$self->{'header'}->header(@_);
}
sub as_string # legacy
{
my $self = shift;
$self->{'header'}->as_string;
}
sub flush_text # internal
{
my $self = shift;
my $tag = $self->{'tag'};
my $text = $self->{'text'};
$text =~ s/^\s+//;
$text =~ s/\s+$//;
$text =~ s/\s+/ /g;
print "FLUSH $tag => '$text'\n" if $DEBUG;
if ($tag eq 'title') {
my $decoded;
$decoded = utf8::decode($text) if $self->utf8_mode && defined &utf8::decode;
HTML::Entities::decode($text);
utf8::encode($text) if $decoded;
$self->{'header'}->push_header(Title => $text);
}
$self->{'tag'} = $self->{'text'} = '';
}
# This is an quote from the HTML3.2 DTD which shows which elements
# that might be present in a <HEAD>...</HEAD>. Also note that the
# <HEAD> tags themselves might be missing:
#
# <!ENTITY % head.content "TITLE & ISINDEX? & BASE? & STYLE? &
# SCRIPT* & META* & LINK*">
#
# <!ELEMENT HEAD O O (%head.content)>
#
# From HTML 4.01:
#
# <!ENTITY % head.misc "SCRIPT|STYLE|META|LINK|OBJECT">
# <!ENTITY % head.content "TITLE & BASE?">
# <!ELEMENT HEAD O O (%head.content;) +(%head.misc;)>
#
# From HTML 5 as of WD-html5-20090825:
#
# One or more elements of metadata content, [...]
# => base, command, link, meta, noscript, script, style, title
sub start
{
my($self, $tag, $attr) = @_; # $attr is reference to a HASH
print "START[$tag]\n" if $DEBUG;
$self->flush_text if $self->{'tag'};
if ($tag eq 'meta') {
my $key = $attr->{'http-equiv'};
if (!defined($key) || !length($key)) {
if ($attr->{name}) {
$key = "X-Meta-\u$attr->{name}";
} elsif ($attr->{charset}) { # HTML 5 <meta charset="...">
$key = "X-Meta-Charset";
$self->{header}->push_header($key => $attr->{charset});
return;
} else {
return;
}
}
$key =~ s/:/-/g;
$self->{'header'}->push_header($key => $attr->{content});
} elsif ($tag eq 'base') {
return unless exists $attr->{href};
(my $base = $attr->{href}) =~ s/^\s+//; $base =~ s/\s+$//; # HTML5
$self->{'header'}->push_header('Content-Base' => $base);
} elsif ($tag eq 'isindex') {
# This is a non-standard header. Perhaps we should just ignore
# this element
$self->{'header'}->push_header(Isindex => $attr->{prompt} || '?');
} elsif ($tag =~ /^(?:title|noscript|object|command)$/) {
# Just remember tag. Initialize header when we see the end tag.
$self->{'tag'} = $tag;
} elsif ($tag eq 'link') {
return unless exists $attr->{href};
# <link href="http:..." rel="xxx" rev="xxx" title="xxx">
my $href = delete($attr->{href});
$href =~ s/^\s+//; $href =~ s/\s+$//; # HTML5
my $h_val = "<$href>";
for (sort keys %{$attr}) {
next if $_ eq "/"; # XHTML junk
$h_val .= qq(; $_="$attr->{$_}");
}
$self->{'header'}->push_header(Link => $h_val);
} elsif ($tag eq 'head' || $tag eq 'html') {
# ignore
} else {
# stop parsing
$self->eof;
}
}
sub end
{
my($self, $tag) = @_;
print "END[$tag]\n" if $DEBUG;
$self->flush_text if $self->{'tag'};
$self->eof if $tag eq 'head';
}
sub text
{
my($self, $text) = @_;
print "TEXT[$text]\n" if $DEBUG;
unless ($self->{first_chunk}) {
# drop Unicode BOM if found
if ($self->utf8_mode) {
$text =~ s/^\xEF\xBB\xBF//;
}
else {
$text =~ s/^\x{FEFF}//;
}
$self->{first_chunk}++;
}
my $tag = $self->{tag};
if (!$tag && $text =~ /\S/) {
# Normal text means start of body
$self->eof;
return;
}
return if $tag ne 'title';
$self->{'text'} .= $text;
}
BEGIN {
*utf8_mode = sub { 1 } unless HTML::Entities::UNICODE_SUPPORT;
}
1;
__END__
=back
=head1 EXAMPLE
$h = HTTP::Headers->new;
$p = HTML::HeadParser->new($h);
$p->parse(<<EOT);
<title>Stupid example</title>
<base href="http://www.linpro.no/lwp/">
Normal text starts here.
EOT
undef $p;
print $h->title; # should print "Stupid example"
=head1 SEE ALSO
L<HTML::Parser>, L<HTTP::Headers>
The C<HTTP::Headers> class is distributed as part of the
I<libwww-perl> package. If you don't have that distribution installed
you need to provide the $header argument to the C<HTML::HeadParser>
constructor with your own object that implements the documented
protocol.
=head1 COPYRIGHT
Copyright 1996-2001 Gisle Aas. All rights reserved.
This library is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
=cut
Git/usr/lib/perl5/vendor_perl/HTML/LinkExtor.pm
+185
View File
@@ -0,0 +1,185 @@
package HTML::LinkExtor;
require HTML::Parser;
@ISA = qw(HTML::Parser);
$VERSION = "3.69";
=head1 NAME
HTML::LinkExtor - Extract links from an HTML document
=head1 SYNOPSIS
require HTML::LinkExtor;
$p = HTML::LinkExtor->new(\&cb, "http://www.perl.org/");
sub cb {
my($tag, %links) = @_;
print "$tag @{[%links]}\n";
}
$p->parse_file("index.html");
=head1 DESCRIPTION
I<HTML::LinkExtor> is an HTML parser that extracts links from an
HTML document. The I<HTML::LinkExtor> is a subclass of
I<HTML::Parser>. This means that the document should be given to the
parser by calling the $p->parse() or $p->parse_file() methods.
=cut
use strict;
use HTML::Tagset ();
# legacy (some applications grabs this hash directly)
use vars qw(%LINK_ELEMENT);
*LINK_ELEMENT = \%HTML::Tagset::linkElements;
=over 4
=item $p = HTML::LinkExtor->new
=item $p = HTML::LinkExtor->new( $callback )
=item $p = HTML::LinkExtor->new( $callback, $base )
The constructor takes two optional arguments. The first is a reference
to a callback routine. It will be called as links are found. If a
callback is not provided, then links are just accumulated internally
and can be retrieved by calling the $p->links() method.
The $base argument is an optional base URL used to absolutize all URLs found.
You need to have the I<URI> module installed if you provide $base.
The callback is called with the lowercase tag name as first argument,
and then all link attributes as separate key/value pairs. All
non-link attributes are removed.
=cut
sub new
{
my($class, $cb, $base) = @_;
my $self = $class->SUPER::new(
start_h => ["_start_tag", "self,tagname,attr"],
report_tags => [keys %HTML::Tagset::linkElements],
);
$self->{extractlink_cb} = $cb;
if ($base) {
require URI;
$self->{extractlink_base} = URI->new($base);
}
$self;
}
sub _start_tag
{
my($self, $tag, $attr) = @_;
my $base = $self->{extractlink_base};
my $links = $HTML::Tagset::linkElements{$tag};
$links = [$links] unless ref $links;
my @links;
my $a;
for $a (@$links) {
next unless exists $attr->{$a};
(my $link = $attr->{$a}) =~ s/^\s+//; $link =~ s/\s+$//; # HTML5
push(@links, $a, $base ? URI->new($link, $base)->abs($base) : $link);
}
return unless @links;
$self->_found_link($tag, @links);
}
sub _found_link
{
my $self = shift;
my $cb = $self->{extractlink_cb};
if ($cb) {
&$cb(@_);
} else {
push(@{$self->{'links'}}, [@_]);
}
}
=item $p->links
Returns a list of all links found in the document. The returned
values will be anonymous arrays with the following elements:
[$tag, $attr => $url1, $attr2 => $url2,...]
The $p->links method will also truncate the internal link list. This
means that if the method is called twice without any parsing
between them the second call will return an empty list.
Also note that $p->links will always be empty if a callback routine
was provided when the I<HTML::LinkExtor> was created.
=cut
sub links
{
my $self = shift;
exists($self->{'links'}) ? @{delete $self->{'links'}} : ();
}
# We override the parse_file() method so that we can clear the links
# before we start a new file.
sub parse_file
{
my $self = shift;
delete $self->{'links'};
$self->SUPER::parse_file(@_);
}
=back
=head1 EXAMPLE
This is an example showing how you can extract links from a document
received using LWP:
use LWP::UserAgent;
use HTML::LinkExtor;
use URI::URL;
$url = "http://www.perl.org/"; # for instance
$ua = LWP::UserAgent->new;
# Set up a callback that collect image links
my @imgs = ();
sub callback {
my($tag, %attr) = @_;
return if $tag ne 'img'; # we only look closer at <img ...>
push(@imgs, values %attr);
}
# Make the parser. Unfortunately, we don't know the base yet
# (it might be different from $url)
$p = HTML::LinkExtor->new(\&callback);
# Request document and parse it as it arrives
$res = $ua->request(HTTP::Request->new(GET => $url),
sub {$p->parse($_[0])});
# Expand all image URLs to absolute ones
my $base = $res->base;
@imgs = map { $_ = url($_, $base)->abs; } @imgs;
# Print them out
print join("\n", @imgs), "\n";
=head1 SEE ALSO
L<HTML::Parser>, L<HTML::Tagset>, L<LWP>, L<URI::URL>
=head1 COPYRIGHT
Copyright 1996-2001 Gisle Aas.
This library is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
=cut
1;
Git/usr/lib/perl5/vendor_perl/HTML/Parser.pm
+1234
View File
File diff suppressed because it is too large. Load diff
Git/usr/lib/perl5/vendor_perl/HTML/PullParser.pm
+209
View File
@@ -0,0 +1,209 @@
package HTML::PullParser;
require HTML::Parser;
@ISA=qw(HTML::Parser);
$VERSION = "3.57";
use strict;
use Carp ();
sub new
{
my($class, %cnf) = @_;
# Construct argspecs for the various events
my %argspec;
for (qw(start end text declaration comment process default)) {
my $tmp = delete $cnf{$_};
next unless defined $tmp;
$argspec{$_} = $tmp;
}
Carp::croak("Info not collected for any events")
unless %argspec;
my $file = delete $cnf{file};
my $doc = delete $cnf{doc};
Carp::croak("Can't parse from both 'doc' and 'file' at the same time")
if defined($file) && defined($doc);
Carp::croak("No 'doc' or 'file' given to parse from")
unless defined($file) || defined($doc);
# Create object
$cnf{api_version} = 3;
my $self = $class->SUPER::new(%cnf);
my $accum = $self->{pullparser_accum} = [];
while (my($event, $argspec) = each %argspec) {
$self->SUPER::handler($event => $accum, $argspec);
}
if (defined $doc) {
$self->{pullparser_str_ref} = ref($doc) ? $doc : \$doc;
$self->{pullparser_str_pos} = 0;
}
else {
if (!ref($file) && ref(\$file) ne "GLOB") {
require IO::File;
$file = IO::File->new($file, "r") || return;
}
$self->{pullparser_file} = $file;
}
$self;
}
sub handler
{
Carp::croak("Can't set handlers for HTML::PullParser");
}
sub get_token
{
my $self = shift;
while (!@{$self->{pullparser_accum}} && !$self->{pullparser_eof}) {
if (my $f = $self->{pullparser_file}) {
# must try to parse more from the file
my $buf;
if (read($f, $buf, 512)) {
$self->parse($buf);
} else {
$self->eof;
$self->{pullparser_eof}++;
delete $self->{pullparser_file};
}
}
elsif (my $sref = $self->{pullparser_str_ref}) {
# must try to parse more from the scalar
my $pos = $self->{pullparser_str_pos};
my $chunk = substr($$sref, $pos, 512);
$self->parse($chunk);
$pos += length($chunk);
if ($pos < length($$sref)) {
$self->{pullparser_str_pos} = $pos;
}
else {
$self->eof;
$self->{pullparser_eof}++;
delete $self->{pullparser_str_ref};
delete $self->{pullparser_str_pos};
}
}
else {
die;
}
}
shift @{$self->{pullparser_accum}};
}
sub unget_token
{
my $self = shift;
unshift @{$self->{pullparser_accum}}, @_;
$self;
}
1;
__END__
=head1 NAME
HTML::PullParser - Alternative HTML::Parser interface
=head1 SYNOPSIS
use HTML::PullParser;
$p = HTML::PullParser->new(file => "index.html",
start => 'event, tagname, @attr',
end => 'event, tagname',
ignore_elements => [qw(script style)],
) || die "Can't open: $!";
while (my $token = $p->get_token) {
#...do something with $token
}
=head1 DESCRIPTION
The HTML::PullParser is an alternative interface to the HTML::Parser class.
It basically turns the HTML::Parser inside out. You associate a file
(or any IO::Handle object or string) with the parser at construction time and
then repeatedly call $parser->get_token to obtain the tags and text
found in the parsed document.
The following methods are provided:
=over 4
=item $p = HTML::PullParser->new( file => $file, %options )
=item $p = HTML::PullParser->new( doc => \$doc, %options )
A C<HTML::PullParser> can be made to parse from either a file or a
literal document based on whether the C<file> or C<doc> option is
passed to the parser's constructor.
The C<file> passed in can either be a file name or a file handle
object. If a file name is passed, and it can't be opened for reading,
then the constructor will return an undefined value and $! will tell
you why it failed. Otherwise the argument is taken to be some object
that the C<HTML::PullParser> can read() from when it needs more data.
The stream will be read() until EOF, but not closed.
A C<doc> can be passed plain or as a reference
to a scalar. If a reference is passed then the value of this scalar
should not be changed before all tokens have been extracted.
Next the information to be returned for the different token types must
be set up. This is done by simply associating an argspec (as defined
in L<HTML::Parser>) with the events you have an interest in. For
instance, if you want C<start> tokens to be reported as the string
C<'S'> followed by the tagname and the attributes you might pass an
C<start>-option like this:
$p = HTML::PullParser->new(
doc => $document_to_parse,
start => '"S", tagname, @attr',
end => '"E", tagname',
);
At last other C<HTML::Parser> options, like C<ignore_tags>, and
C<unbroken_text>, can be passed in. Note that you should not use the
I<event>_h options to set up parser handlers. That would confuse the
inner logic of C<HTML::PullParser>.
=item $token = $p->get_token
This method will return the next I<token> found in the HTML document,
or C<undef> at the end of the document. The token is returned as an
array reference. The content of this array match the argspec set up
during C<HTML::PullParser> construction.
=item $p->unget_token( @tokens )
If you find out you have read too many tokens you can push them back,
so that they are returned again the next time $p->get_token is called.
=back
=head1 EXAMPLES
The 'eg/hform' script shows how we might parse the form section of
HTML::Documents using HTML::PullParser.
=head1 SEE ALSO
L<HTML::Parser>, L<HTML::TokeParser>
=head1 COPYRIGHT
Copyright 1998-2001 Gisle Aas.
This library is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
=cut
Git/usr/lib/perl5/vendor_perl/HTML/TokeParser.pm
+371
View File
@@ -0,0 +1,371 @@
package HTML::TokeParser;
require HTML::PullParser;
@ISA=qw(HTML::PullParser);
$VERSION = "3.69";
use strict;
use Carp ();
use HTML::Entities qw(decode_entities);
use HTML::Tagset ();
my %ARGS =
(
start => "'S',tagname,attr,attrseq,text",
end => "'E',tagname,text",
text => "'T',text,is_cdata",
process => "'PI',token0,text",
comment => "'C',text",
declaration => "'D',text",
# options that default on
unbroken_text => 1,
);
sub new
{
my $class = shift;
my %cnf;
if (@_ == 1) {
my $type = (ref($_[0]) eq "SCALAR") ? "doc" : "file";
%cnf = ($type => $_[0]);
}
else {
unshift @_, (ref($_[0]) eq "SCALAR") ? "doc" : "file" if(scalar(@_) % 2 == 1);
%cnf = @_;
}
my $textify = delete $cnf{textify} || {img => "alt", applet => "alt"};
my $self = $class->SUPER::new(%ARGS, %cnf) || return undef;
$self->{textify} = $textify;
$self;
}
sub get_tag
{
my $self = shift;
my $token;
while (1) {
$token = $self->get_token || return undef;
my $type = shift @$token;
next unless $type eq "S" || $type eq "E";
substr($token->[0], 0, 0) = "/" if $type eq "E";
return $token unless @_;
for (@_) {
return $token if $token->[0] eq $_;
}
}
}
sub _textify {
my($self, $token) = @_;
my $tag = $token->[1];
return undef unless exists $self->{textify}{$tag};
my $alt = $self->{textify}{$tag};
my $text;
if (ref($alt)) {
$text = &$alt(@$token);
} else {
$text = $token->[2]{$alt || "alt"};
$text = "[\U$tag]" unless defined $text;
}
return $text;
}
sub get_text
{
my $self = shift;
my @text;
while (my $token = $self->get_token) {
my $type = $token->[0];
if ($type eq "T") {
my $text = $token->[1];
decode_entities($text) unless $token->[2];
push(@text, $text);
} elsif ($type =~ /^[SE]$/) {
my $tag = $token->[1];
if ($type eq "S") {
if (defined(my $text = _textify($self, $token))) {
push(@text, $text);
next;
}
} else {
$tag = "/$tag";
}
if (!@_ || grep $_ eq $tag, @_) {
$self->unget_token($token);
last;
}
push(@text, " ")
if $tag eq "br" || !$HTML::Tagset::isPhraseMarkup{$token->[1]};
}
}
join("", @text);
}
sub get_trimmed_text
{
my $self = shift;
my $text = $self->get_text(@_);
$text =~ s/^\s+//; $text =~ s/\s+$//; $text =~ s/\s+/ /g;
$text;
}
sub get_phrase {
my $self = shift;
my @text;
while (my $token = $self->get_token) {
my $type = $token->[0];
if ($type eq "T") {
my $text = $token->[1];
decode_entities($text) unless $token->[2];
push(@text, $text);
} elsif ($type =~ /^[SE]$/) {
my $tag = $token->[1];
if ($type eq "S") {
if (defined(my $text = _textify($self, $token))) {
push(@text, $text);
next;
}
}
if (!$HTML::Tagset::isPhraseMarkup{$tag}) {
$self->unget_token($token);
last;
}
push(@text, " ") if $tag eq "br";
}
}
my $text = join("", @text);
$text =~ s/^\s+//; $text =~ s/\s+$//; $text =~ s/\s+/ /g;
$text;
}
1;
__END__
=head1 NAME
HTML::TokeParser - Alternative HTML::Parser interface
=head1 SYNOPSIS
require HTML::TokeParser;
$p = HTML::TokeParser->new("index.html") ||
die "Can't open: $!";
$p->empty_element_tags(1); # configure its behaviour
while (my $token = $p->get_token) {
#...
}
=head1 DESCRIPTION
The C<HTML::TokeParser> is an alternative interface to the
C<HTML::Parser> class. It is an C<HTML::PullParser> subclass with a
predeclared set of token types. If you wish the tokens to be reported
differently you probably want to use the C<HTML::PullParser> directly.
The following methods are available:
=over 4
=item $p = HTML::TokeParser->new( $filename, %opt );
=item $p = HTML::TokeParser->new( $filehandle, %opt );
=item $p = HTML::TokeParser->new( \$document, %opt );
The object constructor argument is either a file name, a file handle
object, or the complete document to be parsed. Extra options can be
provided as key/value pairs and are processed as documented by the base
classes.
If the argument is a plain scalar, then it is taken as the name of a
file to be opened and parsed. If the file can't be opened for
reading, then the constructor will return C<undef> and $! will tell
you why it failed.
If the argument is a reference to a plain scalar, then this scalar is
taken to be the literal document to parse. The value of this
scalar should not be changed before all tokens have been extracted.
Otherwise the argument is taken to be some object that the
C<HTML::TokeParser> can read() from when it needs more data. Typically
it will be a filehandle of some kind. The stream will be read() until
EOF, but not closed.
A newly constructed C<HTML::TokeParser> differ from its base classes
by having the C<unbroken_text> attribute enabled by default. See
L<HTML::Parser> for a description of this and other attributes that
influence how the document is parsed. It is often a good idea to enable
C<empty_element_tags> behaviour.
Note that the parsing result will likely not be valid if raw undecoded
UTF-8 is used as a source. When parsing UTF-8 encoded files turn
on UTF-8 decoding:
open(my $fh, "<:utf8", "index.html") || die "Can't open 'index.html': $!";
my $p = HTML::TokeParser->new( $fh );
# ...
If a $filename is passed to the constructor the file will be opened in
raw mode and the parsing result will only be valid if its content is
Latin-1 or pure ASCII.
If parsing from an UTF-8 encoded string buffer decode it first:
utf8::decode($document);
my $p = HTML::TokeParser->new( \$document );
# ...
=item $p->get_token
This method will return the next I<token> found in the HTML document,
or C<undef> at the end of the document. The token is returned as an
array reference. The first element of the array will be a string
denoting the type of this token: "S" for start tag, "E" for end tag,
"T" for text, "C" for comment, "D" for declaration, and "PI" for
process instructions. The rest of the token array depend on the type
like this:
["S", $tag, $attr, $attrseq, $text]
["E", $tag, $text]
["T", $text, $is_data]
["C", $text]
["D", $text]
["PI", $token0, $text]
where $attr is a hash reference, $attrseq is an array reference and
the rest are plain scalars. The L<HTML::Parser/Argspec> explains the
details.
=item $p->unget_token( @tokens )
If you find you have read too many tokens you can push them back,
so that they are returned the next time $p->get_token is called.
=item $p->get_tag
=item $p->get_tag( @tags )
This method returns the next start or end tag (skipping any other
tokens), or C<undef> if there are no more tags in the document. If
one or more arguments are given, then we skip tokens until one of the
specified tag types is found. For example:
$p->get_tag("font", "/font");
will find the next start or end tag for a font-element.
The tag information is returned as an array reference in the same form
as for $p->get_token above, but the type code (first element) is
missing. A start tag will be returned like this:
[$tag, $attr, $attrseq, $text]
The tagname of end tags are prefixed with "/", i.e. end tag is
returned like this:
["/$tag", $text]
=item $p->get_text
=item $p->get_text( @endtags )
This method returns all text found at the current position. It will
return a zero length string if the next token is not text. Any
entities will be converted to their corresponding character.
If one or more arguments are given, then we return all text occurring
before the first of the specified tags found. For example:
$p->get_text("p", "br");
will return the text up to either a paragraph of linebreak element.
The text might span tags that should be I<textified>. This is
controlled by the $p->{textify} attribute, which is a hash that
defines how certain tags can be treated as text. If the name of a
start tag matches a key in this hash then this tag is converted to
text. The hash value is used to specify which tag attribute to obtain
the text from. If this tag attribute is missing, then the upper case
name of the tag enclosed in brackets is returned, e.g. "[IMG]". The
hash value can also be a subroutine reference. In this case the
routine is called with the start tag token content as its argument and
the return value is treated as the text.
The default $p->{textify} value is:
{img => "alt", applet => "alt"}
This means that <IMG> and <APPLET> tags are treated as text, and that
the text to substitute can be found in the ALT attribute.
=item $p->get_trimmed_text
=item $p->get_trimmed_text( @endtags )
Same as $p->get_text above, but will collapse any sequences of white
space to a single space character. Leading and trailing white space is
removed.
=item $p->get_phrase
This will return all text found at the current position ignoring any
phrasal-level tags. Text is extracted until the first non
phrasal-level tag. Textification of tags is the same as for
get_text(). This method will collapse white space in the same way as
get_trimmed_text() does.
The definition of <i>phrasal-level tags</i> is obtained from the
HTML::Tagset module.
=back
=head1 EXAMPLES
This example extracts all links from a document. It will print one
line for each link, containing the URL and the textual description
between the <A>...</A> tags:
use HTML::TokeParser;
$p = HTML::TokeParser->new(shift||"index.html");
while (my $token = $p->get_tag("a")) {
my $url = $token->[1]{href} || "-";
my $text = $p->get_trimmed_text("/a");
print "$url\t$text\n";
}
This example extract the <TITLE> from the document:
use HTML::TokeParser;
$p = HTML::TokeParser->new(shift||"index.html");
if ($p->get_tag("title")) {
my $title = $p->get_trimmed_text;
print "Title: $title\n";
}
=head1 SEE ALSO
L<HTML::PullParser>, L<HTML::Parser>
=head1 COPYRIGHT
Copyright 1998-2005 Gisle Aas.
This library is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
=cut
Git/usr/lib/perl5/vendor_perl/Net/SSLeay.pm
+1464
View File
File diff suppressed because it is too large. Load diff
Git/usr/lib/perl5/vendor_perl/Net/SSLeay/Handle.pm
+394
View File
@@ -0,0 +1,394 @@
package Net::SSLeay::Handle;
require 5.005_03;
use strict;
use Socket;
use Net::SSLeay;
require Exporter;
=head1 NAME
Net::SSLeay::Handle - Perl module that lets SSL (HTTPS) sockets be
handled as standard file handles.
=head1 SYNOPSIS
use Net::SSLeay::Handle qw/shutdown/;
my ($host, $port) = ("localhost", 443);
tie(*SSL, "Net::SSLeay::Handle", $host, $port);
print SSL "GET / HTTP/1.0\r\n";
shutdown(\*SSL, 1);
print while (<SSL>);
close SSL;
=head1 DESCRIPTION
Net::SSLeay::Handle allows you to request and receive HTTPS web pages
using "old-fashion" file handles as in:
print SSL "GET / HTTP/1.0\r\n";
and
print while (<SSL>);
If you export the shutdown routine, then the only extra code that
you need to add to your program is the tie function as in:
my $socket;
if ($scheme eq "https") {
tie(*S2, "Net::SSLeay::Handle", $host, $port);
$socket = \*S2;
else {
$socket = Net::SSLeay::Handle->make_socket($host, $port);
}
print $socket $request_headers;
...
=cut
use vars qw(@ISA @EXPORT_OK $VERSION);
@ISA = qw(Exporter);
@EXPORT_OK = qw(shutdown);
$VERSION = '0.61';
my $Initialized; #-- only _initialize() once
my $Debug = 0; #-- pretty hokey
my %Glob_Ref; #-- used to make unique \*S names for versions < 5.6
#== Tie Handle Methods ========================================================
#
# see perldoc perltie for details.
#
#==============================================================================
sub TIEHANDLE {
my ($class, $socket, $port) = @_;
$Debug > 10 and print "TIEHANDLE(@{[join ', ', @_]})\n";
ref $socket eq "GLOB" or $socket = $class->make_socket($socket, $port);
$class->_initialize();
my $ctx = Net::SSLeay::CTX_new() or die_now("Failed to create SSL_CTX $!");
my $ssl = Net::SSLeay::new($ctx) or die_now("Failed to create SSL $!");
my $fileno = fileno($socket);
Net::SSLeay::set_fd($ssl, $fileno); # Must use fileno
my $resp = Net::SSLeay::connect($ssl);
$Debug and print "Cipher '" . Net::SSLeay::get_cipher($ssl) . "'\n";
my $self = bless {
ssl => $ssl,
ctx => $ctx,
socket => $socket,
fileno => $fileno,
}, $class;
return $self;
}
sub PRINT {
my $self = shift;
my $ssl = _get_ssl($self);
my $resp = 0;
for my $msg (@_) {
defined $msg or last;
$resp = Net::SSLeay::write($ssl, $msg) or last;
}
return $resp;
}
sub READLINE {
my $self = shift;
my $ssl = _get_ssl($self);
if (wantarray) {
my @lines;
while (my $line = Net::SSLeay::ssl_read_until($ssl)) {
push @lines, $line;
}
return @lines;
} else {
my $line = Net::SSLeay::ssl_read_until($ssl);
return $line ? $line : undef;
}
}
sub READ {
my ($self, $buf, $len, $offset) = \ (@_);
my $ssl = _get_ssl($$self);
defined($$offset) or
return length($$buf = Net::SSLeay::ssl_read_all($ssl, $$len));
defined(my $read = Net::SSLeay::ssl_read_all($ssl, $$len))
or return undef;
my $buf_len = length($$buf);
$$offset > $buf_len and $$buf .= chr(0) x ($$offset - $buf_len);
substr($$buf, $$offset) = $read;
return length($read);
}
sub WRITE {
my $self = shift;
my ($buf, $len, $offset) = @_;
$offset = 0 unless defined $offset;
# Return number of characters written.
my $ssl = $self->_get_ssl();
return $len if Net::SSLeay::write($ssl, substr($buf, $offset, $len));
return undef;
}
sub CLOSE {
my $self = shift;
my $fileno = $self->{fileno};
$Debug > 10 and print "close($fileno)\n";
Net::SSLeay::free ($self->{ssl});
Net::SSLeay::CTX_free ($self->{ctx});
close $self->{socket};
}
sub FILENO { $_[0]->{fileno} }
=head1 FUNCTIONS
=over
=item shutdown
shutdown(\*SOCKET, $mode)
Calls to the main shutdown() don't work with tied sockets created with this
module. This shutdown should be able to distinquish between tied and untied
sockets and do the right thing.
=cut
sub shutdown {
my ($obj, @params) = @_;
my $socket = UNIVERSAL::isa($obj, 'Net::SSLeay::Handle') ?
$obj->{socket} : $obj;
return shutdown($socket, @params);
}
=item debug
my $debug = Net::SSLeay::Handle->debug()
Net::SSLeay::Handle->debug(1)
Get/set debugging mode. Always returns the debug value before the function call.
if an additional argument is given the debug option will be set to this value.
=cut
sub debug {
my ($class, $debug) = @_;
my $old_debug = $Debug;
@_ >1 and $Debug = $debug || 0;
return $old_debug;
}
#=== Internal Methods =========================================================
=item make_socket
my $sock = Net::SSLeay::Handle->make_socket($host, $port);
Creates a socket that is connected to $post using $port. It uses
$Net::SSLeay::proxyhost and proxyport if set and authentificates itself against
this proxy depending on $Net::SSLeay::proxyauth. It also turns autoflush on for
the created socket.
=cut
sub make_socket {
my ($class, $host, $port) = @_;
$Debug > 10 and print "_make_socket(@{[join ', ', @_]})\n";
$host ||= 'localhost';
$port ||= 443;
my $phost = $Net::SSLeay::proxyhost;
my $pport = $Net::SSLeay::proxyhost ? $Net::SSLeay::proxyport : $port;
my $dest_ip = gethostbyname($phost || $host);
my $host_params = sockaddr_in($pport, $dest_ip);
my $socket = $^V ? undef : $class->_glob_ref("$host:$port");
socket($socket, &PF_INET(), &SOCK_STREAM(), 0) or die "socket: $!";
connect($socket, $host_params) or die "connect: $!";
my $old_select = select($socket); $| = 1; select($old_select);
$phost and do {
my $auth = $Net::SSLeay::proxyauth;
my $CRLF = $Net::SSLeay::CRLF;
print $socket "CONNECT $host:$port HTTP/1.0$auth$CRLF$CRLF";
my $line = <$socket>;
};
return $socket;
}
=back
=cut
#--- _glob_ref($strings) ------------------------------------------------------
#
# Create a unique namespace name and return a glob ref to it. Would be great
# to use the fileno but need this before we get back the fileno.
# NEED TO LOCK THIS ROUTINE IF USING THREADS. (but it is only used for
# versions < 5.6 :)
#------------------------------------------------------------------------------
sub _glob_ref {
my $class = shift;
my $preamb = join("", @_) || "_glob_ref";
my $num = ++$Glob_Ref{$preamb};
my $name = "$preamb:$num";
no strict 'refs';
my $glob_ref = \*$name;
use strict 'refs';
$Debug and do {
print "GLOB_REF $preamb\n";
while (my ($k, $v) = each %Glob_Ref) {print "$k = $v\n"}
print "\n";
};
return $glob_ref;
}
sub _initialize {
$Initialized++ and return;
Net::SSLeay::load_error_strings();
Net::SSLeay::SSLeay_add_ssl_algorithms();
Net::SSLeay::randomize();
}
sub __dummy {
my $host = $Net::SSLeay::proxyhost;
my $port = $Net::SSLeay::proxyport;
my $auth = $Net::SSLeay::proxyauth;
}
#--- _get_self($socket) -------------------------------------------------------
# Returns a hash containing attributes for $socket (= \*SOMETHING) based
# on fileno($socket). Will return undef if $socket was not created here.
#------------------------------------------------------------------------------
sub _get_self { return $_[0]; }
#--- _get_ssl($socket) --------------------------------------------------------
# Returns a the "ssl" attribute for $socket (= \*SOMETHING) based
# on fileno($socket). Will cause a warning and return undef if $socket was not
# created here.
#------------------------------------------------------------------------------
sub _get_ssl {
return $_[0]->{ssl};
}
1;
__END__
=head2 USING EXISTING SOCKETS
One of the motivations for writing this module was to avoid
duplicating socket creation code (which is mostly error handling).
The calls to tie() above where it is passed a $host and $port is
provided for convenience testing. If you already have a socket
connected to the right host and port, S1, then you can do something
like:
my $socket \*S1;
if ($scheme eq "https") {
tie(*S2, "Net::SSLeay::Handle", $socket);
$socket = \*S2;
}
my $last_sel = select($socket); $| = 1; select($last_sel);
print $socket $request_headers;
...
Note: As far as I know you must be careful with the globs in the tie()
function. The first parameter must be a glob (*SOMETHING) and the
last parameter must be a reference to a glob (\*SOMETHING_ELSE) or a
scaler that was assigned to a reference to a glob (as in the example
above)
Also, the two globs must be different. When I tried to use the same
glob, I got a core dump.
=head2 EXPORT
None by default.
You can export the shutdown() function.
It is suggested that you do export shutdown() or use the fully
qualified Net::SSLeay::Handle::shutdown() function to shutdown SSL
sockets. It should be smart enough to distinguish between SSL and
non-SSL sockets and do the right thing.
=head1 EXAMPLES
use Net::SSLeay::Handle qw/shutdown/;
my ($host, $port) = ("localhost", 443);
tie(*SSL, "Net::SSLeay::Handle", $host, $port);
print SSL "GET / HTTP/1.0\r\n";
shutdown(\*SSL, 1);
print while (<SSL>);
close SSL;
=head1 TODO
Better error handling. Callback routine?
=head1 CAVEATS
Tying to a file handle is a little tricky (for me at least).
The first parameter to tie() must be a glob (*SOMETHING) and the last
parameter must be a reference to a glob (\*SOMETHING_ELSE) or a scaler
that was assigned to a reference to a glob ($s = \*SOMETHING_ELSE).
Also, the two globs must be different. When I tried to use the same
glob, I got a core dump.
I was able to associate attributes to globs created by this module
(like *SSL above) by making a hash of hashes keyed by the file head1.
Support for old perls may not be 100%. If in trouble try 5.6.0 or
newer.
=head1 CHANGES
Please see Net-SSLeay-Handle-0.50/Changes file.
=head1 KNOWN BUGS
If you let this module construct sockets for you with Perl versions
below v.5.6 then there is a slight memory leak. Other upgrade your
Perl, or create the sockets yourself. The leak was created to let
these older versions of Perl access more than one Handle at a time.
=head1 AUTHOR
Jim Bowlin jbowlin@linklint.org
=head1 SEE ALSO
Net::SSLeay, perl(1), http://openssl.org/
=cut
Git/usr/lib/perl5/vendor_perl/SVN/Base.pm
+118
View File
@@ -0,0 +1,118 @@
package SVN::Base;
=head1 NAME
SVN::Base - Base class for importing symbols for svn modules
=head1 SYNOPSIS
# Load the svn_ra_* functions into the SVN::Ra namespace.
package SVN::Ra;
use SVN::Base qw(Ra svn_ra_);
# Load svn_config_t structure accessors in the magic namcespace
# provided by swig, so we could use it returned by other functions
package _p_svn_config_t;
use SVN::Base qw(Core svn_config_);
=head1 DESCRIPTION
SVN::Base is a module importing the subversion perl bindings raw
symbols created by swig, into proper namespace and make them easier to
use.
It will also find the accessors for members of a C struct, create an
simpler accessor function like C<$data-E<gt>field()> and
C<$data-E<gt>field($new_value)>.
Once you understand the convention of subversion functions in perl
bindings, you could look at the subversion api and write them in perl.
The API is available in the source header files or online at
http://svn.collab.net/svn-doxygen/.
=head1 INTERNALS
The perl bindings of swig wraps raw functions into different perl
modules, for example, SVN::_Core, SVN::_Repos. Upon import, SVN::Base
bootstrap the requested module if it's not yet loaded, and iterate
over the symbols provided in that module, it them puts the function
with prefix trimmed in the namespace of the caller for this import.
The 3rd through the last parameter is a list of symbol endings that
you wish for SVN::Base not to import into your namespace. This is useful
for cases where you may want to import certain symbols differently than
normally.
=head1 CAVEATS
SVN::Base consider a function as structure member accessor if it is
postfixed ``_get'' or ``_set''. Real functions with this postfixes
will need extra handling.
=cut
sub import {
my (undef, $pkg, $prefix, @ignore) = @_;
no warnings 'uninitialized';
unless (${"SVN::_${pkg}::ISA"}[0] eq 'DynaLoader') {
@{"SVN::_${pkg}::ISA"} = qw(DynaLoader);
eval qq'
package SVN::_$pkg;
require DynaLoader;
bootstrap SVN::_$pkg;
1;
' or die $@;
};
my $caller = caller(0);
my $prefix_re = qr/(?i:$prefix)/;
my $ignore_re = join('|', @ignore);
for (keys %{"SVN::_${pkg}::"}) {
my $name = $_;
next unless s/^$prefix_re//;
next if $ignore_re && m/$ignore_re/;
# insert the accessor
if (m/(.*)_get$/) {
my $member = $1;
*{"${caller}::$1"} = sub {
&{"SVN::_${pkg}::${prefix}${member}_".
(@_ > 1 ? 'set' : 'get')}(@_)
}
}
elsif (m/(.*)_set$/) {
}
else {
*{"${caller}::$_"} = ${"SVN::_${pkg}::"}{$name};
}
}
}
=head1 AUTHORS
Chia-liang Kao E<lt>clkao@clkao.orgE<gt>
=head1 COPYRIGHT
Licensed to the Apache Software Foundation (ASF) under one
or more contributor license agreements. See the NOTICE file
distributed with this work for additional information
regarding copyright ownership. The ASF licenses this file
to you under the Apache License, Version 2.0 (the
"License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.apache.org/licenses/LICENSE-2.0
Unless required by applicable law or agreed to in writing,
software distributed under the License is distributed on an
"AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
KIND, either express or implied. See the License for the
specific language governing permissions and limitations
under the License.
=cut
1;
Git/usr/lib/perl5/vendor_perl/SVN/Client.pm
+1887
View File
File diff suppressed because it is too large. Load diff
Git/usr/lib/perl5/vendor_perl/SVN/Core.pm
+1238
View File
File diff suppressed because it is too large. Load diff
Git/usr/lib/perl5/vendor_perl/SVN/Delta.pm
+211
View File
@@ -0,0 +1,211 @@
use strict;
use warnings;
package SVN::Delta;
use SVN::Base qw(Delta svn_delta_);
=head1 NAME
SVN::Delta - Subversion delta functions
=head1 SYNOPSIS
require SVN::Core;
require SVN::Repos;
require SVN::Delta;
# driving an editor
my $editor = SVN::Delta::Editor->
new(SVN::Repos::get_commit_editor($repos, "file://$repospath",
'/', 'root', 'FOO', \&committed));
my $rootbaton = $editor->open_root(0);
my $fbaton = $editor->add_file('filea', $rootbaton,
undef, -1);
my $ret = $editor->apply_textdelta($fbaton, undef);
SVN::TxDelta::send_string("FILEA CONTENT", @$ret);
# implement an editor in perl
SVN::Repos::dir_delta($root1, $path, undef,
$root2, $path,
SVN::Delta::Editor->new(_debug=>1),
1, 1, 0, 1
=head1 DESCRIPTION
SVN::Delta wraps delta related function in subversion. The most
important one is SVN::Delta::Editor, the interface for describing tree
deltas. by default SVN::Delta::Editor relays method calls to its
internal member C<_editor>, which could either be an editor in C (such
as the one you get from get_commit_editor), or another
SVN::Delta::Editor object.
=head1 SVN::Delta::Editor
=head2 Driving Editors
If you want to drive a native editor (such as commit_editor obtained
by SVN::Repos::get_commit_editor), create a SVN::Delta::Editor object
with the native editor/baton pair. The object will then be ready to
use and its method calls will be relayed to the native editor.
=head2 Implementing Editors
If you want to implement an editor, subclass SVN::Delta::Editor and
implement the editors callbacks. see the METHODS section below.
=head2 CONSTRUCTOR - new(...)
=over
=item new($editor, $editor_baton)
Link to the native editor
=back
You can also pass a hash array to new:
=over
=item _debug
Turn on debug.
=item _editor
An arrayref of the editor/baton pair or another SVN::Delta::Editor
object to link with.
=back
=head2 METHODS
Please consult the svn_delta.h section in the Subversion API. Member
functions of svn_delta_editor_t could be called as methods of
SVN::Delta::Editor objects, with the edit_baton omitted. The pool is
also optional.
If you are subclassing, the methods take exactly the same arguments as
the member functions (note that void ** are returned data though as
throughout the perl bindings), with the edit_baton omitted.
=cut
package SVN::TxDelta;
use SVN::Base qw(Delta svn_txdelta_ apply);
*new = *SVN::_Delta::svn_txdelta;
# special case for backward compatibility. When called with an additional
# argument "md5", it's the old style and don't return the md5.
# Note that since the returned m5 is to be populated upon the last window
# sent to the handler, it's not currently working to magically change things
# in Perl land.
sub apply {
if (@_ == 5 || (@_ == 4 && ref($_[-1]) ne 'SVN::Pool' && ref($_[-1]) ne '_p_apr_pool_t')) {
splice(@_, 3, 1);
my @ret = SVN::_Delta::svn_txdelta_apply(@_);
return @ret[1,2];
}
goto \&SVN::_Delta::svn_txdelta_apply;
}
package _p_svn_txdelta_op_t;
use SVN::Base qw(Delta svn_txdelta_op_t_);
package _p_svn_txdelta_window_t;
use SVN::Base qw(Delta svn_txdelta_window_t_);
package SVN::Delta::Editor;
use SVN::Base qw(Delta svn_delta_editor_);
*invoke_set_target_revision = *SVN::_Delta::svn_delta_editor_invoke_set_target_revision;
sub convert_editor {
my $self = shift;
$self->{_editor} = $_[0], return 1
if UNIVERSAL::isa($_[0], __PACKAGE__);
if (ref($_[0]) && $_[0]->isa('_p_svn_delta_editor_t')) {
@{$self}{qw/_editor _baton/} = @_;
return 1;
}
return 0;
}
sub new {
my $class = shift;
my $self = bless {}, $class;
unless ($self->convert_editor(@_)) {
%$self = @_;
$self->convert_editor(@{$self->{_editor}})
if $self->{_editor};
}
return $self;
}
our $AUTOLOAD;
sub AUTOLOAD {
no warnings 'uninitialized';
return unless $_[0]->{_editor};
my $class = ref($_[0]);
my $func = $AUTOLOAD;
$func =~ s/.*:://;
warn "$func: ".join(',',@_)."\n" if $_[0]->{_debug};
return unless $func =~ m/[^A-Z]/;
my %ebaton = ( set_target_revision => 1,
open_root => 1,
close_edit => 1,
abort_edit => 1,
);
my $self = shift;
no strict 'refs';
my @ret = UNIVERSAL::isa($self->{_editor}, __PACKAGE__) ?
$self->{_editor}->$func(@_) :
eval { &{"invoke_$func"}($self->{_editor},
$ebaton{$func} ? $self->{_baton} : (), @_) };
die $@ if $@;
return @ret ? $#ret == 0 ? $ret[0] : [@ret] : undef;
}
=head1 BUGS
Functions returning editor/baton pair should really be typemapped to a
SVN::Delta::Editor object.
=head1 AUTHORS
Chia-liang Kao E<lt>clkao@clkao.orgE<gt>
=head1 COPYRIGHT
Licensed to the Apache Software Foundation (ASF) under one
or more contributor license agreements. See the NOTICE file
distributed with this work for additional information
regarding copyright ownership. The ASF licenses this file
to you under the Apache License, Version 2.0 (the
"License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.apache.org/licenses/LICENSE-2.0
Unless required by applicable law or agreed to in writing,
software distributed under the License is distributed on an
"AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
KIND, either express or implied. See the License for the
specific language governing permissions and limitations
under the License.
=cut
1;
Git/usr/lib/perl5/vendor_perl/SVN/Fs.pm
+503
View File
@@ -0,0 +1,503 @@
use strict;
use warnings;
package SVN::Fs;
use SVN::Base qw(Fs svn_fs_);
=head1 NAME
SVN::Fs - Subversion filesystem functions
=head1 DESCRIPTION
SVN::Fs wraps the functions in svn_fs.h. The actual namespace
for filesystem objects is C<_p_svn_fs_t>.
=head1 FUNCTIONS
=over
=item SVN::Fs::berkeley_logfiles($path, $only_unused)
=item SVN::Fs::berkeley_recover($path)
=item SVN::Fs::check_related($id1, $id2)
=item SVN::Fs::compare_ids($id1, $id2)
=item SVN::Fs::contents_changed($root1, $path1, $root2, $path2)
=item SVN::Fs::create($path, $config)
=item SVN::Fs::delete_fs($path)
=item SVN::Fs::deltify_revision($fs, $rev)
=item SVN::Fs::get_file_delta_stream($source_root, $source_path, $target_root, $target_path)
=item SVN::Fs::hotcopy($src_path, $dest_path, $clean)
=item SVN::Fs::initialize($pool)
=item SVN::Fs::merge($source_root, $source_path, $target_root, $target_path, $ancestor_root, $ancestor_path)
=item SVN::Fs::open($path, $config)
=item SVN::Fs::path($fs)
=item SVN::Fs::print_modules($s)
TODO - doesn't work, segfaults if $s is null, doesn't do anything if
its an empty string
=item SVN::Fs::props_changed($root1, $path1, $root2, $path2)
See also C<SVN::Fs::contents_changed>
=item SVN::Fs::purge_txn($fs, $txn_id)
Cleanup the transaction C<$txn_id>, removing it completely from
the filesystem C<$fs>.
=item SVN::Fs::set_warning_func($fs, $code, $baton)
=item SVN::Fs::unparse_id($id)
Return a string containing the unparsed form of the node or node
revision id $id, which must be a C<_p_svn_fs_id_t> object.
TODO - why isn't this a method of that object?
=item SVN::Fs::version()
TODO - what can we do with the _p_svn_version_t value returned?
=item SVN::Fs::create_access($username)
Return a new C<_p_svn_fs_access_t> object representing C<$username>.
C<$username> is presumed to have been authenticated by the caller.
=back
=cut
package _p_svn_fs_t;
=head1 _p_svn_fs_t
=over
=item $fs-E<gt>begin_txn($rev)
Creates a new transaction in the repository, and returns a
C<_p_svn_fs_txn_t> object representing it. The new transaction's
base revision will be $rev, which should be a number.
=item $fs-E<gt>change_rev_prop
=item $fs-E<gt>generate_lock_token()
Generate a unique lock-token using C<$fs>.
TODO - translate this to apply to Perl:
This can be used in to populate lock-E<gt>token before calling
svn_fs_attach_lock().
=item $fs-E<gt>get_access()
The filesystem's current access context, as a C<_p_svn_fs_access_t>
object. Returns undef if no access context has been set with
the C<set_access()> method.
=item $fs-E<gt>get_lock
=item $fs-E<gt>get_locks
=item $fs-E<gt>get_uuid()
The UUID associated with C<$fs>.
=item $fs-E<gt>list_transactions()
A reference to an array of all currently active transactions in the
filesystem. Each one is a string containing the transaction's ID,
suitable for passing to C<$fs-E<gt>open_txn()>.
=item $fs-E<gt>lock
=item $fs-E<gt>open_txn($name)
Get a transaction in the repository by name. Returns a
C<_p_svn_fs_txn_t> object.
=item $fs-E<gt>revision_prop($rev, $propname)
The value of revision property C<$propname> in revision C<$rev>.
=item $fs-E<gt>revision_proplist($rev)
A hashref containing the names and values of all revision properties
from revision C<$rev>.
=item $fs-E<gt>revision_root
=item $fs-E<gt>set_access($access)
Associate an access context with an open filesystem.
This method can be run multiple times on the same open
filesystem, in order to change the filesystem access context for
different filesystem operations. C<$access> should be
a C<_p_svn_fs_access_t> object, or undef to disassociate the
current access context from the filesystem.
=item $fs-E<gt>set_uuid($uuid)
Associate C<$uuid> with C<$fs>.
=item $fs-E<gt>unlock
=item $fs-E<gt>youngest_rev()
Return the number of the youngest revision in the filesystem.
The oldest revision in any filesystem is numbered zero.
=back
=cut
our @methods = qw/ youngest_rev revision_root revision_prop revision_proplist
change_rev_prop list_transactions open_txn begin_txn
get_uuid set_uuid set_access get_access
lock unlock get_lock get_locks generate_lock_token path /;
for (@methods) {
no strict 'refs';
*{$_} = *{"SVN::Fs::$_"};
}
package _p_svn_fs_root_t;
=head1 _p_svn_fs_root_t
=over
=item $root-E<gt>apply_text
=item $root-E<gt>apply_textdelta
=item $root-E<gt>change_node_prop($path, $propname, $value)
=item $root-E<gt>check_path($path)
Kind of node at C<$path>. A number which matches one of these constants:
$SVN::Node::none, $SVN::Node::file,
$SVN::Node::dir, $SVN::Node::unknown.
=item $root-E<gt>close_root
=item $root-E<gt>closest_copy
=item $root-E<gt>copied_from
=item $root-E<gt>copy
=item $root-E<gt>delete
=item $root-E<gt>dir_entries
=item $root-E<gt>file_contents
=item $root-E<gt>file_length
=item $root-E<gt>file_md5_checksum
=item $root-E<gt>fs()
The filesystem to which C<$root> belongs, as a C<_p_svn_fs_t> object.
=item $root-E<gt>is_dir($path)
True if there is a node at C<$path> which is a directory.
=item $root-E<gt>is_file($path)
True if there is a node at C<$path> which is a file.
=item $root-E<gt>is_revision_root()
True if the root comes from a revision (i.e., the contents has already been
committed).
=item $root-E<gt>is_txn_root()
True if the root comes from a transaction.
=item $root-E<gt>make_dir
=item $root-E<gt>make_file
=item $root-E<gt>node_created_path($path)
=item $root-E<gt>node_created_rev($path)
=item $root-E<gt>node_history($path)
TODO - _p_svn_fs_history_t
=item $root-E<gt>node_id($path)
=item $root-E<gt>node_prop($path, $propname)
=item $root-E<gt>node_proplist($path)
=item $root-E<gt>paths_changed()
A reference to a hash indicating what changes are made in the root.
The keys are the paths of the files changed, starting with C</> to
indicate the top-level directory of the repository. The values
are C<_p_svn_fs_path_change_t> objects which contain information about
what kind of changes are made.
=item $root-E<gt>revision_link
=item $root-E<gt>revision_root_revision
Revision number of the revision the root comes from.
For transaction roots, returns C<$SVN::Core::INVALID_REVNUM>.
=back
=cut
our @methods = qw/ apply_textdelta apply_text change_node_prop
check_path close_root copied_from copy
dir_entries delete file_contents closest_copy
file_length file_md5_checksum is_dir is_file
is_revision_root is_txn_root make_dir make_file
node_created_rev node_history node_id node_prop
node_proplist paths_changed revision_link
revision_root_revision /;
*fs = *SVN::Fs::root_fs;
*txn_name = *_p_svn_fs_txn_t::root_name;
for (@methods) {
no strict 'refs';
*{$_} = *{"SVN::Fs::$_"};
}
package _p_svn_fs_history_t;
use SVN::Base qw(Fs svn_fs_history_);
=head1 _p_svn_fs_history_t
=over
=item $history-E<gt>location()
In list context, a list of two items: the path to the node whose history
this is, and the revision number in which it exists. In scalar context
returns only the revision number.
=item $history-E<gt>prev($cross_copies)
=back
=cut
package _p_svn_fs_txn_t;
use SVN::Base qw(Fs svn_fs_txn_);
=head1 _p_svn_fs_txn_t
=over
=item $txn-E<gt>abort()
Abort the transaction. Any changes made in C<$txn> are discarded, and
the filesystem is left unchanged.
Note: This function first sets the state of C<$txn> to 'dead', and
then attempts to purge it and any related data from the filesystem.
If some part of the cleanup process fails, C<$txn> and some portion
of its data may remain in the database after this function returns.
Use C<$fs-E<gt>purge_txn()> to retry the transaction cleanup.
=item $txn-E<gt>base_revision()
The transaction's base revision number.
=item $txn-E<gt>change_prop($name, $value)
Add, change, or remove a property from the transaction.
If C<$value> is C<undef> then the property C<$name> is removed,
if it exists. Otherwise the property C<$name> is set to the
new value.
=item $txn-E<gt>commit
=item $txn-E<gt>name()
Full name of the revision, in the same format as can be passed
to C<$fs-E<gt>open_txn()>.
=item $txn-E<gt>prop($name)
The value of the transaction's C<$name> property.
=item $txn-E<gt>proplist()
A reference to a hash containing all the transaction's properties,
keyed by name.
=item $txn-E<gt>root()
The root directory of the transaction, as a C<_p_svn_fs_root_t> object.
=back
=cut
*commit = *SVN::Fs::commit_txn;
*abort = *SVN::Fs::abort_txn;
*change_prop = *SVN::Fs::change_txn_prop;
package _p_svn_fs_access_t;
use SVN::Base qw(Fs svn_fs_access_);
=head1 _p_svn_fs_access_t
=head2 SYNOPSIS
my $access = SVN::Fs::create_access($username);
my $access = $fs->get_access;
$fs->set_access($access);
my $username = $access->get_username;
$access->add_lock_token($token);
=head2 METHODS
=over
=item $access-E<gt>add_lock_token($token)
Push a lock-token into the access context. The
context remembers all tokens it receives, and makes them available
to fs functions.
=item $access-E<gt>get_username
The username represented by the access context.
=back
=cut
package _p_svn_fs_dirent_t;
use SVN::Base qw(Fs svn_fs_dirent_t_);
=head1 svn_fs_dirent_t
An object representing a directory entry. Values of this type are returned
as the values in the hash returned by C<$root-E<gt>dir_entries()>. They
are like L<svn_dirent_t|SVN::Core/svn_dirent_t> objects, but have less
information.
=over
=item $dirent-E<gt>id()
TODO
=item $dirent-E<gt>kind()
Node kind. A number which matches one of these constants:
$SVN::Node::none, $SVN::Node::file,
$SVN::Node::dir, $SVN::Node::unknown.
=item $dirent-E<gt>name()
The filename of the directory entry.
=back
=cut
package _p_svn_fs_path_change_t;
use SVN::Base qw(Fs svn_fs_path_change_t_);
=head1 _p_svn_fs_path_change_t
=over
=item $change-E<gt>change_kind()
The type of change made. A number which matches one of the following:
=over
=item $SVN::Fs::PathChange::modify
Content at path modified.
=item $SVN::Fs::PathChange::add
Path added in transaction.
=item $SVN::Fs::PathChange::delete
Path removed in transaction.
=item $SVN::Fs::PathChange::replace
Path removed and re-added in transaction.
=item $SVN::Fs::PathChange::reset
Ignore all previous change items for path (internal-use only).
=back
=item $change-E<gt>node_rev_id()
Node revision id of changed path. A C<_p_svn_fs_id_t> object.
=item $change-E<gt>prop_mod()
True if the properties were modified.
=item $change-E<gt>text_mod()
True if the text (content) was modified.
=back
=head1 COPYRIGHT
Licensed to the Apache Software Foundation (ASF) under one
or more contributor license agreements. See the NOTICE file
distributed with this work for additional information
regarding copyright ownership. The ASF licenses this file
to you under the Apache License, Version 2.0 (the
"License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.apache.org/licenses/LICENSE-2.0
Unless required by applicable law or agreed to in writing,
software distributed under the License is distributed on an
"AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
KIND, either express or implied. See the License for the
specific language governing permissions and limitations
under the License.
=cut
package SVN::Fs::PathChange;
use SVN::Base qw(Fs svn_fs_path_change_);
1;
Git/usr/lib/perl5/vendor_perl/SVN/Ra.pm
+685
View File
@@ -0,0 +1,685 @@
use strict;
use warnings;
package SVN::Ra;
use SVN::Base qw(Ra);
use File::Temp;
=head1 NAME
SVN::Ra - Subversion remote access functions
=head1 SYNOPSIS
use SVN::Core;
use SVN::Ra;
my $ra = SVN::Ra->new('file:///tmp/svntest');
print $ra->get_latest_revnum;
=head1 DESCRIPTION
SVN::Ra wraps the object-oriented C<svn_ra_plugin_t> functions,
providing access to a Subversion repository though a URL, using
whichever repository access module is appropriate.
=head1 SVN::Ra
=head2 SVN::Ra-E<gt>new(...)
The constructor creates an RA object and calls C<open> for it. Its parameters
are either a hash of options or a single value containing the URL of the
repository. Valid options are:
=over
=item url
The URL of the repository.
=item auth
An C<auth_baton> could be given to the SVN::RA object. Defaults to an
C<auth_provider> with a C<username_provider>. See L<SVN::Client> for how to
create C<auth_baton>.
=item pool
The pool for the RA session to use. Member functions will also be
called with this pool. Defaults to a newly created root pool.
=item config
The config hash that could be obtained by calling
C<SVN::Core::config_get_config(undef)>.
=item callback
The C<ra_callback> namespace to use. Defaults to SVN::Ra::Callbacks.
=back
The following examples will both do the same thing, with all the optional
arguments taking their defaults:
my $ra = SVN::Ra->new('file:///tmp/repos');
my $ra = SVN::Ra->new(url => 'file:///tmp/repos');
=head2 METHODS
Please consult the svn_ra.h section in the Subversion API. Member
functions of C<svn_ra_plugin_t> can be called as methods of SVN::Ra
objects, with the C<session_baton> and C<pool> arguments omitted.
=over
=item $ra-E<gt>change_rev_prop($revnum, $name, $value)
Sets the revision (unversioned) property C<$name> to C<$value> on
revision C<$revnum>, or removes the property if C<$value> is undef.
$ra->change_rev_prop(123, 'svn:log', 'New log message.');
Of course this will only work if there is a C<pre-revprop-change>
hook available.
=item $ra-E<gt>check_path($path, $revnum)
Kind of node at C<$path> in revision C<$revnum>. A number which matches one
of these constants:
$SVN::Node::none, $SVN::Node::file,
$SVN::Node::dir, $SVN::Node::unknown.
=item $ra-E<gt>do_diff($revision, $target, $recurse, $ignore_ancestry, $versus_url, $editor)
=item $ra-E<gt>do_diff2($revision, $target, $recurse, $ignore_ancestry, $text_deltas, $versus_url, $editor)
Both of these return a L<SVN::Ra::Reporter> with which you can describe
a working copy. It will then call methods on C<$editor> to indicates
the differences between the repository and the working copy.
The C<do_diff2> method was added in S<Subversion 1.4>. It adds the
C<$text_deltas> option, which if false disables the generation of text
deltas on the editor. With C<do_diff> text deltas are always generated.
my $reporter = $ra->do_diff(1, '', 1, 0, $repos_url,
MyEditor->new);
$reporter->set_path(...);
$reporter->finish_report;
=item $ra-E<gt>do_status($target, $revision, $recurse, $editor)
Returns a L<SVN::Ra::Reporter> to which you can describe the status of
a working copy. It will then call methods on C<$editor> to describe
the current status of the working copy compared to the repository.
=item $ra-E<gt>do_switch($revnum, $target, $recurse, $repos_url, $editor)
Returns a L<SVN::Ra::Reporter> with which you can describe a working copy.
It will then call methods on C<$editor> to indicate how to adjust the working
copy to switch it to revision C<$revnum> of C<$repos_url>.
=item $ra-E<gt>do_update($revision_to_update_to, $target, $recurse, $editor)
Returns a L<SVN::Ra::Reporter> object. Call methods on the reporter to
describe the current state of your working copy (or whatever you're
updating). After calling the reporter's C<finish_report()> method,
Subversion will generate calls to your C<$editor> to describe the
differences between what you already have and the state of the repository in
C<$revision_to_update_to>.
To update to the latest revision, pass C<$SVN::Core::INVALID_REVNUM> for
the first argument.
C<$target> should be the path to the part of the repository you are
interested in. You won't be given information about changes outside this
path. If you want everything, pass an empty string.
If C<$recurse> is true and the target is a directory, update
recursively; otherwise, update just the target and its immediate
entries, but not its child directories (if any).
All paths are relative to the URL used to open C<$ra>.
The caller may not perform any RA operations using C<$ra> before
finishing the report, and may not perform any RA operations using
C<$ra> from within the editing operations of C<$editor>.
This example shows the simplest update, where the client tells the reporter
that it has nothing to start with:
my $reporter = $ra->do_update($revnum, '', 1, MyEditor->new);
$reporter->set_path('', 0, 1, undef);
$reporter->finish_report;
=item $ra-E<gt>get_commit_editor($logmsg, $callback, $callback_baton, $lock_tokens, $keep_locks)
=item $ra-E<gt>get_commit_editor2($logmsg, $callback, $callback_baton, $lock_tokens, $keep_locks)
Return an opaque editor object for committing a new revision to the
repository. The return values should be passed to the
L<SVN::Delta::Editor|SVN::Delta/SVN::Delta::Editor> constructor to create an
editor object you can actually use. For example:
my $editor = SVN::Delta::Editor->new(
$ra->get_commit_editor(
"I'm going to commit some changes from within my Perl code.",
\&commit_callback, undef, {}, 0));
Now that you've got your editor you can call methods on it to describe
changes in the tree you want to make, such as adding directories, changing
file contents, etc. See L<SVN::Delta> for documentation of the editor
interface.
The C<$callback> function will be called during your call to the
C<$ed-E<gt>close_edit()> method, after the commit has succeeded. It will
not be called if there were no changes to commit. If you don't need it,
pass undef instead of a code ref.
C<get_commit_editor2> is identical to C<get_commit_editor> except for
the information passed to the callback function. The new version, added
in S<Subversion 1.4>, will pass the callback a single value (TODO: I
can' test this, but it's probably an object or hash ref) which contains
all the information. It also includes the error message from the
post-commit hook script, which is not available with C<get_commit_editor>.
The callback for the original version will be passed three arguments:
=over
=item *
Number of the new revision.
=item *
Date and time that the revision was committed, which will be exactly
the same value as its C<svn:date> revision property. It will be in
this format: C<2006-04-05T12:17:48.180320Z>
=item *
The name of the author who committed the revision, which will be the same
as the C<svn:author> revision property.
=back
The undef in the argument list in the example above is the baton which is
meant to be passed to the commit callback, but it isn't. This isn't a
problem since you can supply a closure as the callback so that it can get to
whatever variables you need.
The C<$logmsg> value should be a string which will be stored in the
C<svn:log> revision property. If undef is passed instead then the
new revision won't have a C<svn:log> property.
C<$lock_tokens> should be a reference to a hash mapping the paths to
lock tokens to use for them. I seems that with S<Subversion 1.2> this is
required, so if you aren't using any locks simply pass C<{}>. In
S<Subversion 1.3.1> though it seems to be necessary to I<not> pass this
argument at all.
If C<$keep_locks> is true then locks on the files committed won't be
released by the commit.
The C<get_commit_editor()> method itself returns a list of two items, the
first of which (a C<_p_svn_delta_editor_t> object) is the actual editor.
The second is the editor baton. Neither is of any use without wrapping the
pair of them in a L<SVN::Delta::Editor>.
=item $ra-E<gt>get_dated_revision($time)
TODO - this doesn't seem to work in S<Subversion 1.3>.
=item $ra-E<gt>get_dir($path, $revnum)
=item $ra-E<gt>get_dir2($path, $revnum, $dirent_fields)
Fetch the directory entries and properties of the directory at C<$path>
in revision C<$revnum>
A list of three values are returned. The first is a reference to a hash
of directory entries. The keys are the names of all the files and
directories in C<$path> (not full paths, just the filenames). The values
are L<_p_svn_dirent_t|SVN::Core/_p_svn_dirent_t> objects, with all their
fields filled in. The third parameter to C<get_dir2> allows you to
select particular fields. TODO: I don't think the constants you'd use
to construct the C<$dirent_fields> value are provided in the Perl API.
The second value is a number, which is only valid if C<$revnum> is
C<$SVN::Core::INVALID_REVNUM>. If that is the case then the latest revision
will be fetched, and the revision number (the HEAD revision) will be returned
as the second value. Otherwise the revision number returned will be
completely arbitrary.
The third value returned will be a reference to a hash of all properties
on the directory. This means I<all> properties: not just ones controlled by
the user and stored in the repository fs, but non-tweakable ones
generated by the SCM system itself (e.g. 'wcprops', 'entryprops', etc).
my ($dirents, undef, $props) = $ra->get_dir('trunk/dir', 123);
my ($dirents, $fetched_revnum, $props) = $ra->get_dir(
'trunk/dir', $SVN::Core::INVALID_REVNUM);
=item $ra-E<gt>get_file($path, $revnum, $fh)
Fetch the contents and properties of the file at C<$path> in revision
C<$revnum>. C<$fh> should be a Perl filehandle, to which the contents
of the file will be written, or undef if you don't need the file contents.
Note that C<$path> cannot end in a slash unless it is just '/'.
A list of two values are returned. The first is a number, which is only
valid if C<$revnum> is C<$SVN::Core::INVALID_REVNUM>. If that is the
case then the latest revision will be fetched, and the revision number
(the HEAD revision) will be returned as the first value. Otherwise the
number returned will be completely arbitrary.
The second value returned will be a reference to a hash of all properties
on the file. This means I<all> properties: not just ones controlled by
the user and stored in the repository fs, but non-tweakable ones
generated by the SCM system itself (e.g. 'wcprops', 'entryprops', etc).
my (undef, $props) = $ra->get_file(
'trunk/foo', 123, undef);
open my $fh, '>', 'tmp_out'
or die "error opening file: $!";
my (undef, $props) = $ra->get_file(
'trunk/foo', 123, $fh);
my ($fetched_revnum, $props) = $ra->get_file(
'trunk/foo', $SVN::Core::INVALID_REVNUM, $fh);
=item $ra-E<gt>get_file_revs($path, $start, $end, \&callback)
TODO - doesn't seem to work in Subversion 1.3
=item $ra-E<gt>get_latest_revnum
Return the number of the latest revision in the repository (HEAD).
=item $ra-E<gt>get_locations($path, $peg_revnum, \@location_revisions)
TODO - doesn't seem to work in Subversion 1.3
=item $ra-E<gt>get_lock($path)
Returns a L<_p_svn_lock_t|SVN::Core/_p_svn_lock_t> object containing
information about the lock at C<$path>, or undef if that path isn't
currently locked.
=item $ra-E<gt>get_locks($path)
TODO - doesn't seem to work in Subversion 1.3
=item $ra-E<gt>get_log(\@paths, $start, $end, $limit, $discover_changed_paths, $strict_node_history, \&callback)
For C<$limit> revisions from C<$start> to C<$end>, invoke the receiver
C<callback()> with information about the changes made in the revision
(log message, time, etc.).
The caller may not invoke any RA operations using C<$ra> from
within the callback function. They may work in some situations, but
it's not guaranteed.
The first argument can be either a single string or a reference to an
array of strings. Each of these indicates a path in the repository
which you are interested in. Revisions which don't change any of these
paths (or files below them) will be ignored. Simply pass '' if you don't
want to limit by path.
C<$start> and C<$end> should be revision numbers. If C<$start> has a lower
value than C<$end> then the revisions will be produced in ascending order
(r1, r2, ...), otherwise in descending order. If C<$start> is
C<$SVN::Core::INVALID_REVNUM> then it defaults to the latest revision.
TODO - the previous sentence should also be true of $end, but doing that
gets an error message in Subversion 1.3.
C<$limit> is a number indicating the maximum number of times that the
receiver C<callback()> should be called. If it is 0, there will be no
limit.
If C<$discover_changed_paths> is true, then information about which changes
were made to which paths is passed to C<callback()>.
If C<$strict_node_history> is true, copy history will not be traversed
(if any exists) when harvesting the revision logs for each path.
The callback function will be given the following arguments:
=over
=item *
A reference to a hash of paths changed by the revision. Only passed if
C<$discover_changed_paths> is true, otherwise undef is passed in its
place.
The hash's keys are the full paths to the files and directories changed.
The values are L<_p_svn_log_changed_path_t|SVN::Core/_p_svn_log_changed_path_t>
objects.
=item *
Revision number.
=item *
Name of user who made the change, or undef if not known.
=item *
Date and time the revision was committed.
=item *
Log message as a single string, or undef.
=item *
A pool object.
=back
This example prints some of the information received in a simple format,
showing which paths were changed in each revision, for all revisions starting
from the first:
$ra->get_log('', 1, $ra->get_latest_revnum, 0, 1, 0,
\&log_callback);
sub log_callback
{
my ($paths, $revnum, $user, $datetime, $logmsg) = @_;
print "$datetime - $user - r$revnum\n";
while (my ($path, $changes) = each %$paths) {
print $changes->action, " $path\n";
if ($changes->copyfrom_path) {
print " from ", $changes->copyfrom_path,
" r", $changes->copyfrom_rev, "\n"
}
}
print "\n";
}
=item $ra-E<gt>get_repos_root
Returns the repository's root URL. The value will not include
a trailing '/'. The returned URL is guaranteed to be a prefix of the
session's URL.
=item $ra-E<gt>get_uuid
Returns the repository's UUID as a string.
=item $ra-E<gt>lock(\%path_revs, $comment, $steal_lock, \&callback)
TODO - doesn't seem to work in Subversion 1.3.2
=item $ra-E<gt>reparent($url)
Change the root URL of the session in C<$ra> to point to a different
path. C<$url> must be in the same repository as the one C<$ra> is
already accessing.
New in S<Subversion 1.4>.
=item $ra-E<gt>replay($revnum, $low_water_mark, $send_deltas, $editor)
Call methods on C<$editor> to describe the changes made in the revisions
after C<$low_water_mark>, up to revision C<$revnum>. This is like using
C<do_update()>, except that it doesn't return a reporter object, and so
you don't have to describe a working copy to it. It assumes that you've
already got everything up to C<$low_water_mark>.
If C<$send_deltas> is true then file contents and property values will
be supplied, otherwise just filename changes.
New in S<Subversion 1.4>.
=item $ra-E<gt>rev_prop($revnum, $name)
Return the value of the unversioned property C<$name> from revision C<$revnum>.
Returns undef if there is no such property.
print $ra->rev_prop(123, 'svn:date');
=item $ra-E<gt>rev_proplist($revnum)
Returns a reference to a hash containing all the unversioned properties
of revision C<$revnum>.
my $props = $ra->rev_proplist(123);
print $props->{'svn:log'};
=item $ra-E<gt>stat($path, $revnum)
Returns a L<_p_svn_dirent_t|SVN::Core/_p_svn_dirent_t> object containing
information about the file at C<$path> in revision C<$revnum>.
=item $ra-E<gt>unlock(\%path_tokens, $break_lock, \&callback)
TODO - doesn't seem to work in Subversion 1.3.2
=back
=cut
require SVN::Client;
my $ralib = SVN::_Ra::svn_ra_init_ra_libs(SVN::Core->gpool);
# Ra methods that returns reporter
my %reporter = map { $_ => 1 } qw(do_diff do_switch do_status do_update);
our $AUTOLOAD;
sub AUTOLOAD {
my $class = ref($_[0]);
my $method = $AUTOLOAD;
$method =~ s/.*:://;
return unless $method =~ m/[^A-Z]/;
my $self = shift;
no strict 'refs';
my $func = $self->{session}->can($method)
or die "no such method $method";
my @ret = $func->($self->{session}, @_);
# XXX - is there any reason not to use \@ret in this line:
return bless [@ret], 'SVN::Ra::Reporter' if $reporter{$method};
return $#ret == 0 ? $ret[0] : @ret;
}
sub new {
my $class = shift;
my $self = bless {}, $class;
%$self = $#_ ? @_ : (url => $_[0]);
if (defined($self->{auth})) {
if (ref($self->{auth}) ne '_p_svn_auth_baton_t') {
# If the auth is already set to a auth_baton ignore it
# otherwise make an auth_baton and store the callbacks
my ($auth_baton, $auth_callbacks) =
SVN::Core::auth_open_helper($self->{auth});
$self->{auth} = $auth_baton;
$self->{auth_provider_callbacks} = $auth_callbacks;
}
} else {
# no callback to worry about with a username provider so just call
# auth_open directly
$self->{auth} = SVN::Core::auth_open(
[SVN::Client::get_username_provider()]);
}
my $pool = $self->{pool} ||= SVN::Pool->new;
my $callback = 'SVN::Ra::Callbacks';
# custom callback namespace
if ($self->{callback} && !ref($self->{callback})) {
$callback = delete $self->{callback};
}
# instantiate callbacks
$callback = (delete $self->{callback}) || $callback->new(auth => $self->{auth});
$self->{session} = SVN::_Ra::svn_ra_open($self->{url}, $callback, $self->{config} || {}, $pool);
return $self;
}
sub DESTROY { }
package _p_svn_ra_session_t;
use SVN::Base qw(Ra svn_ra_);
package SVN::Ra::Reporter;
use SVN::Base qw(Ra svn_ra_reporter2_);
=head1 SVN::Ra::Reporter
The L<SVN::Ra> methods C<do_diff>, C<do_status>, C<do_switch>, and
C<do_update> all return a SVN::Ra::Reporter object, which can be used
to describe the working copy (or other available data) which the client has.
Subversion uses this to figure out what new information should be provided
through a tree delta editor.
Objects of this class are actually simple wrappers around underlying
C<svn_ra_reporter2_t> objects and their associated baton.
=head2 METHODS
=over
=item $reporter-E<gt>set_path($path, $revision, $start_empty, $lock_token, $pool)
Describe a working copy C<$path> as being at a particular C<$revision>.
If C<$start_empty> is true and C<$path> is a directory, the
implementor should assume the directory has no entries or properties.
This will I<override> any previous C<set_path()> calls made on parent
paths. C<$path> is relative to the URL specified in C<SVN::Ra-E<gt>open()>
or C<SVN::Ra-E<gt>new()>.
If C<$lock_token> is not undef, it is the lock token for C<$path> in the WC.
All temporary allocations are done in C<$pool>.
=item $reporter-E<gt>delete_path($path, $pool)
Describe a working copy C<$path> as missing.
All temporary allocations are done in C<$pool>.
=item $reporter-E<gt>link_path($path, $url, $revision, $start_empty, $lock_token, $pool)
Like C<set_path()>, but differs in that C<$path> in the working copy
(relative to the root of the report driver) isn't a reflection of
C<$path> in the repository (relative to the URL specified when
opening the RA layer), but is instead a reflection of a different
repository C<$url> at C<$revision>.
If C<$start_empty> is true and C<$path> is a directory,
the implementor should assume the directory has no entries or props.
If C<$lock_token> is not undef, it is the lock token for C<$path> in the WC.
All temporary allocations are done in C<$pool>.
=item $reporter-E<gt>finish_report($pool)
Call this when the state report is finished; any directories
or files not explicitly 'set' are assumed to be at the
baseline revision originally passed into C<do_update()>. No other
reporting functions, including C<abort_report()>, should be called after
calling this function.
=item $reporter-E<gt>abort_report($pool)
If an error occurs during a report, this method should cause the
filesystem transaction to be aborted and cleaned up. No other reporting
methods should be called after calling this method.
=back
=cut
our $AUTOLOAD;
sub AUTOLOAD {
my $class = ref($_[0]);
$AUTOLOAD =~ s/^${class}::(SUPER::)?//;
return if $AUTOLOAD =~ m/^[A-Z]/;
my $self = shift;
no strict 'refs';
my $method = $self->can("invoke_$AUTOLOAD")
or die "no such method $AUTOLOAD";
no warnings 'uninitialized';
$method->(@$self, @_);
}
package SVN::Ra::Callbacks;
=head1 SVN::Ra::Callbacks
This is the wrapper class for C<svn_ra_callback_t>. To supply custom
callbacks to SVN::Ra, subclass this class and override the member
functions.
=cut
require SVN::Core;
sub new {
my $class = shift;
my $self = bless {}, $class;
%$self = @_;
return $self;
}
sub open_tmp_file {
local $^W; # silence the warning for unopened temp file
my ($self, $pool) = @_;
my ($fd, $name) = SVN::Core::io_open_unique_file(
( File::Temp::tempfile(
'XXXXXXXX', OPEN => 0, DIR => File::Spec->tmpdir
))[1], 'tmp', 1, $pool
);
return $fd;
}
sub get_wc_prop {
return undef;
}
=head1 AUTHORS
Chia-liang Kao E<lt>clkao@clkao.orgE<gt>
=head1 COPYRIGHT
Licensed to the Apache Software Foundation (ASF) under one
or more contributor license agreements. See the NOTICE file
distributed with this work for additional information
regarding copyright ownership. The ASF licenses this file
to you under the Apache License, Version 2.0 (the
"License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.apache.org/licenses/LICENSE-2.0
Unless required by applicable law or agreed to in writing,
software distributed under the License is distributed on an
"AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
KIND, either express or implied. See the License for the
specific language governing permissions and limitations
under the License.
=cut
1;
Git/usr/lib/perl5/vendor_perl/SVN/Repos.pm
+310
View File
@@ -0,0 +1,310 @@
use strict;
use warnings;
package SVN::Repos;
use SVN::Base qw(Repos svn_repos_);
=head1 NAME
SVN::Repos - Subversion repository functions
=head1 SYNOPSIS
use SVN::Core;
use SVN::Repos;
use SVN::Fs;
my $repos = SVN::Repos::open('/path/to/repos');
print $repos->fs()->youngest_rev;
=head1 DESCRIPTION
SVN::Repos wraps the object-oriented C<svn_repos_t> functions, providing
access to a Subversion repository on the local filesystem.
=head2 CONSTRUCTORS
=over
=item SVN::Repos::open($path)
This function opens an existing repository, and returns an
C<SVN::Repos> object.
=item create($path, undef, undef, $config, $fs_config)
This function creates a new repository, and returns an C<SVN::Repos>
object.
=back
=head2 METHODS
=over
=item $repos-E<gt>dump_fs($dump_fh, $feedback_fh, $start_rev, $end_rev, $incremental, $cancel_callback)
=item $repos-E<gt>dump_fs2($dump_fh, $feedback_fh, $start_rev, $end_rev, $incremental, $deltify, $cancel_callback)
Create a dump file of the repository from revision C<$start_rev> to C<$end_rev>
, store it into the filehandle C<$dump_fh>, and write feedback on the progress
of the operation to filehandle C<$feedback_fh>.
If C<$incremental> is TRUE, the first revision dumped will be a diff
against the previous revision (usually it looks like a full dump of
the tree).
If C<$use_deltas> is TRUE, output only node properties which have
changed relative to the previous contents, and output text contents
as svndiff data against the previous contents. Regardless of how
this flag is set, the first revision of a non-incremental dump will
be done with full plain text. A dump with @a use_deltas set cannot
be loaded by Subversion 1.0.x.
If C<$cancel_callback> is not C<undef>, it must be a code reference
that is called periodically to determine whether the client wishes
to cancel the dump. See L<SVN::Client/"CANCELLATION CALLBACK"> for details.
Example:
use SVN::Core;
use SVN::Repos;
my $repos = SVN::Repos::open('/repo/sandbox');
open my $fh, ">/tmp/tmp.dump" or die "Cannot open file: $!\n";
my $start_rev = 10;
my $end_rev = 20;
my $incremental = 1;
my $deltify = 1;
$repos->dump_fs2($fh, \*STDOUT, # Dump file => $fh, Feedback => STDOUT
$start_rev, $end_rev, # Revision Range
$incremental, $deltify, # Options
undef); # Cancel Callback
close $fh;
=item $repos-E<gt>load_fs($dumpfile_fh, $feedback_fh, $uuid_action, $parent_dir, $cancel_callback);
=item $repos-E<gt>load_fs2($dumpfile_fh, $feedback_fh, $uuid_action, $parent_dir, $use_pre_commit_hook, $use_post_commit_hook, $cancel_callback);
Loads a dumpfile specified by the C<$dumpfile_fh> filehandle into the repository.
If the dumpstream contains copy history that is unavailable in the repository,
an error will be thrown.
The repository's UUID will be updated iff the dumpstream contains a UUID and
C<$uuid_action> is not equal to C<$SVN::Repos::load_uuid_ignore> and either the
repository contains no revisions or C<$uuid_action> is equal to
C<$SVN::Repos::load_uuid_force>.
If the dumpstream contains no UUID, then C<$uuid_action> is
ignored and the repository UUID is not touched.
If C<$parent_dir> is not null, then the parser will reparent all the
loaded nodes, from root to @a parent_dir. The directory C<$parent_dir>
must be an existing directory in the repository.
If C<$use_pre_commit_hook> is set, call the repository's pre-commit
hook before committing each loaded revision.
If C<$use_post_commit_hook> is set, call the repository's
post-commit hook after committing each loaded revision.
If C<$cancel_callback> is not C<undef>, it must be a code reference
that is called periodically to determine whether the client wishes
to cancel the load. See L<SVN::Client/"CANCELLATION CALLBACK"> for details.
You must at least provide C<undef> for these parameters for the method call
to work.
Example:
use SVN::Core;
use SVN::Repos;
my $repos = SVN::Repos::open('/repo/test_repo');
open my $fh, "/repo/sandbox.dump" or die "Cannot open file: $!\n";
my $parent_dir = '/';
my $use_pre_commit_hook = 0;
my $use_post_commit_hook = 0;
$repos->load_fs2($fh, \*STDOUT,
$SVN::Repos::load_uuid_ignore, # Ignore uuid
$parent_dir,
$use_pre_commit_hook, # Use pre-commit hook?
$use_post_commit_hook, # Use post-commit hook?
undef, undef);
close $fh;
=cut
# Build up a list of methods as we go through the file. Add each method
# to @methods, then document it. The full list of methods is then
# instantiated at the bottom of this file.
#
# This should make it easier to keep the documentation and list of methods
# in sync.
my @methods = (); # List of methods to wrap
push @methods, qw(fs);
=item $repos-E<gt>fs()
Returns the C<SVN::Fs> object for this repository.
=cut
push @methods, qw(get_logs);
=item $repos-E<gt>get_logs([$path, ...], $start, $end, $discover_changed_paths, $strict_node_history, $receiver)
Iterates over all the revisions that affect the list of paths passed
as the first parameter, starting at $start, and ending at $end.
$receiver is called for each change. The arguments to $receiver are:
=over
=item $self
The C<SVN::Repos> object.
=item $paths
C<undef> if $discover_changed_paths is false. Otherwise, contains a hash
of paths that have changed in this revision.
=item $rev
The revision this change occurred in.
=item $date
The date and time the revision occurred.
=item $msg
The log message associated with this revision.
=item $pool
An C<SVN::Pool> object which may be used in the function.
=back
If $strict_node_history is true then copies will not be traversed.
=back
=head2 ADDITIONAL METHODS
The following methods work, but are not currently documented in this
file. Please consult the svn_repos.h section in the Subversion API
for more details.
=over
=item $repos-E<gt>get_commit_editor(...)
=item $repos-E<gt>get_commit_editor2(...)
=item $repos-E<gt>path(...)
=item $repos-E<gt>db_env(...)
=item $repos-E<gt>lock_dir(...)
=item $repos-E<gt>db_lockfile(...)
=item $repos-E<gt>hook_dir(...)
=item $repos-E<gt>start_commit_hook(...)
=item $repos-E<gt>pre_commit_hook(...)
=item $repos-E<gt>post_commit_hook(...)
=item $repos-E<gt>pre_revprop_change(...)
=item $repos-E<gt>post_revprop_change(...)
=item $repos-E<gt>dated_revision(...)
=item $repos-E<gt>fs_commit_txn(...)
=item $repos-E<gt>fs_being_txn_for_commit(...)
=item $repos-E<gt>fs_being_txn_for_update(...)
=item $repos-E<gt>fs_change_rev_prop(...)
=item $repos-E<gt>node_editor(...)
=item $repos-E<gt>dump_fs(...)
=item $repos-E<gt>load_fs(...)
=item $repos-E<gt>get_fs_build_parser(...)
=back
=cut
push @methods,
qw( version open create delete hotcopy recover3 recover2
recover db_logfiles path db_env conf_dir svnserve_conf
get_commit_editor get_commit_editor2 fs_commit_txn
lock_dir db_lockfile db_logs_lockfile hook_dir
pre_revprop_change_hook pre_lock_hook pre_unlock_hook
begin_report2 begin_report link_path3 link_path2 link_path
delete_path finish_report dir_delta2 dir_delta replay2 replay
dated_revision stat deleted_rev history2 history
trace_node_locations fs_begin_txn_for_commit2
fs_begin_txn_for_commit fs_begin_txn_for_update fs_lock
fs_unlock fs_change_rev_prop3 fs_change_rev_prop2
fs_change_rev_prop fs_revision_prop fs_revision_proplist
fs_change_node_prop fs_change_txn_prop node_editor
node_from_baton dump_fs2 dump_fs load_fs2 load_fs
authz_check_access check_revision_access invoke_authz_func
invoke_authz_callback invoke_file_rev_handler
invoke_history_func);
{
no strict 'refs';
for (@methods) {
*{"_p_svn_repos_t::$_"} = *{$_};
}
}
=head1 AUTHORS
Chia-liang Kao E<lt>clkao@clkao.orgE<gt>
=head1 COPYRIGHT
Licensed to the Apache Software Foundation (ASF) under one
or more contributor license agreements. See the NOTICE file
distributed with this work for additional information
regarding copyright ownership. The ASF licenses this file
to you under the Apache License, Version 2.0 (the
"License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.apache.org/licenses/LICENSE-2.0
Unless required by applicable law or agreed to in writing,
software distributed under the License is distributed on an
"AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
KIND, either express or implied. See the License for the
specific language governing permissions and limitations
under the License.
=cut
1;
Git/usr/lib/perl5/vendor_perl/SVN/Wc.pm
+557
View File
@@ -0,0 +1,557 @@
use strict;
use warnings;
package SVN::Wc;
use SVN::Base qw(Wc svn_wc_);
use SVN::Core;
=head1 NAME
SVN::Wc - Subversion working copy functions
=head1 SYNOPSIS
Incomplete
=cut
swig_init_asp_dot_net_hack($SVN::Core::gpool);
=head1 FUNCTIONS
=over 4
=item SVN::Wc::parse_externals_description3($parent_directory, $desc, $canonicalize_url, $pool);
Parse the string $desc as an C<svn:externals> value and return a reference
to an array of L<_p_svn_wc_external_item2_t|svn_wc_external_item2_t> objects.
If $canonicalize_url is true, canonicalize the C<url> member of those objects.
$parent_directory is only used in constructing error strings.
=back
=cut
=head1 OBJECTS
=cut
package _p_svn_wc_t;
=head2 svn_wc_status2_t
=over 4
=item $wcstat-E<gt>entry()
A svn_wc_entry_t object for the item. Can be undef if not under version
control.
=item $wcstat-E<gt>text_status()
An integer representing the status of the item's text. Can be one of the
$SVN::Wc::Status::* constants.
=item $wcstat-E<gt>prop_status()
An integer representing the status of the item's properties. Can be one of the
$SVN::Wc::Status::* constants.
=item $wcstat-E<gt>locked()
A boolean telling if the item is locked. A directory can be locked if a
working copy update was interrupted.
=item $wcstat-E<gt>copied()
A boolean telling if the item was copied. A file or directory can be copied if
it's scheduled for addition-with-history (or part of a subtree that is
scheduled as such).
=item $wcstat-E<gt>switched()
A boolean telling if the item was switched. A file or directory can be
switched if the switch command has been used.
=item $wcstat-E<gt>repos_text_status()
An integer representing the status of the item's text in the repository. Can
be one of the $SVN::Wc::Status::* constants.
=item $wcstat-E<gt>repos_prop_status()
An integer representing the status of the item's properties in the repository.
Can be one of the $SVN::Wc::Status::* constants.
=item $wcstat-E<gt>repos_lock()
A svn_lock_t object representing the entry's lock in the repository, if any.
=item $wcstat-E<gt>url()
The url (actual or expected) of the item.
=item $wcstat-E<gt>ood_last_cmt_rev()
An integer representing the youngest committed revision or $SVN::Core::INVALID_REVNUM is not out of date.
=item $wcstat-E<gt>ood_last_cmt_date()
The date of the most recent commit as microseconds since 00:00:00 January 1, 1970 UTC or 0 if not out of date.
=item $wcstat-E<gt>ood_kind()
An integer representing the kind of the youngest commit. Can be any of the $SVN::Node::* constants. Will be $SVN::Node::none if not out of date.
=item $wcstat-E<gt>tree_conflict()
A svn_wc_conflict_description_t object if the entry is the victim of a tree conflict or undef.
=item $wcstat-E<gt>file_external()
A boolean telling if the item is a file that was added to the working copy as an svn:externals. If file_external is TRUE, then switched is always FALSE.
=item $wcstat-E<gt>pristine_text_status()
An integer representing the status of the item's text as compared to the pristine base of the file. Can be one of the $SVN::Wc::Status::* constants.
=item $wcstat-E<gt>pristine_prop_status()
An integer representing the status of the item's properties as compared to the pristine base of the node. Can be one of the $SVN::Wc::Status::* constants.
=back
=cut
package _p_svn_wc_status2_t;
use SVN::Base qw(Wc svn_wc_status2_t_);
=head2 svn_wc_status_t
Same as svn_wc_status2_t, but without the repos_lock, url, ood_last_cmt_rev, ood_last_cmt_date, ood_kind, ood_last_cmt_author, tree_conflict, file_external, pristine_text_status, pristine_prop_status fields.
=cut
package _p_svn_wc_status_t;
use SVN::Base qw(Wc svn_wc_status_t_);
=head2 svn_wc_entry_t
=over 4
=item $wcent-E<gt>name()
Entry's name.
=item $wcent-E<gt>revision()
Base revision.
=item $wcent-E<gt>url()
URL in repository.
=item $wcent-E<gt>repos()
Canonical repository URL.
=item $wcent-E<gt>uuid()
Repository uuid.
=item $wcent-E<gt>kind()
The kind of node. One of the following constants:
$SVN::Node::none, $SVN::Node::file,
$SVN::Node::dir, $SVN::Node::unknown.
=item $wcent-E<gt>schedule()
Scheduling. One of the SVN::Wc::Schedule::* constants.
=item $wcent-E<gt>copied()
In a copied state.
=item $wcent-E<gt>deleted()
Deleted, but parent rev lags behind.
=item $wcent-E<gt>absent()
Absent -- we know an entry of this name exists, but that's all (usually this
happens because of authz restrictions)
=item $wcent-E<gt>incomplete()
For THIS_DIR entry, implies whole entries file is incomplete.
=item $wcent-E<gt>copyfrom_url()
Copyfrom location.
=item $wcent-E<gt>copyfrom_rev()
Copyfrom revision.
=item $wcent-E<gt>conflict_old()
Old version of conflicted file.
=item $wcent-E<gt>conflict_new()
New version of conflicted file.
=item $wcent-E<gt>conflict_wrk()
Working version of conflicted file.
=item $wcent-E<gt>prejfile()
Property reject file.
=item $wcent-E<gt>text_time()
Last up-to-date time for text contents (0 means no information available).
=item $wcent-E<gt>prop_time()
Last up-to-date time for properties (0 means no information available).
=item $wcent-E<gt>checksum()
Base-64 encoded checksum for the untranslated text base file, can be undef for
backwards compatibility.
=item $wcent-E<gt>cmt_rev()
Last revision this was changed.
=item $wcent-E<gt>cmt_date()
Last date this was changed.
=item $wcent-E<gt>cmt_author()
Last commit author of this item.
=back
=cut
package _p_svn_wc_entry_t;
# still need to check if the function prototype allows it to be called
# as method.
use SVN::Base qw(Wc svn_wc_entry_t_);
=head2 svn_wc_external_item2_t
=over 4
=item $ext-E<gt>target_dir()
The name of the subdirectory into which this external should be
checked out. This is relative to the parent directory that
holds this external item.
=item $ext-E<gt>url()
Where to check out from. This is possibly a relative external URL, as
allowed in externals definitions, but without the peg revision.
=item $ext-E<gt>revision()
What revision to check out,
a L<svn_opt_revision_t|SVN::Core/svn_opt_revision_t> object.
The only valid kind()s for this are $SVN::Core::opt_revision_number,
$SVN::Core::opt_revision_date, and $SVN::Core::opt_revision_head.
=item $ext-E<gt>peg_revision()
The peg revision to use when checking out,
a L<svn_opt_revision_t|SVN::Core/svn_opt_revision_t> object.
The only valid kind()s for this are $SVN::Core::opt_revision_number,
$SVN::Core::opt_revision_date, and $SVN::Core::opt_revision_head.
=back
=cut
package _p_svn_wc_external_item2_t;
use SVN::Base qw(Wc svn_wc_external_item2_t_);
=head1 CONSTANTS
=head2 SVN::Wc::Notify::Action
=over 4
=item $SVN::Wc::Notify::Action::add
Adding a path to revision control.
=item $SVN::Wc::Notify::Action::copy
Copying a versioned path.
=item $SVN::Wc::Notify::Action::delete
Deleting a versioned path.
=item $SVN::Wc::Notify::Action::restore
Restoring a missing path from the pristine text-base.
=item $SVN::Wc::Notify::Action::revert
Reverting a modified path.
=item $SVN::Wc::Notify::Action::failed_revert
A revert operation has failed.
=item $SVN::Wc::Notify::Action::resolved
Resolving a conflict.
=item $SVN::Wc::Notify::Action::skip
Skipping a path.
=item $SVN::Wc::Notify::Action::update_delete
Got a delete in an update.
=item $SVN::Wc::Notify::Action::update_add
Got an add in an update.
=item $SVN::Wc::Notify::Action::update_update
Got any other action in an update.
=item $SVN::Wc::Notify::Action::update_completed
The last notification in an update (including updates of externals).
=item $SVN::Wc::Notify::Action::update_external
Updating an external module.
=item $SVN::Wc::Notify::Action::status_completed
The last notification in a status (including status on externals).
=item $SVN::Wc::Notify::Action::status_external
Running status on an external module.
=item $SVN::Wc::Notify::Action::commit_modified
Committing a modification.
=item $SVN::Wc::Notify::Action::commit_added
Committing an addition.
=item $SVN::Wc::Notify::Action::commit_deleted
Committing a deletion.
=item $SVN::Wc::Notify::Action::commit_replaced
Committing a replacement.
=item $SVN::Wc::Notify::Action::commit_postfix_txdelta
Transmitting post-fix text-delta data for a file.
=item $SVN::Wc::Notify::Action::blame_revision
Processed a single revision's blame.
=back
=cut
# no reasonable prefix for these enums
# so we have to do them one by one to import.
package SVN::Wc::Notify::Action;
our $add = $SVN::Wc::notify_add;
our $copy = $SVN::Wc::notify_copy;
our $delete = $SVN::Wc::notify_delete;
our $restore = $SVN::Wc::notify_restore;
our $revert = $SVN::Wc::notify_revert;
our $failed_revert = $SVN::Wc::notify_failed_revert;
our $resolved = $SVN::Wc::notify_resolved;
our $skip = $SVN::Wc::notify_skip;
our $update_delete = $SVN::Wc::notify_update_delete;
our $update_add = $SVN::Wc::notify_update_add;
our $update_update = $SVN::Wc::notify_update_update;
our $update_completed = $SVN::Wc::notify_update_completed;
our $update_external = $SVN::Wc::notify_update_external;
our $status_completed = $SVN::Wc::notify_status_completed;
our $status_external = $SVN::Wc::notify_status_external;
our $commit_modified = $SVN::Wc::notify_commit_modified;
our $commit_added = $SVN::Wc::notify_commit_added;
our $commit_deleted = $SVN::Wc::notify_commit_deleted;
our $commit_replaced = $SVN::Wc::notify_commit_replaced;
our $commit_postfix_txdelta = $SVN::Wc::notify_commit_postfix_txdelta;
our $blame_revision = $SVN::Wc::notify_blame_revision;
=head2 SVN::Wc::Notify::State
=over 4
=item $SVN::Wc::Notify::State::unknown
Notifier doesn't know or isn't saying.
=item $SVN::Wc::Notify::State::unchanged
The state did not change.
=item $SVN::Wc::Notify::State::missing
The item wasn't present.
=item $SVN::Wc::Notify::State::obstructed
An unversioned item obstructed work.
=item $SVN::Wc::Notify::State::changed
Pristine state was modified.
=item $SVN::Wc::Notify::State::merged
Modified state had mods merged in.
=item $SVN::Wc::Notify::State::conflicted
Modified state got conflicting mods.
=back
=cut
package SVN::Wc::Notify::State;
use SVN::Base qw(Wc svn_wc_notify_state_);
=head2 SVN::Wc::Schedule
=over 4
=item $SVN::Wc::Schedule::normal
Nothing special here.
=item $SVN::Wc::Schedule::add
Slated for addition.
=item $SVN::Wc::Schedule::delete
Slated for deletion.
=item $SVN::Wc::Schedule::replace
Slated for replacement (delete + add)
=back
=cut
package SVN::Wc::Schedule;
use SVN::Base qw(Wc svn_wc_schedule_);
=head2 SVN::Wc::Status
=over 4
=item $SVN::Wc::Status::none
Does not exist.
=item $SVN::Wc::Status::unversioned
Is not a versioned node in this working copy.
=item $SVN::Wc::Status::normal
Exists, but uninteresting.
=item $SVN::Wc::Status::added
Is scheduled for addition.
=item $SVN::Wc::Status::missing
Under version control but missing.
=item $SVN::Wc::Status::deleted
Scheduled for deletion.
=item $SVN::Wc::Status::replaced
Was deleted and then re-added.
=item $SVN::Wc::Status::modified
Text or props have been modified.
=item $SVN::Wc::Status::merged
Local mods received repos mods.
=item $SVN::Wc::Status::conflicted
Local mods received conflicting mods.
=item $SVN::Wc::Status::ignored
A node marked as ignored.
=item $SVN::Wc::Status::obstructed
An unversioned resource is in the way of the versioned resource.
=item $SVN::Wc::Status::external
An unversioned path populated by an svn:externals property.
=item $SVN::Wc::Status::incomplete
A directory doesn't contain a complete entries list.
=back
=cut
package SVN::Wc::Status;
use SVN::Base qw(Wc svn_wc_status_);
=head1 COPYRIGHT
Licensed to the Apache Software Foundation (ASF) under one
or more contributor license agreements. See the NOTICE file
distributed with this work for additional information
regarding copyright ownership. The ASF licenses this file
to you under the Apache License, Version 2.0 (the
"License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.apache.org/licenses/LICENSE-2.0
Unless required by applicable law or agreed to in writing,
software distributed under the License is distributed on an
"AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
KIND, either express or implied. See the License for the
specific language governing permissions and limitations
under the License.
=cut
1;
Git/usr/lib/perl5/vendor_perl/Term/ReadKey.pm
+494
View File
@@ -0,0 +1,494 @@
# -*- buffer-read-only: t -*-
#
# This file is auto-generated. ***ANY*** changes here will be lost
#
package Term::ReadKey;
use strict;
use warnings;
=head1 NAME
Term::ReadKey - A perl module for simple terminal control
=head1 SYNOPSIS
use Term::ReadKey;
ReadMode 4; # Turn off controls keys
while (not defined ($key = ReadKey(-1))) {
# No key yet
}
print "Get key $key\n";
ReadMode 0; # Reset tty mode before exiting
=head1 DESCRIPTION
Term::ReadKey is a compiled perl module dedicated to providing simple
control over terminal driver modes (cbreak, raw, cooked, etc.,) support for
non-blocking reads, if the architecture allows, and some generalized handy
functions for working with terminals. One of the main goals is to have the
functions as portable as possible, so you can just plug in "use
Term::ReadKey" on any architecture and have a good likelihood of it working.
Version 2.30.01:
Added handling of arrows, page up/down, home/end, insert/delete keys
under Win32. These keys emit xterm-compatible sequences.
Works with Term::ReadLine::Perl.
=over 4
=item ReadMode MODE [, Filehandle]
Takes an integer argument or a string synonym (case insensitive), which
can currently be one of the following values:
INT SYNONYM DESCRIPTION
0 'restore' Restore original settings.
1 'normal' Change to what is commonly the default mode,
echo on, buffered, signals enabled, Xon/Xoff
possibly enabled, and 8-bit mode possibly disabled.
2 'noecho' Same as 1, just with echo off. Nice for
reading passwords.
3 'cbreak' Echo off, unbuffered, signals enabled, Xon/Xoff
possibly enabled, and 8-bit mode possibly enabled.
4 'raw' Echo off, unbuffered, signals disabled, Xon/Xoff
disabled, and 8-bit mode possibly disabled.
5 'ultra-raw' Echo off, unbuffered, signals disabled, Xon/Xoff
disabled, 8-bit mode enabled if parity permits,
and CR to CR/LF translation turned off.
These functions are automatically applied to the STDIN handle if no
other handle is supplied. Modes 0 and 5 have some special properties
worth mentioning: not only will mode 0 restore original settings, but it
cause the next ReadMode call to save a new set of default settings. Mode
5 is similar to mode 4, except no CR/LF translation is performed, and if
possible, parity will be disabled (only if not being used by the terminal,
however. It is no different from mode 4 under Windows.)
If you just need to read a key at a time, then modes 3 or 4 are probably
sufficient. Mode 4 is a tad more flexible, but needs a bit more work to
control. If you use ReadMode 3, then you should install a SIGINT or END
handler to reset the terminal (via ReadMode 0) if the user aborts the
program via C<^C>. (For any mode, an END handler consisting of "ReadMode 0"
is actually a good idea.)
If you are executing another program that may be changing the terminal mode,
you will either want to say
ReadMode 1; # same as ReadMode 'normal'
system('someprogram');
ReadMode 1;
which resets the settings after the program has run, or:
$somemode=1;
ReadMode 0; # same as ReadMode 'restore'
system('someprogram');
ReadMode 1;
which records any changes the program may have made, before resetting the
mode.
=item ReadKey MODE [, Filehandle]
Takes an integer argument, which can currently be one of the following
values:
0 Perform a normal read using getc
-1 Perform a non-blocked read
>0 Perform a timed read
If the filehandle is not supplied, it will default to STDIN. If there is
nothing waiting in the buffer during a non-blocked read, then undef will be
returned. In most situations, you will probably want to use C<ReadKey -1>.
I<NOTE> that if the OS does not provide any known mechanism for non-blocking
reads, then a C<ReadKey -1> can die with a fatal error. This will hopefully
not be common.
If MODE is greater then zero, then ReadKey will use it as a timeout value in
seconds (fractional seconds are allowed), and won't return C<undef> until
that time expires.
I<NOTE>, again, that some OS's may not support this timeout behaviour.
If MODE is less then zero, then this is treated as a timeout
of zero, and thus will return immediately if no character is waiting. A MODE
of zero, however, will act like a normal getc.
I<NOTE>, there are currently some limitations with this call under Windows.
It may be possible that non-blocking reads will fail when reading repeating
keys from more then one console.
=item ReadLine MODE [, Filehandle]
Takes an integer argument, which can currently be one of the following
values:
0 Perform a normal read using scalar(<FileHandle>)
-1 Perform a non-blocked read
>0 Perform a timed read
If there is nothing waiting in the buffer during a non-blocked read, then
undef will be returned.
I<NOTE>, that if the OS does not provide any known mechanism for
non-blocking reads, then a C<ReadLine 1> can die with a fatal
error. This will hopefully not be common.
I<NOTE> that a non-blocking test is only performed for the first character
in the line, not the entire line. This call will probably B<not> do what
you assume, especially with C<ReadMode> MODE values higher then 1. For
example, pressing Space and then Backspace would appear to leave you
where you started, but any timeouts would now be suspended.
B<This call is currently not available under Windows>.
=item GetTerminalSize [Filehandle]
Returns either an empty array if this operation is unsupported, or a four
element array containing: the width of the terminal in characters, the
height of the terminal in character, the width in pixels, and the height in
pixels. (The pixel size will only be valid in some environments.)
I<NOTE>, under Windows, this function must be called with an B<output>
filehandle, such as C<STDOUT>, or a handle opened to C<CONOUT$>.
=item SetTerminalSize WIDTH,HEIGHT,XPIX,YPIX [, Filehandle]
Return -1 on failure, 0 otherwise.
I<NOTE> that this terminal size is only for B<informative> value, and
changing the size via this mechanism will B<not> change the size of
the screen. For example, XTerm uses a call like this when
it resizes the screen. If any of the new measurements vary from the old, the
OS will probably send a SIGWINCH signal to anything reading that tty or pty.
B<This call does not work under Windows>.
=item GetSpeed [, Filehandle]
Returns either an empty array if the operation is unsupported, or a two
value array containing the terminal in and out speeds, in B<decimal>. E.g,
an in speed of 9600 baud and an out speed of 4800 baud would be returned as
(9600,4800). Note that currently the in and out speeds will always be
identical in some OS's.
B<No speeds are reported under Windows>.
=item GetControlChars [, Filehandle]
Returns an array containing key/value pairs suitable for a hash. The pairs
consist of a key, the name of the control character/signal, and the value
of that character, as a single character.
B<This call does nothing under Windows>.
Each key will be an entry from the following list:
DISCARD
DSUSPEND
EOF
EOL
EOL2
ERASE
ERASEWORD
INTERRUPT
KILL
MIN
QUIT
QUOTENEXT
REPRINT
START
STATUS
STOP
SUSPEND
SWITCH
TIME
Thus, the following will always return the current interrupt character,
regardless of platform.
%keys = GetControlChars;
$int = $keys{INTERRUPT};
=item SetControlChars [, Filehandle]
Takes an array containing key/value pairs, as a hash will produce. The pairs
should consist of a key that is the name of a legal control
character/signal, and the value should be either a single character, or a
number in the range 0-255. SetControlChars will die with a runtime error if
an invalid character name is passed or there is an error changing the
settings. The list of valid names is easily available via
%cchars = GetControlChars();
@cnames = keys %cchars;
B<This call does nothing under Windows>.
=back
=head1 AUTHOR
Kenneth Albanowski <kjahds@kjahds.com>
Currently maintained by Jonathan Stowe <jns@gellyfish.co.uk>
=head1 SUPPORT
The code is maintained at
https://github.com/jonathanstowe/TermReadKey
Please feel free to fork and suggest patches.
=head1 LICENSE
Prior to the 2.31 release the license statement was:
Copyright (C) 1994-1999 Kenneth Albanowski.
2001-2005 Jonathan Stowe and others
Unlimited distribution and/or modification is allowed as long as this
copyright notice remains intact.
And was only stated in the README file.
Because I believe the original author's intent was to be more open than the
other commonly used licenses I would like to leave that in place. However if
you or your lawyers require something with some more words you can optionally
choose to license this under the standard Perl license:
This module is free software; you can redistribute it and/or modify it
under the terms of the Artistic License. For details, see the full
text of the license in the file "Artistic" that should have been provided
with the version of perl you are using.
This program is distributed in the hope that it will be useful, but
without any warranty; without even the implied warranty of merchantability
or fitness for a particular purpose.
=cut
use vars qw($VERSION);
$VERSION = '2.37';
require Exporter;
require DynaLoader;
use vars qw(@ISA @EXPORT_OK @EXPORT);
@ISA = qw(Exporter DynaLoader);
# Items to export into callers namespace by default
# (move infrequently used names to @EXPORT_OK below)
@EXPORT = qw(
ReadKey
ReadMode
ReadLine
GetTerminalSize
SetTerminalSize
GetSpeed
GetControlChars
SetControlChars
);
@EXPORT_OK = qw();
bootstrap Term::ReadKey;
# Should we use LINES and COLUMNS to try and get the terminal size?
# Change this to zero if you have systems where these are commonly
# set to erroneous values. (But if either are near zero, they won't be
# used anyhow.)
use vars qw($UseEnv $CurrentMode %modes);
$UseEnv = 1;
$CurrentMode = 0;
%modes = ( # lowercase is canonical
original => 0,
restore => 0,
normal => 1,
noecho => 2,
cbreak => 3,
raw => 4,
'ultra-raw' => 5
);
# reduce Carp memory footprint, only load when needed
sub croak { require Carp; goto &Carp::croak; }
sub carp { require Carp; goto &Carp::carp; }
sub ReadMode
{
my $mode = $modes{ lc $_[0] }; # lowercase is canonical
my $fh = normalizehandle( ( @_ > 1 ? $_[1] : \*STDIN ) );
if ( defined($mode) ) { $CurrentMode = $mode }
elsif ( $_[0] =~ /^\d/ ) { $CurrentMode = $_[0] }
else { croak("Unknown terminal mode `$_[0]'"); }
SetReadMode($CurrentMode, $fh);
}
sub normalizehandle
{
my ($file) = @_; # allows fake signature optimization
no strict;
# print "Handle = $file\n";
if ( ref($file) ) { return $file; } # Reference is fine
# if ($file =~ /^\*/) { return $file; } # Type glob is good
if ( ref( \$file ) eq 'GLOB' ) { return $file; } # Glob is good
# print "Caller = ",(caller(1))[0],"\n";
return \*{ ( ( caller(1) )[0] ) . "::$file" };
}
sub GetTerminalSize
{
my $file = normalizehandle( ( @_ > 0 ? $_[0] : \*STDOUT ) );
my (@results, @fail);
if ( &termsizeoptions() & 1 ) # VIO
{
@results = GetTermSizeVIO($file);
push( @fail, "VIOGetMode call" );
}
elsif ( &termsizeoptions() & 2 ) # GWINSZ
{
@results = GetTermSizeGWINSZ($file);
push( @fail, "TIOCGWINSZ ioctl" );
}
elsif ( &termsizeoptions() & 4 ) # GSIZE
{
@results = GetTermSizeGSIZE($file);
push( @fail, "TIOCGSIZE ioctl" );
}
elsif ( &termsizeoptions() & 8 ) # WIN32
{
@results = GetTermSizeWin32($file);
push( @fail, "Win32 GetConsoleScreenBufferInfo call" );
}
else
{
@results = ();
}
if ( @results < 4 and $UseEnv )
{
my ($C) = defined( $ENV{COLUMNS} ) ? $ENV{COLUMNS} : 0;
my ($L) = defined( $ENV{LINES} ) ? $ENV{LINES} : 0;
if ( ( $C >= 2 ) and ( $L >= 2 ) )
{
@results = ( $C + 0, $L + 0, 0, 0 );
}
push( @fail, "COLUMNS and LINES environment variables" );
}
if ( @results < 4 && $^O ne 'MSWin32')
{
my ($prog) = "resize";
# Workaround for Solaris path silliness
if ( -f "/usr/openwin/bin/resize" ) {
$prog = "/usr/openwin/bin/resize";
}
my ($resize) = scalar(`$prog 2>/dev/null`);
if (defined $resize
and ( $resize =~ /COLUMNS\s*=\s*(\d+)/
or $resize =~ /setenv\s+COLUMNS\s+'?(\d+)/ )
)
{
$results[0] = $1;
if ( $resize =~ /LINES\s*=\s*(\d+)/
or $resize =~ /setenv\s+LINES\s+'?(\d+)/ )
{
$results[1] = $1;
@results[ 2, 3 ] = ( 0, 0 );
}
else
{
@results = ();
}
}
else
{
@results = ();
}
push( @fail, "resize program" );
}
if ( @results < 4 && $^O ne 'MSWin32' )
{
my ($prog) = "stty size";
my ($stty) = scalar(`$prog 2>/dev/null`);
if (defined $stty
and ( $stty =~ /(\d+) (\d+)/ )
)
{
$results[0] = $2;
$results[1] = $1;
@results[ 2, 3 ] = ( 0, 0 );
}
else
{
@results = ();
}
push( @fail, "stty program" );
}
if ( @results != 4 )
{
carp("Unable to get Terminal Size."
. join( "", map( " The $_ didn't work.", @fail ) ));
return undef;
}
@results;
}
# blockoptions:
#nodelay
#select
sub ReadKey {
my $File = normalizehandle((@_>1?$_[1]:\*STDIN));
if (defined $_[0] && $_[0] > 0) {
if ($_[0]) { return undef if &selectfile($File,$_[0]) == 0 }
}
if (defined $_[0] && $_[0] < 0) { &setnodelay($File,1); }
my $value = getc $File;
if (defined $_[0] && $_[0] < 0) { &setnodelay($File,0); }
$value;
}
sub ReadLine {
my $File = normalizehandle((@_>1?$_[1]:\*STDIN));
if (defined $_[0] && $_[0] > 0) {
if ($_[0]) { return undef if &selectfile($File,$_[0]) == 0 }
}
if (defined $_[0] && $_[0] < 0) { &setnodelay($File,1) };
my $value = scalar(<$File>);
if (defined $_[0] && $_[0] < 0) { &setnodelay($File,0) };
$value;
}
1;
# ex: set ro:
Git/usr/lib/perl5/vendor_perl/auto/HTML/Parser/Parser.dll
BIN
View File
Binary file not shown.
Git/usr/lib/perl5/vendor_perl/auto/Net/SSLeay/SSLeay.dll
BIN
View File
Binary file not shown.
Git/usr/lib/perl5/vendor_perl/auto/Net/SSLeay/autosplit.ix
+80
View File
@@ -0,0 +1,80 @@
# Index created by AutoSplit for blib/lib/Net/SSLeay.pm
# (file acts as timestamp)
package Net::SSLeay;
sub want_nothing ;
sub want_read ;
sub want_write ;
sub want_X509_lookup ;
sub open_tcp_connection ;
sub open_proxy_tcp_connection ;
sub debug_read ;
sub ssl_read_all ;
sub tcp_read_all ;
sub ssl_write_all ;
sub tcp_write_all ;
sub ssl_read_until ($;$$);
sub tcp_read_until ;
sub ssl_read_CRLF ($;$);
sub tcp_read_CRLF ;
sub ssl_write_CRLF ($$);
sub tcp_write_CRLF ;
sub dump_peer_certificate ($);
sub randomize (;$$$);
sub new_x_ctx ;
sub initialize
;
sub sslcat ;
sub tcpcat ;
sub tcpxcat ;
sub https_cat ;
sub http_cat ;
sub httpx_cat ;
sub set_cert_and_key ($$$);
sub set_server_cert_and_key ($$$);
sub set_proxy ($$;**);
sub make_form ;
sub make_headers ;
sub do_httpx3 ;
sub do_https3 ;
sub do_httpx2 ;
sub do_https2 ;
sub do_httpx4 ;
sub do_https4 ;
sub get_https ;
sub post_https ;
sub put_https ;
sub head_https ;
sub get_https3 ;
sub post_https3 ;
sub put_https3 ;
sub head_https3 ;
sub get_https4 ;
sub post_https4 ;
sub put_https4 ;
sub head_https4 ;
sub get_http ;
sub post_http ;
sub put_http ;
sub head_http ;
sub get_http3 ;
sub post_http3 ;
sub put_http3 ;
sub head_http3 ;
sub get_http4 ;
sub post_http4 ;
sub put_http4 ;
sub head_http4 ;
sub get_httpx ;
sub post_httpx ;
sub put_httpx ;
sub head_httpx ;
sub get_httpx3 ;
sub post_httpx3 ;
sub put_httpx3 ;
sub head_httpx3 ;
sub get_httpx4 ;
sub post_httpx4 ;
sub put_httpx4 ;
sub head_httpx4 ;
sub do_https ;
1;
Git/usr/lib/perl5/vendor_perl/auto/Net/SSLeay/debug_read.al
+22
View File
@@ -0,0 +1,22 @@
# NOTE: Derived from blib/lib/Net/SSLeay.pm.
# Changes made here will be lost when autosplit is run again.
# See AutoSplit.pm.
package Net::SSLeay;
#line 565 "blib/lib/Net/SSLeay.pm (autosplit into blib/lib/auto/Net/SSLeay/debug_read.al)"
###
### read and write helpers that block
###
sub debug_read {
my ($replyr, $gotr) = @_;
my $vm = $trace>2 && $linux_debug ?
(split ' ', `cat /proc/$$/stat`)[22] : 'vm_unknown';
warn " got " . blength($$gotr) . ':'
. blength($$replyr) . " bytes (VM=$vm).\n" if $trace == 3;
warn " got `$$gotr' (" . blength($$gotr) . ':'
. blength($$replyr) . " bytes, VM=$vm)\n" if $trace>3;
}
# end of Net::SSLeay::debug_read
1;
Git/usr/lib/perl5/vendor_perl/auto/Net/SSLeay/do_https.al
+19
View File
@@ -0,0 +1,19 @@
# NOTE: Derived from blib/lib/Net/SSLeay.pm.
# Changes made here will be lost when autosplit is run again.
# See AutoSplit.pm.
package Net::SSLeay;
#line 1454 "blib/lib/Net/SSLeay.pm (autosplit into blib/lib/auto/Net/SSLeay/do_https.al)"
sub do_https {
my ($site, $port, $path, $method, $headers,
$content, $mime_type, $crt_path, $key_path) = @_;
do_https2($method, $site, $port, $path, $headers,
$content, $mime_type, $crt_path, $key_path);
}
1;
__END__
1;
# end of Net::SSLeay::do_https
Git/usr/lib/perl5/vendor_perl/auto/Net/SSLeay/do_https2.al
+13
View File
@@ -0,0 +1,13 @@
# NOTE: Derived from blib/lib/Net/SSLeay.pm.
# Changes made here will be lost when autosplit is run again.
# See AutoSplit.pm.
package Net::SSLeay;
#line 1383 "blib/lib/Net/SSLeay.pm (autosplit into blib/lib/auto/Net/SSLeay/do_https2.al)"
sub do_https2 { splice(@_,1,0) = 1; do_httpx2; } # Legacy undocumented
### Returns headers as a hash where multiple instances of same header
### are handled correctly.
# end of Net::SSLeay::do_https2
1;
Git/usr/lib/perl5/vendor_perl/auto/Net/SSLeay/do_https3.al
+13
View File
@@ -0,0 +1,13 @@
# NOTE: Derived from blib/lib/Net/SSLeay.pm.
# Changes made here will be lost when autosplit is run again.
# See AutoSplit.pm.
package Net::SSLeay;
#line 1368 "blib/lib/Net/SSLeay.pm (autosplit into blib/lib/auto/Net/SSLeay/do_https3.al)"
sub do_https3 { splice(@_,1,0) = 1; do_httpx3; } # Legacy undocumented
### do_https2() is a legacy version in the sense that it is unable
### to return all instances of duplicate headers.
# end of Net::SSLeay::do_https3
1;
Git/usr/lib/perl5/vendor_perl/auto/Net/SSLeay/do_https4.al
+12
View File
@@ -0,0 +1,12 @@
# NOTE: Derived from blib/lib/Net/SSLeay.pm.
# Changes made here will be lost when autosplit is run again.
# See AutoSplit.pm.
package Net::SSLeay;
#line 1398 "blib/lib/Net/SSLeay.pm (autosplit into blib/lib/auto/Net/SSLeay/do_https4.al)"
sub do_https4 { splice(@_,1,0) = 1; do_httpx4; } # Legacy undocumented
# https
# end of Net::SSLeay::do_https4
1;
Git/usr/lib/perl5/vendor_perl/auto/Net/SSLeay/do_httpx2.al
+18
View File
@@ -0,0 +1,18 @@
# NOTE: Derived from blib/lib/Net/SSLeay.pm.
# Changes made here will be lost when autosplit is run again.
# See AutoSplit.pm.
package Net::SSLeay;
#line 1373 "blib/lib/Net/SSLeay.pm (autosplit into blib/lib/auto/Net/SSLeay/do_httpx2.al)"
sub do_httpx2 {
my ($page, $response, $headers, $server_cert) = &do_httpx3;
X509_free($server_cert) if defined $server_cert;
return ($page, $response, defined $headers ?
map( { ($h,$v)=/^(\S+)\:\s*(.*)$/; (uc($h),$v); }
split(/\s?\n/, $headers)
) : ()
);
}
# end of Net::SSLeay::do_httpx2
1;
Git/usr/lib/perl5/vendor_perl/auto/Net/SSLeay/do_httpx3.al
+43
View File
@@ -0,0 +1,43 @@
# NOTE: Derived from blib/lib/Net/SSLeay.pm.
# Changes made here will be lost when autosplit is run again.
# See AutoSplit.pm.
package Net::SSLeay;
#line 1333 "blib/lib/Net/SSLeay.pm (autosplit into blib/lib/auto/Net/SSLeay/do_httpx3.al)"
sub do_httpx3 {
my ($method, $usessl, $site, $port, $path, $headers,
$content, $mime_type, $crt_path, $key_path) = @_;
my ($response, $page, $h,$v);
my $len = blength($content);
if ($len) {
$mime_type = "application/x-www-form-urlencoded" unless $mime_type;
$content = "Content-Type: $mime_type$CRLF"
. "Content-Length: $len$CRLF$CRLF$content";
} else {
$content = "$CRLF$CRLF";
}
my $req = "$method $path HTTP/1.0$CRLF";
unless (defined $headers && $headers =~ /^Host:/m) {
$req .= "Host: $site";
unless (($port == 80 && !$usessl) || ($port == 443 && $usessl)) {
$req .= ":$port";
}
$req .= $CRLF;
}
$req .= (defined $headers ? $headers : '') . "Accept: */*$CRLF$content";
warn "do_httpx3($method,$usessl,$site:$port)" if $trace;
my ($http, $errs, $server_cert)
= httpx_cat($usessl, $site, $port, $req, $crt_path, $key_path);
return (undef, "HTTP/1.0 900 NET OR SSL ERROR$CRLF$CRLF$errs") if $errs;
$http = '' if !defined $http;
($headers, $page) = split /\s?\n\s?\n/, $http, 2;
warn "headers >$headers< page >>$page<< http >>>$http<<<" if $trace>1;
($response, $headers) = split /\s?\n/, $headers, 2;
return ($page, $response, $headers, $server_cert);
}
# end of Net::SSLeay::do_httpx3
1;
Git/usr/lib/perl5/vendor_perl/auto/Net/SSLeay/do_httpx4.al
+18
View File
@@ -0,0 +1,18 @@
# NOTE: Derived from blib/lib/Net/SSLeay.pm.
# Changes made here will be lost when autosplit is run again.
# See AutoSplit.pm.
package Net::SSLeay;
#line 1388 "blib/lib/Net/SSLeay.pm (autosplit into blib/lib/auto/Net/SSLeay/do_httpx4.al)"
sub do_httpx4 {
my ($page, $response, $headers, $server_cert) = &do_httpx3;
my %hr = ();
for my $hh (split /\s?\n/, $headers) {
my ($h,$v) = ($hh =~ /^(\S+)\:\s*(.*)$/);
push @{$hr{uc($h)}}, $v;
}
return ($page, $response, \%hr, $server_cert);
}
# end of Net::SSLeay::do_httpx4
1;
Git/usr/lib/perl5/vendor_perl/auto/Net/SSLeay/dump_peer_certificate.al
+29
View File
@@ -0,0 +1,29 @@
# NOTE: Derived from blib/lib/Net/SSLeay.pm.
# Changes made here will be lost when autosplit is run again.
# See AutoSplit.pm.
package Net::SSLeay;
#line 932 "blib/lib/Net/SSLeay.pm (autosplit into blib/lib/auto/Net/SSLeay/dump_peer_certificate.al)"
### Quickly print out with whom we're talking
sub dump_peer_certificate ($) {
my ($ssl) = @_;
my $cert = get_peer_certificate($ssl);
return if print_errs('get_peer_certificate');
print "no cert defined\n" if !defined($cert);
# Cipher=NONE with empty cert fix
if (!defined($cert) || ($cert == 0)) {
warn "cert = `$cert'\n" if $trace;
return "Subject Name: undefined\nIssuer Name: undefined\n";
} else {
my $x = 'Subject Name: '
. X509_NAME_oneline(X509_get_subject_name($cert)) . "\n"
. 'Issuer Name: '
. X509_NAME_oneline(X509_get_issuer_name($cert)) . "\n";
Net::SSLeay::X509_free($cert);
return $x;
}
}
# end of Net::SSLeay::dump_peer_certificate
1;
Git/usr/lib/perl5/vendor_perl/auto/Net/SSLeay/get_http.al
+9
View File
@@ -0,0 +1,9 @@
# NOTE: Derived from blib/lib/Net/SSLeay.pm.
# Changes made here will be lost when autosplit is run again.
# See AutoSplit.pm.
package Net::SSLeay;
#line 1419 "blib/lib/Net/SSLeay.pm (autosplit into blib/lib/auto/Net/SSLeay/get_http.al)"
sub get_http { do_httpx2(GET => 0, @_) }
# end of Net::SSLeay::get_http
1;
Git/usr/lib/perl5/vendor_perl/auto/Net/SSLeay/get_http3.al
+9
View File
@@ -0,0 +1,9 @@
# NOTE: Derived from blib/lib/Net/SSLeay.pm.
# Changes made here will be lost when autosplit is run again.
# See AutoSplit.pm.
package Net::SSLeay;
#line 1424 "blib/lib/Net/SSLeay.pm (autosplit into blib/lib/auto/Net/SSLeay/get_http3.al)"
sub get_http3 { do_httpx3(GET => 0, @_) }
# end of Net::SSLeay::get_http3
1;
Git/usr/lib/perl5/vendor_perl/auto/Net/SSLeay/get_http4.al
+9
View File
@@ -0,0 +1,9 @@
# NOTE: Derived from blib/lib/Net/SSLeay.pm.
# Changes made here will be lost when autosplit is run again.
# See AutoSplit.pm.
package Net::SSLeay;
#line 1429 "blib/lib/Net/SSLeay.pm (autosplit into blib/lib/auto/Net/SSLeay/get_http4.al)"
sub get_http4 { do_httpx4(GET => 0, @_) }
# end of Net::SSLeay::get_http4
1;
Git/usr/lib/perl5/vendor_perl/auto/Net/SSLeay/get_https.al
+9
View File
@@ -0,0 +1,9 @@
# NOTE: Derived from blib/lib/Net/SSLeay.pm.
# Changes made here will be lost when autosplit is run again.
# See AutoSplit.pm.
package Net::SSLeay;
#line 1402 "blib/lib/Net/SSLeay.pm (autosplit into blib/lib/auto/Net/SSLeay/get_https.al)"
sub get_https { do_httpx2(GET => 1, @_) }
# end of Net::SSLeay::get_https
1;
Git/usr/lib/perl5/vendor_perl/auto/Net/SSLeay/get_https3.al
+9
View File
@@ -0,0 +1,9 @@
# NOTE: Derived from blib/lib/Net/SSLeay.pm.
# Changes made here will be lost when autosplit is run again.
# See AutoSplit.pm.
package Net::SSLeay;
#line 1407 "blib/lib/Net/SSLeay.pm (autosplit into blib/lib/auto/Net/SSLeay/get_https3.al)"
sub get_https3 { do_httpx3(GET => 1, @_) }
# end of Net::SSLeay::get_https3
1;
Git/usr/lib/perl5/vendor_perl/auto/Net/SSLeay/get_https4.al
+9
View File
@@ -0,0 +1,9 @@
# NOTE: Derived from blib/lib/Net/SSLeay.pm.
# Changes made here will be lost when autosplit is run again.
# See AutoSplit.pm.
package Net::SSLeay;
#line 1412 "blib/lib/Net/SSLeay.pm (autosplit into blib/lib/auto/Net/SSLeay/get_https4.al)"
sub get_https4 { do_httpx4(GET => 1, @_) }
# end of Net::SSLeay::get_https4
1;
Git/usr/lib/perl5/vendor_perl/auto/Net/SSLeay/get_httpx.al
+9
View File
@@ -0,0 +1,9 @@
# NOTE: Derived from blib/lib/Net/SSLeay.pm.
# Changes made here will be lost when autosplit is run again.
# See AutoSplit.pm.
package Net::SSLeay;
#line 1436 "blib/lib/Net/SSLeay.pm (autosplit into blib/lib/auto/Net/SSLeay/get_httpx.al)"
sub get_httpx { do_httpx2(GET => @_) }
# end of Net::SSLeay::get_httpx
1;
Git/usr/lib/perl5/vendor_perl/auto/Net/SSLeay/get_httpx3.al
+9
View File
@@ -0,0 +1,9 @@
# NOTE: Derived from blib/lib/Net/SSLeay.pm.
# Changes made here will be lost when autosplit is run again.
# See AutoSplit.pm.
package Net::SSLeay;
#line 1441 "blib/lib/Net/SSLeay.pm (autosplit into blib/lib/auto/Net/SSLeay/get_httpx3.al)"
sub get_httpx3 { do_httpx3(GET => @_) }
# end of Net::SSLeay::get_httpx3
1;
Git/usr/lib/perl5/vendor_perl/auto/Net/SSLeay/get_httpx4.al
+9
View File
@@ -0,0 +1,9 @@
# NOTE: Derived from blib/lib/Net/SSLeay.pm.
# Changes made here will be lost when autosplit is run again.
# See AutoSplit.pm.
package Net::SSLeay;
#line 1446 "blib/lib/Net/SSLeay.pm (autosplit into blib/lib/auto/Net/SSLeay/get_httpx4.al)"
sub get_httpx4 { do_httpx4(GET => @_) }
# end of Net::SSLeay::get_httpx4
1;
Git/usr/lib/perl5/vendor_perl/auto/Net/SSLeay/head_http.al
+10
View File
@@ -0,0 +1,10 @@
# NOTE: Derived from blib/lib/Net/SSLeay.pm.
# Changes made here will be lost when autosplit is run again.
# See AutoSplit.pm.
package Net::SSLeay;
#line 1422 "blib/lib/Net/SSLeay.pm (autosplit into blib/lib/auto/Net/SSLeay/head_http.al)"
sub head_http { do_httpx2(HEAD => 0, @_) }
# end of Net::SSLeay::head_http
1;
Git/usr/lib/perl5/vendor_perl/auto/Net/SSLeay/head_http3.al
+10
View File
@@ -0,0 +1,10 @@
# NOTE: Derived from blib/lib/Net/SSLeay.pm.
# Changes made here will be lost when autosplit is run again.
# See AutoSplit.pm.
package Net::SSLeay;
#line 1427 "blib/lib/Net/SSLeay.pm (autosplit into blib/lib/auto/Net/SSLeay/head_http3.al)"
sub head_http3 { do_httpx3(HEAD => 0, @_) }
# end of Net::SSLeay::head_http3
1;
Git/usr/lib/perl5/vendor_perl/auto/Net/SSLeay/head_http4.al
+12
View File
@@ -0,0 +1,12 @@
# NOTE: Derived from blib/lib/Net/SSLeay.pm.
# Changes made here will be lost when autosplit is run again.
# See AutoSplit.pm.
package Net::SSLeay;
#line 1432 "blib/lib/Net/SSLeay.pm (autosplit into blib/lib/auto/Net/SSLeay/head_http4.al)"
sub head_http4 { do_httpx4(HEAD => 0, @_) }
# Either https or http
# end of Net::SSLeay::head_http4
1;
Git/usr/lib/perl5/vendor_perl/auto/Net/SSLeay/head_https.al
+10
View File
@@ -0,0 +1,10 @@
# NOTE: Derived from blib/lib/Net/SSLeay.pm.
# Changes made here will be lost when autosplit is run again.
# See AutoSplit.pm.
package Net::SSLeay;
#line 1405 "blib/lib/Net/SSLeay.pm (autosplit into blib/lib/auto/Net/SSLeay/head_https.al)"
sub head_https { do_httpx2(HEAD => 1, @_) }
# end of Net::SSLeay::head_https
1;
Git/usr/lib/perl5/vendor_perl/auto/Net/SSLeay/head_https3.al
+10
View File
@@ -0,0 +1,10 @@
# NOTE: Derived from blib/lib/Net/SSLeay.pm.
# Changes made here will be lost when autosplit is run again.
# See AutoSplit.pm.
package Net::SSLeay;
#line 1410 "blib/lib/Net/SSLeay.pm (autosplit into blib/lib/auto/Net/SSLeay/head_https3.al)"
sub head_https3 { do_httpx3(HEAD => 1, @_) }
# end of Net::SSLeay::head_https3
1;
Git/usr/lib/perl5/vendor_perl/auto/Net/SSLeay/head_https4.al
+12
View File
@@ -0,0 +1,12 @@
# NOTE: Derived from blib/lib/Net/SSLeay.pm.
# Changes made here will be lost when autosplit is run again.
# See AutoSplit.pm.
package Net::SSLeay;
#line 1415 "blib/lib/Net/SSLeay.pm (autosplit into blib/lib/auto/Net/SSLeay/head_https4.al)"
sub head_https4 { do_httpx4(HEAD => 1, @_) }
# http
# end of Net::SSLeay::head_https4
1;
Git/usr/lib/perl5/vendor_perl/auto/Net/SSLeay/head_httpx.al
+10
View File
@@ -0,0 +1,10 @@
# NOTE: Derived from blib/lib/Net/SSLeay.pm.
# Changes made here will be lost when autosplit is run again.
# See AutoSplit.pm.
package Net::SSLeay;
#line 1439 "blib/lib/Net/SSLeay.pm (autosplit into blib/lib/auto/Net/SSLeay/head_httpx.al)"
sub head_httpx { do_httpx2(HEAD => @_) }
# end of Net::SSLeay::head_httpx
1;
Git/usr/lib/perl5/vendor_perl/auto/Net/SSLeay/head_httpx3.al
+10
View File
@@ -0,0 +1,10 @@
# NOTE: Derived from blib/lib/Net/SSLeay.pm.
# Changes made here will be lost when autosplit is run again.
# See AutoSplit.pm.
package Net::SSLeay;
#line 1444 "blib/lib/Net/SSLeay.pm (autosplit into blib/lib/auto/Net/SSLeay/head_httpx3.al)"
sub head_httpx3 { do_httpx3(HEAD => @_) }
# end of Net::SSLeay::head_httpx3
1;
Git/usr/lib/perl5/vendor_perl/auto/Net/SSLeay/head_httpx4.al
+13
View File
@@ -0,0 +1,13 @@
# NOTE: Derived from blib/lib/Net/SSLeay.pm.
# Changes made here will be lost when autosplit is run again.
# See AutoSplit.pm.
package Net::SSLeay;
#line 1449 "blib/lib/Net/SSLeay.pm (autosplit into blib/lib/auto/Net/SSLeay/head_httpx4.al)"
sub head_httpx4 { do_httpx4(HEAD => @_) }
### Legacy, don't use
# ($page, $respone_or_err, %headers) = do_https(...);
# end of Net::SSLeay::head_httpx4
1;
Git/usr/lib/perl5/vendor_perl/auto/Net/SSLeay/http_cat.al
+34
View File
@@ -0,0 +1,34 @@
# NOTE: Derived from blib/lib/Net/SSLeay.pm.
# Changes made here will be lost when autosplit is run again.
# See AutoSplit.pm.
package Net::SSLeay;
#line 1237 "blib/lib/Net/SSLeay.pm (autosplit into blib/lib/auto/Net/SSLeay/http_cat.al)"
sub http_cat { # address, port, message --> returns reply / (reply,errs,cert)
my ($dest_serv, $port, $out_message) = @_;
my ($got, $errs, $written);
($got, $errs) = open_proxy_tcp_connection($dest_serv, $port);
return (wantarray ? (undef, $errs) : undef) unless $got;
### Connected. Exchange some data (doing repeated tries if necessary).
warn "http_cat $$: sending " . blength($out_message) . " bytes...\n"
if $trace==3;
warn "http_cat $$: sending `$out_message' (" . blength($out_message)
. " bytes)...\n" if $trace>3;
($written, $errs) = tcp_write_all($out_message);
goto cleanup unless $written;
warn "waiting for reply...\n" if $trace>2;
($got, $errs) = tcp_read_all();
warn "Got " . blength($got) . " bytes.\n" if $trace==3;
warn "Got `$got' (" . blength($got) . " bytes)\n" if $trace>3;
cleanup:
close SSLCAT_S;
return wantarray ? ($got, $errs) : $got;
}
# end of Net::SSLeay::http_cat
1;
Git/usr/lib/perl5/vendor_perl/auto/Net/SSLeay/https_cat.al
+95
View File
@@ -0,0 +1,95 @@
# NOTE: Derived from blib/lib/Net/SSLeay.pm.
# Changes made here will be lost when autosplit is run again.
# See AutoSplit.pm.
package Net::SSLeay;
#line 1150 "blib/lib/Net/SSLeay.pm (autosplit into blib/lib/auto/Net/SSLeay/https_cat.al)"
###
### Basic request - response primitive, this is different from sslcat
### because this does not shutdown the connection.
###
sub https_cat { # address, port, message --> returns reply / (reply,errs,cert)
my ($dest_serv, $port, $out_message, $crt_path, $key_path) = @_;
my ($ctx, $ssl, $got, $errs, $written);
($got, $errs) = open_proxy_tcp_connection($dest_serv, $port);
return (wantarray ? (undef, $errs) : undef) unless $got;
### Do SSL negotiation stuff
warn "Creating SSL $ssl_version context...\n" if $trace>2;
initialize();
$ctx = new_x_ctx();
goto cleanup2 if $errs = print_errs('CTX_new') or !$ctx;
CTX_set_options($ctx, &OP_ALL);
goto cleanup2 if $errs = print_errs('CTX_set_options');
warn "Cert `$crt_path' given without key" if $crt_path && !$key_path;
set_cert_and_key($ctx, $crt_path, $key_path) if $crt_path;
warn "Creating SSL connection (context was '$ctx')...\n" if $trace>2;
$ssl = new($ctx);
goto cleanup if $errs = print_errs('SSL_new') or !$ssl;
warn "Setting fd (ctx $ctx, con $ssl)...\n" if $trace>2;
set_fd($ssl, fileno(SSLCAT_S));
goto cleanup if $errs = print_errs('set_fd');
warn "Entering SSL negotiation phase...\n" if $trace>2;
if ($trace>2) {
my $i = 0;
my $p = '';
my $cipher_list = 'Cipher list: ';
$p=Net::SSLeay::get_cipher_list($ssl,$i);
$cipher_list .= $p if $p;
do {
$i++;
$cipher_list .= ', ' . $p if $p;
$p=Net::SSLeay::get_cipher_list($ssl,$i);
} while $p;
$cipher_list .= '\n';
warn $cipher_list;
}
$got = Net::SSLeay::connect($ssl);
warn "SSLeay connect failed" if $trace>2 && $got==0;
goto cleanup if $errs = print_errs('SSL_connect');
my $server_cert = get_peer_certificate($ssl);
print_errs('get_peer_certificate');
if ($trace>1) {
warn "Cipher `" . get_cipher($ssl) . "'\n";
print_errs('get_ciper');
warn dump_peer_certificate($ssl);
}
### Connected. Exchange some data (doing repeated tries if necessary).
warn "https_cat $$: sending " . blength($out_message) . " bytes...\n"
if $trace==3;
warn "https_cat $$: sending `$out_message' (" . blength($out_message)
. " bytes)...\n" if $trace>3;
($written, $errs) = ssl_write_all($ssl, $out_message);
goto cleanup unless $written;
warn "waiting for reply...\n" if $trace>2;
($got, $errs) = ssl_read_all($ssl);
warn "Got " . blength($got) . " bytes.\n" if $trace==3;
warn "Got `$got' (" . blength($got) . " bytes)\n" if $trace>3;
cleanup:
free ($ssl);
$errs .= print_errs('SSL_free');
cleanup2:
CTX_free ($ctx);
$errs .= print_errs('CTX_free');
close SSLCAT_S;
return wantarray ? ($got, $errs, $server_cert) : $got;
}
# end of Net::SSLeay::https_cat
1;
Git/usr/lib/perl5/vendor_perl/auto/Net/SSLeay/httpx_cat.al
+18
View File
@@ -0,0 +1,18 @@
# NOTE: Derived from blib/lib/Net/SSLeay.pm.
# Changes made here will be lost when autosplit is run again.
# See AutoSplit.pm.
package Net::SSLeay;
#line 1263 "blib/lib/Net/SSLeay.pm (autosplit into blib/lib/auto/Net/SSLeay/httpx_cat.al)"
sub httpx_cat {
my ($usessl, $site, $port, $req, $crt_path, $key_path) = @_;
warn "httpx_cat: usessl=$usessl ($site:$port)" if $trace;
if ($usessl) {
return https_cat($site, $port, $req, $crt_path, $key_path);
} else {
return http_cat($site, $port, $req);
}
}
# end of Net::SSLeay::httpx_cat
1;
Git/usr/lib/perl5/vendor_perl/auto/Net/SSLeay/initialize.al
+27
View File
@@ -0,0 +1,27 @@
# NOTE: Derived from blib/lib/Net/SSLeay.pm.
# Changes made here will be lost when autosplit is run again.
# See AutoSplit.pm.
package Net::SSLeay;
#line 1004 "blib/lib/Net/SSLeay.pm (autosplit into blib/lib/auto/Net/SSLeay/initialize.al)"
###
### Standard initialisation. Initialise the ssl library in the usual way
### at most once. Override this if you need differnet initialisation
### SSLeay_add_ssl_algorithms is also protected against multiple runs in SSLeay.xs
### and is also mutex protected in threading perls
###
my $library_initialised;
sub initialize
{
if (!$library_initialised)
{
load_error_strings(); # Some bloat, but I'm after ease of use
SSLeay_add_ssl_algorithms(); # and debuggability.
randomize();
$library_initialised++;
}
}
# end of Net::SSLeay::initialize
1;
Git/usr/lib/perl5/vendor_perl/auto/Net/SSLeay/make_form.al
+25
View File
@@ -0,0 +1,25 @@
# NOTE: Derived from blib/lib/Net/SSLeay.pm.
# Changes made here will be lost when autosplit is run again.
# See AutoSplit.pm.
package Net::SSLeay;
#line 1303 "blib/lib/Net/SSLeay.pm (autosplit into blib/lib/auto/Net/SSLeay/make_form.al)"
###
### Easy https manipulation routines
###
sub make_form {
my (@fields) = @_;
my $form;
while (@fields) {
my ($name, $data) = (shift(@fields), shift(@fields));
$data =~ s/([^\w\-.\@\$ ])/sprintf("%%%2.2x",ord($1))/gse;
$data =~ tr[ ][+];
$form .= "$name=$data&";
}
chop $form;
return $form;
}
# end of Net::SSLeay::make_form
1;
Git/usr/lib/perl5/vendor_perl/auto/Net/SSLeay/make_headers.al
+21
View File
@@ -0,0 +1,21 @@
# NOTE: Derived from blib/lib/Net/SSLeay.pm.
# Changes made here will be lost when autosplit is run again.
# See AutoSplit.pm.
package Net::SSLeay;
#line 1320 "blib/lib/Net/SSLeay.pm (autosplit into blib/lib/auto/Net/SSLeay/make_headers.al)"
sub make_headers {
my (@headers) = @_;
my $headers;
while (@headers) {
my $header = shift(@headers);
my $value = shift(@headers);
$header =~ s/:$//;
$value =~ s/\x0d?\x0a$//; # because we add it soon, see below
$headers .= "$header: $value$CRLF";
}
return $headers;
}
# end of Net::SSLeay::make_headers
1;
Git/usr/lib/perl5/vendor_perl/auto/Net/SSLeay/new_x_ctx.al
+36
View File
@@ -0,0 +1,36 @@
# NOTE: Derived from blib/lib/Net/SSLeay.pm.
# Changes made here will be lost when autosplit is run again.
# See AutoSplit.pm.
package Net::SSLeay;
#line 976 "blib/lib/Net/SSLeay.pm (autosplit into blib/lib/auto/Net/SSLeay/new_x_ctx.al)"
sub new_x_ctx {
if ($ssl_version == 2) {
unless (exists &Net::SSLeay::CTX_v2_new) {
warn "ssl_version has been set to 2, but this version of OpenSSL has been compiled without SSLv2 support";
return undef;
}
$ctx = CTX_v2_new();
}
elsif ($ssl_version == 3) { $ctx = CTX_v3_new(); }
elsif ($ssl_version == 10) { $ctx = CTX_tlsv1_new(); }
elsif ($ssl_version == 11) {
unless (exists &Net::SSLeay::CTX_tlsv1_1_new) {
warn "ssl_version has been set to 11, but this version of OpenSSL has been compiled without TLSv1.1 support";
return undef;
}
$ctx = CTX_tlsv1_1_new;
}
elsif ($ssl_version == 12) {
unless (exists &Net::SSLeay::CTX_tlsv1_2_new) {
warn "ssl_version has been set to 12, but this version of OpenSSL has been compiled without TLSv1.2 support";
return undef;
}
$ctx = CTX_tlsv1_2_new;
}
else { $ctx = CTX_new(); }
return $ctx;
}
# end of Net::SSLeay::new_x_ctx
1;
Git/usr/lib/perl5/vendor_perl/auto/Net/SSLeay/open_proxy_tcp_connection.al
+31
View File
@@ -0,0 +1,31 @@
# NOTE: Derived from blib/lib/Net/SSLeay.pm.
# Changes made here will be lost when autosplit is run again.
# See AutoSplit.pm.
package Net::SSLeay;
#line 542 "blib/lib/Net/SSLeay.pm (autosplit into blib/lib/auto/Net/SSLeay/open_proxy_tcp_connection.al)"
### Open connection via standard web proxy, if one was defined
### using set_proxy().
sub open_proxy_tcp_connection {
my ($dest_serv, $port) = @_;
return open_tcp_connection($dest_serv, $port) if !$proxyhost;
warn "Connect via proxy: $proxyhost:$proxyport" if $trace>2;
my ($ret, $errs) = open_tcp_connection($proxyhost, $proxyport);
return wantarray ? (0, $errs) : 0 if !$ret; # Connection fail
warn "Asking proxy to connect to $dest_serv:$port" if $trace>2;
#print SSLCAT_S "CONNECT $dest_serv:$port HTTP/1.0$proxyauth$CRLF$CRLF";
#my $line = <SSLCAT_S>; # *** bug? Mixing stdio with syscall read?
($ret, $errs) =
tcp_write_all("CONNECT $dest_serv:$port HTTP/1.0$proxyauth$CRLF$CRLF");
return wantarray ? (0,$errs) : 0 if $errs;
($line, $errs) = tcp_read_until($CRLF . $CRLF, 1024);
warn "Proxy response: $line" if $trace>2;
return wantarray ? (0,$errs) : 0 if $errs;
return wantarray ? (1,'') : 1; # Success
}
# end of Net::SSLeay::open_proxy_tcp_connection
1;
Git/usr/lib/perl5/vendor_perl/auto/Net/SSLeay/open_tcp_connection.al
+40
View File
@@ -0,0 +1,40 @@
# NOTE: Derived from blib/lib/Net/SSLeay.pm.
# Changes made here will be lost when autosplit is run again.
# See AutoSplit.pm.
package Net::SSLeay;
#line 510 "blib/lib/Net/SSLeay.pm (autosplit into blib/lib/auto/Net/SSLeay/open_tcp_connection.al)"
sub open_tcp_connection {
my ($dest_serv, $port) = @_;
my ($errs);
$port = getservbyname($port, 'tcp') unless $port =~ /^\d+$/;
my $dest_serv_ip = gethostbyname($dest_serv);
unless (defined($dest_serv_ip)) {
$errs = "$0 $$: open_tcp_connection: destination host not found:"
. " `$dest_serv' (port $port) ($!)\n";
warn $errs if $trace;
return wantarray ? (0, $errs) : 0;
}
my $sin = sockaddr_in($port, $dest_serv_ip);
warn "Opening connection to $dest_serv:$port (" .
inet_ntoa($dest_serv_ip) . ")" if $trace>2;
my $proto = &Socket::IPPROTO_TCP; # getprotobyname('tcp') not available on android
if (socket (SSLCAT_S, &PF_INET(), &SOCK_STREAM(), $proto)) {
warn "next connect" if $trace>3;
if (CORE::connect (SSLCAT_S, $sin)) {
my $old_out = select (SSLCAT_S); $| = 1; select ($old_out);
warn "connected to $dest_serv, $port" if $trace>3;
return wantarray ? (1, undef) : 1; # Success
}
}
$errs = "$0 $$: open_tcp_connection: failed `$dest_serv', $port ($!)\n";
warn $errs if $trace;
close SSLCAT_S;
return wantarray ? (0, $errs) : 0; # Fail
}
# end of Net::SSLeay::open_tcp_connection
1;
Git/usr/lib/perl5/vendor_perl/auto/Net/SSLeay/post_http.al
+9
View File
@@ -0,0 +1,9 @@
# NOTE: Derived from blib/lib/Net/SSLeay.pm.
# Changes made here will be lost when autosplit is run again.
# See AutoSplit.pm.
package Net::SSLeay;
#line 1420 "blib/lib/Net/SSLeay.pm (autosplit into blib/lib/auto/Net/SSLeay/post_http.al)"
sub post_http { do_httpx2(POST => 0, @_) }
# end of Net::SSLeay::post_http
1;
Git/usr/lib/perl5/vendor_perl/auto/Net/SSLeay/post_http3.al
+9
View File
@@ -0,0 +1,9 @@
# NOTE: Derived from blib/lib/Net/SSLeay.pm.
# Changes made here will be lost when autosplit is run again.
# See AutoSplit.pm.
package Net::SSLeay;
#line 1425 "blib/lib/Net/SSLeay.pm (autosplit into blib/lib/auto/Net/SSLeay/post_http3.al)"
sub post_http3 { do_httpx3(POST => 0, @_) }
# end of Net::SSLeay::post_http3
1;
Git/usr/lib/perl5/vendor_perl/auto/Net/SSLeay/post_http4.al
+9
View File
@@ -0,0 +1,9 @@
# NOTE: Derived from blib/lib/Net/SSLeay.pm.
# Changes made here will be lost when autosplit is run again.
# See AutoSplit.pm.
package Net::SSLeay;
#line 1430 "blib/lib/Net/SSLeay.pm (autosplit into blib/lib/auto/Net/SSLeay/post_http4.al)"
sub post_http4 { do_httpx4(POST => 0, @_) }
# end of Net::SSLeay::post_http4
1;
Git/usr/lib/perl5/vendor_perl/auto/Net/SSLeay/post_https.al
+9
View File
@@ -0,0 +1,9 @@
# NOTE: Derived from blib/lib/Net/SSLeay.pm.
# Changes made here will be lost when autosplit is run again.
# See AutoSplit.pm.
package Net::SSLeay;
#line 1403 "blib/lib/Net/SSLeay.pm (autosplit into blib/lib/auto/Net/SSLeay/post_https.al)"
sub post_https { do_httpx2(POST => 1, @_) }
# end of Net::SSLeay::post_https
1;
Git/usr/lib/perl5/vendor_perl/auto/Net/SSLeay/post_https3.al
+9
View File
@@ -0,0 +1,9 @@
# NOTE: Derived from blib/lib/Net/SSLeay.pm.
# Changes made here will be lost when autosplit is run again.
# See AutoSplit.pm.
package Net::SSLeay;
#line 1408 "blib/lib/Net/SSLeay.pm (autosplit into blib/lib/auto/Net/SSLeay/post_https3.al)"
sub post_https3 { do_httpx3(POST => 1, @_) }
# end of Net::SSLeay::post_https3
1;
Git/usr/lib/perl5/vendor_perl/auto/Net/SSLeay/post_https4.al
+9
View File
@@ -0,0 +1,9 @@
# NOTE: Derived from blib/lib/Net/SSLeay.pm.
# Changes made here will be lost when autosplit is run again.
# See AutoSplit.pm.
package Net::SSLeay;
#line 1413 "blib/lib/Net/SSLeay.pm (autosplit into blib/lib/auto/Net/SSLeay/post_https4.al)"
sub post_https4 { do_httpx4(POST => 1, @_) }
# end of Net::SSLeay::post_https4
1;
Git/usr/lib/perl5/vendor_perl/auto/Net/SSLeay/post_httpx.al
+9
View File
@@ -0,0 +1,9 @@
# NOTE: Derived from blib/lib/Net/SSLeay.pm.
# Changes made here will be lost when autosplit is run again.
# See AutoSplit.pm.
package Net::SSLeay;
#line 1437 "blib/lib/Net/SSLeay.pm (autosplit into blib/lib/auto/Net/SSLeay/post_httpx.al)"
sub post_httpx { do_httpx2(POST => @_) }
# end of Net::SSLeay::post_httpx
1;
Git/usr/lib/perl5/vendor_perl/auto/Net/SSLeay/post_httpx3.al
+9
View File
@@ -0,0 +1,9 @@
# NOTE: Derived from blib/lib/Net/SSLeay.pm.
# Changes made here will be lost when autosplit is run again.
# See AutoSplit.pm.
package Net::SSLeay;
#line 1442 "blib/lib/Net/SSLeay.pm (autosplit into blib/lib/auto/Net/SSLeay/post_httpx3.al)"
sub post_httpx3 { do_httpx3(POST => @_) }
# end of Net::SSLeay::post_httpx3
1;
Git/usr/lib/perl5/vendor_perl/auto/Net/SSLeay/post_httpx4.al
+9
View File
@@ -0,0 +1,9 @@
# NOTE: Derived from blib/lib/Net/SSLeay.pm.
# Changes made here will be lost when autosplit is run again.
# See AutoSplit.pm.
package Net::SSLeay;
#line 1447 "blib/lib/Net/SSLeay.pm (autosplit into blib/lib/auto/Net/SSLeay/post_httpx4.al)"
sub post_httpx4 { do_httpx4(POST => @_) }
# end of Net::SSLeay::post_httpx4
1;
Git/usr/lib/perl5/vendor_perl/auto/Net/SSLeay/put_http.al
+9
View File
@@ -0,0 +1,9 @@
# NOTE: Derived from blib/lib/Net/SSLeay.pm.
# Changes made here will be lost when autosplit is run again.
# See AutoSplit.pm.
package Net::SSLeay;
#line 1421 "blib/lib/Net/SSLeay.pm (autosplit into blib/lib/auto/Net/SSLeay/put_http.al)"
sub put_http { do_httpx2(PUT => 0, @_) }
# end of Net::SSLeay::put_http
1;
Git/usr/lib/perl5/vendor_perl/auto/Net/SSLeay/put_http3.al
+9
View File
@@ -0,0 +1,9 @@
# NOTE: Derived from blib/lib/Net/SSLeay.pm.
# Changes made here will be lost when autosplit is run again.
# See AutoSplit.pm.
package Net::SSLeay;
#line 1426 "blib/lib/Net/SSLeay.pm (autosplit into blib/lib/auto/Net/SSLeay/put_http3.al)"
sub put_http3 { do_httpx3(PUT => 0, @_) }
# end of Net::SSLeay::put_http3
1;
Git/usr/lib/perl5/vendor_perl/auto/Net/SSLeay/put_http4.al
+9
View File
@@ -0,0 +1,9 @@
# NOTE: Derived from blib/lib/Net/SSLeay.pm.
# Changes made here will be lost when autosplit is run again.
# See AutoSplit.pm.
package Net::SSLeay;
#line 1431 "blib/lib/Net/SSLeay.pm (autosplit into blib/lib/auto/Net/SSLeay/put_http4.al)"
sub put_http4 { do_httpx4(PUT => 0, @_) }
# end of Net::SSLeay::put_http4
1;
Git/usr/lib/perl5/vendor_perl/auto/Net/SSLeay/put_https.al
+9
View File
@@ -0,0 +1,9 @@
# NOTE: Derived from blib/lib/Net/SSLeay.pm.
# Changes made here will be lost when autosplit is run again.
# See AutoSplit.pm.
package Net::SSLeay;
#line 1404 "blib/lib/Net/SSLeay.pm (autosplit into blib/lib/auto/Net/SSLeay/put_https.al)"
sub put_https { do_httpx2(PUT => 1, @_) }
# end of Net::SSLeay::put_https
1;
Git/usr/lib/perl5/vendor_perl/auto/Net/SSLeay/put_https3.al
+9
View File
@@ -0,0 +1,9 @@
# NOTE: Derived from blib/lib/Net/SSLeay.pm.
# Changes made here will be lost when autosplit is run again.
# See AutoSplit.pm.
package Net::SSLeay;
#line 1409 "blib/lib/Net/SSLeay.pm (autosplit into blib/lib/auto/Net/SSLeay/put_https3.al)"
sub put_https3 { do_httpx3(PUT => 1, @_) }
# end of Net::SSLeay::put_https3
1;
Git/usr/lib/perl5/vendor_perl/auto/Net/SSLeay/put_https4.al
+9
View File
@@ -0,0 +1,9 @@
# NOTE: Derived from blib/lib/Net/SSLeay.pm.
# Changes made here will be lost when autosplit is run again.
# See AutoSplit.pm.
package Net::SSLeay;
#line 1414 "blib/lib/Net/SSLeay.pm (autosplit into blib/lib/auto/Net/SSLeay/put_https4.al)"
sub put_https4 { do_httpx4(PUT => 1, @_) }
# end of Net::SSLeay::put_https4
1;
Git/usr/lib/perl5/vendor_perl/auto/Net/SSLeay/put_httpx.al
+9
View File
@@ -0,0 +1,9 @@
# NOTE: Derived from blib/lib/Net/SSLeay.pm.
# Changes made here will be lost when autosplit is run again.
# See AutoSplit.pm.
package Net::SSLeay;
#line 1438 "blib/lib/Net/SSLeay.pm (autosplit into blib/lib/auto/Net/SSLeay/put_httpx.al)"
sub put_httpx { do_httpx2(PUT => @_) }
# end of Net::SSLeay::put_httpx
1;
Git/usr/lib/perl5/vendor_perl/auto/Net/SSLeay/put_httpx3.al
+9
View File
@@ -0,0 +1,9 @@
# NOTE: Derived from blib/lib/Net/SSLeay.pm.
# Changes made here will be lost when autosplit is run again.
# See AutoSplit.pm.
package Net::SSLeay;
#line 1443 "blib/lib/Net/SSLeay.pm (autosplit into blib/lib/auto/Net/SSLeay/put_httpx3.al)"
sub put_httpx3 { do_httpx3(PUT => @_) }
# end of Net::SSLeay::put_httpx3
1;
Git/usr/lib/perl5/vendor_perl/auto/Net/SSLeay/put_httpx4.al
+9
View File
@@ -0,0 +1,9 @@
# NOTE: Derived from blib/lib/Net/SSLeay.pm.
# Changes made here will be lost when autosplit is run again.
# See AutoSplit.pm.
package Net::SSLeay;
#line 1448 "blib/lib/Net/SSLeay.pm (autosplit into blib/lib/auto/Net/SSLeay/put_httpx4.al)"
sub put_httpx4 { do_httpx4(PUT => @_) }
# end of Net::SSLeay::put_httpx4
1;
Git/usr/lib/perl5/vendor_perl/auto/Net/SSLeay/randomize.al
+31
View File
@@ -0,0 +1,31 @@
# NOTE: Derived from blib/lib/Net/SSLeay.pm.
# Changes made here will be lost when autosplit is run again.
# See AutoSplit.pm.
package Net::SSLeay;
#line 953 "blib/lib/Net/SSLeay.pm (autosplit into blib/lib/auto/Net/SSLeay/randomize.al)"
### Arrange some randomness for eay PRNG
sub randomize (;$$$) {
my ($rn_seed_file, $seed, $egd_path) = @_;
my $rnsf = defined($rn_seed_file) && -r $rn_seed_file;
$egd_path = '';
$egd_path = $ENV{'EGD_PATH'} if $ENV{'EGD_PATH'};
RAND_seed(rand() + $$); # Stir it with time and pid
unless ($rnsf || -r $Net::SSLeay::random_device || $seed || -S $egd_path) {
my $poll_retval = Net::SSLeay::RAND_poll();
warn "Random number generator not seeded!!!" if $trace && !$poll_retval;
}
RAND_load_file($rn_seed_file, -s _) if $rnsf;
RAND_seed($seed) if $seed;
RAND_seed($ENV{RND_SEED}) if $ENV{RND_SEED};
RAND_load_file($Net::SSLeay::random_device, $Net::SSLeay::how_random/8)
if -r $Net::SSLeay::random_device;
}
# end of Net::SSLeay::randomize
1;
Git/usr/lib/perl5/vendor_perl/auto/Net/SSLeay/set_cert_and_key.al
+23
View File
@@ -0,0 +1,23 @@
# NOTE: Derived from blib/lib/Net/SSLeay.pm.
# Changes made here will be lost when autosplit is run again.
# See AutoSplit.pm.
package Net::SSLeay;
#line 1273 "blib/lib/Net/SSLeay.pm (autosplit into blib/lib/auto/Net/SSLeay/set_cert_and_key.al)"
###
### Easy set up of private key and certificate
###
sub set_cert_and_key ($$$) {
my ($ctx, $cert_path, $key_path) = @_;
my $errs = '';
# Following will ask password unless private key is not encrypted
CTX_use_PrivateKey_file ($ctx, $key_path, &FILETYPE_PEM);
$errs .= print_errs("private key `$key_path' ($!)");
CTX_use_certificate_file ($ctx, $cert_path, &FILETYPE_PEM);
$errs .= print_errs("certificate `$cert_path' ($!)");
return wantarray ? (undef, $errs) : ($errs eq '');
}
# end of Net::SSLeay::set_cert_and_key
1;
Git/usr/lib/perl5/vendor_perl/auto/Net/SSLeay/set_proxy.al
+17
View File
@@ -0,0 +1,17 @@
# NOTE: Derived from blib/lib/Net/SSLeay.pm.
# Changes made here will be lost when autosplit is run again.
# See AutoSplit.pm.
package Net::SSLeay;
#line 1294 "blib/lib/Net/SSLeay.pm (autosplit into blib/lib/auto/Net/SSLeay/set_proxy.al)"
sub set_proxy ($$;**) {
($proxyhost, $proxyport, $proxyuser, $proxypass) = @_;
require MIME::Base64 if $proxyuser;
$proxyauth = $proxyuser
? $CRLF . 'Proxy-authorization: Basic '
. MIME::Base64::encode("$proxyuser:$proxypass", '')
: '';
}
# end of Net::SSLeay::set_proxy
1;
Git/usr/lib/perl5/vendor_perl/auto/Net/SSLeay/set_server_cert_and_key.al
+14
View File
@@ -0,0 +1,14 @@
# NOTE: Derived from blib/lib/Net/SSLeay.pm.
# Changes made here will be lost when autosplit is run again.
# See AutoSplit.pm.
package Net::SSLeay;
#line 1288 "blib/lib/Net/SSLeay.pm (autosplit into blib/lib/auto/Net/SSLeay/set_server_cert_and_key.al)"
### Old deprecated API
sub set_server_cert_and_key ($$$) { &set_cert_and_key }
### Set up to use web proxy
# end of Net::SSLeay::set_server_cert_and_key
1;
Git/usr/lib/perl5/vendor_perl/auto/Net/SSLeay/ssl_read_CRLF.al
+10
View File
@@ -0,0 +1,10 @@
# NOTE: Derived from blib/lib/Net/SSLeay.pm.
# Changes made here will be lost when autosplit is run again.
# See AutoSplit.pm.
package Net::SSLeay;
#line 897 "blib/lib/Net/SSLeay.pm (autosplit into blib/lib/auto/Net/SSLeay/ssl_read_CRLF.al)"
# ssl_read_CRLF($ssl [, $max_length])
sub ssl_read_CRLF ($;$) { ssl_read_until($_[0], $CRLF, $_[1]) }
# end of Net::SSLeay::ssl_read_CRLF
1;
Git/usr/lib/perl5/vendor_perl/auto/Net/SSLeay/ssl_read_all.al
+28
View File
@@ -0,0 +1,28 @@
# NOTE: Derived from blib/lib/Net/SSLeay.pm.
# Changes made here will be lost when autosplit is run again.
# See AutoSplit.pm.
package Net::SSLeay;
#line 579 "blib/lib/Net/SSLeay.pm (autosplit into blib/lib/auto/Net/SSLeay/ssl_read_all.al)"
sub ssl_read_all {
my ($ssl,$how_much) = @_;
$how_much = 2000000000 unless $how_much;
my ($got, $errs);
my $reply = '';
while ($how_much > 0) {
$got = Net::SSLeay::read($ssl,
($how_much > 32768) ? 32768 : $how_much
);
last if $errs = print_errs('SSL_read');
$how_much -= blength($got);
debug_read(\$reply, \$got) if $trace>1;
last if $got eq ''; # EOF
$reply .= $got;
}
return wantarray ? ($reply, $errs) : $reply;
}
# end of Net::SSLeay::ssl_read_all
1;
Git/usr/lib/perl5/vendor_perl/auto/Net/SSLeay/ssl_read_until.al
+94
View File
@@ -0,0 +1,94 @@
# NOTE: Derived from blib/lib/Net/SSLeay.pm.
# Changes made here will be lost when autosplit is run again.
# See AutoSplit.pm.
package Net::SSLeay;
#line 786 "blib/lib/Net/SSLeay.pm (autosplit into blib/lib/auto/Net/SSLeay/ssl_read_until.al)"
### from patch by Clinton Wong <clintdw@netcom.com>
# ssl_read_until($ssl [, $delimit [, $max_length]])
# if $delimit missing, use $/ if it exists, otherwise use \n
# read until delimiter reached, up to $max_length chars if defined
sub ssl_read_until ($;$$) {
my ($ssl,$delim, $max_length) = @_;
# guess the delim string if missing
if ( ! defined $delim ) {
if ( defined $/ && length $/ ) { $delim = $/ }
else { $delim = "\n" } # Note: \n,$/ value depends on the platform
}
my $len_delim = length $delim;
my ($got);
my $reply = '';
# If we have OpenSSL 0.9.6a or later, we can use SSL_peek to
# speed things up.
# N.B. 0.9.6a has security problems, so the support for
# anything earlier than 0.9.6e will be dropped soon.
if (&Net::SSLeay::OPENSSL_VERSION_NUMBER >= 0x0090601f) {
$max_length = 2000000000 unless (defined $max_length);
my ($pending, $peek_length, $found, $done);
while (blength($reply) < $max_length and !$done) {
#Block if necessary until we get some data
$got = Net::SSLeay::peek($ssl,1);
last if print_errs('SSL_peek');
$pending = Net::SSLeay::pending($ssl) + blength($reply);
$peek_length = ($pending > $max_length) ? $max_length : $pending;
$peek_length -= blength($reply);
$got = Net::SSLeay::peek($ssl, $peek_length);
last if print_errs('SSL_peek');
$peek_length = blength($got);
#$found = index($got, $delim); # Old and broken
# the delimiter may be split across two gets, so we prepend
# a little from the last get onto this one before we check
# for a match
my $match;
if(blength($reply) >= blength($delim) - 1) {
#if what we've read so far is greater or equal
#in length of what we need to prepatch
$match = substr $reply, blength($reply) - blength($delim) + 1;
} else {
$match = $reply;
}
$match .= $got;
$found = index($match, $delim);
if ($found > -1) {
#$got = Net::SSLeay::read($ssl, $found+$len_delim);
#read up to the end of the delimiter
$got = Net::SSLeay::read($ssl,
$found + $len_delim
- ((blength($match)) - (blength($got))));
$done = 1;
} else {
$got = Net::SSLeay::read($ssl, $peek_length);
$done = 1 if ($peek_length == $max_length - blength($reply));
}
last if print_errs('SSL_read');
debug_read(\$reply, \$got) if $trace>1;
last if $got eq '';
$reply .= $got;
}
} else {
while (!defined $max_length || length $reply < $max_length) {
$got = Net::SSLeay::read($ssl,1); # one by one
last if print_errs('SSL_read');
debug_read(\$reply, \$got) if $trace>1;
last if $got eq '';
$reply .= $got;
last if $len_delim
&& substr($reply, blength($reply)-$len_delim) eq $delim;
}
}
return $reply;
}
# end of Net::SSLeay::ssl_read_until
1;
Git/usr/lib/perl5/vendor_perl/auto/Net/SSLeay/ssl_write_CRLF.al
+23
View File
@@ -0,0 +1,23 @@
# NOTE: Derived from blib/lib/Net/SSLeay.pm.
# Changes made here will be lost when autosplit is run again.
# See AutoSplit.pm.
package Net::SSLeay;
#line 902 "blib/lib/Net/SSLeay.pm (autosplit into blib/lib/auto/Net/SSLeay/ssl_write_CRLF.al)"
sub ssl_write_CRLF ($$) {
# the next line uses less memory but might use more network packets
return ssl_write_all($_[0], $_[1]) + ssl_write_all($_[0], $CRLF);
# the next few lines do the same thing at the expense of memory, with
# the chance that it will use less packets, since CRLF is in the original
# message and won't be sent separately.
#my $data_ref;
#if (ref $_[1]) { $data_ref = $_[1] }
# else { $data_ref = \$_[1] }
#my $message = $$data_ref . $CRLF;
#return ssl_write_all($_[0], \$message);
}
# end of Net::SSLeay::ssl_write_CRLF
1;
Git/usr/lib/perl5/vendor_perl/auto/Net/SSLeay/ssl_write_all.al
+149
View File
@@ -0,0 +1,149 @@
# NOTE: Derived from blib/lib/Net/SSLeay.pm.
# Changes made here will be lost when autosplit is run again.
# See AutoSplit.pm.
package Net::SSLeay;
#line 617 "blib/lib/Net/SSLeay.pm (autosplit into blib/lib/auto/Net/SSLeay/ssl_write_all.al)"
sub ssl_write_all {
my $ssl = $_[0];
my ($data_ref, $errs);
if (ref $_[1]) {
$data_ref = $_[1];
} else {
$data_ref = \$_[1];
}
my ($wrote, $written, $to_write) = (0,0, blength($$data_ref));
my $vm = $trace>2 && $linux_debug ?
(split ' ', `cat /proc/$$/stat`)[22] : 'vm_unknown';
warn " write_all VM at entry=$vm\n" if $trace>2;
while ($to_write) {
#sleep 1; # *** DEBUG
warn "partial `$$data_ref'\n" if $trace>3;
$wrote = write_partial($ssl, $written, $to_write, $$data_ref);
if (defined $wrote && ($wrote > 0)) { # write_partial can return -1
$written += $wrote;
$to_write -= $wrote;
} else {
if (defined $wrote) {
# check error conditions via SSL_get_error per man page
if ( my $sslerr = get_error($ssl, $wrote) ) {
my $errstr = ERR_error_string($sslerr);
my $errname = '';
SWITCH: {
$sslerr == constant("ERROR_NONE") && do {
# according to map page SSL_get_error(3ssl):
# The TLS/SSL I/O operation completed.
# This result code is returned if and only if ret > 0
# so if we received it here complain...
warn "ERROR_NONE unexpected with invalid return value!"
if $trace;
$errname = "SSL_ERROR_NONE";
};
$sslerr == constant("ERROR_WANT_READ") && do {
# operation did not complete, call again later, so do not
# set errname and empty err_que since this is a known
# error that is expected but, we should continue to try
# writing the rest of our data with same io call and params.
warn "ERROR_WANT_READ (TLS/SSL Handshake, will continue)\n"
if $trace;
print_errs('SSL_write(want read)');
last SWITCH;
};
$sslerr == constant("ERROR_WANT_WRITE") && do {
# operation did not complete, call again later, so do not
# set errname and empty err_que since this is a known
# error that is expected but, we should continue to try
# writing the rest of our data with same io call and params.
warn "ERROR_WANT_WRITE (TLS/SSL Handshake, will continue)\n"
if $trace;
print_errs('SSL_write(want write)');
last SWITCH;
};
$sslerr == constant("ERROR_ZERO_RETURN") && do {
# valid protocol closure from other side, no longer able to
# write, since there is no longer a session...
warn "ERROR_ZERO_RETURN($wrote): TLS/SSLv3 Closure alert\n"
if $trace;
$errname = "SSL_ERROR_ZERO_RETURN";
last SWITCH;
};
$sslerr == constant("ERROR_SSL") && do {
# library/protocol error
warn "ERROR_SSL($wrote): Library/Protocol error occured\n"
if $trace;
$errname = "SSL_ERROR_SSL";
last SWITCH;
};
$sslerr == constant("ERROR_WANT_CONNECT") && do {
# according to man page, should never happen on call to
# SSL_write, so complain, but handle as known error type
warn "ERROR_WANT_CONNECT: Unexpected error for SSL_write\n"
if $trace;
$errname = "SSL_ERROR_WANT_CONNECT";
last SWITCH;
};
$sslerr == constant("ERROR_WANT_ACCEPT") && do {
# according to man page, should never happen on call to
# SSL_write, so complain, but handle as known error type
warn "ERROR_WANT_ACCEPT: Unexpected error for SSL_write\n"
if $trace;
$errname = "SSL_ERROR_WANT_ACCEPT";
last SWITCH;
};
$sslerr == constant("ERROR_WANT_X509_LOOKUP") && do {
# operation did not complete: waiting on call back,
# call again later, so do not set errname and empty err_que
# since this is a known error that is expected but, we should
# continue to try writing the rest of our data with same io
# call parameter.
warn "ERROR_WANT_X509_LOOKUP: (Cert Callback asked for in ".
"SSL_write will contine)\n" if $trace;
print_errs('SSL_write(want x509');
last SWITCH;
};
$sslerr == constant("ERROR_SYSCALL") && do {
# some IO error occured. According to man page:
# Check retval, ERR, fallback to errno
if ($wrote==0) { # EOF
warn "ERROR_SYSCALL($wrote): EOF violates protocol.\n"
if $trace;
$errname = "SSL_ERROR_SYSCALL(EOF)";
} else { # -1 underlying BIO error reported.
# check error que for details, don't set errname since we
# are directly appending to errs
my $chkerrs = print_errs('SSL_write (syscall)');
if ($chkerrs) {
warn "ERROR_SYSCALL($wrote): Have errors\n" if $trace;
$errs .= "ssl_write_all $$: 1 - ERROR_SYSCALL($wrote,".
"$sslerr,$errstr,$!)\n$chkerrs";
} else { # que was empty, use errno
warn "ERROR_SYSCALL($wrote): errno($!)\n" if $trace;
$errs .= "ssl_write_all $$: 1 - ERROR_SYSCALL($wrote,".
"$sslerr) : $!\n";
}
}
last SWITCH;
};
warn "Unhandled val $sslerr from SSL_get_error(SSL,$wrote)\n"
if $trace;
$errname = "SSL_ERROR_?($sslerr)";
} # end of SWITCH block
if ($errname) { # if we had an errname set add the error
$errs .= "ssl_write_all $$: 1 - $errname($wrote,$sslerr,".
"$errstr,$!)\n";
}
} # endif on have SSL_get_error val
} # endif on $wrote defined
} # endelse on $wrote > 0
$vm = $trace>2 && $linux_debug ?
(split ' ', `cat /proc/$$/stat`)[22] : 'vm_unknown';
warn " written so far $wrote:$written bytes (VM=$vm)\n" if $trace>2;
# append remaining errors in que and report if errs exist
$errs .= print_errs('SSL_write');
return (wantarray ? (undef, $errs) : undef) if $errs;
}
return wantarray ? ($written, $errs) : $written;
}
# end of Net::SSLeay::ssl_write_all
1;
Git/usr/lib/perl5/vendor_perl/auto/Net/SSLeay/sslcat.al
+97
View File
@@ -0,0 +1,97 @@
# NOTE: Derived from blib/lib/Net/SSLeay.pm.
# Changes made here will be lost when autosplit is run again.
# See AutoSplit.pm.
package Net::SSLeay;
#line 1023 "blib/lib/Net/SSLeay.pm (autosplit into blib/lib/auto/Net/SSLeay/sslcat.al)"
###
### Basic request - response primitive (don't use for https)
###
sub sslcat { # address, port, message, $crt, $key --> reply / (reply,errs,cert)
my ($dest_serv, $port, $out_message, $crt_path, $key_path) = @_;
my ($ctx, $ssl, $got, $errs, $written);
($got, $errs) = open_proxy_tcp_connection($dest_serv, $port);
return (wantarray ? (undef, $errs) : undef) unless $got;
### Do SSL negotiation stuff
warn "Creating SSL $ssl_version context...\n" if $trace>2;
initialize(); # Will init at most once
$ctx = new_x_ctx();
goto cleanup2 if $errs = print_errs('CTX_new') or !$ctx;
CTX_set_options($ctx, &OP_ALL);
goto cleanup2 if $errs = print_errs('CTX_set_options');
warn "Cert `$crt_path' given without key" if $crt_path && !$key_path;
set_cert_and_key($ctx, $crt_path, $key_path) if $crt_path;
warn "Creating SSL connection (context was '$ctx')...\n" if $trace>2;
$ssl = new($ctx);
goto cleanup if $errs = print_errs('SSL_new') or !$ssl;
warn "Setting fd (ctx $ctx, con $ssl)...\n" if $trace>2;
set_fd($ssl, fileno(SSLCAT_S));
goto cleanup if $errs = print_errs('set_fd');
warn "Entering SSL negotiation phase...\n" if $trace>2;
if ($trace>2) {
my $i = 0;
my $p = '';
my $cipher_list = 'Cipher list: ';
$p=Net::SSLeay::get_cipher_list($ssl,$i);
$cipher_list .= $p if $p;
do {
$i++;
$cipher_list .= ', ' . $p if $p;
$p=Net::SSLeay::get_cipher_list($ssl,$i);
} while $p;
$cipher_list .= '\n';
warn $cipher_list;
}
$got = Net::SSLeay::connect($ssl);
warn "SSLeay connect returned $got\n" if $trace>2;
goto cleanup if $errs = print_errs('SSL_connect');
my $server_cert = get_peer_certificate($ssl);
print_errs('get_peer_certificate');
if ($trace>1) {
warn "Cipher `" . get_cipher($ssl) . "'\n";
print_errs('get_ciper');
warn dump_peer_certificate($ssl);
}
### Connected. Exchange some data (doing repeated tries if necessary).
warn "sslcat $$: sending " . blength($out_message) . " bytes...\n"
if $trace==3;
warn "sslcat $$: sending `$out_message' (" . blength($out_message)
. " bytes)...\n" if $trace>3;
($written, $errs) = ssl_write_all($ssl, $out_message);
goto cleanup unless $written;
sleep $slowly if $slowly; # Closing too soon can abort broken servers
CORE::shutdown SSLCAT_S, 1; # Half close --> No more output, send EOF to server
warn "waiting for reply...\n" if $trace>2;
($got, $errs) = ssl_read_all($ssl);
warn "Got " . blength($got) . " bytes.\n" if $trace==3;
warn "Got `$got' (" . blength($got) . " bytes)\n" if $trace>3;
cleanup:
free ($ssl);
$errs .= print_errs('SSL_free');
cleanup2:
CTX_free ($ctx);
$errs .= print_errs('CTX_free');
close SSLCAT_S;
return wantarray ? ($got, $errs, $server_cert) : $got;
}
# end of Net::SSLeay::sslcat
1;
Git/usr/lib/perl5/vendor_perl/auto/Net/SSLeay/tcp_read_CRLF.al
+11
View File
@@ -0,0 +1,11 @@
# NOTE: Derived from blib/lib/Net/SSLeay.pm.
# Changes made here will be lost when autosplit is run again.
# See AutoSplit.pm.
package Net::SSLeay;
#line 899 "blib/lib/Net/SSLeay.pm (autosplit into blib/lib/auto/Net/SSLeay/tcp_read_CRLF.al)"
sub tcp_read_CRLF { tcp_read_until($CRLF, $_[0]) }
# ssl_write_CRLF($ssl, $message) writes $message and appends CRLF
# end of Net::SSLeay::tcp_read_CRLF
1;
Git/usr/lib/perl5/vendor_perl/auto/Net/SSLeay/tcp_read_all.al
+26
View File
@@ -0,0 +1,26 @@
# NOTE: Derived from blib/lib/Net/SSLeay.pm.
# Changes made here will be lost when autosplit is run again.
# See AutoSplit.pm.
package Net::SSLeay;
#line 599 "blib/lib/Net/SSLeay.pm (autosplit into blib/lib/auto/Net/SSLeay/tcp_read_all.al)"
sub tcp_read_all {
my ($how_much) = @_;
$how_much = 2000000000 unless $how_much;
my ($n, $got, $errs);
my $reply = '';
my $bsize = 0x10000;
while ($how_much > 0) {
$n = sysread(SSLCAT_S,$got, (($bsize < $how_much) ? $bsize : $how_much));
warn "Read error: $! ($n,$how_much)" unless defined $n;
last if !$n; # EOF
$how_much -= $n;
debug_read(\$reply, \$got) if $trace>1;
$reply .= $got;
}
return wantarray ? ($reply, $errs) : $reply;
}
# end of Net::SSLeay::tcp_read_all
1;
Git/usr/lib/perl5/vendor_perl/auto/Net/SSLeay/tcp_read_until.al
+33
View File
@@ -0,0 +1,33 @@
# NOTE: Derived from blib/lib/Net/SSLeay.pm.
# Changes made here will be lost when autosplit is run again.
# See AutoSplit.pm.
package Net::SSLeay;
#line 872 "blib/lib/Net/SSLeay.pm (autosplit into blib/lib/auto/Net/SSLeay/tcp_read_until.al)"
sub tcp_read_until {
my ($delim, $max_length) = @_;
# guess the delim string if missing
if ( ! defined $delim ) {
if ( defined $/ && length $/ ) { $delim = $/ }
else { $delim = "\n" } # Note: \n,$/ value depends on the platform
}
my $len_delim = length $delim;
my ($n,$got);
my $reply = '';
while (!defined $max_length || length $reply < $max_length) {
$n = sysread(SSLCAT_S, $got, 1); # one by one
warn "tcp_read_until: $!" if !defined $n;
debug_read(\$reply, \$got) if $trace>1;
last if !$n; # EOF
$reply .= $got;
last if $len_delim
&& substr($reply, blength($reply)-$len_delim) eq $delim;
}
return $reply;
}
# end of Net::SSLeay::tcp_read_until
1;
Git/usr/lib/perl5/vendor_perl/auto/Net/SSLeay/tcp_write_CRLF.al
+23
View File
@@ -0,0 +1,23 @@
# NOTE: Derived from blib/lib/Net/SSLeay.pm.
# Changes made here will be lost when autosplit is run again.
# See AutoSplit.pm.
package Net::SSLeay;
#line 917 "blib/lib/Net/SSLeay.pm (autosplit into blib/lib/auto/Net/SSLeay/tcp_write_CRLF.al)"
sub tcp_write_CRLF {
# the next line uses less memory but might use more network packets
return tcp_write_all($_[0]) + tcp_write_all($CRLF);
# the next few lines do the same thing at the expense of memory, with
# the chance that it will use less packets, since CRLF is in the original
# message and won't be sent separately.
#my $data_ref;
#if (ref $_[1]) { $data_ref = $_[1] }
# else { $data_ref = \$_[1] }
#my $message = $$data_ref . $CRLF;
#return tcp_write_all($_[0], \$message);
}
# end of Net::SSLeay::tcp_write_CRLF
1;
Git/usr/lib/perl5/vendor_perl/auto/Net/SSLeay/tcp_write_all.al
+36
View File
@@ -0,0 +1,36 @@
# NOTE: Derived from blib/lib/Net/SSLeay.pm.
# Changes made here will be lost when autosplit is run again.
# See AutoSplit.pm.
package Net::SSLeay;
#line 758 "blib/lib/Net/SSLeay.pm (autosplit into blib/lib/auto/Net/SSLeay/tcp_write_all.al)"
sub tcp_write_all {
my ($data_ref, $errs);
if (ref $_[0]) {
$data_ref = $_[0];
} else {
$data_ref = \$_[0];
}
my ($wrote, $written, $to_write) = (0,0, blength($$data_ref));
my $vm = $trace>2 && $linux_debug ?
(split ' ', `cat /proc/$$/stat`)[22] : 'vm_unknown';
warn " write_all VM at entry=$vm to_write=$to_write\n" if $trace>2;
while ($to_write) {
warn "partial `$$data_ref'\n" if $trace>3;
$wrote = syswrite(SSLCAT_S, $$data_ref, $to_write, $written);
if (defined $wrote && ($wrote > 0)) { # write_partial can return -1
$written += $wrote;
$to_write -= $wrote;
} elsif (!defined($wrote)) {
warn "tcp_write_all: $!";
return (wantarray ? (undef, "$!") : undef);
}
$vm = $trace>2 && $linux_debug ?
(split ' ', `cat /proc/$$/stat`)[22] : 'vm_unknown';
warn " written so far $wrote:$written bytes (VM=$vm)\n" if $trace>2;
}
return wantarray ? ($written, '') : $written;
}
# end of Net::SSLeay::tcp_write_all
1;
Git/usr/lib/perl5/vendor_perl/auto/Net/SSLeay/tcpcat.al
+37
View File
@@ -0,0 +1,37 @@
# NOTE: Derived from blib/lib/Net/SSLeay.pm.
# Changes made here will be lost when autosplit is run again.
# See AutoSplit.pm.
package Net::SSLeay;
#line 1112 "blib/lib/Net/SSLeay.pm (autosplit into blib/lib/auto/Net/SSLeay/tcpcat.al)"
sub tcpcat { # address, port, message, $crt, $key --> reply / (reply,errs,cert)
my ($dest_serv, $port, $out_message) = @_;
my ($got, $errs, $written);
($got, $errs) = open_proxy_tcp_connection($dest_serv, $port);
return (wantarray ? (undef, $errs) : undef) unless $got;
### Connected. Exchange some data (doing repeated tries if necessary).
warn "tcpcat $$: sending " . blength($out_message) . " bytes...\n"
if $trace==3;
warn "tcpcat $$: sending `$out_message' (" . blength($out_message)
. " bytes)...\n" if $trace>3;
($written, $errs) = tcp_write_all($out_message);
goto cleanup unless $written;
sleep $slowly if $slowly; # Closing too soon can abort broken servers
CORE::shutdown SSLCAT_S, 1; # Half close --> No more output, send EOF to server
warn "waiting for reply...\n" if $trace>2;
($got, $errs) = tcp_read_all();
warn "Got " . blength($got) . " bytes.\n" if $trace==3;
warn "Got `$got' (" . blength($got) . " bytes)\n" if $trace>3;
cleanup:
close SSLCAT_S;
return wantarray ? ($got, $errs) : $got;
}
# end of Net::SSLeay::tcpcat
1;
Git/usr/lib/perl5/vendor_perl/auto/Net/SSLeay/tcpxcat.al
+17
View File
@@ -0,0 +1,17 @@
# NOTE: Derived from blib/lib/Net/SSLeay.pm.
# Changes made here will be lost when autosplit is run again.
# See AutoSplit.pm.
package Net::SSLeay;
#line 1141 "blib/lib/Net/SSLeay.pm (autosplit into blib/lib/auto/Net/SSLeay/tcpxcat.al)"
sub tcpxcat {
my ($usessl, $site, $port, $req, $crt_path, $key_path) = @_;
if ($usessl) {
return sslcat($site, $port, $req, $crt_path, $key_path);
} else {
return tcpcat($site, $port, $req);
}
}
# end of Net::SSLeay::tcpxcat
1;
Git/usr/lib/perl5/vendor_perl/auto/Net/SSLeay/want_X509_lookup.al
+15
View File
@@ -0,0 +1,15 @@
# NOTE: Derived from blib/lib/Net/SSLeay.pm.
# Changes made here will be lost when autosplit is run again.
# See AutoSplit.pm.
package Net::SSLeay;
#line 503 "blib/lib/Net/SSLeay.pm (autosplit into blib/lib/auto/Net/SSLeay/want_X509_lookup.al)"
sub want_X509_lookup { want(shift) == 4 }
###
### Open TCP stream to given host and port, looking up the details
### from system databases or DNS.
###
# end of Net::SSLeay::want_X509_lookup
1;
Git/usr/lib/perl5/vendor_perl/auto/Net/SSLeay/want_nothing.al
+11
View File
@@ -0,0 +1,11 @@
# NOTE: Derived from blib/lib/Net/SSLeay.pm.
# Changes made here will be lost when autosplit is run again.
# See AutoSplit.pm.
package Net::SSLeay;
#line 498 "blib/lib/Net/SSLeay.pm (autosplit into blib/lib/auto/Net/SSLeay/want_nothing.al)"
### Some methods that are macros in C
sub want_nothing { want(shift) == 1 }
# end of Net::SSLeay::want_nothing
1;
Git/usr/lib/perl5/vendor_perl/auto/Net/SSLeay/want_read.al
+9
View File
@@ -0,0 +1,9 @@
# NOTE: Derived from blib/lib/Net/SSLeay.pm.
# Changes made here will be lost when autosplit is run again.
# See AutoSplit.pm.
package Net::SSLeay;
#line 501 "blib/lib/Net/SSLeay.pm (autosplit into blib/lib/auto/Net/SSLeay/want_read.al)"
sub want_read { want(shift) == 2 }
# end of Net::SSLeay::want_read
1;
Git/usr/lib/perl5/vendor_perl/auto/Net/SSLeay/want_write.al
+9
View File
@@ -0,0 +1,9 @@
# NOTE: Derived from blib/lib/Net/SSLeay.pm.
# Changes made here will be lost when autosplit is run again.
# See AutoSplit.pm.
package Net::SSLeay;
#line 502 "blib/lib/Net/SSLeay.pm (autosplit into blib/lib/auto/Net/SSLeay/want_write.al)"
sub want_write { want(shift) == 3 }
# end of Net::SSLeay::want_write
1;
Git/usr/lib/perl5/vendor_perl/auto/SVN/_Client/_Client.dll
BIN
View File
Binary file not shown.
Git/usr/lib/perl5/vendor_perl/auto/SVN/_Core/_Core.dll
BIN
View File
Binary file not shown.
Git/usr/lib/perl5/vendor_perl/auto/SVN/_Delta/_Delta.dll
BIN
View File
Binary file not shown.
Git/usr/lib/perl5/vendor_perl/auto/SVN/_Fs/_Fs.dll
BIN
View File
Binary file not shown.
Loaded 100 of 5813 files, more files were not shown because too many files have changed in this diff. Show more