The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package File::Object;

# Pragmas.
use strict;
use warnings;

# Modules.
use Class::Utils qw(set_params);
use Error::Pure qw(err);
use FindBin qw($Bin $Script);
use File::Spec::Functions qw(catdir catfile splitdir);

# Version.
our $VERSION = 0.05;

# Constructor.
sub new {
	my ($class, @params) = @_;

	# Create object.
	my $self = bless {}, $class;

	# Dir path.
	$self->{'dir'} = [];

	# File path.
	$self->{'file'} = undef;

	# Type of path.
	$self->{'type'} = 'dir';

	# Process parameters.
	set_params($self, @params);

	# Check to right 'type'.
	if (! $self->{'type'} || ($self->{'type'} ne 'file' 
		&& $self->{'type'} ne 'dir')) {

		err 'Bad \'type\' parameter.';
	}

	# Check to dir.
	if (ref $self->{'dir'} ne 'ARRAY') {
		err '\'dir\' parameter must be a reference to array.';
	}

	# Check to file.
	if ($self->{'type'} eq 'file' && @{$self->{'dir'}}
		&& ! defined $self->{'file'}) {

		err 'Bad file constructor with undefined \'file\' parameter.';
	}

	# Reset to constructor values.
	$self->reset;

	# Object.
	return $self;
}

# Add dir.
sub dir {
	my ($self, @dirs) = @_;
	foreach my $dir (@dirs) {
		if (defined $dir) {
			$self->_dir($dir);
		}
	}

	# Object.
	return $self;
}

# Add file.
sub file {
	my ($self, @dirs_or_file) = @_;
	my $file = pop @dirs_or_file;
	$self->dir(@dirs_or_file);
	$self->_file($file);

	# Object.
	return $self;
}


# Get dir.
sub get_dir {
	my ($self, $dir_num) = @_;
	$dir_num ||= 1;
	if ($self->{'type'} eq 'file') {
		$dir_num++;
	}
	return $self->{'path'}->[-$dir_num];
}

# Get file.
sub get_file {
	my $self = shift;
	if ($self->{'type'} eq 'file') {
		return $self->{'path'}->[-1];
	} else {
		return;	
	}
}

# Reset to constructor values.
sub reset {
	my $self = shift;
	if ($self->{'type'} eq 'file') {
		if ($self->{'file'}) {
			$self->{'path'} = [@{$self->{'dir'}}, $self->{'file'}];
		} else {
			$self->{'path'} = [splitdir($Bin), $Script];
		}
	} else {
		if (@{$self->{'dir'}}) {
			$self->{'path'} = [@{$self->{'dir'}}];
		} else {
			$self->{'path'} = [splitdir($Bin)];
		}
	}
	return $self;
}

# Serialize path.
sub s {
	my $self = shift;
	if ($self->{'type'} eq 'dir') {
		return catdir(@{$self->{'path'}});
	} else {
		return catfile(@{$self->{'path'}});
	}
}

# Set actual values to constructor values.
sub set {
	my $self = shift;
	my @path = @{$self->{'path'}};
	if ($self->{'type'} eq 'file') {
		$self->{'file'} = pop @path;
		$self->{'dir'} = \@path;
	} else {
		$self->{'dir'} = \@path;
	}
	return $self;
}

# Go to parent directory.
sub up {
	my ($self, $up_num) = @_;

	# Check number and positive number.
	if (! $up_num || $up_num !~ m/^\d$/ms) {
		$up_num = 1;
	}

	# Process.
	foreach (1 .. $up_num) {
		if ($self->{'type'} eq 'file') {
			if (@{$self->{'path'}} > 2) {
				$self->{'type'} = 'dir';
				$self->{'file'} = undef;
				splice @{$self->{'path'}}, -2;
			} else {
				err 'Cannot go up.', 'PATH', $self->s;
			}
		} else {
			if (@{$self->{'path'}}) {
				pop @{$self->{'path'}};
			} else {
				err 'Cannot go up.', 'PATH', $self->s;
			}
		}
	}

	# Object.
	return $self;
}

