Haha, just kidding. Mozpluck in the last email does not work. Attached
is a corrected script. Umm... I meant to do that!
--
Eugene "Gman" Vasserman
[EMAIL PROTECTED]
http://www.y3k.org/eugene/
#!/usr/bin/perl -w
# Perl code by Eugene Vasserman
# (thanks to David A. Desrosiers from plucker-dev for first version)
# Licence: Free, graits, speech, beer, public domain.
# WARRANTY: None. Don't even ask.
use strict;
use Cwd;
use URI;
#use POSIX;
#use File::Temp qw/ mktemp /;
use File::Which;
use String::Random qw(random_string);
use Win32::TieRegistry(Delimiter=>"/");
#use Win32::Palm::Install::UsersDat::UserEntry;
#die "Only cygwin is supported at this time. Sorry.\n"
# unless $ENV{'OSTYPE'} =~ /cygwin/;
#the above is NOT true if run in a DOS box
# if no arguments, check whether plucker:// is a registered protocol
# (register it otherwise) and exit
my $url = shift @ARGV || do {&checkRegistry()
unless &checkRegistry(); exit;};
my $ext = '.pdb';
my $pl_build = 'C:\Handheld\Plucker\plucker-build.exe';
my $pl_install = 'C:\Handheld\Palm\Instapp.exe';
my @pl_args = (
'--zlib-compression',
'--stayonhost',
'--maxdepth=1',
'--backup',
'--beamable',
'--noimages',
'-V1'
);
my ($scheme, $auth, $path, $query, $frag) = &convpl($url);
#this should hit something eventually...
print "$auth, $path, $query, $scheme, $frag\n";
my $title = $query || $path || $auth || $scheme;
#my $filename = mktemp($ENV{'TEMP'}.'mozpluckXXXXXX');
#my $filename = mktemp('mozpluckXXXXXX');
#my $filename = File::Temp::tempnam($ENV{'TEMP'}, 'mozpluckXXXXXX');
#my $filename = tmpnam();
#none of the crap above (for temp files) works under windows....
#we'll have to write our own. Curse Bill!
#my $filename = $ENV{'TEMP'} . random_string('......');
my $filename = 'mozpluck' . random_string('CCCCCC');
while (-e $filename)
{
$filename = 'mozpluck' . random_string('CCCCCC');
}
# of course, Mr. Bond, you understand that we can not guarantee that the file
# will not exist by the time you want to use it!
#print $filename, "\n";
push @pl_args, '--doc-file=' . $filename;
push @pl_args, '-N '. $title;
#push @pl_args, $url =~ s/^plucker:\/\///;
push @pl_args, 'http:' . $query . $path;
my $exitCode;
system $pl_build, @pl_args;
$exitCode = $? >> 8;
die $pl_build.' failed with exit code '. $exitCode ."\n" if $exitCode;
system $pl_install, $filename.$ext;
$exitCode = $? >> 8;
die $pl_install.' failed with exit code '. $exitCode ."\n" if $exitCode;
warn "Could not remove temporary file $filename: $!\n"
unless unlink $filename.$ext;
exit;
sub convpl {
# mine
# /^\s*plucker\:\/\/(https?)\:\/\/(www\.)?(.+)\.(.+)(\..+)*(\/.*\/)*(.*)\s*$/o
# official
# $uri =~
# my($scheme, $authority, $path, $query, $fragment) =
# m|(?:([^:/?#]+):)?(?://([^/?#]*))?([^?#]*)(?:\?([^#]*))?(?:#(.*))?|;
my $u = URI->new(shift @_);
return ($u->scheme, $u->authority, $u->path, $u->query, $u->fragment);
}
sub checkRegistry
{
### check registry keys ###
my $key = 'HKEY_LOCAL_MACHINE/SOFTWARE/Classes/plucker';
$Registry->{$key} = {
'/' => 'URL:Plucker Protocol',
'/URL Protocol' => '',
'DefaultIcon/' => {},
'shell/' => {
'open/' => {
'command/' => {
'/' => '"'. which('perl.exe') .'"' . '"'. getcwd() .'/'. $0 .'" "%1"'}
#not clean, but works...
}
}
};
return 1;
}
