chmod results from the CPAN

chmod

App-SimpleBackuper

view release on metacpan or search on metacpan

lib/App/SimpleBackuper/Restore.pm view on Meta::CPAN

			}
			$fs_user = scalar getpwuid $<;
			$fs_group = scalar getgrgid $(;
		}
	}
	
	
	if((! @stat or $stat[2] != $version->{mode}) and ! S_ISLNK $version->{mode}) {
		printf "\tin backup it has mode %o but on FS - %o.\n", $version->{mode}, $stat[2] // 0 if $options->{verbose};
		if($options->{write}) {
			chmod($version->{mode}, $fs_path) or die sprintf("Can't chmod %s to %o: %s", $fs_path, $version->{mode}, $!);
		}
	}
			
	my($db_user) = map {$_->{name}}
		grep {$_->{id} == $version->{uid}}
		map { $state->{db}->{uids_gids}->unpack($_) }
		@{ $state->{db}->{uids_gids} }
		;
	my($db_group) = map {$_->{name}}
		grep {$_->{id} == $version->{gid}}

local/lib/perl5/ExtUtils/Helpers/Unix.pm view on Meta::CPAN

		my @lines = <$fh>;
		if (@lines and $lines[0] =~ s{ \A \#! \s* (?:/\S+/)? perl \b (.*) \z }{$Config{startperl}$1}xms) {
			open my $out, ">$layer", "$filename.new" or croak "Couldn't open $filename.new: $!";
			print $out @lines;
			close $out;
			rename $filename, "$filename.bak" or croak "Couldn't rename $filename to $filename.bak";
			rename "$filename.new", $filename or croak "Couldn't rename $filename.new to $filename";
			unlink "$filename.bak";
		}
	}
	chmod $current_mode | oct(111), $filename;
	return;
}

sub detildefy {
	my $value = shift;
	# tilde with optional username
	for ($value) {
		s{ ^ ~ (?= /|$)}          [ $ENV{HOME} || (getpwuid $>)[7] ]ex or # tilde without user name
		s{ ^ ~ ([^/]+) (?= /|$) } { (getpwnam $1)[7] || "~$1" }ex;        # tilde with user name
	}

local/lib/perl5/Module/Build/Base.pm view on Meta::CPAN

  if ($status->{ok}) {
    return $status->{have} if $status->{have} and "$status->{have}" ne '<none>';
    return '0 but true';
  }

  $@ = $status->{message};
  return 0;
}

sub make_executable {
  # Perl's chmod() is mapped to useful things on various non-Unix
  # platforms, so we use it in the base class even though it looks
  # Unixish.

  my $self = shift;
  foreach (@_) {
    my $current_mode = (stat $_)[2];
    chmod $current_mode | oct(111), $_;
  }
}

sub is_executable {
  # We assume this does the right thing on generic platforms, though
  # we do some other more specific stuff on Unixish platforms.
  my ($self, $file) = @_;
  return -x $file;
}

local/lib/perl5/Module/Build/Base.pm view on Meta::CPAN

  my ($self, $manifest, $lines) = @_;
  $lines = [$lines] unless ref $lines;

  my $existing_files = $self->_read_manifest($manifest);
  return unless defined( $existing_files );

  @$lines = grep {!exists $existing_files->{$_}} @$lines
    or return;

  my $mode = (stat $manifest)[2];
  chmod($mode | oct(222), $manifest) or die "Can't make $manifest writable: $!";

  open(my $fh, '<', $manifest) or die "Can't read $manifest: $!";
  my $last_line = (<$fh>)[-1] || "\n";
  my $has_newline = $last_line =~ /\n$/;
  close $fh;

  open($fh, '>>', $manifest) or die "Can't write to $manifest: $!";
  print $fh "\n" unless $has_newline;
  print $fh map "$_\n", @$lines;
  close $fh;
  chmod($mode, $manifest);

  $self->log_verbose(map "Added to $manifest: $_\n", @$lines);
}

