##-*- Mode: CPerl -*-

## File: DDC::Utils.pm
## Author: Bryan Jurish <moocow@cpan.org>
## Description: various utilities
##======================================================================

package DDC::Utils;
use Exporter;
use strict;

##======================================================================
## Globals etc.
our @ISA = qw(Exporter);
our @EXPORT = qw();
our %EXPORT_TAGS =
  (
   'escape' => [qw(unescape unescapeq escape escapeq)],
  );
$EXPORT_TAGS{all} = [map {@$_} values %EXPORT_TAGS];
our @EXPORT_OK = @{$EXPORT_TAGS{all}};

##======================================================================
## escapes

## $sym = unescape($escaped_symbol);
sub unescape {
  my $s = shift;
  if (0) {
    ##-- unsafe but elegant
    return eval '"'.quotemeta($s).'"';
  }
  ##-- safer but klutzy
  $s =~ s/\\([0-7]{1,3})/chr(oct($1))/eg;
  $s =~ s/\\x([0-9A-Fa-f]{1,2})/chr(hex($1))/eg;
  $s =~ s/\\u([0-9A-Fa-f]{1,4})/chr(hex($1))/eg;
  $s =~ s/\\a/\a/g;
  $s =~ s/\\b/\b/g;
  $s =~ s/\\t/\t/g;
  $s =~ s/\\n/\n/g;
  $s =~ s/\\r/\r/g;
  $s =~ s/\\f/\f/g;
  #$s =~ s/\\v/\v/g;
  $s =~ s/\\(.)/$1/g;
  return $s;
}

## $sym = unescapeq($single_quoted_symbol);
sub unescapeq {
  my $sym = shift;
  $sym =~ s/^\'//;
  $sym =~ s/\'\z//;
  return unescape($sym);
}

## $escaped_str = escape($str);
sub escape {
  return quotemeta($_[0]);
}

## $sq_escaped_str = escapeq($str);
sub escapeq {
  my $s = shift;
  return $s if ($s =~ /^[[:alpha:]\-][\w\-\~\$\@\/\?\+\.]*\z/);
  $s =~ s/\\/\\\\/g;
  $s =~ s/\'/\\\'/g;
  $s =~ s/\n/\\n/g;
  $s =~ s/\r/\\r/g;
  $s =~ s/\t/\\t/g;
  return "'$s'";
}

1; ##-- be happy

__END__

##========================================================================
## POD DOCUMENTATION, auto-generated by podextract.perl

##========================================================================
## NAME
=pod

=head1 NAME

DDC::Utils - various utilities for DDC::Concordance bindings

=cut

##========================================================================
## SYNOPSIS
=pod

=head1 SYNOPSIS

 ##========================================================================
 ## PRELIMINARIES
 
 use DDC::Utils;
 
 ##========================================================================
 ## escapes
 
 $sym = unescape($escaped_symbol);
 $sym = unescapeq($single_quoted_symbol);
 $escaped_str = escape($str);
 $sq_escaped_str = escapeq($str);
 

=cut

##========================================================================
## DESCRIPTION
=pod

=head1 DESCRIPTION

=cut

##----------------------------------------------------------------
## DESCRIPTION: Exports
=pod

=head2 Exports

DDC::Utils inherits from L<Exporter|Exporter>, and can export the following tags:

=over 4

=item :escape

Exports the DDC-style escaping functions
C<unescape>, C<unescapeq>, C<escape>, and C<escapeq>.

=item :all

Exports all available symbols (currently just C<:escape>).

=back

Nothing is exported by default.

=cut

##----------------------------------------------------------------
## DESCRIPTION: DDC::Utils: Escapes
=pod

=head2 Escapes

=over 4

=item unescape

 $sym = unescape($escaped_symbol);

Un-escapes a DDC-style symbol string.

=item unescapeq

 $sym = unescapeq($single_quoted_symbol);

Un-escapes a DDC-style quoted symbol symbol string, trimming initial and final single quotes if present.

=item escape

 $escaped_str = escape($str);

Returns a DDC-safe escaped symbol string for C<$str>; currently just wraps L<quotemeta()|perlfunc/quotemeta>.

=item escapeq

 $sq_escaped_str = escapeq($str);

Returns a quoted DDC-safe escaped symbol string for C<$str>, including surrounding single quotes.
Tries to heuristically identify strings which do not require escaping and returns these as
bareword literals.

=back

=cut

##========================================================================
## END POD DOCUMENTATION, auto-generated by podextract.perl


##======================================================================
## Footer
=pod

=head1 ACKNOWLEDGEMENTS

perl by Larry Wall.

=head1 AUTHOR

Bryan Jurish E<lt>moocow@cpan.orgE<gt>

=head1 COPYRIGHT

Copyright (c) 2006-2016, Bryan Jurish.  All rights reserved.

This package is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.14.2 or,
at your option, any later version of Perl 5 you may have available.

=head1 SEE ALSO

perl(1)

=cut
