made the pack completely portable and wrote relevent bat files to go with it
This commit is contained in:
99
gitportable/usr/lib/perl5/vendor_perl/Clone.pm
Normal file
99
gitportable/usr/lib/perl5/vendor_perl/Clone.pm
Normal file
@@ -0,0 +1,99 @@
|
||||
package Clone;
|
||||
|
||||
use strict;
|
||||
our $AUTOLOAD;
|
||||
|
||||
require Exporter;
|
||||
require AutoLoader;
|
||||
use XSLoader ();
|
||||
|
||||
our @ISA = qw(Exporter);
|
||||
our @EXPORT;
|
||||
our @EXPORT_OK = qw( clone );
|
||||
|
||||
our $VERSION = '0.46';
|
||||
|
||||
XSLoader::load('Clone', $VERSION);
|
||||
|
||||
1;
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Clone - recursively copy Perl datatypes
|
||||
|
||||
=for html
|
||||
<a href="https://travis-ci.org/garu/Clone"><img src="https://travis-ci.org/garu/Clone.png?branch=master" alt="Build Status"></a>
|
||||
<a href="https://coveralls.io/r/garu/Clone?branch=master"><img src="https://coveralls.io/repos/garu/Clone/badge.png?branch=master" alt="Coverage Status"></a>
|
||||
<a href="https://metacpan.org/pod/Clone"><img src="https://badge.fury.io/pl/Clone.svg" alt="CPAN version"></a>
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use Clone 'clone';
|
||||
|
||||
my $data = {
|
||||
set => [ 1 .. 50 ],
|
||||
foo => {
|
||||
answer => 42,
|
||||
object => SomeObject->new,
|
||||
},
|
||||
};
|
||||
|
||||
my $cloned_data = clone($data);
|
||||
|
||||
$cloned_data->{foo}{answer} = 1;
|
||||
print $cloned_data->{foo}{answer}; # '1'
|
||||
print $data->{foo}{answer}; # '42'
|
||||
|
||||
You can also add it to your class:
|
||||
|
||||
package Foo;
|
||||
use parent 'Clone';
|
||||
sub new { bless {}, shift }
|
||||
|
||||
package main;
|
||||
|
||||
my $obj = Foo->new;
|
||||
my $copy = $obj->clone;
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This module provides a C<clone()> method which makes recursive
|
||||
copies of nested hash, array, scalar and reference types,
|
||||
including tied variables and objects.
|
||||
|
||||
C<clone()> takes a scalar argument and duplicates it. To duplicate lists,
|
||||
arrays or hashes, pass them in by reference, e.g.
|
||||
|
||||
my $copy = clone (\@array);
|
||||
|
||||
# or
|
||||
|
||||
my %copy = %{ clone (\%hash) };
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<Storable>'s C<dclone()> is a flexible solution for cloning variables,
|
||||
albeit slower for average-sized data structures. Simple
|
||||
and naive benchmarks show that Clone is faster for data structures
|
||||
with 3 or fewer levels, while C<dclone()> can be faster for structures
|
||||
4 or more levels deep.
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
Copyright 2001-2022 Ray Finch. All Rights Reserved.
|
||||
|
||||
This module is free software; you can redistribute it and/or
|
||||
modify it under the same terms as Perl itself.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Ray Finch C<< <rdf@cpan.org> >>
|
||||
|
||||
Breno G. de Oliveira C<< <garu@cpan.org> >>,
|
||||
Nicolas Rochelemagne C<< <atoomic@cpan.org> >>
|
||||
and
|
||||
Florian Ragwitz C<< <rafl@debian.org> >> perform routine maintenance
|
||||
releases since 2012.
|
||||
|
||||
=cut
|
||||
482
gitportable/usr/lib/perl5/vendor_perl/HTML/Entities.pm
Normal file
482
gitportable/usr/lib/perl5/vendor_perl/HTML/Entities.pm
Normal file
@@ -0,0 +1,482 @@
|
||||
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 æres";
|
||||
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 bar";
|
||||
_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ôle", but
|
||||
C<encode_entities_numeric("r\xF4le")> returns "rô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;
|
||||
our $VERSION = '3.81';
|
||||
our (%entity2char, %char2entity);
|
||||
|
||||
require 5.004;
|
||||
require Exporter;
|
||||
our @ISA = qw(Exporter);
|
||||
|
||||
our @EXPORT = qw(encode_entities decode_entities _decode_entities);
|
||||
our @EXPORT_OK = qw(%entity2char %char2entity encode_entities_numeric);
|
||||
|
||||
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;
|
||||
110
gitportable/usr/lib/perl5/vendor_perl/HTML/Filter.pm
Normal file
110
gitportable/usr/lib/perl5/vendor_perl/HTML/Filter.pm
Normal file
@@ -0,0 +1,110 @@
|
||||
package HTML::Filter;
|
||||
|
||||
use strict;
|
||||
|
||||
require HTML::Parser;
|
||||
our @ISA = qw(HTML::Parser);
|
||||
our $VERSION = '3.81';
|
||||
|
||||
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
|
||||
314
gitportable/usr/lib/perl5/vendor_perl/HTML/HeadParser.pm
Normal file
314
gitportable/usr/lib/perl5/vendor_perl/HTML/HeadParser.pm
Normal file
@@ -0,0 +1,314 @@
|
||||
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;
|
||||
our @ISA = qw(HTML::Parser);
|
||||
|
||||
use HTML::Entities ();
|
||||
|
||||
use strict;
|
||||
our $DEBUG;
|
||||
#$DEBUG = 1;
|
||||
our $VERSION = '3.81';
|
||||
|
||||
=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
|
||||
185
gitportable/usr/lib/perl5/vendor_perl/HTML/LinkExtor.pm
Normal file
185
gitportable/usr/lib/perl5/vendor_perl/HTML/LinkExtor.pm
Normal file
@@ -0,0 +1,185 @@
|
||||
package HTML::LinkExtor;
|
||||
|
||||
require HTML::Parser;
|
||||
our @ISA = qw(HTML::Parser);
|
||||
our $VERSION = '3.81';
|
||||
|
||||
=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)
|
||||
our %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;
|
||||
1256
gitportable/usr/lib/perl5/vendor_perl/HTML/Parser.pm
Normal file
1256
gitportable/usr/lib/perl5/vendor_perl/HTML/Parser.pm
Normal file
File diff suppressed because it is too large
Load Diff
210
gitportable/usr/lib/perl5/vendor_perl/HTML/PullParser.pm
Normal file
210
gitportable/usr/lib/perl5/vendor_perl/HTML/PullParser.pm
Normal file
@@ -0,0 +1,210 @@
|
||||
package HTML::PullParser;
|
||||
|
||||
use strict;
|
||||
|
||||
require HTML::Parser;
|
||||
our @ISA = qw(HTML::Parser);
|
||||
our $VERSION = '3.81';
|
||||
|
||||
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
|
||||
372
gitportable/usr/lib/perl5/vendor_perl/HTML/TokeParser.pm
Normal file
372
gitportable/usr/lib/perl5/vendor_perl/HTML/TokeParser.pm
Normal file
@@ -0,0 +1,372 @@
|
||||
package HTML::TokeParser;
|
||||
|
||||
use strict;
|
||||
|
||||
require HTML::PullParser;
|
||||
our @ISA = qw(HTML::PullParser);
|
||||
our $VERSION = '3.81';
|
||||
|
||||
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 line break 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
|
||||
1905
gitportable/usr/lib/perl5/vendor_perl/Net/SSLeay.pm
Normal file
1905
gitportable/usr/lib/perl5/vendor_perl/Net/SSLeay.pm
Normal file
File diff suppressed because it is too large
Load Diff
409
gitportable/usr/lib/perl5/vendor_perl/Net/SSLeay/Handle.pm
Normal file
409
gitportable/usr/lib/perl5/vendor_perl/Net/SSLeay/Handle.pm
Normal file
@@ -0,0 +1,409 @@
|
||||
package Net::SSLeay::Handle;
|
||||
|
||||
use 5.8.1;
|
||||
|
||||
use strict;
|
||||
|
||||
use Socket;
|
||||
use Net::SSLeay;
|
||||
|
||||
require Exporter;
|
||||
|
||||
=encoding utf-8
|
||||
|
||||
=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 = '1.92';
|
||||
|
||||
my $Initialized; #-- only _initialize() once
|
||||
my $Debug = 0; #-- pretty hokey
|
||||
|
||||
#== 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);
|
||||
|
||||
socket(my $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
|
||||
|
||||
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.
|
||||
|
||||
=head1 CHANGES
|
||||
|
||||
Please see Net-SSLeay-Handle-0.50/Changes file.
|
||||
|
||||
=head1 BUGS
|
||||
|
||||
If you encounter a problem with this module that you believe is a bug, please
|
||||
L<create a new issue|https://github.com/radiator-software/p5-net-ssleay/issues/new>
|
||||
in the Net-SSLeay GitHub repository. Please make sure your bug report includes
|
||||
the following information:
|
||||
|
||||
=over
|
||||
|
||||
=item * the code you are trying to run;
|
||||
|
||||
=item * your operating system name and version;
|
||||
|
||||
=item * the output of C<perl -V>;
|
||||
|
||||
=item * the version of OpenSSL or LibreSSL you are using.
|
||||
|
||||
=back
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Originally written by Jim Bowlin.
|
||||
|
||||
Maintained by Sampo Kellomäki between July 2001 and August 2003.
|
||||
|
||||
Maintained by Florian Ragwitz between November 2005 and January 2010.
|
||||
|
||||
Maintained by Mike McCauley between November 2005 and June 2018.
|
||||
|
||||
Maintained by Chris Novakovic, Tuure Vartiainen and Heikki Vatiainen since June 2018.
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
Copyright (c) 2001 Jim Bowlin <jbowlin@linklint.org>
|
||||
|
||||
Copyright (c) 2001-2003 Sampo Kellomäki <sampo@iki.fi>
|
||||
|
||||
Copyright (c) 2005-2010 Florian Ragwitz <rafl@debian.org>
|
||||
|
||||
Copyright (c) 2005-2018 Mike McCauley <mikem@airspayce.com>
|
||||
|
||||
Copyright (c) 2018- Chris Novakovic <chris@chrisn.me.uk>
|
||||
|
||||
Copyright (c) 2018- Tuure Vartiainen <vartiait@radiatorsoftware.com>
|
||||
|
||||
Copyright (c) 2018- Heikki Vatiainen <hvn@radiatorsoftware.com>
|
||||
|
||||
All rights reserved.
|
||||
|
||||
=head1 LICENSE
|
||||
|
||||
This module is released under the terms of the Artistic License 2.0. For
|
||||
details, see the C<LICENSE> file distributed with Net-SSLeay's source code.
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
Net::SSLeay, perl(1), http://openssl.org/
|
||||
|
||||
=cut
|
||||
118
gitportable/usr/lib/perl5/vendor_perl/SVN/Base.pm
Normal file
118
gitportable/usr/lib/perl5/vendor_perl/SVN/Base.pm
Normal 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
|
||||
L<https://subversion.apache.org/docs/api/latest/>.
|
||||
|
||||
=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;
|
||||
1887
gitportable/usr/lib/perl5/vendor_perl/SVN/Client.pm
Normal file
1887
gitportable/usr/lib/perl5/vendor_perl/SVN/Client.pm
Normal file
File diff suppressed because it is too large
Load Diff
1242
gitportable/usr/lib/perl5/vendor_perl/SVN/Core.pm
Normal file
1242
gitportable/usr/lib/perl5/vendor_perl/SVN/Core.pm
Normal file
File diff suppressed because it is too large
Load Diff
210
gitportable/usr/lib/perl5/vendor_perl/SVN/Delta.pm
Normal file
210
gitportable/usr/lib/perl5/vendor_perl/SVN/Delta.pm
Normal file
@@ -0,0 +1,210 @@
|
||||
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.
|
||||
sub apply {
|
||||
if (@_ == 5 || (@_ == 4 && ref($_[-1]) ne 'SVN::Pool' && ref($_[-1]) ne '_p_apr_pool_t')) {
|
||||
# we're called as
|
||||
# apply($source, $target, $result_digest, $error_info [, $pool])
|
||||
splice(@_, 2, 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;
|
||||
503
gitportable/usr/lib/perl5/vendor_perl/SVN/Fs.pm
Normal file
503
gitportable/usr/lib/perl5/vendor_perl/SVN/Fs.pm
Normal 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;
|
||||
685
gitportable/usr/lib/perl5/vendor_perl/SVN/Ra.pm
Normal file
685
gitportable/usr/lib/perl5/vendor_perl/SVN/Ra.pm
Normal 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;
|
||||
310
gitportable/usr/lib/perl5/vendor_perl/SVN/Repos.pm
Normal file
310
gitportable/usr/lib/perl5/vendor_perl/SVN/Repos.pm
Normal 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;
|
||||
557
gitportable/usr/lib/perl5/vendor_perl/SVN/Wc.pm
Normal file
557
gitportable/usr/lib/perl5/vendor_perl/SVN/Wc.pm
Normal 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;
|
||||
494
gitportable/usr/lib/perl5/vendor_perl/Term/ReadKey.pm
Normal file
494
gitportable/usr/lib/perl5/vendor_perl/Term/ReadKey.pm
Normal 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.38';
|
||||
|
||||
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:
|
||||
BIN
gitportable/usr/lib/perl5/vendor_perl/auto/Clone/Clone.dll
Normal file
BIN
gitportable/usr/lib/perl5/vendor_perl/auto/Clone/Clone.dll
Normal file
Binary file not shown.
@@ -0,0 +1,3 @@
|
||||
# Index created by AutoSplit for blib/lib/Clone.pm
|
||||
# (file acts as timestamp)
|
||||
1;
|
||||
Binary file not shown.
BIN
gitportable/usr/lib/perl5/vendor_perl/auto/Net/SSLeay/SSLeay.dll
Normal file
BIN
gitportable/usr/lib/perl5/vendor_perl/auto/Net/SSLeay/SSLeay.dll
Normal file
Binary file not shown.
@@ -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;
|
||||
@@ -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 982 "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;
|
||||
@@ -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 1895 "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
|
||||
@@ -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 1824 "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;
|
||||
@@ -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 1809 "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;
|
||||
@@ -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 1839 "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;
|
||||
@@ -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 1814 "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;
|
||||
@@ -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 1774 "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;
|
||||
@@ -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 1829 "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;
|
||||
@@ -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 1357 "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;
|
||||
@@ -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 1860 "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;
|
||||
@@ -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 1865 "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;
|
||||
@@ -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 1870 "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;
|
||||
@@ -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 1843 "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;
|
||||
@@ -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 1848 "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;
|
||||
@@ -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 1853 "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;
|
||||
@@ -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 1877 "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;
|
||||
@@ -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 1882 "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;
|
||||
@@ -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 1887 "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;
|
||||
@@ -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 1863 "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;
|
||||
@@ -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 1868 "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;
|
||||
@@ -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 1873 "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;
|
||||
@@ -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 1846 "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;
|
||||
@@ -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 1851 "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;
|
||||
@@ -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 1856 "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;
|
||||
@@ -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 1880 "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;
|
||||
@@ -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 1885 "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;
|
||||
@@ -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 1890 "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;
|
||||
@@ -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 1678 "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;
|
||||
@@ -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 1591 "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;
|
||||
@@ -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 1704 "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;
|
||||
@@ -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 1444 "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;
|
||||
@@ -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 1744 "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;
|
||||
@@ -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 1761 "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;
|
||||
@@ -0,0 +1,51 @@
|
||||
# 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 1401 "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;
|
||||
}
|
||||
elsif ($ssl_version == 13) {
|
||||
unless (eval { Net::SSLeay::TLS1_3_VERSION(); } ) {
|
||||
warn "ssl_version has been set to 13, but this version of OpenSSL has been compiled without TLSv1.3 support";
|
||||
return undef;
|
||||
}
|
||||
$ctx = CTX_new();
|
||||
unless(Net::SSLeay::CTX_set_min_proto_version($ctx, Net::SSLeay::TLS1_3_VERSION())) {
|
||||
warn "CTX_set_min_proto failed for TLSv1.3";
|
||||
return undef;
|
||||
}
|
||||
unless(Net::SSLeay::CTX_set_max_proto_version($ctx, Net::SSLeay::TLS1_3_VERSION())) {
|
||||
warn "CTX_set_max_proto failed for TLSv1.3";
|
||||
return undef;
|
||||
}
|
||||
}
|
||||
else { $ctx = CTX_new(); }
|
||||
return $ctx;
|
||||
}
|
||||
|
||||
# end of Net::SSLeay::new_x_ctx
|
||||
1;
|
||||
@@ -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 959 "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;
|
||||
@@ -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 927 "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;
|
||||
@@ -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 1861 "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;
|
||||
@@ -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 1866 "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;
|
||||
@@ -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 1871 "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;
|
||||
@@ -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 1844 "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;
|
||||
@@ -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 1849 "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;
|
||||
@@ -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 1854 "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;
|
||||
@@ -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 1878 "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;
|
||||
@@ -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 1883 "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;
|
||||
@@ -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 1888 "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;
|
||||
@@ -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 1862 "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;
|
||||
@@ -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 1867 "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;
|
||||
@@ -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 1872 "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;
|
||||
@@ -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 1845 "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;
|
||||
@@ -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 1850 "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;
|
||||
@@ -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 1855 "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;
|
||||
@@ -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 1879 "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;
|
||||
@@ -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 1884 "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;
|
||||
@@ -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 1889 "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;
|
||||
@@ -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 1378 "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;
|
||||
@@ -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 1714 "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 ) == 1
|
||||
or $errs .= print_errs("private key `$key_path' ($!)");
|
||||
CTX_use_certificate_file ($ctx, $cert_path, &FILETYPE_PEM) == 1
|
||||
or $errs .= print_errs("certificate `$cert_path' ($!)");
|
||||
return wantarray ? (undef, $errs) : ($errs eq '');
|
||||
}
|
||||
|
||||
# end of Net::SSLeay::set_cert_and_key
|
||||
1;
|
||||
@@ -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 1735 "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;
|
||||
@@ -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 1729 "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;
|
||||
@@ -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 1322 "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;
|
||||
@@ -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 996 "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, $rv, $errs);
|
||||
my $reply = '';
|
||||
|
||||
while ($how_much > 0) {
|
||||
($got, $rv) = Net::SSLeay::read($ssl,
|
||||
($how_much > 32768) ? 32768 : $how_much
|
||||
);
|
||||
if (! defined $got) {
|
||||
my $err = Net::SSLeay::get_error($ssl, $rv);
|
||||
if ($err != Net::SSLeay::ERROR_WANT_READ() and
|
||||
$err != Net::SSLeay::ERROR_WANT_WRITE()) {
|
||||
$errs = print_errs('SSL_read');
|
||||
last;
|
||||
}
|
||||
next;
|
||||
}
|
||||
$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;
|
||||
@@ -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 1211 "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::ssl_read_all($ssl, $found+$len_delim);
|
||||
#read up to the end of the delimiter
|
||||
$got = Net::SSLeay::ssl_read_all($ssl,
|
||||
$found + $len_delim
|
||||
- ((blength($match)) - (blength($got))));
|
||||
$done = 1;
|
||||
} else {
|
||||
$got = Net::SSLeay::ssl_read_all($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::ssl_read_all($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;
|
||||
@@ -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 1327 "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;
|
||||
@@ -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 1042 "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;
|
||||
@@ -0,0 +1,98 @@
|
||||
# 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 1463 "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
|
||||
Net::SSLeay::shutdown($ssl); # Useful starting with OpenSSL 1.1.1e
|
||||
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;
|
||||
@@ -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 1324 "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;
|
||||
@@ -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 1024 "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;
|
||||
@@ -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 1297 "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;
|
||||
@@ -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 1342 "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;
|
||||
@@ -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 1183 "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;
|
||||
@@ -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 1553 "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;
|
||||
@@ -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 1582 "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;
|
||||
@@ -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 920 "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;
|
||||
@@ -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 915 "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;
|
||||
@@ -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 918 "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;
|
||||
@@ -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 919 "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;
|
||||
Binary file not shown.
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user