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