1. kod klasy, zapisany w obiektowej wersji PERLa
2. pliki z wersjami językowymi użytych etykiet
3. pliki z wersjami językowymi pomocy

package Users;

#begin graph definiction
package TCount_UserGrapher;
use strict;
use Carp;	#for errors displaying
use Misc;	#misc linuxstat procedures
use Lstatobj; #primary object definiction

use vars qw ( @ISA );
@ISA = qw ( TADVGrapher ); #inherited form TADVGrapher

##### constructor ##################
sub new {
 my $proto = shift;
 my $class = ref ($proto) || $proto;
 my $self = $class -> SUPER::new (); #run inherited constructor

 LoadLangData ('','count_users'); #load dictionary values
#tutaj zostaną załadowane etykietki dla stałych tekstowych używanych na wykresie
 
#count_users to nazwa pliku umieszczonego w etc/templates/standard, w rożnych 
#wersjach językowych (pl i en)

 #setting default values
 $self -> {'TITLE_TAG'} = 'COUNTUSERS_DEFTITLE'; #default title
#tu właśnie przykład użycia załadowanej etykietki.

 $self -> {'BAR'} = 1; # 1 for user bar select
#parametr BAR decyduje, czy wykres może używać słupków(1), czy tylko linii(0)
 $self -> {'VERTICAL_LABEL'} =$dict {'USERS_VLABEL'}; #vertical label
#pionowa etykieta wykresu
 $self -> {'DS_TYPE'} = 'GAUGE'; #data source type
#typ źródła danych wykresu, zgodnie z dokumentacją RRDTool
 
#GAUGE - dla danych które pokazują aktualny stan wartości
#COUNTER - dla danych które rosną np. liczniki przesłanych bajtów

 $self->{'NO_INSERT'} = 1; #this graph can not  delete and insert new adv properties
#NO_INSERT zabezpiecza przed dodawaniem przez uzytkownika nowych lini lub słupków do wykresu
#0 - tylko pozycje zdefioniowane w kodzie
#1 - uzytkownik może dodawać nowe pozycje

 $self -> {'ADV_DESC'} = {name => '', desc => '', size => 0, maxsize => 0};#setting for edit
#struktura opisująca dane podczas edycji zaawansowanych właściwości

 $self->{'SHOW_TABLE_DATA'} = [(0,1,1,1,1)]; #define whitch columns can display

 $self -> {'HAS_INFO'} = 1; #this object has additional info
#wartość 1 dla HAS_INFO oznacza, że wykres posiada 
 
#dodatkowe informacje (ikonka INFO), które należy 
#oprogramować w metodzie Info
 $self -> {'HELP_FILE'} = 'users.html'; #set help file
#nazwa pliku HTML w dokumentacji, który ma się wyświetlić po naciśnięciu przycisku HELP
 
#umieszczony jest on w katlogu www/doc, z podzialem na wersje językowe
 $dict {'TABLE_DESC'} = $dict {'USERS_TABLE'}; #table description
#nagłówek tabelki z danymi na wykresie

 bless ($self, $class);
 return $self;
}

#fill data on new objects
#to jest metoda, która wywoływana jest podczas tworzenia nowego wykresu
#jej zadaniem jest ustawienie domyślnych wartości dla wykresu

sub OnNew {
 my $self = shift;
 my @ADV_DATA;
 my %row;
#%row opisuje wartości początkowe dla pojednyńczej lini/słupka na wykresie
 #first field
 $row {'COLOR'} = ''; #add color field
#COLOR - kolor w formacie RGB lub domyslny, jeżeli to pole jest puste
 $row {'DESC'} = $dict {'LOGGED'}; #add graph label form dictionary
#DESC - to opis, który zostanie umieszczony w legendzie wykresu
 
#widać, tu użycie etykietki, załadowanej z pliku count_users
 $row {'BAR'} = 1; #draw as bar
#BAR: 1 rysuj jako słupek, 0 jako linię
 push (@ADV_DATA, { %row } ); #store

#domyślne wartości dla drugiej linii
 $row {'COLOR'} = ''; #add color field
 $row {'DESC'} = $dict {'UNIQUE_LOGGED'}; #add graph label
 $row {'BAR'} = 0; #draw as line
 push (@ADV_DATA, { %row } ); #store

 $self -> {'DESC'}{'ADV'} = [ @ADV_DATA ] ; #reference to object info
}

