[29459] in Perl-Users-Digest

home help back first fref pref prev next nref lref last post

Perl-Users Digest, Issue: 703 Volume: 11

daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Tue Jul 31 11:09:45 2007

Date: Tue, 31 Jul 2007 08:09:07 -0700 (PDT)
From: Perl-Users Digest <Perl-Users-Request@ruby.OCE.ORST.EDU>
To: Perl-Users@ruby.OCE.ORST.EDU (Perl-Users Digest)

Perl-Users Digest           Tue, 31 Jul 2007     Volume: 11 Number: 703

Today's topics:
        Both Methods and Indexing for Objects? <vtatila@mail.student.oulu.fi>
    Re: Both Methods and Indexing for Objects? anno4000@radom.zrz.tu-berlin.de
        define an array in perl <zenith.of.perfection@gmail.com>
    Re: define an array in perl anno4000@radom.zrz.tu-berlin.de
    Re: define an array in perl <noreply@gunnar.cc>
    Re: define an array in perl  ivakras1@gmail.com
    Re: deleting duplicates in array using references anno4000@radom.zrz.tu-berlin.de
    Re: deleting duplicates in array using references anno4000@radom.zrz.tu-berlin.de
    Re: getting arguments <bik.mido@tiscalinet.it>
    Re: getting arguments <yankeeinexile@gmail.com>
    Re: Perl threads <zentara@highstream.net>
    Re: Perl with DBI <stoupa@practisoft.cz>
    Re: threads and logfile rotation <zentara@highstream.net>
        Variable declaration - C vs script style <marko.anastasov@gmail.com>
    Re: Variable declaration - C vs script style <bugbear@trim_papermule.co.uk_trim>
        Digest Administrivia (Last modified: 6 Apr 01) (Perl-Users-Digest Admin)

----------------------------------------------------------------------

Date: Tue, 31 Jul 2007 16:18:07 +0300
From: Veli-Pekka =?iso-8859-1?Q?T=E4til=E4?= <vtatila@mail.student.oulu.fi>
Subject: Both Methods and Indexing for Objects?
Message-Id: <46AF368F.F3C67D54@mail.student.oulu.fi>

Hi,
I'd like to treat an object like an array but also provide methods for
accessing bits of the object state that aren't array-like. An example in
which this would be useful comes from Ruby, its regexp Match objects are
indexable like arrays for accessing back references, yet they also have
a nice interface via methods. Can Perl also do objects having both
methods and hash or array-like indexing? 

I think I've found one possible solution, for arrays at least, after
reading Object Oriented Perl Ch 9.7 on tied objects. You could have a
constructor that returns a blessed ref to an underlying tied array,
which the user accesses like any array ref. As it is tied, its easy to
make the array read-only, for instance, if more restricted  access is
desired. As the object made by the constructor is a blessed scalar the
user can also call methods on it. One way to handle the methods, and
also be able to store object state beside the array itself, is to
implement the tied array as a blessed hash behind the scenes. When a
method in which the non-array bits of the object are needed gets
called,  you can dig up the underlying object behind the tied array via
tied. 

To my surprise, at least in this simple script, both the array and the
object usage seem to be working OK. On second thought, putting the
methods dealing with tied variables in a separate package might have
been cleaner.

Are there easier ways of achieving essentially the same thing? Howabout
modules that would factor out the common bits even further, so that you
could state which hash member should have array-like access - in the
spirit of how Struct and MethodMaker automate matters. I'm still a bit
envious of Ruby's mixins and have been thinking of ways to implement
them in Perl, too.

And now the code, currently in a single file:

package TiedArray;
use strict; use warnings; use Tie::Array;
our @ISA = qw|Tie::Array|;

sub new
{ # Tie an array and bless the tied variable in $class.
   my $class = shift;
   my @array;
   tie @array, $class, @_;
   bless \@array, $class;
} # sub 

sub TIEARRAY
{ #  Implement as a hash with an array field.
   my $self = { };
   bless $self, shift;
   $self->init(@_);     
   return $self;
} # sub 

sub init
{ # Add fields and process arguments.
   my $self = shift;
   $self->{data} = shift;
} # sub 

