# Tehtävä 2.3            Perl-kurssi 81389-4, Tietojenkäsittelytieteen laitos
# Launo Tuuri                                             Helsingin yliopisto
# Opiskelijanumero 011648671                                       29.11.1999


=head1 NIMI

HistoriaTaulu - alkioittensa aikaisemmat arvot muistavia taulukoita

=head1 KÄYTTÖ

C<tie @arr, "HistoriaTaulu", 1, 100;>

C<$arr[3]='foo'; print $arr[3]; historia(@arr,3,-1);>

=head1 KUVAUS

Kiinteämittaisten taulukoitten - tai taulukon - oliopohjainen
toteutus; alkiot muistavat aikaisemmat arvonsa.

Käyttö on yksinkertaista ja yksinkertaistettua. Huomaa että useat
normaalit taulukkojen toiminteet kuten $#arr, scalar @arr, push, pop,
shift ja unshift I<eivät> ole käytettävissä.

=head2 Käyttöönotto ja luominen

Moduli otetaan käyttöön sijoittamalla skriptin alkupuolelle

    use HistoriaTaulu 'historia';

Uusi taulukko luodaan sitomalla luokka tavalliseen taulukkomuuttujaan,
esim.

    tie @taulukko, "HistoriaTaulu", 0, 19;

mikä muodostaa kaksikymmentäalkioisen taulukon, jonka indeksit ovat
välillä 0...19.

=head2 Operaatiot

=over 0

=item * 

Kirjoitus taulukon alkion viimeisimmäksi arvoksi: S<$tau[8] = 'foo'>

=item *

Taulukon alkion viimeisin arvo: S<tau[8]> I<tai> S<historia(@tau, 8,
0)>

=item *

Taulukon alkion edellistä edeltävä arvo: S<historia(@tau, 8, -2)>

=item *

Taulukon tuhoaminen: S<untie @tau>

=back
    
=head2 Poikkeukset

Yritys kirjoittaa tai lukea yli taulukon rajojen, yritys lukea
historiaa kauemmaksi taaksepäin kuin alkioon on talletettu tai
alustamattoman arvon lukuyritys aiheuttaa ohjelman
keskeytyksen. Virheilmoituksessa palautetaan kutsuvan ohjelman nimi ja
rivinumero.

Mahdollisesti aiheutuvia ongelmia voi ratkaista esim. sijoittamalla
ko. koodi eval-lohkon sisään:

    eval {
	$arvo = historia(@taulukko, 4, -250);
    };            

Mahdollinen virheilmoitus olisi nyt muuttujassa $@

=head1 TEKIJÄ

Launo Tuuri, <lt@iki.fi>

=cut


# Modulin käyttäytymiseen, käyttöön ja myös periytyvyyten vaikuttavaa

package HistoriaTaulu;
use strict;
use Exporter;
use Carp;
use vars ('$VERSION', '@ISA', '@EXPORT_OK');
$VERSION = 0.10;
@ISA = 'Exporter';
@EXPORT_OK = 'historia';


# Luokan ainoa "suoraan käyttöön" tarkoitettu rutiini - funktio

sub historia (\@$$) {
    my ($tau, $i, $hist) = @_;
    my $self = tied @$tau;
    _onkoIndeksi($self, $i);
    my $lkm = scalar @{$self->{$i}};
    _onkoHistoria($self, $i, $hist, $lkm);
    return $self->{$i}->[($lkm-1) + $hist];
}


# Perlin automaattiseti kutsumat funktio ja metodit

sub TIEARRAY {
    my $class = shift;
    my $self = {};
    $self->{_ALA} = shift;
    $self->{_YLA} = shift;
    if ($self->{_ALA} =~ /\D/ || $self->{_YLA} =~ /\D/ ||
	$self->{_ALA} > $self->{_YLA} || @_ ) {
	croak $class, ": Käyttö: tie \@arr, \"$class\", min, max;\n";
    }
    my $i;
    for ($i = $self->{_ALA}; $i <= $self->{_YLA}; $i++) {
	$self->{$i} = [];
    }
    return bless $self, $class;
}

sub FETCH {
    my ($self, $i) = @_;
    _onkoIndeksi($self, $i);
    return $self->{$i}->[-1];
}

sub STORE {
    my ($self, $i, $data) = @_;
    _onkoIndeksi($self, $i);
    push( @{$self->{$i}}, $data );
}


# Luokan sisäiseen käyttöön tarkoitetut apumetodit

sub _onkoIndeksi {
    my ($self, $i) = @_;
    if ($i < $self->{_ALA} || $i > $self->{_YLA}) {
	croak ref($self), ": indeksi $i laiton: taulukon rajat ", 
	      "ovat ($self->{_ALA}, $self->{_YLA})\n"; 
    }
}

sub _onkoHistoria {
    my ($self, $i, $hist, $lkm) = @_;
    if ($lkm) {
	if ($hist > 0 || $hist < -($lkm - 1)) {
	    croak ref($self), ": historia $hist laiton: historian ",
			      "rajat ovat (", -($lkm - 1), ", 0)\n"; 
	}
    } else {
	croak ref($self), ": indeksi $i on alustamaton\n";
    }
}

1;