#update values in RRD file
#ta metoda służy do zebrania danych dla wykresu
#wywoływana jest z prawami roota, co pewien, ustalony czas
#dla wykresów LIVE może to byc nawet co kilka sekund
#jej wykonanie powinno trwać krótko, aby nie zakłócać aktualizacji 
#pozostałych wykresów
#UWAGA: Po każdej zmiane kodu tej metody należy ponownie uruchomić service lstatd!!!

sub Update_Object {
 my $self = shift;
 my $start=time;

 #grab users command output
 my $users_com = $sysconfig{'USERS'}; #patch to users command
#sysconfig to tablica, w której znajduje się zawartość pliku etc/config
 
#jest on uzywany to przechowywania informacji o ścieżkach do poleceń i plików
#i innych krytycznych parametrów, które może zmieniać tylko root
#jest on aktalizowany podczas instalacji lub ręcznie przez uzytkownika 

#w tym przypadku pobieramy pełną ścieżkę do pliku /usr/bin/users
 if ( -x $users_com ) {
 my $users = `$users_com 2>&1`;

 #move user name to array
 chomp ($users);
 my @u_array = split (/\s/, $users);
 my $total=@u_array;

 #find unique
 my %uniq;
 foreach my $u (@u_array) {
 $uniq {$u} = 1 if (! exists ($uniq {$u}));
  }
 my $unique_users = keys %uniq;

#zadaniem metody Update_Object jest zwrócenie pojedyńczej linijki, gdzie maja się znaleźć
 
#aktualne wartości danych na wykresie, poprzedone czasem, w którym zostały zebrane
 
#wartości należy rozdzielić znakiem :
#liczba zwracanych danych musi być zgodna z liczbą prezentowanych danych
 $start .=":$total:$unique_users"; #add to timestamp
 }
 return ($start);
}

#to jest dodatkowa metoda, która jest wywoływana gdy użytkownik naciśnie ikonkę INFO na wykresie
#jej zadaniem jest wyprowadzenie informacji w formacie HTML
#nie zostranie uruchomiona w przypadku, gdy wykres nie posiada 
 
#dodatkowych informacji (zob. konstruktor)
 
# lub gdy w parametrach globalnych jest zablokowana możliwość wyświetlania doadatkowych informacji

sub Info { #additional info
 my $self = shift;
 my $to_run = $sysconfig {'W'}; #get w command
 if ( -x $to_run) {
 my @content;
 eval {
 $to_run .=' -h'; #additional switches
 open (FILE,"$to_run 2>&1 |") && (@content=<FILE>) && (close FILE);
 }; #end eval
 if (!$@){
  print "<TABLE BORDER=1 BORDERCOLOR=black CELLSPACING=0 CELLPADDING=5>\n";
  unshift (@content, ' USER TTY FROM LOGIN@ IDLE JCPU PCPU WHAT');
  my $color='yellow';
  foreach my $line (@content) {
   chomp ($line);
   $line =~ s/^\s+//;
   my @data = split (/\s+/, $line,8);
   print "<TR BGCOLOR=$color>";
   foreach my $d (@data) {
    print "<TD>$d</TD>\n";
   }
   print "</TR>";
   $color='white';
  }
  print "</TABLE>\n";
 }
}
}
## END class definition ###

use Misc;
#kod poniżej służy do rejestracji wykresu, który został oprogramowany wyżej
 
#dopiero po jego wykonaniu będzie możliwe korzystanie z wykresu

BEGIN {
 #register all graphs from this package

 RegisterClass ('TCount_UserGrapher', '','count_users','COUNTUSERS_DESC',
 sub  { my $obj;  $obj = TCount_UserGrapher -> new ();  return ($obj); } );
#jako parametry RegisterClass należy użyć:
# - nazwÄ™ utworzonej klasy, 
# - katalog gdzie znajdujÄ… siÄ™ pliki z etykietkami lub pusty jezeli standard
#  lub np. plugins
# - nazwa pliku z etykietkami
# - nazwa etykietki opisujÄ…cej te wykres
# - kod, który ma być wykonany, aby utworzyć obiekt
}