# Add dir array.
sub _dir {
	my ($self, @dir) = @_;	
	if ($self->{'type'} eq 'file') {
		$self->{'type'} = 'dir';
		$self->{'file'} = undef;
		pop @{$self->{'path'}};
	}
	push @{$self->{'path'}}, @dir;
	return;
}

# Add file array.
sub _file {
	my ($self, $file) = @_;
	if ($self->{'type'} eq 'file') {
		pop @{$self->{'path'}};
		push @{$self->{'path'}}, $file;
	} else {
		push @{$self->{'path'}}, $file;
		$self->{'type'} = 'file';
	}
	return;
}

1;

__END__

=pod

=encoding utf8

=head1 NAME

File::Object - Object system for filesystem paths.

=head1 SYNOPSIS

 use File::Object;
 my $obj = File::Object->new(%parameters);
 $obj->dir($dir);
 $obj->file($file);
 my $dir = $obj->get_dir($dir_num);
 my $file = $obj->get_file;
 $obj->reset;
 my $path = $obj->s;
 $obj->set;
 $obj->up($num);

=head1 METHODS

=over 8

=item C<new(%parameters)>

Constructor.

=over 8

=item * C<dir>

 Directory path.

=item * C<file>

 File path.

=item * C<type>

 Type of path.
 Types:
 - file
 - dir

=back

=item C<dir(@dir)>

 Add directory or directories to object.
 Returns main object.

=item C<file(@file)>

 Add file or directory/directories with file to object.
 Returns main object.

=item C<get_dir($dir_num)>

 Returns $dir_num level directory.
 Default value of $dir_num is 1.

=item C<get_file()>

 Returns:
 - Filename if object is file path.
 - undef if object is directory path.

=item C<reset()>

 Reset to constructor values.

=item C<s()>

 Serialize path and return.

=item C<set()>

 Set actual values to constructor values.

=item C<up($up_num)>

 Go to $up_num upper directory. 
 Returns main object.

=back

=head1 ERRORS

 Mine:
         'dir' parameter must be a reference to array.
         Bad 'type' parameter.
         Bad file constructor with undefined 'file' parameter.
         Cannot go up.
                 PATH -> path;

 From Class::Utils::set_params():
         Unknown parameter '%s'.

=head1 EXAMPLE1

 # Pragmas.
 use strict;
 use warnings;

 # Modules.
 use File::Object;

 # Print actual directory path.
 print File::Object->new->s."\n";

=head1 EXAMPLE2

 # Pragmas.
 use strict;
 use warnings;

 # Modules.
 use File::Object;

 # Print parent directory path.
 print File::Object->new->up->s."\n";

=head1 EXAMPLE3

 # Pragmas.
 use strict;
 use warnings;

 # Modules.
 use File::Object;

 # Object with directory path.
 my $obj = File::Object->new(
         'dir' => ['path', 'to', 'subdir'],
 );

 # Relative path to file1.
 print $obj->file('file1')->s."\n";

 # Relative path to file2.
 print $obj->file('file2')->s."\n";

 # Output:
 # Unix:
 # path/to/subdir/file1
 # path/to/subdir/file2
 # Windows:
 # path\to\subdir\file1
 # path\to\subdir\file2

=head1 EXAMPLE4

 # Pragmas.
 use strict;
 use warnings;

 # Modules.
 use File::Object;

 # Object with directory path.
 my $obj = File::Object->new(
         'dir' => ['path', 'to', 'subdir'],
 );

 # Relative path to dir1.
 print $obj->dir('dir1')->s."\n";

 # Relative path to dir2.
 print $obj->reset->dir('dir2')->s."\n";

 # Output:
 # Unix:
 # path/to/subdir/dir1
 # path/to/subdir/dir2
 # Windows:
 # path\to\subdir\dir1
 # path\to\subdir\dir2

=head1 DEPENDENCIES

L<Class::Utils>,
L<Error::Pure>,
L<FindBin>,
L<File::Spec::Functions>.

=head1 REPOSITORY

L<https://github.com/tupinek/File-Object>

=head1 AUTHOR

Michal Špaček L<mailto:skim@cpan.org>

L<http://skim.cz>

=head1 LICENSE AND COPYRIGHT

BSD license.

=head1 VERSION

0.05

=cut