sub _sign_dir {
  my ($self, $dir) = @_;

  unless (eval { require Module::Signature; 1 }) {
    $self->log_warn("Couldn't load Module::Signature for 'distsign' action:\n $@\n");
    return;

local/lib/perl5/Module/Build/Base.pm view on Meta::CPAN

    # hack so that the resulting archive is compatible with older clients.
    # If no file path is 100 chars or longer, we disable the prefix field
    # for maximum compatibility.  If there are any long file paths then we
    # need the prefix field after all.
    $Archive::Tar::DO_NOT_USE_PREFIX =
      (grep { length($_) >= 100 } @$files) ? 0 : 1;

    my $tar   = Archive::Tar->new;
    $tar->add_files(@$files);
    for my $f ($tar->get_files) {
      $f->mode($f->mode & ~022); # chmod go-w
    }
    $tar->write("$file.tar.gz", 1);
  }
}

sub install_path {
  my $self = shift;
  my( $type, $value ) = ( @_, '<empty>' );

  Carp::croak( 'Type argument missing' )

local/lib/perl5/Module/Build/Base.pm view on Meta::CPAN

    local $self->{properties}{quiet} = 1;
    $self->delete_filetree($to_path); # delete destination if exists
  }

  # Create parent directories
  File::Path::mkpath(File::Basename::dirname($to_path), 0, oct(777));

  $self->log_verbose("Copying $file -> $to_path\n");

  if ($^O eq 'os2') {# copy will not overwrite; 0x1 = overwrite
    chmod 0666, $to_path;
    File::Copy::syscopy($file, $to_path, 0x1) or die "Can't copy('$file', '$to_path'): $!";
  } else {
    File::Copy::copy($file, $to_path) or die "Can't copy('$file', '$to_path'): $!";
  }

  # mode is read-only + (executable if source is executable)
  my $mode = oct(444) | ( $self->is_executable($file) ? oct(111) : 0 );
  chmod( $mode, $to_path );

  return $to_path;
}

sub up_to_date {
  my ($self, $source, $derived) = @_;
  $source  = [$source]  unless ref $source;
  $derived = [$derived] unless ref $derived;

  # empty $derived means $source should always run

local/lib/perl5/Module/Build/ConfigData.pm view on Meta::CPAN

sub config_names  { sort keys %$config }

sub write {
  my $me = __FILE__;

  # Can't use Module::Build::Dumper here because M::B is only a
  # build-time prereq of this module
  require Data::Dumper;

  my $mode_orig = (stat $me)[2] & 07777;
  chmod($mode_orig | 0222, $me); # Make it writeable
  open(my $fh, '+<', $me) or die "Can't rewrite $me: $!";
  seek($fh, 0, 0);
  while (<$fh>) {
    last if /^__DATA__$/;
  }
  die "Couldn't find __DATA__ token in $me" if eof($fh);

  seek($fh, tell($fh), 0);
  my $data = [$config, $features, $auto_features];
  print($fh 'do{ my '
	      . Data::Dumper->new([$data],['x'])->Purity(1)->Dump()
	      . '$x; }' );
  truncate($fh, tell($fh));
  close $fh;

  chmod($mode_orig, $me)
    or warn "Couldn't restore permissions on $me: $!";
}

sub feature {
  my ($package, $key) = @_;
  return $features->{$key} if exists $features->{$key};

  my $info = $auto_features->{$key} or return 0;

  require Module::Build;  # XXX should get rid of this

local/lib/perl5/Module/Build/Notes.pm view on Meta::CPAN

sub config_names  { sort keys %$config }

sub write {
  my $me = __FILE__;

  # Can't use Module::Build::Dumper here because M::B is only a
  # build-time prereq of this module
  require Data::Dumper;

  my $mode_orig = (stat $me)[2] & 07777;
  chmod($mode_orig | 0222, $me); # Make it writeable
  open(my $fh, '+<', $me) or die "Can't rewrite $me: $!";
  seek($fh, 0, 0);
  while (<$fh>) {
    last if /^__DATA__$/;
  }
  die "Couldn't find __DATA__ token in $me" if eof($fh);

  seek($fh, tell($fh), 0);
  my $data = [$config, $features, $auto_features];
  print($fh 'do{ my '
	      . Data::Dumper->new([$data],['x'])->Purity(1)->Dump()
	      . '$x; }' );
  truncate($fh, tell($fh));
  close $fh;

  chmod($mode_orig, $me)
    or warn "Couldn't restore permissions on $me: $!";
}

sub feature {
  my ($package, $key) = @_;
  return $features->{$key} if exists $features->{$key};

  my $info = $auto_features->{$key} or return 0;

  require Module::Build;  # XXX should get rid of this

local/lib/perl5/Module/Build/Platform/MacOS.pm view on Meta::CPAN

    my $args = MacPerl::Ask('Any extra arguments?  (ie. verbose=1)', '');
    return unless defined $args;
    push @ARGV, $self->split_like_shell($args);
  }

  $self->SUPER::dispatch(@_);
}

sub ACTION_realclean {
  my $self = shift;
  chmod 0666, $self->{properties}{build_script};
  $self->SUPER::ACTION_realclean;
}

# ExtUtils::Install has a hard-coded '.' directory in versions less
# than 1.30.  We use a sneaky trick to turn that into ':'.
#
# Note that we do it here in a cross-platform way, so this code could
# actually go in Module::Build::Base.  But we put it here to be less
# intrusive for other platforms.

local/lib/perl5/Net/SFTP/Foreign.pm view on Meta::CPAN

        $sftp->_check_status_ok($id,
                                SFTP_ERR_REMOTE_SETSTAT_FAILED,
                                "Couldn't setstat remote file ($name)");
    };
    no strict 'refs';
    *$name = $sub;
}

_gen_setstat_shortcut(truncate => 'file', SSH2_FILEXFER_ATTR_SIZE,        'int64');
_gen_setstat_shortcut(chown    => 'any' , SSH2_FILEXFER_ATTR_UIDGID,      'int32', 'int32');
_gen_setstat_shortcut(chmod    => 'any' , SSH2_FILEXFER_ATTR_PERMISSIONS, 'int32');
_gen_setstat_shortcut(utime    => 'any' , SSH2_FILEXFER_ATTR_ACMODTIME,   'int32', 'int32');

sub _close {
    @_ == 2 or croak 'Usage: $sftp->close($fh, $attrs)';

    my $sftp = shift;
    my $id = $sftp->_queue_rid_request(SSH2_FXP_CLOSE, @_);
    defined $id or return undef;

    my $ok = $sftp->_check_status_ok($id,

local/lib/perl5/Net/SFTP/Foreign.pm view on Meta::CPAN

                $$numbered = $local if ref $numbered;
		binmode $fh;
		$lstart = sysseek($fh, 0, 2) if $append;
	    }
	}

	if (defined $perm) {
            my $error;
	    do {
                local ($@, $SIG{__DIE__}, $SIG{__WARN__});
                unless (eval { CORE::chmod($perm, $local) > 0 }) {
                    $error = ($@ ? $@ : $!);
                }
            };
	    if ($error and !$best_effort) {
                unlink $local unless $resume or $append;
		$sftp->_set_error(SFTP_ERR_LOCAL_CHMOD_FAILED,
				  "Can't chmod $local", $error);
		return undef
	    }
	}
    }

    my $converter = _gen_converter $conversion;

    my $rfid = $sftp->_rfid($rfh);
    defined $rfid or die "internal error: rfid not defined";

local/lib/perl5/Net/SFTP/Foreign.pm view on Meta::CPAN

Returns true on success and undef on failure.

=item $sftp-E<gt>fsetstat($handle, $attrs)

this method is deprecated.

=item $sftp-E<gt>truncate($path_or_fh, $size)

=item $sftp-E<gt>chown($path_or_fh, $uid, $gid)

=item $sftp-E<gt>chmod($path_or_fh, $perm)

=item $sftp-E<gt>utime($path_or_fh, $atime, $mtime)

Shortcuts around C<setstat> method.

=item $sftp-E<gt>remove($path)

Sends a C<SSH_FXP_REMOVE> command to remove the remote file
C<$path>. Returns a true value on success and undef on failure.

( run in 0.509 second using v1.01-cache-2.11-cpan-496ff517765 )