view release on metacpan or  search on metacpan

lib/Text/Quote.pm  view on Meta::CPAN

	my $low    = $counts{$qsym};
	my $lowsym = $qsym;
	while ( $low > 0 ) {
		last unless @chars;
		$qsym = shift @chars;
		if ($counts{$qsym} < $low) {
			$low = $counts{$qsym};
			$lowsym=$qsym;
		}
	}
	$qsym=$lowsym;

	my $qbegin = substr( $qsym, 0,  1 );
	my $qend   = substr( $qsym, -1, 1 );
	my $needs_type;
	if ($qq) {
		$qq = 'qq';
		$needs_type = $qbegin eq '"' ? 0 : 1;
	} else {
		$qq = 'q';
		$needs_type = $qbegin eq "'" ? 0 : 1;
	}

	return ( $qq, $qbegin, $qend, $needs_type );
}

=head1 OVERIDE METHODS

These methods are defined by Text::Quote for when it runs as a stand alone.
Normally they would be overriden by child classes, or alternatively used by
the child class.

=cut

BEGIN {

	# things we need to escape
	#from G.A.

	my %esc_chars = (
		"\a" => "\\a",
		"\b" => "\\b",
		"\t" => "\\t",
		"\n" => "\\n",
		"\f" => "\\f",
		"\r" => "\\r",
		"\e" => "\\e",
	);

	my %known_keywords = map { $_ => 1 }
		qw( __FILE__ __LINE__ __PACKAGE__ __DATA__ __END__ AUTOLOAD BEGIN CORE
		DESTROY END EQ GE GT INIT LE LT NE abs accept alarm and atan2 bind
		binmode bless caller chdir chmod chomp chop chown chr chroot close
		closedir cmp connect continue cos crypt dbmclose dbmopen defined
		delete die do dump each else elsif endgrent endhostent endnetent
		endprotoent endpwent endservent eof eq eval exec exists exit exp fcntl
		fileno flock for foreach fork format formline ge getc getgrent
		getgrgid getgrnam gethostbyaddr gethostbyname gethostent getlogin
		getnetbyaddr getnetbyname getnetent getpeername getpgrp getppid
		getpriority getprotobyname getprotobynumber getprotoent getpwent
		getpwnam getpwuid getservbyname getservbyport getservent getsockname
		getsockopt glob gmtime goto grep gt hex if index int ioctl join keys
		kill last lc lcfirst le length link listen local localtime lock log
		lstat lt m map mkdir msgctl msgget msgrcv msgsnd my ne next no not oct
		open opendir or ord pack package pipe pop pos print printf prototype
		push q qq qr quotemeta qw qx rand read readdir readline readlink
		readpipe recv redo ref rename require reset return reverse rewinddir
		rindex rmdir s scalar seek seekdir select semctl semget semop send
		setgrent sethostent setnetent setpgrp setpriority setprotoent setpwent
		setservent setsockopt shift shmctl shmget shmread shmwrite shutdown
		sin sleep socket socketpair sort splice split sprintf sqrt srand stat
		study sub substr symlink syscall sysopen sysread sysseek system
		syswrite tell telldir tie tied time times tr truncate uc ucfirst umask
		undef unless unlink unpack unshift untie until use utime values vec
		wait waitpid wantarray warn while write x xor y);

=head2 init()

Takes a list of options and uses them to initialize the quoting object.
Defaults are provided if an option is not specified.

  esc_chars     : a hash of chars needing to be escaped and their escaped equivelent
  esc_class     : a regex class that matches the chars needing to be escaped
  quote_chars   : chars to be used as alternate quote chars
  key_quote_hash    : hash of words that must be quoted if used as a hash key
  repeat_len    : Length of pattern to look for in the string
  encode_high   : Set to 1 to cause high bits chars to be escaped. Dafaults to 0

Set the following to 0 to disable

  repeat_at     : Length of string at which Text::Quote should see if there is a repeated pattern.
  encode_at     : Length at which binary data should be quoted in Base64
  compress_at   : Length at which the string should be compressed using Compress::Zlib

These options are set using L<quote_prop()|quote_prop()>

=cut

	sub init {
		my $self = shift;

		$self->_stamp;
		my %hash = (
		    esc_chars => {%esc_chars},
		    esc_class => join ( "", "[", keys(%esc_chars), "]" ),

		    #Forbidden until best_quotes is fixed :
		    quote_chars    => [ qw; / ! |  - .  :  () [] {} ;, '#', ';' ],
		    key_quote_hash => {%known_keywords},
		    key_quote      => 'auto', #auto/true/false
		    repeat_len  => 20,     # maximum size of repeat sequence
		    repeat_at   => 20,     # number of chars before we even bother
		    encode_at   => 160,
		    compress_at => 512,    # number of chars at which we compress no matter what
		    encode_high => 0,
		    @_
		);
		$self->quote_prop( \%hash );
		return \%hash;
	}
}