The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.
#!/usr/bin/perl -w
# -*- perl -*-

#
# $Id: 92_concurrent.t,v 1.4 2002/10/20 18:26:06 eserte Exp $
# Author: Slaven Rezic
#

use strict;
use FindBin;

use WE_Sample::Root;
use WE::Util::Support;

BEGIN {
    if (!eval q{
	use Test;
	1;
    }) {
	print "# tests only work with installed Test module\n";
	print "1..1\n";
	print "ok 1\n";
	exit;
    }
}

BEGIN { plan tests => 10 }

my $testdir = "$FindBin::RealBin/test2";
ok(-d $testdir, 1);
ok(-w $testdir, 1);

pipe(RDR,WTR);
my $pid = fork;
if (!defined $pid) {
    die "fork failed";
}
if ($pid == 0) {
    close WTR;
    child();
    exit 0;
}
close RDR;

my $r = new WE::DB -class => 'WE_Sample::Root',
                   -rootdir => $testdir,
                   -locking => 1,
                   -connect => 1;
print WTR "connected to database\n";

ok(ref $r, 'WE_Sample::Root');
my $objdb = $r->ObjDB;
ok(grep { $_ eq 'write' } @{$objdb->DBTieArgs});

ok(ref $objdb, 'WE::DB::Obj');
$r->delete_db_contents;

{
    my $integrity_check = $objdb->check_integrity;
    ok($integrity_check->has_errors, 0, "Integrity check");
    if ($integrity_check->has_errors) {
	require Data::Dumper;
	print STDERR "Line " . __LINE__ . ", File: " . __FILE__ . "\n" .
	    Data::Dumper->new([$integrity_check],[])->Indent(1)->Useqq(1)->Dump;
    }
}

{
    my $integrity_check2 = $r->ContentDB->check_integrity($objdb);
    ok($integrity_check2->has_errors, 0, "Integrity check for ContentDB");
    if ($integrity_check2->has_errors) {
	require Data::Dumper;
	print STDERR "Line " . __LINE__ . ", File: " . __FILE__ . "\n" .
	    Data::Dumper->new([$integrity_check2],[])->Indent(1)->Useqq(1)->Dump;
    }
}

$objdb->create_folder_tree(-standardargs => {-Rights => 'All rights'},
			   -string => <<'EOF');
-Title "Support 1" -Rights "No rights" -Name norights
 -Title "Support 1/1"
  -Title "Support 1/1/1"
 -Title "Support 1/2"
-Title "Support 2" -Name support2_name
 -Title "Support 2/1" -Name support21_name
  -Title "Support 2/1/1" -Name support211_name
   -Title "Support 2/1/1/1" -Name support2111_name
  -Title "Support 2/1/2"
   -Title "Support 2/1/2/1" -Release_State norel
   -Title "Support 2/1/2/2" -Name support2122_name
 -Title "Support 2/2"
  -Title "Support 2/2/1"
 -Title "en:Support english 2/3" "de:Support german 2/3"
 -Title "xxx:Support 2/4 no lang"
 -Title "de:Support german 2/5" "en:Support english 2/5" -Name anothername
 -Title "Support 2/6"
EOF

# why is this necessary?
$objdb->disconnect;
$r->NameDB->disconnect;
print WTR "disconnected from database\n";
close WTR;

my $support2_name_id = $objdb->name_to_objid("support2_name");

for(1..100) {
    $objdb->insert_doc(-parent => $support2_name_id,
		       -content => "Parent $_",
		       -Title => "parent $_",
		      );
}

waitpid($pid, 0);
ok($?, 0, "Child returned with non-zero value");

{
    my $integrity_check = $objdb->check_integrity;
    ok($integrity_check->has_errors, 0, "Integrity check");
    if ($integrity_check->has_errors) {
	require Data::Dumper;
	print STDERR "Line " . __LINE__ . ", File: " . __FILE__ . "\n" .
	    Data::Dumper->new([$integrity_check],[])->Indent(1)->Useqq(1)->Dump;
    }
}

{
    my $integrity_check2 = $r->ContentDB->check_integrity($objdb);
    ok($integrity_check2->has_errors, 0, "Integrity check for ContentDB");
    if ($integrity_check2->has_errors) {
	require Data::Dumper;
	print STDERR "Line " . __LINE__ . ", File: " . __FILE__ . "\n" .
	    Data::Dumper->new([$integrity_check2],[])->Indent(1)->Useqq(1)->Dump;
    }
}

sub child {
    scalar <RDR>; # wait for "connected" message from parent
    scalar <RDR>; # wait from "disconnected" message from parent
    close RDR;

    my $r = new WE::DB -class => 'WE_Sample::Root',
	               -rootdir => $testdir,
                       -locking => 1,
                       -connect => 0;
    my $objdb = $r->ObjDB;

    my $support2_name_id = $objdb->name_to_objid("support2_name");
    die "Can't find object with name support2_name in database"
	if !defined $support2_name_id;

    for(1..100) {
	$objdb->insert_doc(-parent => $support2_name_id,
			   -content => "Child $_",
			   -Title => "child $_",
			  );
    }
}

__END__