package FileSystemObjects::File;

use warnings;
use strict;

use File::Basename qw(fileparse);
use File::Spec;
use File::Slurp;
use base qw(File::Copy);

use IO::File;
use POSIX qw(strftime);

use Cwd;
use Carp;
use Time::Local;
use Digest::MD5 qw(md5 md5_hex md5_base64);

use Data::Dumper;

my %size_units = ( b => 1, kb => 1024, mb => 1024 * 1024, tb => 1024 *
+ 1024 * 1024);
my %stat_modes = ( mtime => 9, atime =>8, ctime => 10 );

my %filetest_subs;

my %loaded_optional_modules = ();

my @stat_names = qw (dev ino mode nlink uid gid rdev size atime mtime 
+ctime blksize blocks);
my @time_names = qw (sec min hour day mon year);

#documented: synopsis
sub new
{
    my $class = shift;
    my $name  = shift || croak "Must specify a filename!";

    my $self = { };

    bless $self, $class;

    $self->_analyze( $name );

    return $self;
}

#documented: -
sub _analyze
{
    my $self = shift;
    my $name = shift;

    $self->{_full_path} = File::Spec->rel2abs ($name);
    ($self->{_drive}, $self->{_path}, $self->{_name}) = File::Spec->sp
+litpath($self->{_full_path});
}

#documented: synopsis
sub stat
{
    my $self = shift;

    croak "Can't stat a non existant file" unless -e $self->full_path;

    return CORE::stat($self->full_path);
}

#documented: synopsis
sub stath
{
    my $self = shift;
    my @stat = $self->stat;

    return map { $stat_names[$_] => $stat[$_] } (0..12);
}

#documented: synopsis
sub atime
{
    my $self = shift;
    my $format = shift || "%c";

    return $self->_time ($format, "a");
}

#documented: synopsis
sub mtime
{
    my $self = shift;
    my $format = shift || "%c";

    return $self->_time ($format, "m");
}

#documented: synopsis
sub ctime
{
    my $self = shift;
    my $format = shift || "%c";

    croak "Can't time a non existant file" unless -e $self->full_path;

    return $self->_time ($format, "c");
}

#documented: -
sub _time
{
    my $self   = shift;
    my $format = shift;
    my $mode   = shift;

    my $t = (CORE::stat($self->full_path))[$stat_modes{"${mode}time"}]
+;

    return strftime ($format, localtime($t));
}

#documented: synopsis
sub size
{
    my $self = shift;

    croak "Can't copy a non existant file" unless -e $self->full_path;

    my %args = @_;

    my $unit = $size_units{lc($args{unit})} || 1;
    my $size = (-s $self->full_path) / $unit;
    my $form = $args{format} || "%d";

    return sprintf $form, $size;
}

#documented: synopsis
sub exists
{
    my $self = shift;
    return -e $self->full_path;
}

