File Coverage

blib/lib/Text/Buffer.pm

Criterion	Covered	Total	%
statement	268	317	84.5
branch	59	96	61.4
condition	34	76	44.7
subroutine	41	45	91.1
pod	34	34	100.0
total	436	568	76.7

package Text::Buffer;

use strict;
use vars qw($VERSION $DEBUG);

use Carp;

BEGIN {
	$VERSION = '0.4';
	$DEBUG = 1;
}

sub new {
	my $proto = shift;
	my $class = ref($proto) || $proto;
	my $self = {
				 _debug    => 0,
				 _buffer   => [],
				 _currline => 0,
				 _modified => 0,
				 _autonewline => "unix",
				 _newline  => "\n"
	};

	bless( $self, $class );

	my %opts = @_;
	if ($opts{debug}) { $self->{_debug} = $opts{debug}}
	$self->_debug("Instantiated new object $class");
	if ( $opts{file} ) {
		$self->{file} = $opts{file};
		$self->load();
	}
	elsif ( $opts{array} ) {
		if ( ref( $opts{array} ) eq "ARRAY" ) {
			foreach ( @{ $opts{array} } ) {
				$self->append($_);
			}
		}
		$self->setModified(1);
	}
	foreach (qw(autonewline)) {
		$self->{"_$_"} = $opts{$_} if exists($opts{$_});
	}

	return $self;
}

sub load {
	my $self = shift;
	my $file = shift || $self->{file};
	if ( !$file ) {
		$self->_setError("No file to load specified");
		return undef;
	}
	$self->_debug("Loading file $file");
	if ( open( FIL, $file ) ) {
		$self->_debug("clearing buffer and adding $file to buffer");
		$self->clear();
		while () {
			$self->append($_);
		}
		close(FIL);
		$self->_clearModified();
		return 1;
	}
	else {
		$self->_setError("Failed to load file $file");
		return undef;
	}
	return 0;
}

sub save {
	my $self = shift;
	my $file = shift || $self->{file};
	if ( !$file ) {
		$self->_setError("No file to save to specified");
		return undef;
	}

	if ( $self->{file} && $file eq $self->{file} && !$self->isModified() ) {
		$self->_debug("Buffer not modified, not saving to file $file");
		return 1;
	}
	else {
		$self->_debug(
				   "Saving " . $self->getLineCount() . " lines to file $file" );
	}

	if ( open( FIL, ">$file" ) ) {
		$self->_debug("saving buffer to $file");
		$self->goto('top');
		my $str = $self->get();
		my $cnt = 0;
		while ( defined($str) ) {
			$self->_debug("saving: '$str'");
			$cnt++;
			print FIL $str;
			$str = $self->next();
		}
		close(FIL);
		return $cnt;
	}
	else {
		$self->_setError("Failed to load file $file");
		return undef;
	}

	return 0;
}

sub clear {
	my $self = shift;
	@{ $self->{_buffer} } = ();
	$self->{_currline} = 0;
	return 1;
}

#=============================================================
# Public Methods
#=============================================================
# Navigation methods
#-------------------------------------------------------------

# Internal method returning the resulting array position (starting at 0)
sub _translateLinePos {
	my $self    = shift;
	my $linenum = shift || return undef;
	my $curr    = $self->{_currline};      # Resulting line to return
	if ( $linenum =~ /^[0-9]+$/ ) {
		$curr = $linenum - 1;
	}
	elsif ( $linenum =~ /^[+-]\d+$/ ) {
		eval "\$curr=$curr$linenum";
	}
	elsif ( $linenum =~ /^(start|top|first)$/ ) {
		$curr = 0;
	}
	elsif ( $linenum =~ /^(end|bottom|last)$/ ) {
		$curr = $self->getLineCount() - 1;
	}
	else {
		$self->_debug("Could not translate: $linenum");
		return undef;
	}

	# do sanity check now
	if ( $curr < 0 || $curr >= $self->getLineCount() ) {
		$self->_debug(
					"Failed sanity check, current line would be out of bounds");
		return undef;
	}

	return $curr;
}

