package IO::Easy::File;

use Class::Easy;

use Encode qw(decode encode perlio_ok is_utf8);

use Fcntl ':seek';

use File::Spec;
our $FS = 'File::Spec';

use IO::Easy;
use base qw(IO::Easy);

use IO::Dir;

our $PART = 1 << 20;
our $ENC  = '';

our $IRS;

if ( $^O =~ /win32/i || $^O =~ /vms/i ) {
	$IRS = "\015\012" ;
} elsif ( $^O =~ /mac/i ) {
	$IRS = "\015" ;
} else {
	$IRS = "\012" ;
}

sub _init {
	my $self = shift;
	
	return $self->_init_layer;
	
}

sub type {
	return 'file';
}

sub enc {
	my $self = shift;
	my $enc  = shift;
	
	return $self->{enc} || $ENC
		unless $enc;
	
	$self->{enc} = $enc;
	return $self->_init_layer;
}

sub _init_layer {
	my $self = shift;
	
	my $enc = $self->enc;
	
	if (!defined $enc or $enc eq '') {
		# binary reading
		$self->{layer} = ':raw';
	} else {
		my $enc_ok = perlio_ok ($enc);
		unless ($enc_ok) {
			warn "selected encoding ($enc) are not perlio savvy";
			return undef;
		}
		$self->{layer} = ":encoding($enc)";
	}
	return $self;
}

sub layer {
	my $self = shift;
	my $layer = shift;
	
	$self->_init_layer;
	
	return $self->{layer}
		unless $layer;
	
	my $old_layer = $self->{layer};
	$self->{layer} = $layer;
	
	return $old_layer;
}

sub part {
	my $self = shift;
	my $part = shift;
	
	return $self->{part} || $PART
		unless $part;
	
	$self->{part} = $part;
}

sub contents {
	my $self = shift;
	
	my $enc = $self->enc;
	
	my $io_layer = $self->layer;
	
	my $fh;
	open ($fh, "<$io_layer", $self->{path})
		|| die "cannot open file $self->{path}: $!";
	
	my $contents;
	
	my $part = $self->part;
	my $buff;
	
	while (read ($fh, $buff, $part)) {
		$contents .= $buff;
	}
	
	close ($fh);
	
	return $contents;
}

sub store {
	my $self = shift;
	my $contents = shift;
	
	my $enc = $self->enc;
	
	my $change_layer;
	
	if (defined $enc and $enc ne '' and ! is_utf8 ($contents)) {
		$change_layer = $self->layer (':raw');
	}
	
	my $io_layer = $self->layer;
	
	my $fh;
	open ($fh, ">$io_layer", $self->{path})
		|| die "cannot open file $self->{path}: $!";
	
	print $fh $contents
		if defined $contents;
	
	close $fh;
	
	if (defined $change_layer and $change_layer ne '') {
		$self->layer ($change_layer);
	}
	
	return 1;
}

sub store_if_empty {
	my $self = shift;
	return if -e $self;
	
	$self->store (@_);
}

sub move {
	my $self = shift;
	my $to = shift;
	
	# rename function is highly dependent on os, don't rely on it
	my $from_file = $self->path;
	my $to_file = $to;
	$to_file = $to->path
		if ref $to eq 'IO::Easy::File';
	
	$to_file = $FS->join($to->path, $self->file_name)
		if ref $to eq 'IO::Easy::Dir';
	
	$to = IO::Easy::File->new ($to_file);
	
	$to->dir_path->create; # create dir if necessary
	
	print 'move from: ', $from_file, ' to: ', $to_file, "\n";
	
	unless (open (IN, $from_file)) {
		warn "can't open $from_file: $!";
		return;
	}
	unless (open (OUT, '>', $to_file)) {
		warn "can't open $to_file: $!";
		return;
	}

	binmode(IN);
	binmode(OUT);
	
	my $buff;
	
	my $part = $self->part;
	
	# TODO: async
	
	while (read(IN, $buff, $part)) {
		print OUT $buff;
	}
	
	close IN;
	close OUT;
	
	unlink $from_file;
	
	$self->{path} = $to_file;
	
}

sub string_reader {
	my $self = shift;
	my $sub  = shift;
	my %params = @_;
	
	# because we can't seek in characters
	my $fh;
	open ($fh, '<:raw', $self->{path}) or return;

	my $seek_pos = 0;
	if ($params{reverse}) {
		if (seek ($fh, 0, SEEK_END)) {
			$seek_pos = tell ($fh);
		} else {
			return;
		}
	}
	
	my $buffer_size = $self->part;
	
	my $remains = '';
	my $buffer;
	my $read_cnt = 0;
	
	my $c = 10;
	
	if ($params{reverse}) {
		do {
			$seek_pos -= $buffer_size;
			$seek_pos = 0
				if $seek_pos < 0;

			seek ($fh, $seek_pos, SEEK_SET);
			$read_cnt = read ($fh, $buffer, $buffer_size);

			my @lines = split $IRS, $buffer . 'aaa';
			
			if ($lines[$#lines] eq 'aaa') {
				$lines[$#lines] = '';
			} else {
				$lines[$#lines] =~ s/aaa$//s;
			}
			
			$lines[$#lines] = $lines[$#lines] . $remains;
			$remains = shift @lines;
			
			for (my $i = $#lines; $i >= 0; $i--) {
				&$sub ($lines[$i]);
			}
			
		} while $seek_pos > 0;
	} else {
		do {
			# seek ($fh, $seek_pos, SEEK_SET);
			$read_cnt = read ($fh, $buffer, $buffer_size);
			
			$seek_pos += $buffer_size;
			
			my @lines = split $IRS, $buffer . 'aaa';
			
			if ($lines[$#lines] eq 'aaa') {
				$lines[$#lines] = '';
			} else {
				$lines[$#lines] =~ s/aaa$//s;
			}
			
			$lines[0] = $remains . $lines[0];
			$remains = pop @lines;
			
			foreach my $line (@lines) {
				&$sub ($line);
			}
			
		} while $read_cnt == $buffer_size;
		
	}
	
	&$sub ($remains);

	#	@{$lines_ref} = ( $self->{'sep_is_regex'} ) ?
	#		$text =~ /(.*?$self->{'rec_sep'}|.+)/gs :
	#		$text =~ /(.*?\Q$self->{'rec_sep'}\E|.+)/gs ;

}

sub __data__files {
	
	my ($caller) = caller; 
	
	$caller ||= '';
	
	no strict 'refs';
	
	local $/;
	my $buf;
	my $data_position;
	eval "\$data_position = tell (${caller}::DATA); \$buf = <${caller}::DATA>; seek (${caller}::DATA, \$data_position, 0);";
	
	my @files = split /\s*#+\s+#*\s*(?=IO::Easy)/s, $buf;
	
	my $response = {};
	
	foreach my $contents (@files) {
		
		my ($key, $value) = split (/\s+#+\s+/, $contents, 2);
		
		next unless defined $key;
		
		$key =~ s/IO::Easy(?:::File)?\s+//;
		
		$response->{$key} = $value;
	}
	
	return $response;
}

1;

=head1 NAME

IO::Easy::File - IO::Easy child class for operations with files.

=head1 METHODS

=head2 contents, path, extension, dir_path

	my $io = IO::Easy->new ('.');
	my $file = $io->append('example.txt')->as_file;
	print $file->contents;		# prints file content
	print $file->path;			# prints file path, in this example it's './example.txt'

=cut

=head2 store, store_if_empty

IO::Easy::File has 2 methods for saving file: store and store_if_empty

	my $io = IO::Easy->new ('.');
	my $file = $io->append('example.txt')->as_file;
	my $content = "Some text goes here";

	$file->store($content);   			# saves the variable $content to file

	$file->store_if_empty ($content);	# saves the variable $content to file, only 
										# if there's no such a file existing.		

=cut

=head2 string_reader

read strings from file in normal or reverse order

	$io->string_reader (sub {
		my $s = shift;

		print $s;
	});

read from file end

	$io->string_reader (sub {
		my $s = shift;

		print $s;
	}, reverse => 1);

=cut

=head2 __data__files

parse __DATA__ section and return hash of file contents encoded as:

	__DATA__

	########################
	# IO::Easy file1
	########################

	FILE1 CONTENTS

	########################
	# IO::Easy file2
	########################

	FILE2 CONTENTS

returns

	{
		file1 => 'FILE1 CONTENTS',
		file2 => 'FILE2 CONTENTS',
	}

=cut

=head2 enc

file encoding for reading and writing files. by default '', which is :raw for
PerlIO. you can redefine it by providing supported encoding, as example utf-8 or ascii

=cut

=head2 layer

PerlIO layer name for reading and writing files. you can redefine it by providing argument

=cut

=head2 part

chunk size for file reading, storing and moving

=cut

=head2 move

moving file to another path

=cut

=head2 type

always 'file'

=cut

=head1 AUTHOR

Ivan Baktsheev, C<< <apla at the-singlers.us> >>

=head1 BUGS

Please report any bugs or feature requests to my email address,
or through the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=IO-Easy>. 
I will be notified, and then you'll automatically be notified
of progress on your bug as I make changes.

=head1 SUPPORT



=head1 ACKNOWLEDGEMENTS



=head1 COPYRIGHT & LICENSE

Copyright 2007-2009 Ivan Baktsheev

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.


=cut