http://www.perlmonks.org?node_id=965325

ghosh123 has asked for the wisdom of the Perl Monks concerning the following question:

I am having a problem of high memory consumption caused by multiple instances of ItemStyles being created for same confiugration at multiple places in all my derived classes. Let's say I have a base class (B.pm ) which has some derived classes D1.pm, D2.pm , D3.pm etc. Now consider in D1.pm ItemStyle being created at two different places for different style as :

my $style1 = $tree-> ItemStyle ('text', -anchor => 'w', -font => 'Time +s 12',-justify => 'right'); my $style2 = $tree->ItemStyle ('text', -anchor => 'e', -font => 'Couri +er 16' -foreground => 'red', -justify => 'left');

Likewise in all the derived classes (D2,D3 etc) ItemStyle with exactly same combination of parameters and different combinations of parameters are getting created and used multiple times, hence consuming high memory . To get rid of this the idea is to create all the ItemStyles globally and store them in the base class and create one ItemStyle per parameter set. May be we can stringify the parameters and use that as a key in the global hash. Each time we need a ItemStyle in a derived class, then it will call a base class function (say getItemStyle ) with all the parameter set. The base class will sort the parameters, so that the order of mentioning the parameters ( -fg => 'red' , -justify => ' right' OR -justify => 'right', -fg => 'red') does NOT matter and NOT create the ItemStyle twice. If ItemStyle with that passed parameter combination is already present then I will return that and reuse otherwise I will create it once and return. Hope, I could explain my problem clearly. Please help me. Thanks. ghosh

Replies are listed 'Best First'.
Re: ItemStyle causing high memory consumption
by zentara (Archbishop) on Apr 16, 2012 at 15:05 UTC
    Hope, I could explain my problem clearly.

    To make things clear, you really need to post a running example, like make some minimal packages that demonstrate your problem. But that said, I think you may be able to use Tk::option, to affect all packages. See Configure default widget options in Tk for example.


    I'm not really a human, but I play one on earth.
    Old Perl Programmer Haiku ................... flash japh

      Hello zentara, Thanks for replying. A more elaborated exapmle could be like this say in D1.pm :

      my $style1 = $tree-> ItemStyle ('text', -anchor => 'w', -font => 'Time +s 12',-justify => 'right'); $tree->ItemConfigure($self->treeEntryPath, $self->columnNo(), -text => + $result , -style => $style1 )

      Similarly for $style2 in D1.pm

      my $style2 = $tree->ItemStyle ('text', -anchor => 'e', -font => 'Couri +er 16' -foreground => 'red', -justify => 'left'); $tree->ItemConfigure($self->treeEntryPath, $self->columnNo(), -text => + $name , -style => $style2 )

      Posting a running example would be difficult since it is part of big code base. All I need is to program the logic so that in place of $style1 or $style2 , I will call a base class function which will create the itemStyle there once for each parameter set and return it to the derived class. Say from D1.pm, I will call it like :

      $style1 = $baseObject->getItemStyle($tree, 'text',-anchor =>'nw', -fg +=> 'red');

      I need help in programming the logic in the getItemStyle() of base class, so that it can create the ItemStyle widget from the passed parameter and store them in a hash. So that for the same parameter combination later I don't need to create it again. From the hash key-value pair I will get the stored ItemStyle created earlier.

        To be honest, I'm not very agile with object oriented programming , although I can work thru it, if I had code to run. In your case, from reading the description of your classes, it seems that you could define all the ItemStyles in your B base class, if B.pm is derived from Tk::Tree, then make all your D1 , D2, etc. classes as Derived from B. See perldoc Tk::Derived. That way they all inherit the settings. You might want to look at Using the Option Database. Possibly setting the the Option Database is the way to avoid the memory gain problems. Possibly in B.pm you could access the $mw with the SUPER. Something along the lines of
        sub ClassInit { my ($class, $mw) = @_; $class->SUPER::ClassInit($mw); $mw->optionAdd("*tree*font", $text_font); $mw->optionAdd("*tree*foreground", $fgcolor); return $class; }
        I'm sorry I can't help you further, maybe some Object Oriented monk can help you, but I'm totally non-OO in my thinking style. :-)

        I'm not really a human, but I play one on earth.
        Old Perl Programmer Haiku ................... flash japh
Re: ItemStyle causing high memory consumption
by zentara (Archbishop) on Apr 16, 2012 at 21:46 UTC
    Hi, this interested me a bit, so I tried to setup a simple example of the way to get the ItemStyle from a packaged Tree. This seems to work, but I have no idea how your memory gain would be affected, or if it is the problem you are trying to describe. Anyways, can you reformulate your question in terms of this simple example? Is the fact that all the Style objects are different the cause of the memory gain problem you experience? Are you looking for a setup where only 2 ItemStyle objects are created instead of 4?

    Anyways, its a start for other monks who may know more about OO.

    #!/usr/bin/perl use warnings; use strict; use Tk; package ZTree; use base qw(Tk::Derived Tk::Tree); require Tk::ItemStyle; Tk::Widget->Construct('ZTree'); sub ClassInit { my ($class, $mw) = @_; #set the $mw as parent $class->SUPER::ClassInit($mw); } # end ClassInit sub Populate { my ( $self, $args ) = @_; print "@_\n"; $self->SUPER::Populate($args); $self->{'tree'} = $self->Tree(); $self->Advertise( Tree => $self->{'tree'} ); my $tree = $self->{'tree'}; $self->{'red_style'} = $tree->ItemStyle('text', -refwindow => $tree +, -bg => 'red'); $self->{'green_style'} = $tree->ItemStyle('text', -refwindow => $tr +ee, -bg => 'green'); $tree->autosetmode; print "2\n"; } 1; package main; use Tk; my $mw = MainWindow->new; $mw->geometry("400x400"); my $tree = $mw->ZTree( -bg => 'white') ; $tree->add(1, -text => 'abcd', -itemtype => 'text', -style => $tree +->{'red_style'}); $tree->add(2, -text => '1234', -itemtype => 'text', -style => $tree +->{'green_style'}); $tree->pack(-fill=>'both',-expand => 1); my $tree1 = $mw->ZTree( -bg => 'black') ; $tree1->add(1, -text => 'abcd', -itemtype => 'text', -style => $tre +e1->{'red_style'}); $tree1->add(2, -text => '1234', -itemtype => 'text', -style => $tre +e1->{'green_style'}); $tree1->pack(-fill=>'both',-expand => 1); my $button1 = $mw->Button( -text=>'Exit', -command=> sub{exit} )->pack +(); my $button2 = $mw->Button( -text=>'Get Styles', -command=> sub{ my $style1 = $tree->entrycget(1, '-style'); print "$style1\n"; my $style2 = $tree->entrycget(2, '-style'); print "$style2\n"; my $style3 = $tree1->entrycget(1, '-style'); print "$style3\n"; my $style4 = $tree1->entrycget(2, '-style'); print "$style4\n"; } )->pack(); Tk::MainLoop;

    I'm not really a human, but I play one on earth.
    Old Perl Programmer Haiku ................... flash japh