Update of /cvsroot/fink/fink/perlmod/Fink
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv13572
Modified Files:
Engine.pm Services.pm ChangeLog
Log Message:
Replace Services::do_calls() with call_queue_clear() and call_queue_add().
Index: Services.pm
===================================================================
RCS file: /cvsroot/fink/fink/perlmod/Fink/Services.pm,v
retrieving revision 1.145
retrieving revision 1.146
diff -u -d -r1.145 -r1.146
--- Services.pm 20 Jan 2005 03:28:50 -0000 1.145
+++ Services.pm 23 Jan 2005 08:48:31 -0000 1.146
@@ -50,7 +50,7 @@
&file_MD5_checksum &get_arch
&get_sw_vers &enforce_gcc
&get_system_perl_version &get_path
&eval_conditional &count_files
- &growl &do_calls);
+ &growl &call_queue_clear
&call_queue_add);
}
our @EXPORT_OK;
@@ -1355,59 +1355,83 @@
return 1;
}
-=item do_calls
+=item call_queue_clear
- &do_calls([EMAIL PROTECTED]);
+=item call_queue_add
-Loop through the method and function calls specified in @call_list,
-running each one in turn. Each element of @call_list is a ref to a
-list having one of two forms:
+ &call_queue_clear;
+ # some loop {
+ &call_queue_add [EMAIL PROTECTED];
+ # }
+ &call_queue_clear;
- $call_list[n] = [ $object, $method, @params ]
+This implements a primitive function/method call queue for potential
+future parallelization. Using this model, there is a single queue. One
+calls call_queue_clear to make sure there are no calls left from a
+previous queue usage, then call_queue_add to add calls to the queue,
+then call_queue_clear to make sure all the calls are complete.
+
+call_queue_clear blocks until there are no calls pending.
+
+call_queue_add blocks until there is an agent available to handle the
+call, then hands it off to the agent. Each call is specified by a ref
+to a list having one of two forms:
+
+ [ $object, $method, @params ]
In this form, a call will be made to the specified $method name
(given as a string, i.e., a symbolic ref) of (blessed) object
$obj, that is, $object->$method(@params).
- $call_list[n] = [ \&function, @params ]
+ [ \&function, @params ]
In this form, a call will be made to function &function (unblessed
CODE ref), that is, &$function(@params).
In both cases, the thing is called with parameter list @params (if
-given, otherwise an empty list). Return values are discarded.
-
-The anonymous list referenced from $call_list[n] will be clobbered. At
-some point, this function may be rewritten using fork(), so you should
-not expect sane results if your functions and methods change
-parameters passed by reference, (object) instance variables, or other
-runtime data structures.
+given, otherwise an empty list). Return values are discarded. The lis
[EMAIL PROTECTED] will be clobbered. Unless you are extremely careful to check
the
+underlying function or method for thread safety and the use of
+whatever var are declared "shared", you should not expect sane results
+if your functions and methods change parameters passed by reference,
+(object) instance variables, or other runtime data structures.
=cut
-# should rewrite this as a queue where the API is an add_call function
-# that blocks until an agent is available to run it (to save memory in
-# the parent).
+# At this time, there is no parallelization. Each call is handled in
+# the main thread and call_queue_add does not return until the call
+# returns.
-sub do_calls {
- my $call_list = shift;
- my( $object, $method, $function );
+# Should rewrite using multithreading with the pdb and aptdb as shared
+# vars. But perl doesn't implement modern threading until 5.8 so can't
+# do it until we drop support for OS X 10.2.
- foreach my $call (@$call_list) {
- $function = shift @$call;
- if (ref($function) ne 'CODE') {
- # not an unblessed CODE ref so assume it is an object
- $object = $function;
- $method = shift @$call;
- $function = $object->can($method); # CODE ref for pkg
function
- unshift @$call, $object; # handle $obj->$method as
&function($obj)
- if (not defined $function) {
- warn "$object does not appear to have a
\"$method\" method...will skip\n";
- next;
- }
+# If we get a real queue and use it for many purposes, should rewrite
+# it as a queue object so can have multiple queues
+
+sub call_queue_clear {
+ return;
+}
+
+sub call_queue_add {
+ my $call = shift;
+
+ # get function CODE ref and convert object form to function form
+ my $function = shift @$call;
+ if (ref($function) ne 'CODE') {
+ # not an unblessed CODE ref so assume it is an object
+ my $object = $function;
+ my $method = shift @$call;
+ $function = $object->can($method); # CODE ref for pkg function
+ unshift @$call, $object; # handle $obj->$method as
&function($obj)
+ if (not defined $function) {
+ warn "$object does not appear to have a \"$method\"
method...will skip\n";
+ next;
}
- &$function(@$call);
}
+
+ # no ||ization, so just call and wait for return
+ &$function(@$call);
}
=back
Index: Engine.pm
===================================================================
RCS file: /cvsroot/fink/fink/perlmod/Fink/Engine.pm,v
retrieving revision 1.222
retrieving revision 1.223
diff -u -d -r1.222 -r1.223
--- Engine.pm 19 Jan 2005 22:34:45 -0000 1.222
+++ Engine.pm 23 Jan 2005 08:48:31 -0000 1.223
@@ -23,7 +23,7 @@
package Fink::Engine;
-use Fink::Services qw(&latest_version &sort_versions &execute
&file_MD5_checksum &get_arch &expand_percent &count_files &do_calls);
+use Fink::Services qw(&latest_version &sort_versions &execute
&file_MD5_checksum &get_arch &expand_percent &count_files &call_queue_clear
&call_queue_add);
use Fink::CLI qw(&print_breaking &prompt_boolean &prompt_selection_new
&get_term_width);
use Fink::Package;
use Fink::PkgVersion;
@@ -599,7 +599,7 @@
### package-related commands
sub cmd_fetch {
- my ($package, @plist, @fetch_calls);
+ my ($package, @plist);
my (%options, $norestrictive, $dryrun);
my @sav = @_;
@@ -620,16 +620,16 @@
die "no package specified for command 'fetch'!\n";
}
- @fetch_calls = ();
+ &call_queue_clear;
foreach $package (@plist) {
my $pname = $package->get_name();
if ($norestrictive && $package->has_param("license") &&
$package->param("license") =~ m/Restrictive\s*$/i) {
print "Ignoring $pname due to License:
Restrictive\n";
next;
}
- push @fetch_calls, [ $package, 'phase_fetch', 0, $dryrun ];
+ &call_queue_add([ $package, 'phase_fetch', 0, $dryrun ]);
}
- &do_calls([EMAIL PROTECTED]);
+ &call_queue_clear;
}
sub cmd_description {
@@ -693,14 +693,15 @@
#This sub is currently only used for bootstrap. No command line parsing needed
sub cmd_fetch_missing {
- my (@plist, @fetch_calls);
+ my @plist;
@plist = &expand_packages(@_);
if ($#plist < 0) {
die "no package specified for command 'fetch'!\n";
}
- @fetch_calls = map { [ $_, 'phase_fetch', 1, 0 ] } @plist;
- &do_calls([EMAIL PROTECTED]);
+ &call_queue_clear;
+ map { &call_queue_add([ $_, 'phase_fetch', 1, 0 ]) } @plist;
+ &call_queue_clear;
}
sub cmd_fetch_all {
@@ -1243,7 +1244,6 @@
my ($oversion, $opackage, $v, $ep, $dp, $dname);
my ($answer, $s);
my (%to_be_rebuilt, %already_activated);
- my @fetch_calls;
if (Fink::Config::verbosity_level() > -1) {
$showlist = 1;
@@ -1683,21 +1683,21 @@
# remove buildconfilcts before new builds reinstall after build
Fink::Engine::cmd_remove("remove", @removals) if (scalar(@removals) >
0);
- @fetch_calls = ();
+ &call_queue_clear;
# fetch all packages that need fetching
foreach $pkgname (sort keys %deps) {
$item = $deps{$pkgname};
next if $item->[OP] == $OP_INSTALL and
$item->[PKGVER]->is_installed();
if (not $item->[PKGVER]->is_present() and $item->[OP] !=
$OP_REBUILD) {
- push @fetch_calls, [
+ &call_queue_add([
$item->[PKGVER],
$deb_from_binary_dist &&
$item->[PKGVER]->is_aptgetable()
? 'phase_fetch_deb'
: 'phase_fetch',
- 1, 0 ];
+ 1, 0 ]);
}
}
- &do_calls([EMAIL PROTECTED]);
+ &call_queue_clear;
# install in correct order...
while (1) {
Index: ChangeLog
===================================================================
RCS file: /cvsroot/fink/fink/perlmod/Fink/ChangeLog,v
retrieving revision 1.816
retrieving revision 1.817
diff -u -d -r1.816 -r1.817
--- ChangeLog 22 Jan 2005 21:42:55 -0000 1.816
+++ ChangeLog 23 Jan 2005 08:48:32 -0000 1.817
@@ -1,3 +1,8 @@
+2005-01-23 Daniel Macks <[EMAIL PROTECTED]>
+
+ * Engine.pm, Services.pm: Replace do_calls() with
+ call_queue_clear() and call_queue_add().
+
2005-01-22 Dave Morrison <[EMAIL PROTECTED]>
* Bootstrap.pm: Disallow bootstrapping with perl 5.8.4
-------------------------------------------------------
This SF.Net email is sponsored by: IntelliVIEW -- Interactive Reporting
Tool for open source databases. Create drag-&-drop reports. Save time
by over 75%! Publish reports on the web. Export to DOC, XLS, RTF, etc.
Download a FREE copy at http://www.intelliview.com/go/osdn_nl
_______________________________________________
Fink-commits mailing list
Fink-commits@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/fink-commits