sub goto {
	my $self = shift;
	my $goto = shift;
	my $curr = $self->_translateLinePos($goto);

	if ( !defined($curr) ) {
		$self->_setError("Invalid line position: $goto");
		return undef;
	}

	$self->_debug(   "goto $goto succeeded from array pos "
				   . $self->{_currline}
				   . " to $curr" );
	$self->{_currline} = $curr;
	return $self->getLineNumber();
}

sub getLineCount {
	my $self = shift;
	return ( $#{ $self->{_buffer} } + 1 );
}

sub getLineNumber {
	my $self = shift;
	$self->_debug(   "line is "
				   . ( $self->{_currline} + 1 )
				   . ", array pos is $self->{_currline}" );
	return ( $self->{_currline} + 1 );
}

sub isEOF { return shift->isEndOfBuffer() }

sub isEndOfBuffer {
	my $self = shift;
	return ( $self->{_currline} >= $self->getLineCount() );
}
sub isEmpty { return ( shift->getLineCount() == 0 ) }

sub isModified     { return shift->{_modified}; }
sub setModified    { my $self = shift; $self->_debug("Marking buffer modified"); $self->{_modified} = 1; }
sub _clearModified { my $self = shift; $self->_debug("Marking buffer unmodified"); $self->{_modified} = 0; }

sub setAutoNewline {
	my $self = shift;
	my $newline = shift;
	if (!$newline || $newline eq "off" || $newline eq "none") {
		$self->{_autonewline} = ""; $self->{_newline} = "";
	}
	elsif ($newline eq "\n" || lc($newline) eq "unix") {
		$self->{_autonewline} = "unix"; $self->{_newline} = "\n";
	}
	elsif ($newline eq "\r" || lc($newline) eq "mac") {
		$self->{_autonewline} = "mac"; $self->{_newline} = "\r";
	}
	elsif ($newline eq "\r\n" || lc($newline) eq "windows") {
		$self->{_autonewline} = "windows"; $self->{_newline} = "\r\n";
	}
	else {
		$self->{_autonewline} = "other"; $self->{_newline} = "$newline";
	}
	return 1;
}

sub getAutoNewline {
	my $self = shift;
	return $self->{_newline};
}

sub next {
	my $self = shift;
	my $num  = shift || 1;

	#FIXME should return all lines as array in array context
	if ( !$self->goto("+$num") ) {
		return undef;
	}
	return $self->get();
}

sub previous {
	my $self = shift;
	my $num  = shift || 1;

	#FIXME should return all lines as array in array context
	if ( !$self->goto("-$num") ) {
		return undef;
	}
	return $self->get();
}

#-------------------------------------------------------------
# Searching methods
#-------------------------------------------------------------
sub find {
	my $self = shift;
	my $match = shift || return undef;
	# TODO Add a more sophisticated interface, like
	# find(regex => "\d+", startat => 'top', wrap => 1)
	my $wrap = shift;
	$match = $self->escapeRegexString($match);
	$self->{_findstart} = 1;	# Start at top, unless startline is defined
	$self->{_findlast}  = undef;
	$self->{_findregex} = $match;
	$self->{_findwrap}  = $wrap;
	$self->goto($self->{_findstart});
	return $self->findNext();
}

sub findNext {
	my $self = shift;
	my $match = $self->{_findregex};
	return undef if !$match;
	# Continue from current-line + 1 (avoid matchloop)
	if (defined($self->{_findlast})) { $self->goto($self->{_findlast} + 1); }
	my $line = $self->get();
	my $MAXCOUNT = $self->getLineCount();
	my $count = 0;
	while (defined($line) && $count++ <= $MAXCOUNT) {
		$self->_debug("Finding $match in line: '$line'");
		if ($line =~ /$match/) {
			if (defined($self->{_findlast}) && $self->{_currline} eq $self->{_findlast}) {
				$self->_debug("Ohoh, should not have found same match again");
				return undef;
			}
			$self->{_findlast} = $self->getLineNumber();
			$self->_debug("Found match $match in line $self->{_findlast}");
			return $self->getLineNumber();
		}
		$line = $self->next();
		if ($self->isEOF() && $self->{_findwrap}) {
			$self->goto('top');
			$line = $self->get();
		}
	}
	return undef;
}

sub findPrevious {
	return undef;
}

#-------------------------------------------------------------
# Viewing/Editing methods
#-------------------------------------------------------------
sub get {
	my $self    = shift;
	my $linenum = shift;
	if ( defined($linenum) ) { $linenum = $self->_translateLinePos($linenum) }
	else { $linenum = $self->{_currline} }
	if ( !defined($linenum) ) {
		$self->_setError("Invalid line position");
		return undef;
	}
	my $line = $self->_appendAutoNewline(${ $self->{_buffer} }[$linenum]);
	$self->_debug( "get line $linenum in array: "
				   . ( defined($line) ? $line : "*undef*" ) );
	return $line;
}

sub set {
	my $self    = shift;
	my $line    = shift;
	my $linenum = shift;
	if ( defined($linenum) ) { $linenum = $self->translateLinePos($linenum) }
	else { $linenum = $self->{_currline} }
	if ( !defined($line) ) {
		$self->_setError("Cannot set undefined data for line $linenum");
		return undef;
	}
	$self->_debug("set line $linenum in array: $line");
	if ( !defined( ${ $self->{_buffer} }[$linenum] )
		 || ${ $self->{_buffer} }[$linenum] ne $line )
	{
		$self->setModified();
	}

	${ $self->{_buffer} }[$linenum] = $line;
	return 1;
}

# Insert before start of buffer
sub insert {
	my $self = shift;
	unshift( @{ $self->{_buffer} }, @_ );
	return 1;
}

sub append {
	my $self = shift;
	push( @{ $self->{_buffer} }, @_ );
	return 1;
}

sub delete {
	my $self = shift;
	splice( @{ $self->{_buffer} }, $self->{_currline}, 1 );
	return $self->get();
}

sub dumpAsString {
	my $self = shift;
	return
	  join( "", map { ( defined($_) ? $_ : "*undef*" ) } @{ $self->{_buffer} } )
	  if ( $self->{_buffer} )
	  && ( ref( $self->{_buffer} ) eq "ARRAY" )
	  && $#{ $self->{_buffer} } >= 0;
	return "";
}

sub replaceString {
	my $self  = shift;
	my ($match,$with) = @_;
	my $str = $self->get();
	return undef if !defined($str);
	$self->_debug( "Doing string replacement of '$match' with '$with' on string: $str" );
	my $pos = 0;
	my $index = 0;
	my $count = 0;
	my $MAXCOUNT = 1000;
	while ($pos < length($str) && ($index = index($str,$match,$pos)) >= $pos && $count++ < $MAXCOUNT) {
		# myfoobar, foo is at index 2, foo is replaced by bar,
		$self->_debug("Found $match at $index (pos was $pos)");
		$str = substr($str,0,$index) . $with . substr($str,$index + length($match));
		$pos = $index + length($with);
		$self->_debug("String is now $str, pos is $pos");
	}
	if ($count == $MAXCOUNT) { $self->setError("Maximum loopcount reached"); return undef; }
	if ($count) {
		$self->set($str);
	}
	return $count;
}

sub replaceWildcard {
	my $self  = shift;
	my ($match,$with,$opts) = @_;
	# Replace wildcards with apropriate regex terms
	# map '*' to '.*?'
	# map '?' to '.'
	# leave other things the same, but escape / and ()
	$self->_debug("Doing wildcard replacement of '$match' with '$with'" );
	$match = $self->escapeRegexString($match,"*.");
	$match =~ s/\?/./g;
	$match =~ s/\*/\\S*/g;
	$self->_debug("After wildcard expansion: $match (was $_[1])");
	return $self->replaceRegex($match, $with, $opts);
}

sub replaceRegex {
	my $self  = shift;
	my $match = shift;
	my $with  = shift;
	my $opts  = shift;
	if ( !defined($opts) ) { $opts = "g"; }
	my $count;
	my $str = $self->get();
	return undef if !defined($str);
	# Be sure to escape our used seperation char for s//
	$with =~ s?(^|[^\\])/?$1\\/?g;
	$self->_debug(
"Doing regex replacement of '$match' with '$with' (opts: $opts) on string: $str" );
	eval "\$count = (\$str =~ s/$match/$with/$opts)";

	if ($count) {
		$self->set($str);
	}
	return $count;
}

# replace is an alias for replaceRegex
sub replace { shift->replaceRegex(@_); }

#=============================================================
# Utility functions / class methods
#=============================================================
sub convertWildcardToRegex {
	my $self = shift;
	my $string = shift || return "";
	$self->_debug("convert wildcard '$string'");
	$string = $self->escapeRegexString($string,"?*");
	$string =~ s/\?/./g;
	$string =~ s/\*/.*/g;
#	$string =~ s/([\(\)\/])/\\$1/g;
	$self->_debug("converted to regex: $string");
	return $string;
}

sub escapeRegexString {
	# We need to escape all regex specific chars
	# ignore chars will not be escaped
	my $self = shift;
	my $string = shift || return "";
	my $ignorechars = shift || "";
	my $regexchars = '\\/()[]{}+.*?'; #'
	my $escapechars = "";
	$self->_debug("escape string: '$string'   ignoring: '$ignorechars'  regex: '$regexchars'\n");
	# Build a hash of chars to ignore and
	my %chars = (map { $_ => 1 } split(//,$ignorechars));
	# Now remove all unused ignored chars
	foreach (split(//,$regexchars)) { $escapechars .= '\\' . $_ if !$chars{$_} }
	$string =~ s/([$escapechars])/\\$1/g;
	$self->_debug("escape: '$escapechars', string: '$string'");
	return $string;
}

sub convertStringToRegex {
	return shift->escapeRegexString(@_);
}

#-------------------------------------------------------------
# ErrorHandling Methods
#-------------------------------------------------------------
sub _setError { my $self = shift; $self->{error} = shift; }
sub isError { return ( shift->{'error'} ? 1 : 0 ); }

sub getError {
	my $self  = shift;
	my $error = $self->{error};
	$self->_clearError();
	return $error;
}
sub _clearError { shift->{error} = ""; }

#=============================================================
# Private Methods
#=============================================================
# Only internal function for debug output
sub _appendAutoNewline {
	my $self = shift;
	my $text = shift;
	return $text if (!$self->{_autonewline} || !$text);
	my $newline = $self->{_newline} || "";
	$text =~ s/[\r\n]+$//;
	$self->_debug("appended autonewline " . $self->{_autonewline}. "'$newline' to '$text'");
	return "$text$newline";
}

sub _debuglevel {
	my $self = shift;
	my $level = shift;
	if (ref($self) eq __PACKAGE__) {
		if (defined($level)) { $self->{_debug} = $level; }
		$level = $self->{_debug};
#		print "Object debug is $level (" . ref($self) . ")\n";
	} else {
		if (defined($level)) { $DEBUG = $level; }
		$level = $DEBUG;
#		print "Class debug is $level (" . ref($self) . ")\n";
	}
	return $level;
}

sub _debug {
	my $self = shift;
	my $lvl = $self->_debuglevel();
	if ( $self->_debuglevel() ) {
		print "[DEBUG$lvl] @_\n";
	}
}

1;
__END__