5
Use of uninitialized value in numeric ne (!=) at ObjectMonitor.pm line 76.
Use of uninitialized value in numeric ne (!=) at ObjectMonitor.pm line 76.
Use of uninitialized value in numeric ne (!=) at ObjectMonitor.pm line 76.
Use of uninitialized value in numeric ne (!=) at ObjectMonitor.pm line 76.
Use of uninitialized value in numeric ne (!=) at ObjectMonitor.pm line 76.
4
DESTROYED !
Use of uninitialized value in subroutine entry at /usr/local/lib/perl/5.10.0/IPC/ShareLite.pm line 304 during global destruction.
        (in cleanup) IPC::ShareLite::read_share: share is not of type SharePtr at /usr/local/lib/perl/5.10.0/IPC/ShareLite.pm line 304 during global destruction.
Use of uninitialized value in subroutine entry at /usr/local/lib/perl/5.10.0/IPC/ShareLite.pm line 304 during global destruction.

##</code><code>##

IPC::ShareLite=HASH(0x9472760)
DESTROYED
IPC::ShareLite=HASH(0x948e240)
Use of uninitialized value in subroutine entry at /usr/local/lib/perl/5.10.0/IPC/ShareLite.pm line 304 during global destruction.
        (in cleanup) IPC::ShareLite::read_share: share is not of type SharePtr at /usr/local/lib/perl/5.10.0/IPC/ShareLite.pm line 304 during global destruction.
IPC::ShareLite=HASH(0x95ae458)
DESTROYED
IPC::ShareLite=HASH(0x95b2338)
DESTROYED
Use of uninitialized value in say at bugreport.pl line 45 during global destruction.

        (in cleanup) Can't call method "fetch" on an undefined value at bugreport.pl line 46 during global destruction.


##</code><code>##




package Test123;
use strict;
use warnings;
use IPC::ShareLite;
use Storable qw/ freeze thaw /;
use Data::Dumper;
use feature 'say';
sub new {
    my ($class,$key) = @_;
    my $shared=undef;
    eval {
	$shared=IPC::ShareLite->new(
	    -key     => $key,
	    -create  => 'no',
	    -destroy => 'no'
	);
	say Dumper @{thaw($shared->fetch)};
	say "old";
    };
    unless($shared){
	$shared=IPC::ShareLite->new(
	    -key     => $key,
	    -create  => 'yes',
	    -destroy => 'no'
	);
	my @d;
	push @d,{
	    stuff => 'aaaaa',
	} for 0..1;
	$shared->store(freeze(\@d));
	say "new";
    };
    say $shared->key();
    return bless {
	blah  => $$,
	shared=> $shared
    },$class;
}

sub DESTROY {
    my ($self)=@_;
    say $self->{shared};
    my @data= @{ thaw( $self->{shared}->fetch ) };
    #say Dumper \@data;
    say "DESTROYED";
}

package main;
use feature 'say';
use strict;
use warnings;
my @a;
use constant KEY_ID =>6119;
sub f {
    my $b = Test123->new(KEY_ID);
    push @a, Test123->new(KEY_ID) for 0..3;
};

f();


##</code><code>##

=begin
the goal of this module is for us to have a way of keeping track of objects
accross processes
=cut

#using ipcs command in linux to see shared memory segments and shared semaphores
#ipcrm deletes those shared structures
package ObjectMonitor; #monitors all instances of objects over multiple processes

use strict;
use warnings;
use feature 'say';
use Data::Dumper;
use IPC::ShareLite;
use Storable qw/ freeze thaw /;

my $newcall=0;

sub new {
    my($class,$key_id) = @_;
    say 'call:'.++$newcall;
    my $shared=undef;
    my $just_created=0;
    my $self;
    my @data;
    eval {
	say "ALREADY";
	$shared = IPC::ShareLite->new(
	    -key     => $key_id,
	    -create  => 'no',
	    -destroy => 'no'
	);
	@data = @{ thaw( $shared->fetch() )  };
	push @data,{
	    id => $data[-1]->{id}+1,
	    pid=> $$,
	};
	$shared->store(freeze(\@data));
    };
    unless($shared) {
	say "NEW SHARED!";
	$shared = IPC::ShareLite->new(
	    -key     => $key_id,
	    -create  => 'yes',
	    -destroy => 'no'
	);
	push @data,{
	    id => 0,
	    pid=> $$,
	};
	$shared->store(freeze(\@data));
	$just_created=1;
    };

    $self->{key_id}= $key_id;
    $self->{shared}= $shared;
    #say Dumper \@data;
    #$self->{cross_process_id}=$data[-1];

    return bless($self , $class);
}

sub print_ids {
    my($self) = @_;
    my @data = @{ thaw($self->{shared}->fetch) };
    #say Dumper \@data;
}


sub DESTROY {
    my ($self) = @_;
    return unless $self->{shared};
    my $cross_id = $self->{cross_process_id};
    my @data =  @{ thaw( $self->{shared}->fetch ) };
    say scalar @data;
    @data = grep{ $_->{id} != $self->{cross_process_id}  } @data;
    $self->{shared}->store(freeze(\@data));
    say scalar @data;
    say "DESTROYED !";
}

1;


##</code><code>##


use ObjectMonitor;
use Data::Dumper;
use feature 'say';


use constant KEYID => 2434;
my @a;

sub f(){
    my $b = ObjectMonitor->new(KEYID);
#    $b->print_ids();

    push @a,ObjectMonitor->new(KEYID) for 0..3;
};

f();