view release on metacpan or  search on metacpan

lib/DocSet/Util.pm  view on Meta::CPAN

# gzip_file($src_path);
# gzip a file at $src_path
###############
sub gzip_file {
    my ($src) = @_;
    system "gzip -f $src";
}


# write_file($filename, $ref_to_array||scalar);
# content will be written to the file from the passed array of
# paragraphs
###############
sub write_file {
    my ($filename, $content) = @_;

    # make sure that the directory exist or create one
    my $dir = File::Basename::dirname $filename;
    create_dir($dir) unless -d $dir;

    my $fh = Symbol::gensym;
    open $fh, ">$filename" or croak "Can't open $filename for writing: $!";
    print $fh ref $content ? @$content : defined $content ? $content : '';
    close $fh;
}


# recursively creates a multi-layer directory
###############
sub create_dir {
    my $path = shift;
    return if !defined($path) || -e $path;
    # META: mode could be made configurable
    File::Path::mkpath($path, 0, 0755) or croak "Couldn't create $path: $!";
}

# read_file($filename, $ref);
# assign to a ref to a scalar
###############
sub read_file {
    my ($filename, $r_content) = @_;

    my $fh = Symbol::gensym;
    open $fh, $filename  or croak "Can't open $filename for reading: $!";
    local $/;
    $$r_content = <$fh>;
    close $fh;

}

# read_file_paras($filename, $ref_to_array);
# read by paragraph
# content will be set into a ref to an array
###############
sub read_file_paras {
    my ($filename, $ra_content) = @_;

    my $fh = Symbol::gensym;
    open $fh, $filename  or croak "Can't open $filename for reading: $!";
    local $/ = "";
    @$ra_content = <$fh>;
    close $fh;

}

# return the filename part of the path
sub filename {
    my ($path) = @_;
    return File::Basename::basename($path);
}

# return the passed file's extension or '' if there is no one
# note: that '/foo/bar.conf.in' returns an extension: 'conf.in';
# note: a hidden file .foo will be recognized as an extension 'foo'
sub filename_ext {
    my ($filename) = @_;
    my $ext = (File::Basename::fileparse($filename, '\.[^\.]*'))[2] || '';
    $ext =~ s/^\.(.*)/lc $1/e;
    $ext;
}


# since on non-Unix platforms the fs path's separator don't match the
# URI separator ('/'), we need to rewrite those paths
# accept a relative native path 
# return relative URI
sub path2uri {
    return unless defined $_[0];
    return join '/', File::Spec->splitdir(shift);
}

# File::Spec->abs2rel doesn't strip the volume (e.g. /^c:/) before
# Perl v5.8.0 on Win32. This function fixes this bug.
#
# Make sure to call this function as DocSet::Util::abs2rel, especially
# in the code that already uses File::Spec functions.
sub abs2rel {
    my $res = File::Spec->abs2rel(@_);
    $res =~ s/^[a-zA-Z]:// if IS_WIN32 && PERL_LT_580 && defined $res;
    $res;
}


sub get_date {
    sprintf "%s %d, %d", (split /\s+/, scalar localtime)[1,2,4];
}

sub get_timestamp {
    my ($mon,$day,$year) = (localtime ( time ) )[4,3,5];
    return scalar gmtime() . ' GMT';
}

my %require_seen = ();
# convert Foo::Bar into Foo/Bar.pm and require
sub require_package {
    my $package = shift;
    die "no package passed" unless $package;
    return if $require_seen{$package};
    $require_seen{$package} = 1;
    $package =~ s|::|/|g;