package Padre::File::Local;

use 5.008;
use strict;
use warnings;
use File::Basename  ();
use File::Spec      ();
use Padre::Constant ();
use Padre::File     ();

our $VERSION = '1.00';
our @ISA     = 'Padre::File';

sub _reformat_filename {
	my $self = shift;

	if (Padre::Constant::WIN32) {

		# Fixing the case of the filename on Win32.
		require Win32;
		$self->{filename} = Win32::GetLongPathName( $self->{filename} )
			|| $self->{filename};
	}

	# Convert the filename to correct format. On Windows C:\dir\file.pl and C:/dir/file.pl are the same
	# file but have different names.
	my $New_Filename = File::Spec->catfile(

		# Handle UNC paths on win32
		Padre::Constant::WIN32
			and $self->{filename} =~ m{^\\\\}
		? File::Spec->splitpath( File::Basename::dirname( $self->{filename} ) )
		: File::Spec->splitdir( File::Basename::dirname( $self->{filename} ) ),
		File::Basename::basename( $self->{filename} )
	);

	if ( defined($New_Filename) and ( length($New_Filename) > 0 ) ) {
		$self->{filename} = $New_Filename;
	}
}

sub new {
	my $class = shift;
	my $self = bless { filename => $_[0] }, $class;
	$self->{protocol} = 'local'; # Should not be overridden

	$self->{filename} = File::Spec->rel2abs( $self->{filename} )
		unless File::Spec->file_name_is_absolute( $self->{filename} );

	$self->_reformat_filename;

	return $self;
}

sub can_clone {

	# Local files don't have connections, no need to clone objects
	return 0;
}

sub can_run {
	return 1;
}

sub can_delete {
	my $self = shift;

	# Can't delete readonly files
	return $self->readonly ? 0 : 1;
}

sub stat {
	my $self = shift;
	return CORE::stat( $self->{filename} );
}

sub size {
	my $self = shift;
	return -s $self->{filename} || 0;
}

sub dev {
	my $self = shift;
	return ( CORE::stat( $self->{filename} ) )[0];
}

sub inode {
	my $self = shift;
	return ( CORE::stat( $self->{filename} ) )[0];
}

sub mode {
	my $self = shift;
	return ( CORE::stat( $self->{filename} ) )[2];
}

sub nlink {
	my $self = shift;
	return ( CORE::stat( $self->{filename} ) )[3];
}

sub uid {
	my $self = shift;
	return ( CORE::stat( $self->{filename} ) )[4];
}

sub gid {
	my $self = shift;
	return ( CORE::stat( $self->{filename} ) )[5];
}

sub rdev {
	my $self = shift;
	return ( CORE::stat( $self->{filename} ) )[6];
}

sub atime {
	my $self = shift;
	return ( CORE::stat( $self->{filename} ) )[8] || 0;
}

sub mtime {
	my $self = shift;
	return ( CORE::stat( $self->{filename} ) )[9] || 0;
}

sub ctime {
	my $self = shift;
	return ( CORE::stat( $self->{filename} ) )[10] || 0;
}

sub blksize {
	my $self = shift;
	return ( CORE::stat( $self->{filename} ) )[11] || 0;
}

sub blocks {
	my $self = shift;
	return ( CORE::stat( $self->{filename} ) )[12] || 0;
}

sub exists {
	my $self = shift;
	return -e $self->{filename};
}

sub read {
	my $self = shift;

	# The return value should be the file content, so returning
	# undef is better than nothing (in this situation) if there
	# is no filename
	return if not defined $self->{filename};

	if ( open my $fh, '<', $self->{filename} ) {
		binmode($fh);
		local $/ = undef;
		my $buffer = <$fh>;
		close $fh;
		return $buffer;
	}

	$self->{error} = $!;
	return;
}

sub write {
	my $self    = shift;
	my $content = shift;
	my $encode  = shift || ''; # undef encode = default, but undef will trigger a warning

	if ( open my $fh, ">$encode", $self->{filename} ) {
		print {$fh} $content;
		close $fh;
		return 1;
	}

	$self->{error} = $!;
	return;
}

sub basename {
	my $self = shift;
	return File::Basename::basename( $self->{filename} );
}

sub dirname {
	my $self = shift;
	return File::Basename::dirname( $self->{filename} );
}

sub splitvdir {
	my ( $v, $d, $f ) = File::Spec->splitpath( $_[0]->{filename} );
	my @d = File::Spec->splitdir($d);
	pop @d if $d[-1] eq '';
	return $v, @d;
}

sub splitall {
	my ( $v, $d, $f ) = File::Spec->splitpath( $_[0]->{filename} );
	my @d = File::Spec->splitdir($d);
	pop @d if $d[-1] eq '';
	return $v, @d, $f;
}

sub readonly {
	my $self = shift;
	# see #1447
	# return 1 if ( !-w $self->{filename} );
	return 1 if ( -e $self->{filename} && !-w $self->{filename} );
}

sub browse_url_join {
	my $self     = shift;
	my $server   = shift;
	my $path     = shift;
	my $filename = shift;

	return File::Spec->catfile( $server, $path, $filename );
}

sub delete {
	my $self = shift;

	return 1 if unlink $self->{filename};

	$self->{error} = $!;
}


1;

# Copyright 2008-2013 The Padre development team as listed in Padre.pm.
# LICENSE
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl 5 itself.