sub object
{ # Get the tied object given the tied variable $self.
   my $self = shift;
   tied @$self;
} # sub 

# Pasted from Tie::StdArray with minor mods, as the array is in a hash.
sub FETCHSIZE { scalar @{$_[0]{array}} }
sub STORESIZE { $#{$_[0]{array}} = $_[1]-1 }
sub STORE     { $_[0]->{array}[$_[1]] = $_[2] }
sub FETCH     { $_[0]->{array}[$_[1]] }

# Methods for the underlying object:
sub data
{ # Accessor for the "data" hash member. 
   my $self = object(shift);
   return $self->{data} unless @_;
   $self->{data} = shift;
} # sub 

sub size
{ # Getting the array size as a method.
   my $self = shift;
   return scalar @$self;   
} # sub
1;

package main; # Some rather arbitrary tests.
my $array = TiedArray->new('stuff');
@$array[0 .. 1] = (qw|first second|);

print "Array: @$array\n";
print "Data: ", $array->data(), "\n";

$array->data('foo'),
push @$array, int(10 * rand) for 1 .. 4;

print "Array: @$array\n";
print "New data: ", $array->data(), "\n";

@$array = splice @$array, 1, 2;
print "Array: @$array\n";
print $array->size(), " elements.\n";

Thanks for any help in advance. I'm rather new to Perl OOP, especially
tied variables.

-- 
With kind regards Veli-Pekka Tätilä (vtatila@mail.student.oulu.fi)
Accessibility, game music, synthesizers and programming:
http://www.student.oulu.fi/~vtatila


------------------------------

Date: 31 Jul 2007 13:59:38 GMT
From: anno4000@radom.zrz.tu-berlin.de
Subject: Re: Both Methods and Indexing for Objects?
Message-Id: <5h8tiaF3k2ikhU1@mid.dfncis.de>

Veli-Pekka Tätilä  <vtatila@mail.student.oulu.fi> wrote in comp.lang.perl.misc:
> Hi,
> I'd like to treat an object like an array but also provide methods for
> accessing bits of the object state that aren't array-like. An example in
> which this would be useful comes from Ruby, its regexp Match objects are
> indexable like arrays for accessing back references, yet they also have
> a nice interface via methods. Can Perl also do objects having both
> methods and hash or array-like indexing? 

You can overload de-referencing in your class.  That won't make objects
look like arrays, but like array references, which may be good enough.

I've made up a Regex class that behaves a bit like what you describe.
After a match, an object can be used like an array ref that holds
the captured strings (with the entire match in array position 0).

Anno

-----------------------------------------------------------------------

my $r = Regex->new( '(.)(.)(.)');
$r->match( 'abc');

print "$r->[ $_]\n" for 1 .. 3;
print "@$r\n";


package Regex;

sub new {
    my ( $class, $re) = @_;
    bless { re => qr/$re/, capt => [] }, $class;
}

sub match {
    my ( $r, $str) = @_;
    @{ $r->{ capt} } = $str =~ /($r->{ re})/;
    return scalar @{ $r->{ capt} };
}

use overload '@{}' => sub { shift()->{ capt} };
__END__


------------------------------

Date: Tue, 31 Jul 2007 10:43:42 -0000
From:  jeniffer <zenith.of.perfection@gmail.com>
Subject: define an array in perl
Message-Id: <1185878622.081510.59310@z28g2000prd.googlegroups.com>

Hi
I am a newbie in perl. I have an array block_list :

 push ( @block_list ,$word); # this word is read from a file.
 $list_name = $block_list[$#block_list]; # i extract the last element
ie $word in this case
now i want to define an array with the name $list_name


like ,
my @"$list_name";

But this is giving me errors...
sorry for the stupid question,,,please help me out ,,,,



------------------------------

Date: 31 Jul 2007 10:59:57 GMT
From: anno4000@radom.zrz.tu-berlin.de
Subject: Re: define an array in perl
Message-Id: <5h8j1dF3j74ilU1@mid.dfncis.de>

jeniffer  <zenith.of.perfection@gmail.com> wrote in comp.lang.perl.misc:
> Hi
> I am a newbie in perl. I have an array block_list :
> 
>  push ( @block_list ,$word); # this word is read from a file.
>  $list_name = $block_list[$#block_list]; # i extract the last element

Why don't you use $word itself?  If you still have the variable, there's
no need to access the array.  If $word is no longer available, the
last element of an array is better accessed as

    $block_list[-1];

> ie $word in this case
> now i want to define an array with the name $list_name
> 
> 
> like ,
> my @"$list_name";

Bad plan.  You're aiming for symbolic references.  See "perldoc -q
'variable as a variable name'" for why this is not a good idea.

> But this is giving me errors...
> sorry for the stupid question,,,please help me out ,,,,

Use a "hash of arrays" %h where the keys are the prospective variable
names and the values are references to the arrays.  The array for
$list_name would be

    @{ $h{ $list_name} }

and the $n-th element of that array can be accessed through

    $h{ $list_name}->[ $n]

See "perldoc perldsc" and "perldoc perlreftut" for more on that.

Anno


------------------------------

Date: Tue, 31 Jul 2007 12:59:34 +0200
From: Gunnar Hjalmarsson <noreply@gunnar.cc>
Subject: Re: define an array in perl
Message-Id: <5h8j75F3jh7aiU1@mid.individual.net>

jeniffer wrote:
> I have an array block_list :
> 
>  push ( @block_list ,$word); # this word is read from a file.
>  $list_name = $block_list[$#block_list]; # i extract the last element
> ie $word in this case
> now i want to define an array with the name $list_name
> 
> like ,
> my @"$list_name";
> 
> But this is giving me errors...

It can be done, but is not recommended. Consider this solution instead:

     my $word = 'Perl';
     my %lists;                      # declare a HoA

     push @{ $lists{$word} }, $word;

     print @{ $lists{Perl} }, "\n";  # prints 'Perl'

You may want to read the FAQ entry

     perldoc -q "variable name"

about why what you tried to do is not recommended.

-- 
Gunnar Hjalmarsson
Email: http://www.gunnar.cc/cgi-bin/contact.pl


------------------------------

Date: Tue, 31 Jul 2007 11:03:45 -0000
From:  ivakras1@gmail.com
Subject: Re: define an array in perl
Message-Id: <1185879825.940142.271000@w3g2000hsg.googlegroups.com>

On 31    , 14:43, jeniffer <zenith.of.perfect...@gmail.com> wrote:
> Hi
> I am a newbie in perl. I have an array block_list :
>
>  push ( @block_list ,$word); # this word is read from a file.
>  $list_name = $block_list[$#block_list]; # i extract the last element
> ie $word in this case
> now i want to define an array with the name $list_name
>
> like ,
> my @"$list_name";
>
> But this is giving me errors...
> sorry for the stupid question,,,please help me out ,,,,

arrays starts its name from @. you cant define an array with the name
$list_name, it looks like a string, member of array, but not the
array. You may want to split $list_name into array. So use split().
Example: my @arr=split('-',$list_name). It splits the string
$list_name into an array with '-' as a delimiter.
my $str="abc-def-123-456";
my @array=split('-',$str);



------------------------------

Date: 31 Jul 2007 10:29:27 GMT
From: anno4000@radom.zrz.tu-berlin.de
Subject: Re: deleting duplicates in array using references
Message-Id: <5h8h87F3i5e3uU1@mid.dfncis.de>

billb  <billbealey@f2s.com> wrote in comp.lang.perl.misc:
> On 30 Jul, 19:46, Paul Lalli <mri...@gmail.com> wrote:
> > On Jul 30, 2:37 pm, billb <billbea...@f2s.com> wrote:
> >
> > > i have a multidimensional array, but i want to delete duplicate
                                                            ^^^^^^^^^
[Paul's solution snipped]

> ah, very simple and very fast as well! I'll have to understand how
> this is working. It uses a hash I see. Many thanks.

On hearing the word "duplicate", like a Pavlovian dog a Perl programmer
goes "Hash, hash, hash...".  The word "unique" hash the same effect.

Anno


------------------------------

Date: 31 Jul 2007 10:32:25 GMT
From: anno4000@radom.zrz.tu-berlin.de
Subject: Re: deleting duplicates in array using references
Message-Id: <5h8hdpF3i5e3uU3@mid.dfncis.de>

billb  <billbealey@f2s.com> wrote in comp.lang.perl.misc:
> On 30 Jul, 19:46, Paul Lalli <mri...@gmail.com> wrote:
> > On Jul 30, 2:37 pm, billb <billbea...@f2s.com> wrote:
> >
> > > i have a multidimensional array, but i want to delete duplicate
                                                            ^^^^^^^^^
[Paul's solution snipped]

> ah, very simple and very fast as well! I'll have to understand how
> this is working. It uses a hash I see. Many thanks.

On hearing the word "duplicate", like a Pavlovian dog a Perl programmer
goes "Hash, hash, hash...".  The word "unique" has the same effect.

Anno



------------------------------

Date: Tue, 31 Jul 2007 11:35:25 +0200
From: Michele Dondi <bik.mido@tiscalinet.it>
Subject: Re: getting arguments
Message-Id: <ah0ua39nl1jv6rokv91p1ggdbtflhkjm65@4ax.com>

On Mon, 30 Jul 2007 16:38:13 -0400, Sherm Pendley
<spamtrap@dot-app.org> wrote:

>> Huh, sorry for being dense... is this the famous Monty Pyton's sketch?
>
>Yep. :-)
>
>I'm glad someone got it - I dread the day when a Monty Python reference is
>too obscure for this group...

Well, I was about to make a joke about a very well known programming
language occasionally compared with Perl... but I'm refraining to...


Michele
-- 
{$_=pack'B8'x25,unpack'A8'x32,$a^=sub{pop^pop}->(map substr
(($a||=join'',map--$|x$_,(unpack'w',unpack'u','G^<R<Y]*YB='
 .'KYU;*EVH[.FHF2W+#"\Z*5TI/ER<Z`S(G.DZZ9OX0Z')=~/./g)x2,$_,
256),7,249);s/[^\w,]/ /g;$ \=/^J/?$/:"\r";print,redo}#JAPH,


------------------------------

Date: 31 Jul 2007 07:56:40 -0500
From: Lawrence Statton <yankeeinexile@gmail.com>
Subject: Re: getting arguments
Message-Id: <87bqdsybnb.fsf@hummer.cluon.com>

Michele Dondi <bik.mido@tiscalinet.it> writes:
> Well, I was about to make a joke about a very well known programming
> language occasionally compared with Perl... but I'm refraining to...
> 

Something like ... 

  The American comedy troupe Monty Perl was far superior to those lame
  brits....

"This is an undef parrot, he has been garbage collected  ..... " 

-- 
	Lawrence Statton - lawrenabae@abaluon.abaom s/aba/c/g
Computer  software  consists of  only  two  components: ones  and
zeros, in roughly equal proportions.   All that is required is to
place them into the correct order.


------------------------------

Date: Tue, 31 Jul 2007 11:44:10 GMT
From: zentara <zentara@highstream.net>
Subject: Re: Perl threads
Message-Id: <fnpsa310h33g1enkd6mb9b6pk6icrnin17@4ax.com>

On Tue, 31 Jul 2007 04:44:12 -0000, ivakras1@gmail.com wrote:

>is to make main program work with no pauses for waiting joined thread
>or something else, it causes packet missing.
I would suspect that the startup time for the thread, is where the
packets are being lost. Especially if the system load is heavy, the
thread takes time to set itself up.  You may need to rethink your
approach to this.

> I tried to fire up
>threads with detach (threads creates fast, 10-20 per second). But when
>the main program is done (by ctrl+c or else) - perl warns me the
>number of threads still running. How can i get this number by myself
>to wait for detached threads dies?

When you detach a thread, the main thread forgets about it, so there is
no way to get them without keeping track of them yourself.

Make a shared array or scalar, to keep track of your threads. 
When you create a thread, push it's identifier ( use a hash ) onto
the array.
At the end of the thread code block, just before it exits, have it
remove it's name from the array. 

Then you can tell how many threads you have running, by the
scalar count of the array.

If you want to terminate early, remember, you will need a "$die" shared
variable, to tell the remaining threads to return immediately, and then
you can cleanly exit.  (This means your thread code block needs to be
written to check for $die often.

One word of warning, about spawning alot of detached threads containing 
object code from some module......... you may very well will gain memory
as the script runs, if the cleanup of refcounts is not good. You may get
lucky, but it is something to watch out for. It is very dis-heartening
to spend a bunch of time getting it all to work, only to find it sucks
up ram like a vacuum cleaner. :-) 

Personally, if speed is important, to avoid missing packets, I would
create a bank of reusable joinable threads, that you can cycle thru.
You may also want to ask this on http://perlmonks.org, where a fellow
named BrowserUk may be able to show you how to use thread->queue.
I'm a "crude crafter" and like to hammer all my stuff together with
shared variables and event loops, but there are some more sophisticated
techniques out there.

Here is an example of a reusable thread-bank. I create 3 threads, and
when they finish, they get pushed back into an array for the next
available job. It also shows you how to track your threads with a shared
hash.


#!/usr/bin/perl
use warnings;
use strict;
use threads;
use threads::shared;

#works on WindowsME ActiveState 5.8.6.811

my $data = shift || 'date';  #sample code to pass to thread

my %shash;
#share(%shash); #will work only for first level keys
my %hash;
my %workers;
my $numworkers = 3;

foreach my $dthread(1..$numworkers){
 share ($shash{$dthread}{'go'});
 share ($shash{$dthread}{'progress'});
 share ($shash{$dthread}{'timekey'});  #actual instance of the thread
 share ($shash{$dthread}{'frame_open'}); #open or close the frame
 share ($shash{$dthread}{'handle'});
 share ($shash{$dthread}{'data'});
 share ($shash{$dthread}{'pid'});
 share ($shash{$dthread}{'die'});
 
 $shash{$dthread}{'go'} = 0;
 $shash{$dthread}{'progress'} = 0;
 $shash{$dthread}{'timekey'} = 0;
 $shash{$dthread}{'frame_open'} = 0; 
 $shash{$dthread}{'handle'} = 0;
 $shash{$dthread}{'data'} = $data;
 $shash{$dthread}{'pid'} = -1;
 $shash{$dthread}{'die'} = 0;
 $hash{$dthread}{'thread'} = threads->new(\&work,$dthread);
}


use Tk;
use Tk::Dialog;

my $mw = MainWindow->new(-background => 'gray50');

my $lframe = $mw->Frame( -background => 'gray50',-borderwidth=>10 )
                  ->pack(-side =>'left' ,-fill=>'y');
my $rframe = $mw->Frame( -background => 'gray50',-borderwidth=>10 )
                  ->pack(-side =>'right',-fill =>'both' );

my %actives = ();   #hash to hold reusable numbered widgets used for
downloads
my @ready = ();     #array to hold markers indicating activity is needed

#make 3 reusable downloader widget sets-------------------------
foreach(1..$numworkers){
   push @ready, $_;
#frames to hold indicator
$actives{$_}{'frame'} = $rframe->Frame( -background => 'gray50' );

$actives{$_}{'stopbut'} = $actives{$_}{'frame'}->Button(
        -text       => "Stop Worker $_",
        -background => 'lightyellow',
        -command    => sub {  } )->pack( -side => 'left', -padx => 10 );

$actives{$_}{'label1'} = $actives{$_}{'frame'} ->Label(
         -width       => 3,
	 -background => 'black',
	 -foreground => 'lightgreen',
         -textvariable => \$shash{$_}{'progress'},
    )->pack( -side => 'left' );

$actives{$_}{'label2'} = $actives{$_}{'frame'} ->Label(
         -width       => 1,
         -text        => '%',
	 -background  => 'black',
	 -foreground  => 'lightgreen',
    )->pack( -side => 'left' );


$actives{$_}{'label3'} = $actives{$_}{'frame'} ->Label(
          -text        => '',
	 -background  => 'black',
	 -foreground  => 'skyblue',
    )->pack( -side => 'left',-padx =>10 );

}
#--------------------------------------------------

my $button = $lframe->Button(
    -text       => 'Get a worker',
    -background => 'lightgreen',
    -command    => sub { &get_a_worker(time) } 
           )->pack( -side => 'top', -anchor => 'n', -fill=>'x', -pady =>
20 );

my $text = $rframe->Scrolled("Text",
                   -scrollbars => 'ose',
                   -background => 'black',
                   -foreground => 'lightskyblue',
                   )->pack(-side =>'top', -anchor =>'n');

my $repeat;
my $startbut;
my $repeaton = 0;
$startbut = $lframe->Button(
    -text       => 'Start Test Count',
    -background => 'hotpink',
    -command    => sub {
        my $count = 0;
        $startbut->configure( -state => 'disabled' );
        $repeat = $mw->repeat(
            100,
            sub {
                $count++;
                $text->insert( 'end', "$count\n" );
                $text->see('end');
            }
        );
        $repeaton = 1;
    })->pack( -side => 'top',  -fill=>'x', -pady => 20);

my $stoptbut = $lframe->Button(
    -text    => 'Stop Count',
    -command => sub {
        $repeat->cancel;
        $repeaton = 0;
        $startbut->configure( -state => 'normal' );
    })->pack( -side => 'top',-anchor => 'n', -fill=>'x', -pady => 20 );

my $exitbut = $lframe->Button(
    -text    => 'Exit',
    -command => sub {
        
        foreach my $dthread(keys %hash){
          $shash{$dthread}{'die'} = 1;
          $hash{$dthread}{'thread'}->join
	 }
        
         if ($repeaton) { $repeat->cancel }
           #foreach ( keys %downloads ) {
           #    #$downloads{$_}{'repeater'}->cancel;
           #}
      # $mw->destroy;	
       exit;
      })->pack( -side => 'top',-anchor => 'n', -fill=>'x', -pady => 20
);


#dialog to get file url---------------------
    my $dialog = $mw->Dialog(
        -background => 'lightyellow',
        -title      => 'Get File',
        -buttons    => [ "OK", "Cancel" ]
    );

    my $hostl = $dialog->add(
        'Label',
        -text       => 'Enter File Url',
        -background => 'lightyellow'
    )->pack();

    my $hostd = $dialog->add(
        'Entry',
        -width        => 100,
        -textvariable => '',
        -background   => 'white'
    )->pack();

$dialog->bind( '<Any-Enter>' => sub { $hostd->Tk::focus } );

   my $message = $mw->Dialog(
        -background => 'lightyellow',
        -title      => 'ERROR',
    	-buttons    => [ "OK" ]
    );

  my $messagel = $message->add(
               'Label',
        -text       => '       ',
	-background => 'hotpink'
    )->pack();

$mw->repeat(10, sub{  
   if(scalar @ready == $numworkers){return}
         
   foreach my $set(1..$numworkers){  
     $actives{$set}{'label1'}->
         configure(-text =>\$shash{$set}{'progress'});
       
         if(($shash{$set}{'go'} == 0) and
	    ($shash{$set}{'frame_open'} == 1)) 
	    { 
            my $timekey = $shash{$set}{'timekey'};
           $workers{ $timekey }{'frame'}->packForget; 
	   $shash{$set}{'frame_open'} = 0;    
	   push @ready, $workers{$timekey}{'setnum'};
	   if((scalar @ready) == 3)
	      {  }
	      $workers{$timekey} = ();
	     delete $workers{$timekey};
           }
        }
    });

$mw->MainLoop;
###################################################################

sub get_a_worker {

   my $timekey = shift;

  $hostd->configure( -textvariable => \$data);
  if ( $dialog->Show() eq 'Cancel' ) { return }

#----------------------------------------------
#get an available frameset
my $setnum; 
  if($setnum = shift @ready){print "setnum->$setnum\n"}
    else{ print "no setnum available\n"; return}

$workers{$timekey}{'setnum'} = $setnum;
$shash{$setnum}{'timekey'} = $timekey;

$workers{$timekey}{'frame'} = $actives{$setnum}{'frame'};
$workers{$timekey}{'frame'}->pack(-side =>'bottom', -fill => 'both' );

$workers{$timekey}{'stopbut'} = $actives{$setnum}{'stopbut'};
$workers{$timekey}{'stopbut'}->configure(
         -command => sub { 
	    $workers{$timekey}{'frame'}->packForget; 
	    $shash{ $workers{$timekey}{'setnum'} }{'go'} = 0;
	    $shash{ $workers{$timekey}{'setnum'} }{'frame_open'} = 0;
	    push @ready, $workers{$timekey}{'setnum'};
	    if((scalar @ready) == $numworkers)
	      {  }
	       $workers{$timekey} = ();
	       delete $workers{$timekey};
	    	    });

$workers{$timekey}{'label1'} = $actives{$setnum}{'label1'};
$workers{$timekey}{'label1'}->configure(
              -textvariable => \$shash{$setnum}{'progress'},
	       );

$workers{$timekey}{'label2'} = $actives{$setnum}{'label2'};


$workers{$timekey}{'label3'} = $actives{$setnum}{'label3'};
$workers{$timekey}{'label3'}->configure(-text => $timekey);



$shash{$setnum}{'go'} = 1; 
$shash{$setnum}{'frame_open'} = 1; 
#--------end of get_file sub--------------------------
}

##################################################################
sub work{
  my $dthread = shift;
    $|++; 
    while(1){
       if($shash{$dthread}{'die'} == 1){ return }; 
      
       if ( $shash{$dthread}{'go'} == 1 ){

    eval( system( $shash{$dthread}{'data'} )    );

   foreach my $num (1..100){
          $shash{$dthread}{'progress'} = $num; 
       print "\t" x $dthread,"$dthread->$num\n";
       select(undef,undef,undef, .5);
       if($shash{$dthread}{'go'} == 0){last}
       if($shash{$dthread}{'die'} == 1){ return }; 
       }
       
    $shash{$dthread}{'go'} = 0; #turn off self before returning      
       }else
         { select(undef,undef,undef,.1) }
    }
}
#####################################################################

__END__



-- 
I'm not really a human, but I play one on earth.
http://zentara.net/japh.html


------------------------------

Date: Mon, 30 Jul 2007 15:04:07 +0200
From: "Petr Vileta" <stoupa@practisoft.cz>
Subject: Re: Perl with DBI
Message-Id: <f8n9ji$r2a$1@ns.felk.cvut.cz>

Jason wrote:
> I'm tagging this onto the same thread because it's the same topic, but
> the issue is a little different.
>
> With the ID field, I'm wanting to create a unique ID for each new
> submission. I was originally using auto_increment, but the problem is
> that when I remove a row, I do not want the ID to be reused.
>
When you use auto_increment then ID will not be reused when you delete last 
added row. Try it ;-)
If you want to know the inserted ID then use last_insert_id() sql function 
but you must use it immediate after insert command. Take a look into mysql 
manual.
-- 

Petr Vileta, Czech republic
(My server rejects all messages from Yahoo and Hotmail. Send me your mail 
from another non-spammer site please.)




------------------------------

Date: Tue, 31 Jul 2007 12:38:03 GMT
From: zentara <zentara@highstream.net>
Subject: Re: threads and logfile rotation
Message-Id: <epssa3dehu3rjbgl4fo1m33s3j2icfhdah@4ax.com>

On Mon, 30 Jul 2007 18:56:40 +0200, Thomas Kratz
<ThomasKratz@REMOVEwebCAPS.de> wrote:

>I am a bit stumped with handling logfile rotation with a threaded app.
>The below test script dies with "rename failed, Permission denied".
>I assume this is because of the detached thread still referencing the 
>filehandle because it got copied at thread creation.
>
>Moving the thread creation before creation of the file solves this, but 
>it is not really what I want. Ideally the thread should be able to log 
>as well to the copied handle.
>
>Is there a way around this?
>
>(perl 5.88 under Win23 with threads 1.64)
>

I don't know how this will work on win32, but the preffered way
of having threads share a filehandle, is by passing in the fileno;
usually through a shared variable, but this passes it in directly.

You can go both ways with this. You can create the filehandle in the 
thread and place it's fileno in a shared variable, and the main thread
can then access it.

#!/usr/bin/perl
use warnings; 
use strict;
use threads;
use threads::shared;

# original idea from BrowserUK at  
# http://perlmonks.org?node_id=493754

for my $file ( map{ glob $_ } @ARGV ) {
  open my $fh, '<', $file or warn "$file : $!" and next;
  printf "From main: %s", scalar <$fh> for 1 .. 10;
  printf "Fileno:%d\n", fileno $fh;
  threads->create( \&thread, fileno( $fh ) )->detach;
  printf 'paused:';<STDIN>;
}

sub thread{
my( $fileno ) = @_;
open my $fh, "<&=$fileno" or warn $! and die;
printf "%d:%s", threads->self->tid, $_ while defined( $_ = <$fh> );
close $fh;
}
__END__


zentara
-- 
I'm not really a human, but I play one on earth.
http://zentara.net/japh.html


------------------------------

Date: Tue, 31 Jul 2007 05:01:10 -0700
From:  markoa <marko.anastasov@gmail.com>
Subject: Variable declaration - C vs script style
Message-Id: <1185883270.375241.4660@o61g2000hsh.googlegroups.com>

Hello,

I've been wondering whether there are any differences in performance
when declaring variables within loops
comparing to all forward declarations. I'm mostly writing up to a few
hundred lines long scripts, but I need
relatively a lot variables, which look kind of ugly and IMO make the
script less readable when declared all
at the top. For example,

my ($var1, var2, var3, var4, var5, ...);
my (another set of variables);
while (...) {
    $var1 = ...
    $var2 = &foo($var1);
    ...
    if ($var3) {
        ...
    }

    for ($var4 : ...)
}

vs

while (...) {
    my $var1 = ...
    my $var2 = &foo($var1);
    ...
    my $var3 = ....;
    if ($var3) {
        ...
    }

    for (my $var4 : ...)
}

Will the latter approach lead to more memory allocation and/or
significantly more work
for the garbage collector?

Marko



------------------------------

Date: Tue, 31 Jul 2007 14:04:38 +0100
From: bugbear <bugbear@trim_papermule.co.uk_trim>
Subject: Re: Variable declaration - C vs script style
Message-Id: <46af3366$0$1608$ed2619ec@ptn-nntp-reader02.plus.net>

markoa wrote:
> Hello,
> 
> I've been wondering whether there are any differences in performance
> when declaring variables within loops
> comparing to all forward declarations. I'm mostly writing up to a few
> hundred lines long scripts, but I need
> relatively a lot variables, which look kind of ugly and IMO make the
> script less readable when declared all
> at the top. For example,

I would write for legibility, and worry about
performance only when forced.

If the limiting factor in your script
is the GC'ing of local variables,
you have an unusual script :-)

    BugBear


------------------------------

Date: 6 Apr 2001 21:33:47 GMT (Last modified)
From: Perl-Users-Request@ruby.oce.orst.edu (Perl-Users-Digest Admin) 
Subject: Digest Administrivia (Last modified: 6 Apr 01)
Message-Id: <null>


Administrivia:

#The Perl-Users Digest is a retransmission of the USENET newsgroup
#comp.lang.perl.misc.  For subscription or unsubscription requests, send
#the single line:
#
#	subscribe perl-users
#or:
#	unsubscribe perl-users
#
#to almanac@ruby.oce.orst.edu.  

NOTE: due to the current flood of worm email banging on ruby, the smtp
server on ruby has been shut off until further notice. 

To submit articles to comp.lang.perl.announce, send your article to
clpa@perl.com.

#To request back copies (available for a week or so), send your request
#to almanac@ruby.oce.orst.edu with the command "send perl-users x.y",
#where x is the volume number and y is the issue number.

#For other requests pertaining to the digest, send mail to
#perl-users-request@ruby.oce.orst.edu. Do not waste your time or mine
#sending perl questions to the -request address, I don't have time to
#answer them even if I did know the answer.


------------------------------
End of Perl-Users Digest V11 Issue 703
**************************************


home help back first fref pref prev next nref lref last post