view release on metacpan or  search on metacpan

lib/Treex/PML/IO.pm  view on Meta::CPAN

#$Debug=0;
my %input_protocol_handler;

BEGIN {
  *_find_exe = eval {
      require File::Which;
      \&File::Which::which
  } || sub {};

  $VERSION = '2.29'; # version template
  @ISA=qw(Exporter);
  @EXPORT_OK = qw($kioclient $kioclient_opts
                  $ssh $ssh_opts
                  $curl $curl_opts
                  $gzip $gzip_opts
                  $zcat $zcat_opts
                  &set_encoding
                  &open_backend &open_uri &close_backend &close_uri
                  &get_protocol &quote_filename
                  &rename_uri);

  $zcat         ||= _find_exe('zcat');
  $gzip         ||= _find_exe('gzip');
  $kioclient    ||= _find_exe('kioclient');
  $ssh          ||= _find_exe('ssh');
  $curl         ||= _find_exe('curl');
  $ssh_opts     ||= '-C';
  $reject_proto ||= '^(pop3?s?|imaps?)\$';
  $lwp_user_agent = Treex::PML::IO::UserAgent->new(keep_alive=>1);
  $lwp_user_agent->agent("Treex::PML_IO/$VERSION");
};


=over 4

=item C<DirPart($path)>

Returns directory part of a given path (including volume).

=cut

sub DirPart {
  return File::Spec->catpath(
    (File::Spec->splitpath($_[0]))[0,1],''
   );
}

=item C<CallerDir($rel_path?)>

If called without an argument, returns the directory of the perl
module or macro-file that invoked this macro.

If a relative path is given as an argument, a respective absolute path
is computed based on the caller's directory and returned.

=cut

sub CallerDir {
  return
    @_>0
      ? File::Spec->rel2abs($_[0], DirPart( (caller)[1] ))
      : DirPart( (caller)[1] );
}

=item C<register_input_protocol_handler($scheme,$callback)>

Register a callback to fetch URIs of a given protocol. C<$scheme> is
the URI scheme of the protocol (i.e. the first part of an URI
preceding the comma, e.g. 'ftp' or 'https'). <$callback> is either a
CODE reference or an ARRAY reference whose first element is a CODE
reference and the other elements are additional arguments to be passed
to the callback prior to the standard arguments.

When the library attempts to fetch a resource from an URI matching
given scheme, the callback is invoked with the (optional) user
parameters followed by the URI.

The callback function must either return a new URI (typically a
file:// URI pointing to a temporary file) and a boolean flag
indicating whether the library should attempt to delete the
returned file after it finished reading.

If the callback returns the same or another URI with the C<$scheme>,
the callback is not reinvoked, but passed on to further processing
(i.e. by Treex::PML I/O backends).

=cut

sub register_input_protocol_handler {
  my ($proto,$handler)=@_;
  if (ref($handler) eq 'CODE' or ref($handler) eq 'ARRAY') {
    if (exists($input_protocol_handler{$proto})) {
      carp(__PACKAGE__."::register_input_protocol_handler: WARNING: redefining protocol handler for '$proto'");
    }
    $input_protocol_handler{$proto}=$handler;
  } else {
    croak("Wrong arguments. Usage: Treex::PML::IO::register_input_protocol_handler(protocol=>callback)");
  }
}

=item unregister_input_protocol_handler($scheme)

Unregister a handler for a given URI scheme.

=cut

sub unregister_input_protocol_handler {
  my ($proto)=@_;
  return delete $input_protocol_handler{$proto};
}

=item get_input_protocol_handler($scheme)

Returns the user-defined handler registered for a given URI scheme; if
none, undef is returned.

=cut

sub get_input_protocol_handler {
  my ($proto)=@_;
  return $input_protocol_handler{$proto};
}