[Cascavel-pm] getfree.pl - instalando softwares livres no Windows
Nelson Ferraz
nferraz em phperl.com
Sexta Outubro 17 23:23:22 CDT 2003
Flavio S. Glock wrote:
> Eu já usei o PAR para criação de executável - funciona bem, e o
> executável não fica muito grande.
Obrigado pela dica!
O executável ficou com 2.4Mb, mas consegui reduzir o tamanho para 1.3Mb,
com o UPX.
(Apenas como teste, um "Hello, world" gerou um executável de 1.7Mb, que
foi reduzido para 615kb com o UPX).
Aqui vai a última versão do script.
--
[]s
Nelson
________________________________________________________________
Nelson Ferraz
GNU BIS: http://www.gnubis.com.br
PhPerl: http://www.phperl.com
-------------- Próxima Parte ----------
#!/usr/bin/perl
# Perl script to automatically download and install open source software
#
# To generate executable: (pp -o getfree.exe getfree.pl)
use strict;
use warnings;
#
# Don't execute if year > 2003 (expiration date)
#
my ($sec,$min,$hour,$day,$mon,$year,$wday) = localtime(time);
die "Expired" if $year > 103;
#############
# #
# LIBRARIES #
# #
#############
use FindBin; # I'm running in $FindBin::Bin
use File::Copy;
use URI ();
use LWP::UserAgent;
use Archive::Zip qw(:ERROR_CODES);
#use Digest::SHA1 qw(sha1);
#use Win32::TieRegistry ( TiedHash => '%RegHash' );
#use Win32::Shortcut;
########
# #
# DATA #
# #
########
# These are the files we'll download
my %SW = (
'OpenOffice.org 1.1' => {
uri => 'http://www.ibiblio.org/pub/packages/openoffice/stable/1.1.0/OOo_1.1.0_Win32Intel_install.zip',
sha1=> '454953c6595b91b175f79d57c99d065f5b89025f',
install => 'OOo_1.1.0_Win32Intel_install/setup.exe'
},
'Mozilla 1.5' => {
uri => 'http://ftp.mozilla.org/pub/mozilla.org/mozilla/releases/mozilla1.5/mozilla-win32-1.5-installer.exe',
sha1 => '8e02cc5d34bf38fce3ccc03417e8b535c723c462',
install => 'mozilla-win32-1.5-installer.exe'
},
'Mozilla Firebird 0.7' => {
uri => 'http://ftp.mozilla.org/pub/mozilla.org/firebird/releases/0.7/MozillaFirebird-0.7-win32.zip',
sha1 => '3dfd5a22525d6af7b4ab97cb6a250a9ef4cc1937'
},
'Mozilla Thunderbird 0.3' => {
uri => 'http://ftp.mozilla.org/pub/mozilla.org/thunderbird/releases/0.3/thunderbird-0.3-win32.zip',
sha1 => '93f33e6addd8d95e47f92459a7a4e964b67d040a'
},
'Perl 5.8.0' => {
uri => 'http://www.cpan.org/authors/id/G/GR/GRAHAMC/SiePerl-5.8.0-bin-1.0-Win32.INSTALL.exe',
sha1 => 'f020bdfcb571071f4317aae6e30a50a87f4da71b',
install => 'SiePerl-5.8.0-bin-1.0-Win32.INSTALL.exe'
}
);
my $USER_AGENT = "GetFree/0.0.3";
my $HOME = $ENV{HOMEDRIVE}; # Usually "C:"
my ($SCRIPT_NAME) = $0 =~ m!([^/]+)$!;
my $DEBUG = 1;
########
# #
# MAIN #
# #
########
# Install myself
Install_myself();
# Download files
foreach (keys %SW) {
print "Preparing to download '$_'...\n" if $DEBUG;
Download($SW{$_}->{uri});
}
# Install files
foreach (keys %SW) {
print "Preparing to install '$_'...\n" if $DEBUG;
my ($filename) = $SW{$_}->{uri} =~ m!([^/]+)$!; # get filename from uri
Unzip($filename) if $filename =~ m/\.zip$/i;
system($SW{$_}->{install}) if -f $SW{$_}->{install};
}
# Uninstall myself
Uninstall_myself();
########
# #
# SUBS #
# #
########
sub Install_myself {
# Copy myself to home drive
if (!-f "$HOME/$SCRIPT_NAME") {
# Copy myself to home dir
copy("$FindBin::Bin/$SCRIPT_NAME","$HOME/$SCRIPT_NAME") or die "copy failed: $!";
# TO-DO: Add key to registry
# [HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run]
}
}
###
sub Uninstall_myself {
# Remove myself from home drive
if (-f "$HOME/$SCRIPT_NAME") {
# Delete me from home dir
unlink("$HOME/$SCRIPT_NAME");
# TO-DO: Delete key from registry
# [HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run]
}
}
###
sub Download {
# Download a file from uri (resume if interrupted)
my ( $file, $fsize, $last, $mod, $req, $res, $start, $size, $time, $total, $s );
my $uri = URI->new(shift);
($file) = $uri =~ m!([^/]+)$!; # get filename from url
my $ua = new LWP::UserAgent;
$ua->agent( $USER_AGENT );
print "Checking remote file '$uri'...\n" if $DEBUG;
$req = new HTTP::Request HEAD => $uri->as_string;
$res = $ua->request( $req );
$req = new HTTP::Request GET => $uri->as_string;
if (!$res->is_success) {
die "Error"; # $res->status_line;
}
$fsize = 0;
$total = $res->content_length || 0;
$mod = $res->last_modified || time;
print "Looking for local file '$file'...\n" if $DEBUG;
if (-e $file) {
my @s = stat($file);
$fsize = $s[7];
my $fmod = $s[9];
if ($fmod >= $mod && $fsize >= $total) {
# Completed
print "Found it, and seems complete.\n" if $DEBUG;
return;
} elsif ($fsize < $total && $res->protocol =~ /1\.1/) {
print "Found it, but seems incomplete. Appending to file '$file'\n" if $DEBUG;
$size = $fsize;
my $headers = $req->headers();
$headers->push_header( Range => "bytes=$fsize-" );
open(FILE, ">>$file") || return "$file: $!\n";
}
} else {
print "Not found. Saving as new file '$file'\n" if $DEBUG;
open(FILE, ">$file") || return 0;
}
print "Requesting '$uri'...\n" if $DEBUG;
$start = time;
$last = 0;
$res = $ua->request($req,
sub
{
my ($data, $response, $protocol) = @_;
print FILE $data;
$time = time - $start;
$size += length($data);
if ($time != $last) {
$last = $time;
}
}
);
if ( $res->is_success
|| $res->message =~ /^Interrupted/
|| $res->message =~ /^OK/)
{
close (FILE);
my $now = time;
utime $now, $now, $file;
print "Finished!\n" if $DEBUG;
}
else {
print "Transfer incomplete: '$res->message'\n\n";
}
}
###
sub Unzip {
# Unzip a file (extract the entire tree)
my $zipName = shift;
die "File not found" if ! -f $zipName;
my $zip = Archive::Zip->new();
print "Unzip '$zipName'...\n" if $DEBUG;
my $status = $zip->read( $zipName );
die "Read of $zipName failed\n" if $status != AZ_OK;
$zip->extractTree();
die "Extracting from $zipName failed\n" if $status != AZ_OK;
print "Ok\n" if $DEBUG;
}
Mais detalhes sobre a lista de discussão Cascavel-pm