#!/usr/local/bin/perl -w
# sema-demo.pl -- Loest das Erzeuger/Verbraucher-Problem
#           mit Semaphoren und einem Tie::Shareable-Puffer.

use IPC::SysV qw(IPC_PRIVATE IPC_CREAT  S_IRWXU);
use IPC::Semaphore;
use IPC::Shareable;                   # CPAN-Modul

use constant NSLOTS => 5;             # Anzahl der freien Pufferslots
use constant MAXSLEEP_PRODUCER => 5;  # Maximale Schlafzeit Erzeuger
use constant MAXSLEEP_CONSUMER => 5;  # Maximale Schlafzeit Verbraucher

use vars qw($g_elemnr $g_slotnr $g_buffer);  # Globale Variablen
use strict;

# -------- Hauptprogramm ------------------------------------------
my ($mutex, $empty, $full) = initialize();
if (fork()) { producer($mutex,$empty,$full); }
       else { consumer($mutex,$empty,$full); }

sub initialize {
  # Hier werden die Semaphore erzeugt und initialisiert.
  my $mutex  = initialize_semaphore(1);
  my $empty  = initialize_semaphore(NSLOTS);
  my $full   = initialize_semaphore(0);

  return ($mutex, $empty, $full);
}

# -------- Semaphorlogik ------------------------------------------
sub initialize_semaphore {
    my $initvalue = shift;
    my $sem = new IPC::Semaphore(IPC_PRIVATE, 1, S_IRWXU | IPC_CREAT);
    $sem->setall(($initvalue) x 1);
    return $sem;
}

sub P {
    my $sem = shift;
    $sem->op(0, -1, 0);  # 0-tes Semaphor um -1 dekrementieren,
                         # wobei ohne IPC_NOWAIT blockiert wird!
}

sub V {
    my $sem = shift;
    $sem->op(0, +1, 0);  # 0-tes Semaphor um +1 inkrementieren,
                         # wobei ohne IPC_NOWAIT blockiert wird!
}

# -------- Shared-Memory-Logik ------------------------------------
sub initialize_buffer {
    my $nelems = shift;     # Anzahl der Slots im Puffer $g_buffer

    tie $g_buffer, 'IPC::Shareable', 'TEsT',
        { create => 1, mode => 0666 }
        or die "can't tie buffer to shared memory: $!\n";

    $g_buffer = join(':', map { "Slot#$_" } 0 .. $nelems);
    $g_slotnr = $nelems - 1;
}

# -------- Erzeugerlogik ------------------------------------------
sub producer {
  # Das ist der Erzeuger. Er laeuft in einem eigenen Prozess.
  my ($mutex, $empty, $full) = @_;
  P($mutex); initialize_buffer(NSLOTS); V($mutex); # ...$g_buffer
  my $newelem;

  while (1) {
    sleep(rand(MAXSLEEP_PRODUCER));

    $newelem = generate_new_element();

    P($empty);        # Bald ein Slot weniger frei.
      P($mutex);
        store_element($newelem);    # ...in $g_buffer
      V($mutex);
    V($full);         # Jetzt ein Slot mehr belegt.
  }
}

sub generate_new_element {
    print "Producer: Generated(", ++$g_elemnr, ")\n";
    return $g_elemnr;            # Sollte global sein
}

sub store_element {
    my $newelem   = shift;

    my @bufelems = split(/:/, $g_buffer);

    # Suche einen freien Slot von rechts aus, und fuelle ihn.
    # Es ist immer mindestens einer frei, wenn store_element()
    # vom producer() aufgerufen wird!!!
    for (my $i=$#bufelems; $i>=0; $i--) {
    if ($bufelems[$i] =~ /Slot#(\d+)/) {
        # Ein leerer Slot ganz rechts gefunden.
            $bufelems[$i] = $newelem;
            last;
    }
    }
    $g_buffer = join(':', @bufelems);

    print "Producer: New buffer=($g_buffer)\n";
}

# -------- Verbraucherlogik ---------------------------------------
sub consumer {
  # Das ist der Verbraucher. Er laeuft in einem eigenen Prozess.
  my ($mutex, $empty, $full) = @_;
  P($mutex); initialize_buffer(NSLOTS); V($mutex); # ...$g_buffer
  my $newelem;

  while (1) {
    sleep(rand(MAXSLEEP_CONSUMER));

    P($full);         # Bald ein Slot weniger belegt.
      P($mutex);
        $newelem = fetch_element();  # ... aus $g_buffer
      V($mutex);
    V($empty);        # Jetzt ein Slot mehr frei.

    consume_new_element($newelem);
  }
}

sub consume_new_element {
    my $elem = shift;
    print "Consumer:   Fetched($elem)\n";
}

sub fetch_element {
    my @bufelems = split(/:/, $g_buffer);

    # Suche einen gefuellten Slot und leere ihn.
    # Es ist mindestens ein nicht leerer Slot da, wenn der consumer()
    # uns hier aufruft!!! Leere Slots sind links, volle Slots rechts!
    my $elem = pop(@bufelems);                 # Raus damit
    unshift(@bufelems, 'Slot#' . ++$g_slotnr); # Neuer leerer Slot
    $g_buffer = join(':', @bufelems);

    print "Consumer: New buffer=($g_buffer)\n";
    return $elem;
}