#documented: synopsis
sub test
{
    my $self = shift;
    my $test = shift || croak "empty test";

    croak "Can't test a non existant file" unless -e $self->full_path;

    my @r;

    unless ( $self->{_test} )
    {
        for ( qw(r w x o R W X O e z s f l p S b c t) )
        {
            $filetest_subs{$_} = eval "sub { return -$_ \$_[0] }";
        }
    }

    for ( split //, $test )
    {
        next if /-/;

        if ( my $sub = $filetest_subs{$_} )
        {
            push @r, &$sub($self->full_path);
        }
        else
        {
            warn "unknown test: $_";
        }
    }

    return scalar @r == 1 ? $r[0] : @r;
}


#documented: synopsis
sub drive
{
    my $self = shift;
    return $self->{_drive};
}

#documented: synopsis
sub path
{
    my $self = shift;
    return $self->{_path};
}

#documented: synopsis
sub name
{
    my $self     = shift;
    return $self->{_name};
}

#documented: synopsis
sub full_path
{
    my $self = shift;
    return $self->{_full_path};
}


#documented: synopsis
sub rel_name
{
    my $self = shift;
    my $relative = shift || Cwd::abs_path;
    my $drive;

    ($drive, $relative) = File::Spec->splitpath(File::Spec->rel2abs($r
+elative), 1);

    croak "cannot find a relative name across drives" unless $drive eq
+ $self->drive;

    print $self->full_path, "relative to\n", "$drive$relative is", "\n
+";

    return File::Spec->abs2rel($self->full_path, "$drive$relative");
}

#documented: synopsis
sub content_md5
{
    my $self = shift;
    my $mode = shift;

    croak "Can't md5 a non existant file" unless -e $self->full_path;

    if ( not $mode )
    {
        return md5($self->slurp);
    }
    elsif ( $mode =~ /^hex$/i )
    {
        return md5_hex($self->slurp);
    }
    elsif ( $mode =~ /^base64$/i )
    {
        return md5_base64($self->slurp);
    }
}

#documented: synopsis
sub content_md5_file
{
    my $self = shift;
    my $mode = shift;
    my $md5  = Digest::MD5->new ();

    croak "Can't md5 a non existant file" unless -e $self->full_path;

    my $digest;

    if ( $self->{_handle} )
    {
        carp "File is already open. The checksum will most likely inac
+curate";
    }
    else
    {
        $self->open ("<");
    }

    my $handle = $self->handle;
    binmode ($handle);

    $md5->addfile($handle);

    if ( not $mode )
    {
        $digest = $md5->digest;
    }
    elsif ( $mode =~ /^hex$/i )
    {
        $digest = $md5->hexdigest();
    }
    elsif ( $mode =~ /^base64$/i )
    {
        $digest = $md5->b64digest;
    }

    $self->close;

    return $digest;
}

#documented: synopsis
sub slurp
{
    my $self = shift;

    croak "Can't slurp a non existant file" unless -e $self->full_path
+;

    return wantarray ? (read_file $self->full_path) : read_file $self-
+>full_path;
}

#documented: synopsis
sub open
{
    my $self = shift;
    my $mode = shift;

    carp "Possibly unintended reopen of file" if $self->{_handle};

    $self->{_handle} = IO::File->new();

    if ( $self->{_handle}->open ($mode.$self->full_path, @_) )
    {
        return $self->{_handle};
    }
    else
    {
        return;
    }
}

#documented: synopsis
sub close
{
    my $self = shift;
    $self->{_handle}->close if $self->{_handle};
    delete $self->{_handle};
}

#documented: synopsis
sub handle
{
    my $self = shift;
    return $self->{_handle};
}


#documented: synopsis
sub copy
{
    my $self = shift;
    my $to   = shift;

    croak "Can't copy a non existant file" unless -e $self->full_path;

    $to = File::Spec->join($to, $self->name) if -d $to;


    if ( File::Copy::copy ($self->full_path, $to) )
    {
        return FileSystemObjects::File->new ($to);
    }
}

#documented: synopsis
sub move
{
    my $self = shift;
    my $to   = shift;

    croak "Can't move a non existant file" unless -e $self->full_path;

    $to = File::Spec->join($to, $self->name) if -d $to;

    if ( File::Copy::move ($self->full_path, $to ) )
    {
        $self->_analyze ( $to );
        return $self;
    }
}

#documented: synopsis
sub delete
{
    my $self = shift;

    croak "Can't delete a non existant file" unless -e $self->full_pat
+h;

    return unlink $self->full_path;
}

#documented: synopsis
sub magic
{
    my $self = shift;

    croak "Can't magic a non existant file" unless -e $self->full_path
+;

    unless ( $loaded_optional_modules{"File::Type"} )
    {
        eval { require File::Type };
        croak "Cant' load required module 'File::Type' for method 'mag
+ic' (Original: $@)" if $@;
        $loaded_optional_modules{"File::Type"} = 1;
    }        ;

    my $ft = File::Type->new();
    return $ft->checktype_filename($self->full_path);
}

#documented: synopsis
sub touch
{
    my $self = shift;
    my %args = @_;

    croak "Can't touch a non existant file" unless -e $self->full_path
+;

    unless ( $loaded_optional_modules{"File::Touch"} )
    {
        eval { require File::Touch };
        croak "Cant' load required module 'File::Touch' for method 'to
+uch' (Original: $@)" if $@;
        $loaded_optional_modules{"File::Touch"} = 1;
    }        ;

    for my $mode ( "a", "m")
    {
        unless ( $args{"${mode}time"} )
        {
            $args{"${mode}time"} = CORE::time;
        }
        else
        {
            $args{"${mode}time"} = (CORE::stat($args{"${mode}time"}))[
+$stat_modes{"${mode}time"}]
                if -e $args{"${mode}time"};

           $args{"${mode}time"} = (CORE::stat($args{"${mode}time"}->fu
+ll_path))[$stat_modes{"${mode}time"}]
                if $args{"${mode}time"}->isa ("FileSystemObjects::File
+");


            $args{"${mode}time"} = _touch_time (%{$args{"${mode}time"}
+})
                if ref($args{"${mode}time"}) eq "HASH";
        }
    }

    print Dumper (\%args);

    my $ref = File::Touch->new( %args );
    $ref->touch($self->full_path);
}

sub _touch_time
{
    my %args = @_;

    $args{year}  -= 1900 if $args{year};
    $args{month} -= 1    if $args{month};

    my @ltime = localtime;
    my %time  = map { $time_names[$_] => $args{$time_names[$_]} || $lt
+ime[$_] } (0..5);
    my @ntime = map { $time{$_} } @time_names;

    return timelocal(@ntime);
}


#todo
#- zip
#- attribute

=pod

=head1 Name

FileSystemObjects::File

=head1 Synopsis

 #load the class
 use FileSystemObjects::File;

 #create a new object, "drive:" is optional on systems
 #that have no drives
 $file = FileSystemObjects::File->new ("file");

 #get the volume/drive
 $drive = $f->drive;

 #get the absolute path
 $path  = $f->path;

 #get the name
 $name  = $f->name;

 #get the full path (drive, path and name)
 $name  = $f->full_path;

 #get path and name of the file, relative to another
 #path. If the path is ommited, the cwd is used
 $name  = $f->rel_name ($path);

 #open file to read, return IO::File - Object
 $handle = $f->open ("<");

 #open file to write, return IO::File - Object on success
 #return false otherwise
 $handle = $f->open (">");

 #get the open handle
 $handle = $f->handle;

 #close the file
 $f->close;

 #slurp the file
 $content = $f->slurp;
 @lines   = $f->slurp;

 #call stat() on the file
 @s = $file->stat;

 #call stat() on the file and return a hash containing the result
 %s = $file->stath;
 print $s{mtime};

 #get modification time formatted via sprintf
 #same for atime() and ctime()
 $mtime = $f->mtime();
 $mtime = $f->mtime($format);

 #get size of file in bytes
 $size = $f->size();

 #get size of file in kilobytes, same for "mb" and "tb"
 $size = $f->size("kb");

 #returns true if file exists
 $e = $f->exists;

 #run a number of filetests on the file
 $size = $f->test("s");   #returns -s
 @test = $f->test("efs"); #returns -e, -f and -s

 #copy to other file, returns new File - Object
 $file2 = $file->copy ("path/to/new/file");

 #move to another place
 $success = $f->move ("/another/place");

 #remove file
 $success = $f->delete;

 #touch file, using user defined data
 #ommited keys are filled up using localtime
 #touch mtime only
 $f->touch (mtime => { hour => 3, year => 2002, mon => 6, day => 1, ho
+ur => 11, min => 22, sec => 33 }, mtime_only => 1);

 #touch atime and mtime using localtime
 $f->touch ();

 #touch using another filename as reference, atime using localtime
 $f->touch (mtime => "/autoexec.bat");

 #touch mtime using another File-Object as reference, atime using loca
+ltime
 $f->touch (mtime => $f2);

 #touch using an epoch
 $f->touch (mtime => 1999597886, atime => 1999597333);

 #try to guess the mime type
 $mime = $f->magic();

 #calculate md5 all in memory
 $md5 = $f->content_md5;
 $md5 = $f->content_md5("hex");
 $md5 = $f->content_md5("base64");

 #calculate md5 all on disk
 $md5 = $f->content_md5_file;
 $md5 = $f->content_md5_file("hex");
 $md5 = $f->content_md5_file("base64");

=head1 Description

This module is part of the the still to write suite of FileSystemObjec
+ts. It combines the powers of many File::* and other modules to bring
+ the standard tasks with files under one OO-hood.

=back

1;