OpenPKG CVS Repository
http://cvs.openpkg.org/
____________________________________________________________________________
Server: cvs.openpkg.org Name: Michael van Elst
Root: /e/openpkg/cvs Email: [EMAIL PROTECTED]
Module: openpkg-re Date: 19-Nov-2002 13:11:45
Branch: HEAD Handle: 2002111912114500
Modified files:
openpkg-re openpkg-build
Log:
get rid of Getopt::Std dependency.
get rid of use of LWP module, curl works fine.
get rid of manual spawning of bzip2, use popen feature.
now runs under microperl.
Summary:
Revision Changes Path
1.32 +48 -79 openpkg-re/openpkg-build
____________________________________________________________________________
Index: openpkg-re/openpkg-build
============================================================
$ cvs diff -u -r1.31 -r1.32 openpkg-build
--- openpkg-re/openpkg-build 19 Nov 2002 09:42:51 -0000 1.31
+++ openpkg-re/openpkg-build 19 Nov 2002 12:11:45 -0000 1.32
@@ -33,8 +33,39 @@
##########################################################################
-use Getopt::Std;
-use vars qw/$opt_R $opt_r $opt_f $opt_u $opt_U $opt_a $opt_A $opt_z $opt_P $opt_N/;
+sub getopts ($) {
+ my($opts) = @_;
+ my(%opts) = map { /(\w)/; $1 => $_ } $opts =~ /(\w:|\w)/g;
+ my(@argv,$optarg);
+
+ foreach (@ARGV) {
+ if (@argv) {
+ push @argv, $_;
+ } elsif (defined $optarg) {
+ eval "\$opt_$optarg = \"".quotemeta($_)."\";";
+ $optarg = undef;
+ } elsif (/^-(\w)/) {
+ if (exists $opts{$1}) {
+ if (length($opts{$1}) > 1) {
+ $optarg = $1;
+ } else {
+ eval "\$opt_$1 = 1;";
+ }
+ } else {
+ warn "warning: unknown option $_\n";
+ }
+ } else {
+ push @argv, $_;
+ }
+ }
+ if (defined $optarg) {
+ warn "warning: option $optarg requires an argument\n";
+ }
+
+ @ARGV = @argv;
+}
+
+#use vars qw/$opt_R $opt_r $opt_f $opt_u $opt_U $opt_a $opt_A $opt_z $opt_P $opt_N/;
my(%env) = ( '' => { opt => {}, argv => [] } );
if (open(FH, "< $ENV{'HOME'}/.openpkg-build.rc")) {
@@ -290,43 +321,10 @@
return \%with;
}
-sub spawn ($@) {
- my($source,@argv) = @_;
- my($pid);
-
- pipe RFH, WFH
- or die "FATAL: cannot create pipe ($!)\n";
-
- print "# uncompressing\n";
-
- $pid = fork;
- die "FATAL: cannot fork ($!)\n" unless defined $pid;
-
- if ($pid == 0) {
- close(RFH);
- open STDOUT,'>&='.fileno(WFH) or die;
-
- if (ref $source) {
- # filehandle
- open STDIN,'<&='.fileno($source) or die;
- exec @argv;
- } else {
- # buffer
- open FH, '| '.join(' ',@argv) or die;
- print FH $source or die;
- close FH or die;
- }
- exit 0;
- }
- close WFH;
-
- return $pid;
-}
-
sub get_index ($$$) {
my($url,$fn,$with) = @_;
my($ua,$req,$res,$rdf);
- my($pid,$bzip2,$curl);
+ my($bzip2,$curl,$path);
my(%map);
$url = $fn if defined $fn;
@@ -340,58 +338,30 @@
or die "FATAL: $bzip2 not found\n";
if ($url =~ /^\w+:/) { # looks like URL scheme
+ $curl = $RPM;
+ $curl =~ s/bin\/rpm$/lib\/openpkg\/curl/
+ or die "FATAL: cannot deduce curl path from $RPM\n";
+ -x $curl
+ or die "FATAL: $curl not found\n";
- eval {
- require LWP;
- };
- if ($@) {
-
- print "# curling index $url\n";
-
- $curl = $RPM;
- $curl =~ s/bin\/rpm$/lib\/openpkg\/curl/
- or die "FATAL: cannot deduce curl path from $RPM\n";
- -x $curl
- or die "FATAL: $curl not found\n";
-
- if ($url =~ /\.bz2$/) {
- open(FH, "$curl -q -s -o - \"$url\" |")
- or die "FATAL: cannot curl '$url' ($!)\n";
- $pid = spawn(\*FH,$bzip2,'-dc');
- close(FH);
- } else {
- open(RFH, "$curl -q -s -o - \"$url\" |")
- or die "FATAL: cannot curl '$url' ($!)\n";
- }
+ print "# curling index $url\n";
+ if ($url =~ /\.bz2$/) {
+ $path = "$curl -q -s -o - \"$url\" | $bzip2 -dc |";
} else {
- print "# fetching index $url\n";
-
- $ua = new LWP::UserAgent;
- $req = new HTTP::Request GET => $url;
- $res = $ua->request($req);
-
- die "FATAL: cannot read build index\n" unless $res->is_success;
-
- if ($url =~ /\.bz2$/) {
- $pid = spawn($res->content,$bzip2,'-dc');
- } else {
- $pid = cat($res->content,'cat');
- }
+ $path = "$curl -q -s -o - \"$url\" |";
}
} else {
print "# reading index file $fn\n";
-
if ($url =~ /\.bz2$/) {
- open(FH, "< $url") or
- die "FATAL: cannot read file '$url' ($!)\n";
- $pid = spawn(\*FH,$bzip2,'-dc');
- close(FH);
+ $path = "$bzip2 -dc $url |";
} else {
- open(RFH, "< $url") or
- die "FATAL: cannot read file '$url' ($!)\n";
+ $path = "< $url";
}
}
+ open(RFH, $path) or
+ die "FATAL: cannot open '$url' ($!)\n";
+
eval {
require XML::Simple;
};
@@ -528,7 +498,6 @@
}
close(RFH);
- waitpid $pid,0 if $pid;
return \%map;
}
______________________________________________________________________
The OpenPKG Project www.openpkg.org
CVS Repository Commit List [EMAIL PROTECTED]
