perl und fork: parallelisiertes gzip

[hetticom]

Hi!

Ich bräuchte mal eure Hilfe, häng da n bisschen fest (hab auch noch nicht so die tiefen perl-Kenntnisse).

Folgendes Problem: Ich habe ein Skript gebastelt, mit dem ich 5 Dateien parallel mit gzip komprimieren kann. Soweit, so gut. Nun hab ich aber das Problem, dass die Dateien nicht aus dem Array geschoben werden. D.h. wenn 8 Dateien im Array liegen, werden die ersten 5 gezippt, danach müssten dann die restlichen 3 parallel laufen, das Skript versucht aber wieder 5 zu zippen. Das liegt daran, dass meine Subroutine nach dem Zippen die Dateien nicht aus dem Array wirft. Habt ihr dafür ne Lösung? Hier mal die Code-Schnipsel:

# Bestimmung der aeusseren Schleifendurchlaeufe

if (scalar @dateien > $prozesse) {

	$aussen = int(scalar @dateien / $prozesse);

	$aussen++;

}

else {

	$prozesse = scalar @dateien;

}



# Aeussere Schleife. Durchlaeufe: (Anzahl Dateien / Prozessanzahl) + 1

for ($i=1; $i <= $aussen; $i++) {

print "anz: scalar @dateien \t array: @dateien \n";


	if (scalar @dateien < $prozesse) {

		$prozesse = scalar @dateien;

	}

print "prozesse: $prozesse \n";

	# Innere Schleife. Durchlaeufe: Anzahl Prozesse

	for (1..$prozesse) {

		my $pid = fork();

		if ($pid) {

		# parent-Prozess

			push (@children, $pid);

		}

		elsif ($pid == 0) {

			# child-Prozess

			&zipfile;

			exit(0);

		} 

		else { die "couldn't fork: $!\n";  }

	$index++;

	}



foreach (@children) {

	waitpid($_, 0);

}

}	


sub zipfile {

	&timestamp;

	print "Zippe $dateien[$index]\n";

	$rc = system("gzip -N $dateien[$index]");


	if ($rc != 0) {

		&timestamp;

		&print_message ('30001', "$dateien[$index] konnte nicht gezippt werden");


	}

	else {

		&timestamp;

		print "Zippen von Datei $dateien[$index] erfolgreich beendet \n";

		shift (@dateien);		

	}

}


sub timestamp {	

	($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)=localtime(time);

	printf "%02d.%02d.%4d %02d:%02d:%02d\t", $mday,$mon+1,$year+1900,$hour,$min,$sec;

}		



$rc = 0;

Weder das Shiften in der Main-Funktion noch in der Zipfile-Funktion führen zum Erfolg. Es ist sogar egal, ob ich der Zipfile-Funktion das Array übergebe oder nicht. Ergebnis ist immer das gleiche.

Danke!

Christian

[bigvic]

Hi,

benutze doch mal das allerbeste DEBUG-Tool -> print.

else 

{

[B]print @dateien;[/B]

&timestamp;

print "Zippen von Datei $dateien[$index] erfolgreich beendet \n";

shift (@dateien);	

[B]print @dateien;	[/B]

}

Da siehst du recht schnell, ob das shiften klappt.

cu,

vic

[hetticom]

hey,

das mit dem shiften klappt. Aber ich hab folgendes Problem: Return-Codes!

Wenn das Zippen in einem Child-Prozess nicht klappt, soll dieser einen bestimmten Return-Code zurückgeben, damit das ganze Programm mit diesem abgebrochen wird. Aber irgendwie haut das noch nicht so hin wie es soll.

$prozesse = $options{'n'};

@dateien = glob("$options{'p'}/*$options{'f'}*");


if (scalar @dateien < 1) {

	&print_message ('30001', "Keine Dateien gefunden");

	$rc = 10;

	exit $rc;

}


# Bestimmung der aeusseren Schleifendurchlaeufe

if (scalar @dateien > $prozesse) {

	$aussen = int(scalar @dateien / $prozesse);

	$aussen++;

}

else {

	$prozesse = scalar @dateien;

}



# Aeussere Schleife. Durchlaeufe: (Anzahl Dateien / Prozessanzahl) + 1

for ($i=1; $i <= $aussen; $i++) {

	if (scalar @dateien < $prozesse) {

		$prozesse = scalar @dateien;

	}


	# Innere Schleife. Durchlaeufe: Anzahl Prozesse

	for (1..$prozesse) {

		my $pid = fork();

		if ($pid != 0) {

		# parent-Prozess

			push (@children, $pid);

		}

		elsif ($pid == 0) {

			# child-Prozess

			$rc = &zipfile;

			if ($rc == 1) {

				exit(0);

			}

			else {

				$rc = 6;

				exit(6);	

			}


		} 

		else { die "couldn't fork: $!\n";  }

	$index++;

	}



foreach (@children) {

	waitpid($_, 0);

	if ($? != 0){

		exit(6);

	}

}

splice (@dateien,0,$prozesse);

$index = 0;

}


print "rc: $rc \n";


##########################################################################

sub zipfile {								 #

##########################################################################

	&timestamp;

	print "Zippe $dateien[$index]\n";

	$rc = system("gzip -N $dateien[$index]");


	if ($rc != 0) {

		&print_message ('30001', "$dateien[$index] konnte nicht gezippt werden \n");

		return(6);


	}

	else {

		&timestamp;

		print "Zippen von Datei $dateien[$index] erfolgreich beendet \n";		

		return(0);

	}

}


##########################################################################

sub timestamp {								 #

##########################################################################

	($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)=localtime(time);

	printf "%02d.%02d.%4d %02d:%02d:%02d\t", $mday,$mon+1,$year+1900,$hour,$min,$sec;

}

[bigvic]

Hi,

Aber irgendwie haut das noch nicht so hin wie es soll.

das ist keine ausreichende Fehlerbeschreibung.

ciao,

vic

[hetticom]

Hi,

das ist keine ausreichende Fehlerbeschreibung.

ciao,

vic

Ja da hast du leider Recht ... :upps

Hab schon einige Varianten versucht, aber entweder läuft das Skript komplett durch und das "erfolgreich" oder es gibt mir jeden anderen Return-Code raus (meist die 1), nur nicht die "6", die es in dem Fall ausgeben müsste.

Das Problem liegt im elsif-else-Zweig. Da steht zwar ein "exit(6)", wenn das Zippen der Datei nicht funktioniert. Aber der Return-Code wird scheinbar danach noch verändert (von wem weiß ich nicht), sodass am Ende des Skriptes eine "1" ausgegeben wird.

Das is aber auch kompliziert mit diesem fork und den child- und parent-Prozessen. Ich steig da nicht so ganz durch

[hetticom]

hat jemand von euch Ahnung von Interprozesskommunikation? Wie ich mit Pipes und STDIN/STDOUT die Kommunikation hinbekomme?

[bigvic]

Hi,

perlipc - perldoc.perl.org

ciao,

vic