1 | use strict; |
---|
2 | use warnings; |
---|
3 | |
---|
4 | package SVN::Core; |
---|
5 | use SVN::Base qw(Core svn_ VERSION); |
---|
6 | # Some build tool hates VERSION assign across two lines. |
---|
7 | $SVN::Core::VERSION = "$SVN::Core::VER_MAJOR.$SVN::Core::VER_MINOR.$SVN::Core::VER_MICRO"; |
---|
8 | |
---|
9 | =head1 NAME |
---|
10 | |
---|
11 | SVN::Core - Core module of the subversion perl bindings |
---|
12 | |
---|
13 | =head1 SYNOPSIS |
---|
14 | |
---|
15 | use SVN::Core; # does apr_initialize and cleanup for you |
---|
16 | |
---|
17 | # create a root pool and set it as default pool for later use |
---|
18 | my $pool = SVN::Pool->new_default; |
---|
19 | |
---|
20 | sub something { |
---|
21 | # create a subpool of the current default pool |
---|
22 | my $pool = SVN::Pool->new_default_sub; |
---|
23 | # some svn operations... |
---|
24 | |
---|
25 | # $pool gets destroyed and the previous default pool |
---|
26 | # is restored when $pool's lexical scope ends |
---|
27 | } |
---|
28 | |
---|
29 | # svn_stream_t as native perl io handle |
---|
30 | my $stream = $txn->root->apply_text('trunk/filea', undef); |
---|
31 | print $stream $text; |
---|
32 | close $stream; |
---|
33 | |
---|
34 | # native perl io handle as svn_stream_t |
---|
35 | SVN::Repos::dump_fs($repos, \*STDOUT, \*STDERR, |
---|
36 | 0, $repos->fs->youngest_rev, 0); |
---|
37 | |
---|
38 | =head1 DESCRIPTION |
---|
39 | |
---|
40 | SVN::Core implements higher level functions of fundamental subversion |
---|
41 | functions. |
---|
42 | |
---|
43 | =head1 FUNCTIONS |
---|
44 | |
---|
45 | =over 4 |
---|
46 | |
---|
47 | =cut |
---|
48 | |
---|
49 | BEGIN { |
---|
50 | SVN::_Core::apr_initialize(); |
---|
51 | } |
---|
52 | |
---|
53 | my $gpool = SVN::Pool->new_default; |
---|
54 | sub gpool { $gpool } # holding the reference to gpool |
---|
55 | SVN::Core::utf_initialize($gpool); |
---|
56 | |
---|
57 | END { |
---|
58 | SVN::_Core::apr_terminate(); |
---|
59 | } |
---|
60 | |
---|
61 | =item SVN::Core::auth_open([auth provider array]); |
---|
62 | |
---|
63 | Takes a reference to an array of authentication providers |
---|
64 | and returns an auth_baton. If you use prompt providers |
---|
65 | you can not use this function, but need to use the |
---|
66 | auth_open_helper. |
---|
67 | |
---|
68 | =item SVN::Core::auth_open_helper([auth provider array]); |
---|
69 | |
---|
70 | Prompt providers return two values instead of one. The |
---|
71 | 2nd parameter is a reference to whatever was passed into |
---|
72 | them as the callback. auth_open_helper splits up these |
---|
73 | arguments, passing the provider objects into auth_open |
---|
74 | which gives it an auth_baton and putting the other |
---|
75 | ones in an array. The first return value of this |
---|
76 | function is the auth_baton, the second is a reference |
---|
77 | to an array containing the references to the callbacks. |
---|
78 | |
---|
79 | These callback arrays should be stored in the object |
---|
80 | the auth_baton is attached to. |
---|
81 | |
---|
82 | =back |
---|
83 | |
---|
84 | =cut |
---|
85 | |
---|
86 | sub auth_open_helper { |
---|
87 | my $args = shift; |
---|
88 | my (@auth_providers,@auth_callbacks); |
---|
89 | |
---|
90 | foreach my $arg (@{$args}) { |
---|
91 | if (ref($arg) eq '_p_svn_auth_provider_object_t') { |
---|
92 | push @auth_providers, $arg; |
---|
93 | } else { |
---|
94 | push @auth_callbacks, $arg; |
---|
95 | } |
---|
96 | } |
---|
97 | my $auth_baton = SVN::Core::auth_open(\@auth_providers); |
---|
98 | return ($auth_baton,\@auth_callbacks); |
---|
99 | } |
---|
100 | |
---|
101 | # import the INVALID and IGNORED constants |
---|
102 | our $INVALID_REVNUM = $SVN::_Core::SWIG_SVN_INVALID_REVNUM; |
---|
103 | our $IGNORED_REVNUM = $SVN::_Core::SWIG_SVN_IGNORED_REVNUM; |
---|
104 | |
---|
105 | package _p_svn_stream_t; |
---|
106 | use SVN::Base qw(Core svn_stream_); |
---|
107 | |
---|
108 | package SVN::Stream; |
---|
109 | use IO::Handle; |
---|
110 | our @ISA = qw(IO::Handle); |
---|
111 | |
---|
112 | =head1 OTHER OBJECTS |
---|
113 | |
---|
114 | =head2 svn_stream_t - SVN::Stream |
---|
115 | |
---|
116 | You can use native perl io handles (including io globs) as |
---|
117 | svn_stream_t in subversion functions. Returned svn_stream_t are also |
---|
118 | translated into perl io handles, so you could access them with regular |
---|
119 | print, read, etc. |
---|
120 | |
---|
121 | Note that some functions take a stream to read from or write to, but do not |
---|
122 | close the stream while still holding the reference to the io handle. |
---|
123 | In this case the handle won't be destroyed properly. |
---|
124 | You should always set up the correct default pool before calling |
---|
125 | such functions. |
---|
126 | |
---|
127 | =cut |
---|
128 | |
---|
129 | use Symbol (); |
---|
130 | |
---|
131 | sub new |
---|
132 | { |
---|
133 | my $class = shift; |
---|
134 | my $self = bless Symbol::gensym(), ref($class) || $class; |
---|
135 | tie *$self, $self; |
---|
136 | *$self->{svn_stream} = shift; |
---|
137 | $self; |
---|
138 | } |
---|
139 | |
---|
140 | sub svn_stream { |
---|
141 | my $self = shift; |
---|
142 | *$self->{svn_stream}; |
---|
143 | } |
---|
144 | |
---|
145 | sub TIEHANDLE |
---|
146 | { |
---|
147 | return $_[0] if ref($_[0]); |
---|
148 | my $class = shift; |
---|
149 | my $self = bless Symbol::gensym(), $class; |
---|
150 | *$self->{svn_stream} = shift; |
---|
151 | $self; |
---|
152 | } |
---|
153 | |
---|
154 | sub CLOSE |
---|
155 | { |
---|
156 | my $self = shift; |
---|
157 | *$self->{svn_stream}->close |
---|
158 | if *$self->{svn_stream}; |
---|
159 | undef *$self->{svn_stream}; |
---|
160 | } |
---|
161 | |
---|
162 | sub GETC |
---|
163 | { |
---|
164 | my $self = shift; |
---|
165 | my $buf; |
---|
166 | return $buf if $self->read($buf, 1); |
---|
167 | return undef; |
---|
168 | } |
---|
169 | |
---|
170 | sub print |
---|
171 | { |
---|
172 | my $self = shift; |
---|
173 | $self->WRITE ($_[0], length ($_[0])); |
---|
174 | } |
---|
175 | |
---|
176 | sub PRINT |
---|
177 | { |
---|
178 | my $self = shift; |
---|
179 | if (defined $\) { |
---|
180 | if (defined $,) { |
---|
181 | $self->print(join($,, @_).$\); |
---|
182 | } else { |
---|
183 | $self->print(join("",@_).$\); |
---|
184 | } |
---|
185 | } else { |
---|
186 | if (defined $,) { |
---|
187 | $self->print(join($,, @_)); |
---|
188 | } else { |
---|
189 | $self->print(join("",@_)); |
---|
190 | } |
---|
191 | } |
---|
192 | } |
---|
193 | |
---|
194 | sub PRINTF |
---|
195 | { |
---|
196 | my $self = shift; |
---|
197 | my $fmt = shift; |
---|
198 | $self->print(sprintf($fmt, @_)); |
---|
199 | } |
---|
200 | |
---|
201 | sub getline |
---|
202 | { |
---|
203 | my $self = shift; |
---|
204 | *$self->{pool} ||= SVN::Core::pool_create (undef); |
---|
205 | my ($buf, $eof) = *$self->{svn_stream}->readline ($/, *$self->{pool}); |
---|
206 | return undef if $eof && !length($buf); |
---|
207 | return $eof ? $buf : $buf.$/; |
---|
208 | } |
---|
209 | |
---|
210 | sub getlines |
---|
211 | { |
---|
212 | die "getlines() called in scalar context\n" unless wantarray; |
---|
213 | my $self = shift; |
---|
214 | my($line, @lines); |
---|
215 | push @lines, $line while defined($line = $self->getline); |
---|
216 | return @lines; |
---|
217 | } |
---|
218 | |
---|
219 | sub READLINE |
---|
220 | { |
---|
221 | my $self = shift; |
---|
222 | unless (defined $/) { |
---|
223 | my $buf = ''; |
---|
224 | while (length( my $chunk = *$self->{svn_stream}->read |
---|
225 | ($SVN::Core::STREAM_CHUNK_SIZE)) ) { |
---|
226 | $buf .= $chunk; |
---|
227 | } |
---|
228 | return $buf; |
---|
229 | } |
---|
230 | elsif (ref $/) { |
---|
231 | my $buf = *$self->{svn_stream}->read (${$/}); |
---|
232 | return length($buf) ? $buf : undef; |
---|
233 | } |
---|
234 | return wantarray ? $self->getlines : $self->getline; |
---|
235 | } |
---|
236 | |
---|
237 | sub READ { |
---|
238 | my $self = shift; |
---|
239 | my $len = $_[1]; |
---|
240 | if (@_ > 2) { # read offset |
---|
241 | substr($_[0],$_[2]) = *$self->{svn_stream}->read ($len); |
---|
242 | } else { |
---|
243 | $_[0] = *$self->{svn_stream}->read ($len); |
---|
244 | } |
---|
245 | return $len; |
---|
246 | } |
---|
247 | |
---|
248 | sub WRITE { |
---|
249 | my $self = shift; |
---|
250 | my $slen = length($_[0]); |
---|
251 | my $len = $slen; |
---|
252 | my $off = 0; |
---|
253 | |
---|
254 | if (@_ > 1) { |
---|
255 | $len = $_[1] if $_[1] < $len; |
---|
256 | if (@_ > 2) { |
---|
257 | $off = $_[2] || 0; |
---|
258 | die "Offset outside string" if $off > $slen; |
---|
259 | if ($off < 0) { |
---|
260 | $off += $slen; |
---|
261 | die "Offset outside string" if $off < 0; |
---|
262 | } |
---|
263 | my $rem = $slen - $off; |
---|
264 | $len = $rem if $rem < $len; |
---|
265 | } |
---|
266 | *$self->{svn_stream}->write (substr ($_[0], $off, $len)); |
---|
267 | } |
---|
268 | return $len; |
---|
269 | } |
---|
270 | |
---|
271 | *close = \&CLOSE; |
---|
272 | |
---|
273 | sub FILENO { |
---|
274 | return undef; # XXX perlfunc says this means the file is closed |
---|
275 | } |
---|
276 | |
---|
277 | sub DESTROY { |
---|
278 | my $self = shift; |
---|
279 | $self->close; |
---|
280 | } |
---|
281 | |
---|
282 | package _p_apr_pool_t; |
---|
283 | |
---|
284 | my %WRAPPED; |
---|
285 | |
---|
286 | sub default { |
---|
287 | my ($pool) = @_; |
---|
288 | my $pobj = SVN::Pool->_wrap ($$pool); |
---|
289 | $WRAPPED{$pool} = $pobj; |
---|
290 | $pobj->default; |
---|
291 | } |
---|
292 | |
---|
293 | sub DESTROY { |
---|
294 | my ($pool) = @_; |
---|
295 | delete $WRAPPED{$pool}; |
---|
296 | } |
---|
297 | |
---|
298 | package SVN::Pool; |
---|
299 | use SVN::Base qw(Core svn_pool_); |
---|
300 | |
---|
301 | =head2 svn_pool_t - SVN::Pool |
---|
302 | |
---|
303 | The perl bindings significantly simplify the usage of pools, while |
---|
304 | still being manually adjustable. |
---|
305 | |
---|
306 | For functions requiring a pool as the last argument (which are, almost all |
---|
307 | of the subversion functions), the pool argument is optional. The default pool |
---|
308 | is used if it is omitted. When C<SVN::Core> is loaded, it creates a |
---|
309 | new default pool, which is also available from C<SVN::Core-E<gt>gpool>. |
---|
310 | |
---|
311 | For callback functions providing a pool to your subroutine, you could |
---|
312 | also use $pool-E<gt>default to make it the default pool in the scope. |
---|
313 | |
---|
314 | =head3 Methods |
---|
315 | |
---|
316 | =over 4 |
---|
317 | |
---|
318 | =item new ([$parent]) |
---|
319 | |
---|
320 | Create a new pool. The pool is a root pool if $parent is not supplied. |
---|
321 | |
---|
322 | =item new_default ([$parent]) |
---|
323 | |
---|
324 | Create a new pool. The pool is a root pool if $parent is not supplied. |
---|
325 | Set the new pool as default pool. |
---|
326 | |
---|
327 | =item new_default_sub |
---|
328 | |
---|
329 | Create a new subpool of the current default pool, and set the |
---|
330 | resulting pool as new default pool. |
---|
331 | |
---|
332 | =item clear |
---|
333 | |
---|
334 | Clear the pool. |
---|
335 | |
---|
336 | =item DESTROY |
---|
337 | |
---|
338 | Destroy the pool. If the pool was the default pool, restore the |
---|
339 | previous default pool. This is normally called |
---|
340 | automatically when the SVN::Pool object is no longer used and |
---|
341 | destroyed by the perl garbage collector. |
---|
342 | |
---|
343 | =back |
---|
344 | |
---|
345 | =cut |
---|
346 | |
---|
347 | { |
---|
348 | # block is here to restrict no strict refs to this block |
---|
349 | no strict 'refs'; |
---|
350 | *{"apr_pool_$_"} = *{"SVN::_Core::apr_pool_$_"} |
---|
351 | for qw/clear destroy/; |
---|
352 | } |
---|
353 | |
---|
354 | my @POOLSTACK; |
---|
355 | |
---|
356 | sub new { |
---|
357 | my ($class, $parent) = @_; |
---|
358 | $parent = $$parent if ref ($parent) eq 'SVN::Pool'; |
---|
359 | my $self = bless \create ($parent), $class; |
---|
360 | return $self; |
---|
361 | } |
---|
362 | |
---|
363 | sub new_default_sub { |
---|
364 | my $parent = ref ($_[0]) ? ${+shift} : $SVN::_Core::current_pool; |
---|
365 | my $self = SVN::Pool->new_default ($parent); |
---|
366 | return $self; |
---|
367 | } |
---|
368 | |
---|
369 | sub new_default { |
---|
370 | my $self = new(@_); |
---|
371 | $self->default; |
---|
372 | return $self; |
---|
373 | } |
---|
374 | |
---|
375 | sub default { |
---|
376 | my $self = shift; |
---|
377 | push @POOLSTACK, $SVN::_Core::current_pool |
---|
378 | unless $$SVN::_Core::current_pool == 0; |
---|
379 | $SVN::_Core::current_pool = $$self; |
---|
380 | } |
---|
381 | |
---|
382 | sub clear { |
---|
383 | my $self = shift; |
---|
384 | apr_pool_clear ($$self); |
---|
385 | } |
---|
386 | |
---|
387 | my $globaldestroy; |
---|
388 | |
---|
389 | END { |
---|
390 | $globaldestroy = 1; |
---|
391 | } |
---|
392 | |
---|
393 | my %WRAPPOOL; |
---|
394 | |
---|
395 | # Create a cloned _p_apr_pool_t pointing to the same apr_pool_t |
---|
396 | # but on different address. this allows pools that are from C |
---|
397 | # to have proper lifetime. |
---|
398 | sub _wrap { |
---|
399 | my ($class, $rawpool) = @_; |
---|
400 | my $pool = \$rawpool; |
---|
401 | bless $pool, '_p_apr_pool_t'; |
---|
402 | my $npool = \$pool; |
---|
403 | bless $npool, $class; |
---|
404 | $WRAPPOOL{$npool} = 1; |
---|
405 | $npool; |
---|
406 | } |
---|
407 | |
---|
408 | use Scalar::Util 'reftype'; |
---|
409 | |
---|
410 | sub DESTROY { |
---|
411 | return if $globaldestroy; |
---|
412 | my $self = shift; |
---|
413 | # for some reason, REF becomes SCALAR in perl -c or after apr_terminate |
---|
414 | return if reftype($self) eq 'SCALAR'; |
---|
415 | if ($$self eq $SVN::_Core::current_pool) { |
---|
416 | $SVN::_Core::current_pool = pop @POOLSTACK; |
---|
417 | } |
---|
418 | if (exists $WRAPPOOL{$self}) { |
---|
419 | delete $WRAPPOOL{$self}; |
---|
420 | } |
---|
421 | else { |
---|
422 | apr_pool_destroy ($$self) |
---|
423 | } |
---|
424 | } |
---|
425 | |
---|
426 | package _p_svn_error_t; |
---|
427 | use SVN::Base qw(Core svn_error_t_); |
---|
428 | |
---|
429 | sub strerror { |
---|
430 | return SVN::Error::strerror($_[$[]->apr_err()); |
---|
431 | } |
---|
432 | |
---|
433 | sub handle_error { |
---|
434 | return SVN::Error::handle_error(@_); |
---|
435 | } |
---|
436 | |
---|
437 | sub expanded_message { |
---|
438 | return SVN::Error::expanded_message(@_); |
---|
439 | } |
---|
440 | |
---|
441 | sub handle_warning { |
---|
442 | # need to swap parameter order. |
---|
443 | return SVN::Error::handle_warning($_[$[+1],$_[$[]); |
---|
444 | } |
---|
445 | |
---|
446 | foreach my $function (qw(compose clear quick_wrap)) { |
---|
447 | no strict 'refs'; |
---|
448 | my $real_function = \&{"SVN::_Core::svn_error_$function"}; |
---|
449 | *{"_p_svn_error_t::$function"} = sub { |
---|
450 | return $real_function->(@_); |
---|
451 | } |
---|
452 | } |
---|
453 | |
---|
454 | package SVN::Error; |
---|
455 | use SVN::Base qw(Core svn_error_); |
---|
456 | use SVN::Base qw(Core SVN_ERR_); |
---|
457 | use Carp; |
---|
458 | our @CARP_NOT = qw(SVN::Base SVN::Client SVN::Core SVN::Delta |
---|
459 | SVN::Delta::Editor SVN::Error SVN::Fs SVN::Node |
---|
460 | SVN::Pool SVN::Ra SVN::Ra::Callbacks SVN::Ra::Reporter |
---|
461 | SVN::Repos SVN::Stream SVN::TxDelta SVN::Wc); |
---|
462 | |
---|
463 | =head2 svn_error_t - SVN::Error |
---|
464 | |
---|
465 | By default the perl bindings handle exceptions for you. The default handler |
---|
466 | automatically croaks with an appropriate error message. This is likely |
---|
467 | sufficient for simple scripts, but more complex usage may demand handling of |
---|
468 | errors. |
---|
469 | |
---|
470 | You can override the default exception handler by changing the |
---|
471 | $SVN::Error::handler variable. This variable holds a reference to a perl sub |
---|
472 | that should be called whenever an error is returned by a svn function. This |
---|
473 | sub will be passed a svn_error_t object. Its return value is ignored. |
---|
474 | |
---|
475 | If you set the $SVN::Error::handler to undef then each call will return an |
---|
476 | svn_error_t object as its first return in the case of an error, followed by the |
---|
477 | normal return values. If there is no error then a svn_error_t will not be |
---|
478 | returned and only the normal return values will be returned. When using this |
---|
479 | mode you should be careful only to call functions in array context. For |
---|
480 | example: my ($ci) = $ctx-E<gt>mkdir('http://svn/foo'); In this case $ci will |
---|
481 | be an svn_error_t object if an error occurs and a svn_client_commit_info object |
---|
482 | otherwise. If you leave the parenthesis off around $ci (scalar context) it |
---|
483 | will be the commit_info object, which in the case of an error will be undef. |
---|
484 | |
---|
485 | If you plan on using explicit exception handling, understanding the exception |
---|
486 | handling system the C API uses is helpful. You can find information on it in |
---|
487 | the HACKING file and the API documentation. Looking at the implementation of |
---|
488 | SVN::Error::croak_on_error and SVN::Error::expanded_message may be helpful as |
---|
489 | well. |
---|
490 | |
---|
491 | =over 4 |
---|
492 | |
---|
493 | =item $svn_error_t-E<gt>apr_err() |
---|
494 | |
---|
495 | APR error value, possibly SVN_ custom error. |
---|
496 | |
---|
497 | =item $svn_error_t-E<gt>message() |
---|
498 | |
---|
499 | Details from producer of error. |
---|
500 | |
---|
501 | =item $svn_error_t-E<gt>child() |
---|
502 | |
---|
503 | svn_error_t object of the error that's wrapped. |
---|
504 | |
---|
505 | =item $svn_error_t-E<gt>pool() |
---|
506 | |
---|
507 | The pool holding this error and any child errors it wraps. |
---|
508 | |
---|
509 | =item $svn_error_t-E<gt>file() |
---|
510 | |
---|
511 | Source file where the error originated. |
---|
512 | |
---|
513 | =item $svn_error_t-E<gt>line() |
---|
514 | |
---|
515 | Source line where the error originated. |
---|
516 | |
---|
517 | =item SVN::Error::strerror($apr_status_t) |
---|
518 | |
---|
519 | Returns the english description of the status code. |
---|
520 | |
---|
521 | =item $svn_error_t-E<gt>strerror() |
---|
522 | |
---|
523 | Returns the english description of the apr_err status code set on the |
---|
524 | $svn_error_t. This is short for: |
---|
525 | SVN::Error::strerror($svn_error_t-E<gt>apr_err()); |
---|
526 | |
---|
527 | =item SVN::Error::create($apr_err, $child, $message); |
---|
528 | |
---|
529 | Returns a new svn_error_t object with the error status specified in $apr_err, |
---|
530 | the child as $child, and error message of $message. |
---|
531 | |
---|
532 | =item SVN::Error::quick_wrap($child, $new_msg); or $child-E<gt>quick_wrap($new_msg); |
---|
533 | |
---|
534 | A quick n' easy way to create a wrappered exception with your own message |
---|
535 | before throwing it up the stack. |
---|
536 | |
---|
537 | $child is the svn_error_t object you want to wrap and $new_msg is the new error |
---|
538 | string you want to set. |
---|
539 | |
---|
540 | =item SVN::Error::compose($chain, $new_error); or $chain-E<gt>compose($new_error); |
---|
541 | |
---|
542 | Add new_err to the end of $chain's chain of errors. |
---|
543 | |
---|
544 | The $new_err chain will be copied into $chain's pool and destroyed, so $new_err |
---|
545 | itself becomes invalid after this function. |
---|
546 | |
---|
547 | =item SVN::Error::clear($svn_error_t); or $svn_error_t-E<gt>clear(); |
---|
548 | |
---|
549 | Free the memory used by $svn_error_t, as well as all ancestors and descendants |
---|
550 | of $svn_error_t. |
---|
551 | |
---|
552 | You must call this on every svn_error_t object you get or you will leak memory. |
---|
553 | |
---|
554 | =cut |
---|
555 | |
---|
556 | # Permit users to determine if they want automatic croaking or not. |
---|
557 | our $handler = \&croak_on_error; |
---|
558 | |
---|
559 | # Import functions that don't follow the normal naming scheme. |
---|
560 | foreach my $function (qw(handle_error handle_warning strerror)) { |
---|
561 | no strict 'refs'; |
---|
562 | my $real_function = \&{"SVN::_Core::svn_$function"}; |
---|
563 | *{"SVN::Error::$function"} = sub { |
---|
564 | return $real_function->(@_); |
---|
565 | } |
---|
566 | } |
---|
567 | |
---|
568 | =item SVN::Error::expanded_message($svn_error_t) or $svn_error_t-E<gt>expanded_message() |
---|
569 | |
---|
570 | Returns the error message by tracing through the svn_error_t object and its |
---|
571 | children and concatenating the error messages. This is how the internal |
---|
572 | exception handlers get their error messages. |
---|
573 | |
---|
574 | =cut |
---|
575 | |
---|
576 | sub expanded_message { |
---|
577 | my $svn_error = shift; |
---|
578 | unless (is_error($svn_error)) { |
---|
579 | return undef; |
---|
580 | } |
---|
581 | |
---|
582 | my $error_message = $svn_error->strerror(); |
---|
583 | while ($svn_error) { |
---|
584 | $error_message .= ': ' . $svn_error->message(); |
---|
585 | $svn_error = $svn_error->child(); |
---|
586 | } |
---|
587 | return $error_message; |
---|
588 | } |
---|
589 | |
---|
590 | |
---|
591 | =item SVN::Error::is_error($value) |
---|
592 | |
---|
593 | Returns true if value is of type svn_error. Returns false if value is |
---|
594 | anything else or undefined. This is useful for seeing if a call has returned |
---|
595 | an error. |
---|
596 | |
---|
597 | =cut |
---|
598 | |
---|
599 | sub is_error { |
---|
600 | return (ref($_[$[]) eq '_p_svn_error_t'); |
---|
601 | } |
---|
602 | |
---|
603 | =item SVN::Error::croak_on_error |
---|
604 | |
---|
605 | Default error handler. It takes an svn_error_t and extracts the error messages |
---|
606 | from it and croaks with those messages. |
---|
607 | |
---|
608 | It can be used in two ways. The first is detailed above as setting it as the |
---|
609 | automatic exception handler via setting $SVN::Error::handler. |
---|
610 | |
---|
611 | The second is if you have $SVN::Error::handler set to undef as a wrapper for |
---|
612 | calls you want to croak on when there is an error, but you don't want to write |
---|
613 | an explicit error handler. For example: |
---|
614 | |
---|
615 | my $result_rev=SVN::Error::croak_on_error($ctx-E<gt>checkout($url,$path,'HEAD',1)); |
---|
616 | |
---|
617 | If there is no error then croak_on_error will return the arguments passed to it |
---|
618 | unchanged. |
---|
619 | |
---|
620 | =cut |
---|
621 | |
---|
622 | sub croak_on_error { |
---|
623 | unless (is_error($_[$[])) { |
---|
624 | return @_; |
---|
625 | } |
---|
626 | my $svn_error = shift; |
---|
627 | |
---|
628 | my $error_message = $svn_error->expanded_message(); |
---|
629 | |
---|
630 | $svn_error->clear(); |
---|
631 | |
---|
632 | croak($error_message); |
---|
633 | } |
---|
634 | |
---|
635 | =item SVN::Error::confess_on_error |
---|
636 | |
---|
637 | The same as croak_on_error except it will give a more detailed stack backtrace, |
---|
638 | including internal calls within the implementation of the perl bindings. |
---|
639 | This is useful when you are doing development work on the bindings themselves. |
---|
640 | |
---|
641 | =cut |
---|
642 | |
---|
643 | sub confess_on_error { |
---|
644 | unless (is_error($_[$[])) { |
---|
645 | return @_; |
---|
646 | } |
---|
647 | my $svn_error = shift; |
---|
648 | |
---|
649 | my $error_message = $svn_error->expanded_message(); |
---|
650 | |
---|
651 | $svn_error->clear(); |
---|
652 | |
---|
653 | confess($error_message); |
---|
654 | } |
---|
655 | |
---|
656 | =item SVN::Error::ignore_error |
---|
657 | |
---|
658 | This is useful for wrapping around calls which you wish to ignore any potential |
---|
659 | error. It checks to see if the first parameter is an error and if it is it |
---|
660 | clears it. It then returns all the other parameters. |
---|
661 | |
---|
662 | =back |
---|
663 | |
---|
664 | =cut |
---|
665 | |
---|
666 | sub ignore_error { |
---|
667 | if (is_error($_[$[])) { |
---|
668 | my $svn_error = shift; |
---|
669 | $svn_error->clear(); |
---|
670 | } |
---|
671 | |
---|
672 | return @_; |
---|
673 | } |
---|
674 | |
---|
675 | package _p_svn_log_changed_path_t; |
---|
676 | use SVN::Base qw(Core svn_log_changed_path_t_); |
---|
677 | |
---|
678 | =head2 svn_log_changed_path_t |
---|
679 | |
---|
680 | =over 4 |
---|
681 | |
---|
682 | =item $lcp-E<gt>action() |
---|
683 | |
---|
684 | 'A'dd, 'D'elete, 'R'eplace, 'M'odify |
---|
685 | |
---|
686 | =item $lcp-E<gt>copyfrom_path() |
---|
687 | |
---|
688 | Source path of copy, or C<undef> if there isn't any previous revision |
---|
689 | history. |
---|
690 | |
---|
691 | =item $lcp-E<gt>copyfrom_rev() |
---|
692 | |
---|
693 | Source revision of copy, or C<$SVN::Core::INVALID_REVNUM> if there is |
---|
694 | no previous history. |
---|
695 | |
---|
696 | =back |
---|
697 | |
---|
698 | =cut |
---|
699 | |
---|
700 | package SVN::Node; |
---|
701 | use SVN::Base qw(Core svn_node_); |
---|
702 | |
---|
703 | =head2 svn_node_kind_t - SVN::Node |
---|
704 | |
---|
705 | An enum of the following constants: |
---|
706 | |
---|
707 | $SVN::Node::none, $SVN::Node::file, |
---|
708 | $SVN::Node::dir, $SVN::Node::unknown. |
---|
709 | |
---|
710 | =cut |
---|
711 | |
---|
712 | package _p_svn_opt_revision_t; |
---|
713 | use SVN::Base qw(Core svn_opt_revision_t_); |
---|
714 | |
---|
715 | =head2 svn_opt_revision_t |
---|
716 | |
---|
717 | =cut |
---|
718 | |
---|
719 | package _p_svn_opt_revision_t_value; |
---|
720 | use SVN::Base qw(Core svn_opt_revision_t_value_); |
---|
721 | |
---|
722 | package _p_svn_config_t; |
---|
723 | use SVN::Base qw(Core svn_config_); |
---|
724 | |
---|
725 | =head2 svn_config_t |
---|
726 | |
---|
727 | Opaque object describing a set of configuration options. |
---|
728 | |
---|
729 | =cut |
---|
730 | |
---|
731 | package _p_svn_dirent_t; |
---|
732 | use SVN::Base qw(Core svn_dirent_t_); |
---|
733 | |
---|
734 | =head2 svn_dirent_t |
---|
735 | |
---|
736 | =over 4 |
---|
737 | |
---|
738 | =item $dirent-E<gt>kind() |
---|
739 | |
---|
740 | Node kind. A number which matches one of these constants: |
---|
741 | $SVN::Node::none, $SVN::Node::file, |
---|
742 | $SVN::Node::dir, $SVN::Node::unknown. |
---|
743 | |
---|
744 | =item $dirent-E<gt>size() |
---|
745 | |
---|
746 | Length of file text, or 0 for directories. |
---|
747 | |
---|
748 | =item $dirent-E<gt>has_props() |
---|
749 | |
---|
750 | Does the node have properties? |
---|
751 | |
---|
752 | =item $dirent-E<gt>created_rev() |
---|
753 | |
---|
754 | Last revision in which this node changed. |
---|
755 | |
---|
756 | =item $dirent-E<gt>time() |
---|
757 | |
---|
758 | Time of created_rev (mod-time). |
---|
759 | |
---|
760 | =item $dirent-E<gt>last_author() |
---|
761 | |
---|
762 | Author of created rev. |
---|
763 | |
---|
764 | =back |
---|
765 | |
---|
766 | =cut |
---|
767 | |
---|
768 | package _p_svn_auth_cred_simple_t; |
---|
769 | use SVN::Base qw(Core svn_auth_cred_simple_t_); |
---|
770 | |
---|
771 | =head2 svn_auth_cred_simple_t |
---|
772 | |
---|
773 | =over 4 |
---|
774 | |
---|
775 | =item $simple-E<gt>username() |
---|
776 | |
---|
777 | Username. |
---|
778 | |
---|
779 | =item $simple-E<gt>password() |
---|
780 | |
---|
781 | Password. |
---|
782 | |
---|
783 | =item $simple-E<gt>may_save() |
---|
784 | |
---|
785 | Indicates if the credentials may be saved (to disk). |
---|
786 | |
---|
787 | =back |
---|
788 | |
---|
789 | =cut |
---|
790 | |
---|
791 | package _p_svn_auth_cred_username_t; |
---|
792 | use SVN::Base qw(Core svn_auth_cred_username_t_); |
---|
793 | |
---|
794 | =head2 svn_auth_cred_username_t |
---|
795 | |
---|
796 | =over 4 |
---|
797 | |
---|
798 | =item $username-E<gt>username() |
---|
799 | |
---|
800 | Username. |
---|
801 | |
---|
802 | =item $username-E<gt>may_save() |
---|
803 | |
---|
804 | Indicates if the credentials may be saved (to disk). |
---|
805 | |
---|
806 | =back |
---|
807 | |
---|
808 | =cut |
---|
809 | |
---|
810 | package _p_svn_auth_cred_ssl_server_trust_t; |
---|
811 | use SVN::Base qw(Core svn_auth_cred_ssl_server_trust_t_); |
---|
812 | |
---|
813 | =head2 svn_auth_cred_ssl_server_trust_t |
---|
814 | |
---|
815 | =over 4 |
---|
816 | |
---|
817 | =item $strust-E<gt>may_save() |
---|
818 | |
---|
819 | Indicates if the credentials may be saved (to disk). |
---|
820 | |
---|
821 | =item $strust-E<gt>accepted_failures() |
---|
822 | |
---|
823 | Bit mask of the accepted failures. |
---|
824 | |
---|
825 | =back |
---|
826 | |
---|
827 | =cut |
---|
828 | |
---|
829 | package _p_svn_auth_ssl_server_cert_info_t; |
---|
830 | use SVN::Base qw(Core svn_auth_ssl_server_cert_info_t_); |
---|
831 | |
---|
832 | =head2 svn_auth_ssl_server_cert_info_t |
---|
833 | |
---|
834 | =over 4 |
---|
835 | |
---|
836 | =item $scert-E<gt>hostname() |
---|
837 | |
---|
838 | Primary CN. |
---|
839 | |
---|
840 | =item $scert-E<gt>fingerprint() |
---|
841 | |
---|
842 | ASCII fingerprint. |
---|
843 | |
---|
844 | =item $scert-E<gt>valid_from() |
---|
845 | |
---|
846 | ASCII date from which the certificate is valid. |
---|
847 | |
---|
848 | =item $scert-E<gt>valid_until() |
---|
849 | |
---|
850 | ASCII date until which the certificate is valid. |
---|
851 | |
---|
852 | =item $scert-E<gt>issuer_dname() |
---|
853 | |
---|
854 | DN of the certificate issuer. |
---|
855 | |
---|
856 | =item $scert-E<gt>ascii_cert() |
---|
857 | |
---|
858 | Base-64 encoded DER certificate representation. |
---|
859 | |
---|
860 | =back |
---|
861 | |
---|
862 | =cut |
---|
863 | |
---|
864 | package _p_svn_auth_cred_ssl_client_cert_t; |
---|
865 | use SVN::Base qw(Core svn_auth_cred_ssl_client_cert_t_); |
---|
866 | |
---|
867 | =head2 svn_auth_cred_ssl_client_cert_t |
---|
868 | |
---|
869 | =over 4 |
---|
870 | |
---|
871 | =item $ccert-E<gt>cert_file() |
---|
872 | |
---|
873 | Full paths to the certificate file. |
---|
874 | |
---|
875 | =item $ccert-E<gt>may_save() |
---|
876 | |
---|
877 | Indicates if the credentials may be saved (to disk). |
---|
878 | |
---|
879 | =back |
---|
880 | |
---|
881 | =cut |
---|
882 | |
---|
883 | package _p_svn_auth_cred_ssl_client_cert_pw_t; |
---|
884 | use SVN::Base qw(Core svn_auth_cred_ssl_client_cert_pw_t_); |
---|
885 | |
---|
886 | =head2 svn_auth_cred_ssl_client_cert_pw_t |
---|
887 | |
---|
888 | =over 4 |
---|
889 | |
---|
890 | =item $ccertpw-E<gt>password() |
---|
891 | |
---|
892 | Certificate password. |
---|
893 | |
---|
894 | =item $ccertpw-E<gt>may_save() |
---|
895 | |
---|
896 | Indicates if the credentials may be saved (to disk). |
---|
897 | |
---|
898 | =back |
---|
899 | |
---|
900 | =cut |
---|
901 | |
---|
902 | =head1 CONSTANTS |
---|
903 | |
---|
904 | =head2 SVN::Auth::SSL |
---|
905 | |
---|
906 | =over 4 |
---|
907 | |
---|
908 | =item $SVN::Auth::SSL::NOTYETVALID |
---|
909 | |
---|
910 | Certificate is not yet valid. |
---|
911 | |
---|
912 | =item $SVN::Auth::SSL::EXPIRED |
---|
913 | |
---|
914 | Certificate has expired. |
---|
915 | |
---|
916 | =item $SVN::Auth::SSL::CNMISMATCH |
---|
917 | |
---|
918 | Certificate's CN (hostname) does not match the remote hostname. |
---|
919 | |
---|
920 | =item $SVN::Auth::SSL::UNKNOWNCA |
---|
921 | |
---|
922 | Certificate authority is unknown (i.e. not trusted). |
---|
923 | |
---|
924 | =item $SVN::Auth::SSL::OTHER |
---|
925 | |
---|
926 | Other failure. This can happen if neon has introduced a new failure bit that we |
---|
927 | do not handle yet. |
---|
928 | |
---|
929 | =back |
---|
930 | |
---|
931 | =cut |
---|
932 | |
---|
933 | package SVN::Auth::SSL; |
---|
934 | use SVN::Base qw(Core SVN_AUTH_SSL_); |
---|
935 | |
---|
936 | package _p_svn_lock_t; |
---|
937 | use SVN::Base qw(Core svn_lock_t_); |
---|
938 | |
---|
939 | =head2 _p_svn_lock_t |
---|
940 | |
---|
941 | Objects of this class contain information about locks placed on files |
---|
942 | in a repository. It has the following accessor methods: |
---|
943 | |
---|
944 | =over |
---|
945 | |
---|
946 | =item path |
---|
947 | |
---|
948 | The full path to the file which is locked, starting with a forward slash (C</>). |
---|
949 | |
---|
950 | =item token |
---|
951 | |
---|
952 | A string containing the lock token, which is a unique URI. |
---|
953 | |
---|
954 | =item owner |
---|
955 | |
---|
956 | The username of whoever owns the lock. |
---|
957 | |
---|
958 | =item comment |
---|
959 | |
---|
960 | A comment associated with the lock, or undef if there isn't one. |
---|
961 | |
---|
962 | =item is_dav_comment |
---|
963 | |
---|
964 | True if the comment was made by a generic DAV client. |
---|
965 | |
---|
966 | =item creation_date |
---|
967 | |
---|
968 | Time at which the lock was created, as the number of microseconds since |
---|
969 | 00:00:00 S<January 1>, 1970 UTC. Divide it by 1_000_000 to get a Unix |
---|
970 | time_t value. |
---|
971 | |
---|
972 | =item expiration_date |
---|
973 | |
---|
974 | When the lock will expire. Has the value '0' if the lock will never expire. |
---|
975 | |
---|
976 | =back |
---|
977 | |
---|
978 | =cut |
---|
979 | |
---|
980 | package SVN::MD5; |
---|
981 | use overload |
---|
982 | '""' => sub { SVN::Core::md5_digest_to_cstring(${$_[0]})}; |
---|
983 | |
---|
984 | sub new { |
---|
985 | my ($class, $digest) = @_; |
---|
986 | bless \$digest, $class; |
---|
987 | } |
---|
988 | |
---|
989 | =head1 AUTHORS |
---|
990 | |
---|
991 | Chia-liang Kao E<lt>clkao@clkao.orgE<gt> |
---|
992 | |
---|
993 | =head1 COPYRIGHT |
---|
994 | |
---|
995 | Copyright (c) 2003 CollabNet. All rights reserved. |
---|
996 | |
---|
997 | This software is licensed as described in the file COPYING, which you |
---|
998 | should have received as part of this distribution. The terms are also |
---|
999 | available at http://subversion.tigris.org/license-1.html. If newer |
---|
1000 | versions of this license are posted there, you may use a newer version |
---|
1001 | instead, at your option. |
---|
1002 | |
---|
1003 | This software consists of voluntary contributions made by many |
---|
1004 | individuals. For exact contribution history, see the revision history |
---|
1005 | and logs, available at http://subversion.tigris.org/. |
---|
1006 | |
---|
1007 | =cut |
---|
1008 | |
---|
1009 | 1; |
---|