# Copyright (C) 2004-2006, The Perl Foundation.
# $Id: File.pm 21450 2007-09-21 09:33:12Z paultcochrane $

=head1 NAME

Parrot::IO::File - File

=head1 SYNOPSIS

    use Parrot::IO::File;

=head1 DESCRIPTION

Use this to query and manipulate files and their contents.

=head2 Class Methods

=over

=cut

package Parrot::IO::File;

use strict;
use warnings;

use base qw( Parrot::IO::Path );

use FileHandle;
use Parrot::IO::Directory;

=item C<tmp_file($path)>

Returns the file for C<$path> relative to the default temporary
directory.

=cut

sub tmp_file {
    my $self = shift;

    return $self->new( File::Spec->catfile( File::Spec->tmpdir, @_ ) );
}

=item C<new($path)>

Returns the instance for C<$path>.

=cut

sub new {
    my $self = shift;
    my $path = shift;

    return unless defined $path and !-d $path;

    return $self->SUPER::new($path);
}

=back

=head2 Instance Methods

=over 4

=item C<create_path()>

This is called from C<new()> to create the path if necessary.

=cut

sub create_path {
    my $self = shift;

    return unless $self->SUPER::create_path;

    # Just to touch the file.
    # Make sure write() doesn't dismiss this as a noop.
    $self->write('') unless -e $self->path;

    return -f $self->path;
}

=item C<parent($path)>

Returns the file's parent directory.

=cut

sub parent {
    my $self = shift;
    my $path = shift;

    return Parrot::IO::Directory->new( $self->parent_path );
}

=item C<read()>

This reads the contents of the file and returns it as an array or string
depending on the context in which the method is called.

    $contents = $file->read;
    @lines = $file->read;

=cut

sub read {
    my $self = shift;
    my $fh   = FileHandle->new( $self->path )
        or die 'Failed to open ' . $self->path . ": $!";
    my @lines = <$fh>;

    $fh->close;

    return wantarray ? @lines : join '', @lines;
}

=item C<write(@lines)>

Writes the specified lines to the file.

=cut

sub write {
    my $self = shift;

    return unless @_;

    my $fh = FileHandle->new( '>' . $self->path )
        or die 'Failed to open ' . $self->path . ": $!";

    print $fh @_;

    $fh->close;
}

=item C<append(@lines)>

Writes the specified lines to the file.

=cut

sub append {
    my $self = shift;

    return unless @_;

    my $fh = FileHandle->new( '>>' . $self->path )
        or die 'Failed to open ' . $self->path . ": $!";

    print $fh @_;

    $fh->close;
}

=item C<is_executable()>

This tells you whether the file is executable.

=cut

sub is_executable {
    my $self = shift;

    return $self->stat->mode & 0111;
}

=item C<modified_since($time)>

Use this to find out whether the file has been modified since the
specified time. C<$time> is a number of non-leap seconds since the
epoch.

=cut

sub modified_since {
    my $self = shift;
    my $time = shift;

    return $self->stat->mtime > $time;
}

=item C<svn_id()>

Returns the svn C<$Id> string.

=cut

sub svn_id {
    my $self    = shift;
    my $content = $self->read;

    # Break up the $Id to prevent svn messing with it.
    my ($id) = $content =~ /((?:\$)Id:[^\$]+\$)/so;

    return $id;
}

=item C<has_svn_id()>

Returns whether the file has a svn C<$Id> string.

=cut

sub has_svn_id {
    my $self    = shift;
    my $content = $self->read;

    # Break up the $Id to prevent svn messing with it.
    my $has_id = $content =~ /(?:\$)Id:[^\$]+\$/so;

    return $has_id;
}

=item C<svn_version()>

Returns the svn version number of the file.

=cut

sub svn_version {
    my $self = shift;
    my $id   = $self->svn_id;
    my ($version) = $id =~ /,v\s+(\S+)/s;

    return $version;
}

=item C<is_hidden()>

Returns whether the file is "hidden", i.e. it's name starts with a dot.

=cut

sub is_hidden {
    my $self = shift;

    return $self->parent eq '.SVN' or $self->name =~ /^\./o;
}

=item C<is_generated()>

Returns whether the file is generated.

=cut

sub is_generated {
    my $self = shift;

    # CFLAGS
    # libparrot.def
    # Makefile
    # myconfig

    # include/parrot/config.h
    # include/parrot/core_pmcs.h
    # include/parrot/feature.h
    # include/parrot/platform.h

    # runtime/parrot/include/* (all?)

    # lib/Parrot/Config.pm

    return 1
        if $self->suffix =~ /^(?:dump|html|flag|o)$/o
            or $self->name =~
/^(?:perl6-config|libparrot.def|CFLAGS|myconfig|(?:core_pmcs|exec_(?:cpu|dep)|fingerprint|jit_(?:cpu|emit)|nci|platform(?:_interface)?)\.[ch]|(?:charclass|feature)\.h)$/o
            or $self->parent->name eq 'ops' and $self->suffix =~ /^(?:c|pod)$/;

    return 0;
}

=item C<delete()>

Deletes the file, removes the instance from the cache, and undefines it.

Raises an exception if the delete fails.

=cut

sub delete {

    # Use $_[0] so that we can undef the instance in SUPER::delete().

    unlink( $_[0]->path ) or die 'Failed to unlink ' . $_[0]->path . ": $!";

    $_[0]->SUPER::delete;
}

=back

=head1 SEE ALSO

=over 4

=item C<Parrot::IO::Directory>

=item C<Parrot::IO::Path>

=back

=cut

1;

# Local Variables:
#   mode: cperl
#   cperl-indent-level: 4
#   fill-column: 100
# End:
# vim: expandtab shiftwidth=4: