our
@ISA
=
qw(Exporter)
;
our
@EXPORT
=
qw()
;
use
5.010;
use
FindBin
qw( $RealBin $RealScript )
;
use
if
scalar
($^O =~ /win32/i),
'Win32'
;
use
if
scalar
($^O =~ /win32/i),
'Win32::Process'
;
use
if
scalar
($^O =~ /win32/i),
'Win32::ShellQuote'
;
my
%dl_urls
= (
fatpack
=>
"$download_url_prefix/perl/rakubrew"
,
win
=>
"$download_url_prefix/win/rakubrew.exe"
,
macos
=>
"$download_url_prefix/macos/rakubrew"
,
);
sub
update {
my
$quiet
=
shift
;
my
$current_rakubrew_file
= catfile(
$RealBin
,
$RealScript
);
if
(
$distro_format
eq
'cpan'
) {
say
STDERR
'Rakubrew was installed via CPAN, use your CPAN client to update.'
;
exit
1;
}
my
$ht
= HTTP::Tinyish->new();
my
$release_index
= _download_release_index(
$ht
);
if
(
$App::Rakubrew::VERSION
>=
$release_index
->{latest}) {
say
'Rakubrew is up-to-date!'
;
exit
0;
}
if
(!
$quiet
) {
say
"Changes\n"
;
say
"=======\n"
;
for
my
$change
(@{
$release_index
->{releases}}) {
next
if
$change
->{version} <=
$App::Rakubrew::VERSION
;
say
$change
->{version} .
':'
;
say
" $_"
for
split
(/^/,
$change
->{changes});
say
''
;
}
print
'Shall we do the update? [y|N] '
;
my
$reply
= <STDIN>;
chomp
$reply
;
exit
0
if
$reply
ne
'y'
;
say
''
;
}
mkdir
catdir(
$prefix
,
'update'
)
unless
(-d catdir(
$prefix
,
'update'
));
my
$update_file
= catfile(
$prefix
,
'update'
,
$RealScript
);
unlink
$update_file
;
my
$res
=
$ht
->get(
$dl_urls
{
$distro_format
});
unless
(
$res
->{success}) {
say
STDERR
"Couldn\'t download update. Error: $res->{status} $res->{reason}"
;
exit
1;
}
my
$fh
;
if
(!
sysopen
(
$fh
,
$update_file
, O_WRONLY|O_CREAT|O_EXCL, 0777)) {
say
STDERR
"Couldn't write update file to $update_file. Aborting update."
;
exit
1;
}
binmode
$fh
;
print
$fh
$res
->{content};
close
$fh
;
if
($^O =~ /win32/i) {
say
'You will now see a command prompt, even though the update process is still running.'
;
say
'This is caused by a quirk in Windows\' process handling.'
;
say
'Just wait a few seconds until an "Update successful!" message shows up'
;
my
$ProcessObj
;
if
(!Win32::Process::Create(
$ProcessObj
,
$update_file
,
Win32::ShellQuote::quote_native(
$update_file
,
'internal_update'
,
$App::Rakubrew::VERSION
,
$current_rakubrew_file
),
0,
Win32::Process::NORMAL_PRIORITY_CLASS(),
"."
)) {
say
STDERR
'Failed to call the downloaded rakubrew executable! Aborting update.'
;
exit
1;
};
exit
0;
}
else
{
{
exec
(
$update_file
,
'internal_update'
,
$App::Rakubrew::VERSION
,
$current_rakubrew_file
) };
say
STDERR
'Failed to call the downloaded rakubrew executable! Aborting update.'
;
exit
1;
}
}
sub
internal_update {
my
(
$old_version
,
$old_rakubrew_file
) =
@_
;
my
$current_script
= catfile(
$RealBin
,
$RealScript
);
my
$update_file
= catfile(
$prefix
,
'update'
,
$RealScript
);
if
(
$update_file
ne
$current_script
) {
say
STDERR
"'internal_update' was called on a rakubrew ($current_script) that's not $update_file. That's probably wrong and dangerous. Aborting update."
;
exit
1;
}
unlink
$old_rakubrew_file
or
die
"Failed to unlink old file: $old_rakubrew_file. Error: $!"
;
my
$fh
;
if
(!
sysopen
(
$fh
,
$old_rakubrew_file
, O_WRONLY|O_CREAT|O_EXCL, 0777)) {
say
STDERR
"Couldn't copy update file to $old_rakubrew_file. Rakubrew is broken now. Try manually copying '$update_file' to '$old_rakubrew_file' to get it fixed again."
;
exit
1;
}
binmode
$fh
;
if
(!copy(
$update_file
,
$fh
)) {
close
$fh
;
unlink
$old_rakubrew_file
;
say
STDERR
"Couldn't copy update file to $old_rakubrew_file. Rakubrew is broken now. Try manually copying '$update_file' to '$old_rakubrew_file' to get it fixed again."
;
exit
1;
}
close
$fh
;
unlink
$update_file
;
say
'Update successful!'
;
}
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});
}