view release on metacpan or  search on metacpan

lib/CPANPLUS/Internals/Utils.pm  view on Meta::CPAN

        return;
    }
}

=pod

=head2 $cb->_copy( from => $file|$dir, to => $target );

Moves a file or directory to the target.

Returns true on success, false on failure.

=cut

sub _copy {
    my $self = shift;
    my %hash = @_;

    my($from,$to);
    my $tmpl = {
        file    =>{ required => 1, allow => [IS_FILE,IS_DIR],
                        store => \$from },
        to      => { required => 1, store => \$to }
    };

    check( $tmpl, \%hash ) or return;

    if( File::Copy::copy( $from, $to ) ) {
        return 1;
    } else {
        error(loc("Failed to copy '%1' to '%2': %3", $from, $to, $!));
        return;
    }
}

=head2 $cb->_mode_plus_w( file => '/path/to/file' );

Sets the +w bit for the file.

Returns true on success, false on failure.

=cut

sub _mode_plus_w {
    my $self = shift;
    my %hash = @_;

    require File::stat;

    my $file;
    my $tmpl = {
        file    => { required => 1, allow => IS_FILE, store => \$file },
    };

    check( $tmpl, \%hash ) or return;

    ### set the mode to +w for a file and +wx for a dir
    my $x       = File::stat::stat( $file );
    my $mask    = -d $file ? 0100 : 0200;

    if( $x and chmod( $x->mode|$mask, $file ) ) {
        return 1;

    } else {
        error(loc("Failed to '%1' '%2': '%3'", 'chmod +w', $file, $!));
        return;
    }
}

=head2 $uri = $cb->_host_to_uri( scheme => SCHEME, host => HOST, path => PATH );

Turns a CPANPLUS::Config style C<host> entry into an URI string.

Returns the uri on success, and false on failure

=cut

sub _host_to_uri {
    my $self = shift;
    my %hash = @_;

    my($scheme, $host, $path);
    my $tmpl = {
        scheme  => { required => 1,             store => \$scheme },
        host    => { default  => 'localhost',   store => \$host },
        path    => { default  => '',            store => \$path },
    };

    check( $tmpl, \%hash ) or return;

    ### it's an URI, so unixify the path.
    ### VMS has a special method for just that
    $path = ON_VMS
                ? VMS::Filespec::unixify($path)
                : File::Spec::Unix->catdir( File::Spec->splitdir( $path ) );

    return "$scheme://" . File::Spec::Unix->catdir( $host, $path );
}

=head2 $cb->_vcmp( VERSION, VERSION );

Normalizes the versions passed and does a '<=>' on them, returning the result.

=cut

sub _vcmp {
    my $self = shift;
    my ($x, $y) = @_;

    $x = $self->_version_to_number(version => $x);
    $y = $self->_version_to_number(version => $y);

    return $x <=> $y;
}

=head2 $cb->_home_dir

Returns the user's homedir, or C<cwd> if it could not be found

=cut

sub _home_dir {

    if ( can_load( modules => { 'File::HomeDir' => 0.0 } ) ) {
      if ( defined $ENV{APPDATA} && length $ENV{APPDATA} && !(ON_WIN32 or ON_CYGWIN) ) {

lib/CPANPLUS/Internals/Utils.pm  view on Meta::CPAN

    }
}

{   my %escapes = map {
        chr($_) => sprintf("%%%02X", $_)
    } 0 .. 255;

    sub _uri_encode {
        my $self = shift;
        my %hash = @_;

        my $str;
        my $tmpl = {
            uri => { store => \$str, required => 1 }
        };

        check( $tmpl, \%hash ) or return;

        ### XXX taken straight from URI::Encode
        ### Default unsafe characters.  RFC 2732 ^(uric - reserved)
        $str =~ s|([^A-Za-z0-9\-_.!~*'()])|$escapes{$1}|g;

        return $str;
    }


    sub _uri_decode {
        my $self = shift;
        my %hash = @_;

        my $str;
        my $tmpl = {
            uri => { store => \$str, required => 1 }
        };

        check( $tmpl, \%hash ) or return;

        ### XXX use unencode routine in utils?
        $str =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;

        return $str;
    }
}

sub _update_timestamp {
    my $self = shift;
    my %hash = @_;

    my $file;
    my $tmpl = {
        file => { required => 1, store => \$file, allow => FILE_EXISTS }
    };

    check( $tmpl, \%hash ) or return;

    ### `touch` the file, so windoze knows it's new -jmb
    ### works on *nix too, good fix -Kane
    ### make sure it is writable first, otherwise the `touch` will fail

    my $now = time;
    unless( chmod( 0644, $file) && utime ($now, $now, $file) ) {
        error( loc("Couldn't touch %1", $file) );
        return;
    }

    return 1;
}


1;

# Local variables:
# c-indentation-style: bsd
# c-basic-offset: 4
# indent-tabs-mode: nil
# End:
# vim: expandtab shiftwidth=4: