view release on metacpan or  search on metacpan

lib/App/Rakubrew/Download.pm  view on Meta::CPAN

		MSWin32 => 'win',
		darwin  => 'macos',
		linux   => 'linux',
		openbsd => 'openbsd',
	);
    return $oses{$^O} // $^O;
}

sub _my_arch {
    my $arch;
    my $mac_brand_string;
    if ($Config{archname} =~ /darwin/i) {
        # Some MacOS' have sysctl in /usr/sbin/ and that dir not in path.
        # Seems to be the case at least on Ventura 13.5.1
        # See https://github.com/Raku/App-Rakubrew/issues/77
        my @mac_sysctls = File::Which::which('sysctl');
        my $mac_sysctl = $mac_sysctls[0] // '/usr/sbin/sysctl';
        $mac_brand_string = `$mac_sysctl -n machdep.cpu.brand_string`;
        $arch =
            $mac_brand_string =~ /Apple/i ? 'arm64'  : # MacOS M1 / Apple Silicon
            $mac_brand_string =~ /Intel/i ? 'x86_64' : # MacOS Intel
            '';
    }
    else {
        $arch =
            $Config{archname} =~ /x64/i                               ? 'x86_64' :
            $Config{archname} =~ /x86_64/i                            ? 'x86_64' :
            $Config{archname} =~ /amd64/i                             ? 'x86_64' :
            $Config{archname} =~ /x86/i                               ? 'x86'    :
            $Config{archname} =~ /i686/i                              ? 'x86'    :
            $Config{archname} =~ /aarch64/i                           ? 'arm64'  : # e.g. Raspi >= 2.1 with 64bit OS
            $Config{archname} =~ /arm-linux-gnueabihf/i               ? 'armhf'  : # e.g. Raspi >= 2, with 32bit OS
            $Config{archname} =~ /s390x-linux/i                       ? 's390x'  :
            '';
    }

    unless ($arch) {
        say STDERR 'Couldn\'t detect system architecture. Current arch is: ' . $Config{archname};
        say STDERR 'Current uname -a is: ' . `uname -a`;
        say STDERR 'Current machdep.cpu.brand_string is: ' . $mac_brand_string if $mac_brand_string;
        exit 1;
    }
    return $arch;
}

sub _download_release_index {
    my $ht = shift;
    my $res = $ht->get($release_index_url);
    unless ($res->{success}) {
        say STDERR "Couldn\'t fetch release index at $release_index_url. Error: $res->{status} $res->{reason}";
        exit 1;
    }
    return decode_json($res->{content});
}

sub _untar {
    my ($data, $target) = @_;
    my $back = cwd();
    chdir $target;
    open (TAR, '| tar -xz');
    binmode(TAR);
    print TAR $data;
    close TAR;
    chdir $back;
}

sub _unzip {
    my ($data_ref, $target) = @_;

    my $zip = IO::Uncompress::Unzip->new($data_ref);
    unless ($zip) {
        say STDERR "Reading zip file failed. Error: $UnzipError";
        exit 1;
	}

    my $status;
    for ($status = 1; $status > 0; $status = $zip->nextStream()) {
        my $header = $zip->getHeaderInfo();

        my ($vol, $path, $file) = splitpath($header->{Name});

        if (index($path, updir()) != -1) {
            say STDERR 'Found updirs in zip file, this is bad. Aborting.';
            exit 1;
        }

        my $target_dir  = catdir($target, $path);

        unless (-d $target_dir) {
            unless (make_path($target_dir)) {
                say STDERR "Failed to create directory $target_dir. Error: $!";
                exit 1;
            }
        }

        next unless $file;

        my $target_file = catfile($target, $path, $file);

        unless (open(FH, '>', $target_file)) {
            say STDERR "Failed to write $target_file. Error: $!";
            exit 1;
        }
        binmode(FH);

        my $buf;
        while (($status = $zip->read($buf)) > 0) {
            print FH $buf;
        }
        close FH;
    }

    if ($status < 0) {
        say STDERR "Failed to extract archive. Error: $UnzipError";
        exit 1;
    }
}