[Cascavel-pm] getfree.pl - instalando softwares livres no Windows
Nelson Ferraz
nferraz em phperl.com
Quinta Outubro 16 13:38:14 CDT 2003
Pessoal,
Aqui vai um pequeno script para automaticamente baixar e instalar
diversos softwares livres no Windows.
A idéia é que o programa seja executado sempre que o computador é
ligado, baixe os arquivos necessários, efetue a instalação e depois se
desinstale automaticamente. Se a transmissão for interrompida, o
programa deve continuar o download de onde parou.
A maior parte já está ok, incluindo o download e a descompactação. O que
falta fazer é:
- Criar chave no registry para execução na inicialização
- Criar atalhos no Desktop após o término do download
Para o futuro, seria legal se o script pudesse ler as informações do
Outlook/ICQ/MSN/etc e configurar as alternativas livres corretamente.
Mas isto fica para depois. :)
Pergunta: alguém aqui tem experiência com os módulos Win32 e com a
criação de executáveis no Windows?
--
[]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 bytecode:
# perl -MO=Bytecode,-O6,-ogetfree.plc,-umain getfree.pl
#
# More info on compiling perl scripts:
# http://search.cpan.org/~jhi/perl-5.8.1-RC5/pod/perlcompile.pod
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 LWP::UserAgent;
use LWP::MediaTypes qw(guess_media_type media_suffix);
use URI ();
use HTTP::Date ();
use Digest::SHA1 qw(sha1);
use Archive::Zip qw(:ERROR_CODES);
#use Win32::Shortcut;
#use Win32::TieRegistry;
########
# #
# DATA #
# #
########
# These are the files we'll download
my %SW = (
'OpenOffice.org 1.1' => 'http://www.ibiblio.org/pub/packages/openoffice/stable/1.1.0/OOo_1.1.0_Win32Intel_install.zip',
'Mozilla Firebird 0.7' => 'http://ftp.mozilla.org/pub/mozilla.org/firebird/releases/0.7/MozillaFirebird-0.7-win32.zip',
'Mozilla Thunderbird 0.3' => 'http://ftp.mozilla.org/pub/mozilla.org/thunderbird/releases/0.3/thunderbird-0.3-win32.zip'
);
my $USER_AGENT = "GetFree/0.0.1";
my $DEBUG = 1;
########
# #
# MAIN #
# #
########
# Install myself
Install_myself();
# Download files
foreach (keys %SW) {
Download($SW{$_});
}
# Unzip files
foreach (keys %SW) {
my ($filename) = $SW{$_} =~ m!([^/]+)$!; # get filename from url
Unzip($filename) if $filename =~ m/\.zip$/i;
}
# Uninstall myself
Uninstall_myself();
########
# #
# SUBS #
# #
########
sub Install_myself {
# Copy myself to home drive
my $home = $ENV{HOMEDRIVE}; # Usually "C:"
my ($script_name) = $0 =~ m!([^/]+)$!;
if (!-f "$home/$script_name") {
# Copy myself to home dir
system("copy $FindBin::Bin/$script_name $home");
# TO-DO: Add key to registry
# [HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run]
}
}
###
sub Uninstall_myself {
# Remove myself from home drive
my $home = $ENV{HOMEDRIVE}; # Usually "C:"
my ($script_name) = $0 =~ m!([^/]+)$!;
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 given URL; 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. Creating 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\n" if $DEBUG;
}
else {
print "Transfer incomplete: '$res->message'\n\n";
}
}
###
sub Unzip {
# Unzip a given zip file (extract the entire tree)
my $zipName = shift;
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;
}
__END__
Mais detalhes sobre a lista de discussão Cascavel-pm