Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- #!/usr/bin/perl
- use 5.010;
- use strict;
- no warnings "deprecated";
- use utf8;
- use if $^O =~ /win/i, encoding => ("utf8", STDOUT => "cp866");
- use LWP;
- use Archive::Extract;
- use File::Temp;
- use File::Spec::Functions qw/catfile catdir/;
- use File::Copy qw/move/;
- use File::Copy::Recursive qw/rcopy/;
- use File::Path qw/rmtree/;
- # ----------------------------------------
- my $game_dir = "cataclysmdda-tiles";
- my $backup_dir = "cataclysmdda-tiles.old";
- # ----------------------------------------
- my $lwp = new LWP::UserAgent;
- say "Получаем ссылку на последнюю версию...";
- my $address = $^O =~ /win/i ? "http://dev.narc.ro/cataclysm/jenkins-latest/Windows/Tiles/"
- : "http://dev.narc.ro/cataclysm/jenkins-latest/Linux/Tiles/";
- my $res = $lwp->get($address);
- die $res->status_line unless $res->is_success;
- my $latest = $address . ($res->content =~ /href="(cataclysmdda.*?\.(?:gz|zip))/gm)[-1];
- # ----------------------------------------
- say "Загрузка `$latest'...";
- $res = $lwp->get($latest);
- die $res->status_line unless $res->is_success;
- my $tmpfile = new File::Temp(suffix => $latest =~ /\d{4}(.*)$/gm);
- open my $fh, '>', $tmpfile->filename or die $!;
- binmode $fh;
- syswrite $fh, $res->content, $res->content_length;
- close $fh;
- # ----------------------------------------
- if(-d $game_dir) {
- say "Обнаружена старая версия игры. Перемещение в `$backup_dir'...";
- rmtree("$backup_dir") if -d $backup_dir;
- move $game_dir, $backup_dir or die $!;
- }
- say "Распаковка архива...";
- my $archive = new Archive::Extract(archive => $tmpfile);
- my $tmpdir = File::Temp->newdir;
- $archive->extract(to => $tmpdir->dirname);
- die $archive->error if $archive->error;
- say "Перемещение в `$game_dir/'...";
- if($archive->is_tgz) {
- move(catdir($tmpdir->dirname, $archive->files->[0]), $game_dir) or die $!;
- } else {
- move $tmpdir->dirname, $game_dir or die $!;
- }
- # ----------------------------------------
- if(-d $backup_dir) {
- say "Копирование сохранений и настроек из старой версии...";
- for my $dir ("save", "config", catdir("data", "font"),
- catdir("gfx", "MShock32Xotto++"), catdir("data", "sound", "ChestHole")) {
- my($orig, $new) = (catdir($backup_dir, $dir), catdir($game_dir, $dir));
- if(-d $orig) {
- say "$orig -> $new";
- rcopy $orig, $new;# or die $!;
- }
- }
- }
- # ----------------------------------------
- say "Похоже, что всё прошло нормально.";
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement