PROGRAM BIBLIOTHEQUE; SIGNAL Del_Rec_Inexistant, Key_AlReady_In_Index, TreeHeight_Overflow, Signal11, Signal12, Signal14; (*-------------------------------------------------*) (* MODULE de GESTION des FICHIERS de l'application *) (*-------------------------------------------------*) UNIT FileSystem: CLASS; (*-----------------------------------------------------------*) (* CLASSE representant la FILE des FICHIERS de l'application *) (*-----------------------------------------------------------*) UNIT RFile: CLASS; VAR Name: ARRAYOF CHAR, Opened: BOOLEAN, RecLen, Position, Length: INTEGER, Fichier: file, Next, Prev: RFile END RFile; VAR System: RFile; (* FICHIER manipule lors des differentes operations *) (*-----------------------------------------------------------*) (* RECHERCHE d'un FICHIER dans les FICHIERS de l'APPLICATION *) (*-----------------------------------------------------------*) UNIT FindInSystem : FUNCTION(Name:ARRAYOF CHAR): RFile; (*-------------------------------------------*) (* COMPARAISON de deux CHAINES de caracteres *) (*-------------------------------------------*) UNIT EqualString: FUNCTION(chaine1, chaine2: ARRAYOF CHAR):BOOLEAN; VAR i1, i2, len, i: INTEGER; BEGIN IF (chaine1 = NONE) OR (chaine2 = NONE) THEN writeln("Un parametre est egal a NONE dans EqualString"); CALL ENDRUN (* ARRET du programme *) FI; i1 := LOWER(chaine1); i2 := LOWER(chaine2); len := UPPER(chaine1) - i1 + 1; IF len =/= UPPER(chaine2) - i2 + 1 THEN RETURN (* Chaines de longueurs differentes *) FI; FOR i := 1 TO len DO IF chaine1(i1) =/= chaine2(i2) THEN RETURN (* Chaines differentes *) FI; i1 := i1 + 1; i2 := i2 + 1 OD; (* Si on arrive la les chaines sont egales *) RESULT := TRUE END EqualString; VAR df :RFile; BEGIN System.Name := Name; df := System.Next; WHILE NOT EqualString(Name,df.Name) DO df := df.Next OD; IF (df = System) THEN RESULT := NONE ELSE RESULT := df FI; END FindInSystem; (*-------------------------------------------*) (* AJOUT d'un Fichier a la FILE des FICHIERS *) (*-------------------------------------------*) UNIT AddToSystem: FUNCTION(Name: ARRAYOF CHAR): RFile; BEGIN RESULT := NEW RFile; RESULT.Name := Name; RESULT.Next := System.Next; RESULT.Prev := System; System.Next.Prev := RESULT; System.Next := RESULT; END AddToSystem; (*----------------------------------------------*) (* SUPPRIMER un FICHIER de la FILE des FICHIERS *) (*----------------------------------------------*) UNIT DeleteFromSystem: PROCEDURE(df:RFile); BEGIN IF df = System THEN RETURN FI; df.Next.Prev := df.Prev; df.Prev.Next := df.Next END DeleteFromSystem; (*-------------------------------------------------------------------------*) (* CALCUL de la LONGUEUR d'un Fichier exprime en nombres d'enregistrements *) (*-------------------------------------------------------------------------*) UNIT FindFileLength: FUNCTION(df :file, RecLen :INTEGER) :INTEGER; VAR record: ARRAYOF INTEGER, i:INTEGER; BEGIN IF df = NONE THEN writeln("ERREUR FindFileLength : Fichier inexistant"); RETURN; FI; RESULT := 1; CALL RESET(df); ARRAY record DIM (1:RecLen); i := RecLen*INTSIZE; DO GETREC(df,record,i); IF i =/= RecLen*INTSIZE THEN EXIT FI; RESULT := RESULT + 1; OD; END FindFileLength; (*-----------------------------------------------------------------------*) (* CREATION d'un nouveau FICHIER et insertion de ce Fichier dans la FILE *) (* le Fichier est ouvert est sa longueur est egal a 1 *) (*-----------------------------------------------------------------------*) UNIT MakeFile: FUNCTION(Name: ARRAYOF CHAR, RecLen: INTEGER): RFile; BEGIN IF FindInSystem(Name) =/= NONE THEN writeln("ERREUR MakeFile : Fichier existant"); FI; IF RecLen <= 0 THEN writeln("ERREUR MakeFile : Longueur de Fichier doit etre positive"); FI; RESULT := AddToSystem(Name); RESULT.Opened := TRUE; RESULT.RecLen := RecLen; RESULT.Position := 1; RESULT.Length := 1; OPEN(RESULT.Fichier, direct, Name); CALL REWRITE(RESULT.Fichier); END MakeFile; (*------------------------------------------------------------------*) (* OUVRIR un Fichier deja present dans la FILE des FICHIERS *) (* ou AJOUT de ce FICHIER a la FILE si il n'y est pas. *) (*------------------------------------------------------------------*) UNIT OpenFile: FUNCTION(Name: ARRAYOF CHAR, RecLen: INTEGER): RFile; BEGIN IF RecLen <= 0 THEN writeln("ERREUR OpenFile : La longueur d'enregistrement doit etre positive"); FI; RESULT := FindInSystem(Name); IF RESULT = NONE THEN RESULT := AddToSystem(Name) FI; RESULT.Opened := TRUE; RESULT.RecLen := RecLen; RESULT.Position := 1; OPEN(RESULT.Fichier,direct,Name); RESULT.Length := FindFileLength(RESULT.Fichier,RecLen); IF RESULT.Length = 1 THEN CALL REWRITE(RESULT.Fichier) (* Le FICHIER est VIDE *) ELSE CALL RESET(RESULT.Fichier) FI; (* Le FICHIER n'est pas VIDE *) END OpenFile; (*--------------------------------------------*) (* FERMETURE d'un fichier ouvert par OpenFile *) (*--------------------------------------------*) UNIT CloseFile: PROCEDURE (df :RFile); BEGIN IF df = NONE THEN writeln("ERREUR CloseFile : Fichier inexistant"); FI; IF NOT df.Opened THEN writeln("ERREUR CloseFile : Fermeture d'un fichier pas ouvert"); FI; df. Opened := FALSE; KILL(df.fichier) END CloseFile; (*-------------------------------*) (* TEST si un FICHIER est OUVERT *) (*-------------------------------*) UNIT IsOpen: FUNCTION(df :RFile) :BOOLEAN; BEGIN IF df = NONE THEN writeln("ERREUR IsOpen : Fichier inexistant"); FI; RESULT := df.Opened END IsOpen; (*----------------------------------------------------*) (* MISE a 1 de la POSITION de LECTURE dans le FICHIER *) (*----------------------------------------------------*) UNIT Frewind: PROCEDURE(df :RFile); BEGIN IF df = NONE THEN writeln("Frewind : Fichier inexistant"); FI; IF NOT df.Opened THEN writeln("Frewind : Fichier pas ouvert"); FI; df.Position := 1; CALL RESET(df.Fichier) END Frewind; (*----------------------------------*) (* TEST si on est en fin de FICHIER *) (*----------------------------------*) UNIT Feof: FUNCTION(df: RFile): BOOLEAN; BEGIN IF df = NONE THEN writeln("Feof : Fichier inexistant"); FI; IF NOT df.Opened THEN writeln("Feof : Fichier pas ouvert"); FI; RESULT := ( df.Position >= df.Length ) END Feof; (*----------------------------------------------*) (* ECRITURE d'un enregistrement dans le fichier *) (*----------------------------------------------*) UNIT Fput: PROCEDURE(df :RFile, Record :ARRAYOF INTEGER); VAR nbint, i : INTEGER; BEGIN IF df = NONE THEN writeln("ERREUR Fput : Fichier inexistant"); CALL ENDRUN; (* FIN du PROGRAMME *) FI; IF NOT df.Opened THEN writeln("ERREUR Fput : Fichier pas ouvert"); FI; IF df.Position > df.Length THEN writeln("ERREUR Fput : Tentative d'acces apres la fin de fichier"); FI; IF Record = NONE THEN writeln("ERREUR Fput : Enregistrement inexistant"); FI; nbint := UPPER(Record) - LOWER(Record) + 1; IF nbint =/= df.RecLen THEN writeln("ERREUR Fput : Taille enregistrement incorrect") FI; i := nbint * intsize; PUTREC(df.Fichier, Record, i); IF i =/= nbint * intsize THEN writeln("ERREUR Fput : ERREUR durant l'ecriture") FI; (* MODIFICATION de la POSITION de LECTURE du FICHIER et de la LONGUEUR eventuellement du FICHIER *) df.Position := df.Position + 1; IF df.Position > df.Length THEN df.Length := df.Position FI; END Fput; (*---------------------------------------------*) (* LECTURE d'un ENREGISTREMENT dans le FICHIER *) (*---------------------------------------------*) UNIT Fget: FUNCTION(df :RFile): ARRAYOF INTEGER; VAR Record: ARRAYOF INTEGER, nbint, i : INTEGER; BEGIN IF df = NONE THEN writeln("ERREUR Fget : Fichier inexistant"); FI; IF NOT df.Opened THEN writeln("ERREUR Fget : Fichier pas ouvert"); FI; IF df.Position >= df.Length THEN writeln("ERREUR Fget : Tentative lecture apres la fin de fichier"); FI; nbint := df.RecLen; ARRAY Record dim (1:nbint); i := nbint * intsize; GETREC(df.Fichier, Record, i); IF i =/= nbint * intsize THEN writeln("ERREUR Fget : Erreur durant la lecture"); FI; df.Position := df.Position + 1; RESULT := Record; END Fget; (*------------------------------------------------------------------------*) (* DEPLACEMENT dans le fichier a la Position du NUMRECieme ENREGISTREMENT *) (*------------------------------------------------------------------------*) UNIT Fseek: PROCEDURE(df :RFile, numrec :INTEGER); VAR offset: INTEGER; BEGIN IF df = NONE THEN writeln("ERREUR Fseek : Fichier inexistant"); FI; IF NOT df.Opened THEN writeln("ERREUR Fseek : Fichier non ouvert"); FI; IF numrec <= 0 THEN writeln("ERREUR Fseek : Numero de record doit etre positif"); FI; IF numrec > df.Length THEN writeln("ERREUR Fseek : Tentative d'acces apres la fin de fichier"); FI; df.Position := numrec; offset := (numrec - 1) * df.RecLen * intsize; CALL seek(df.Fichier, offset, 0) END Fseek; (*-------------------------------------------------------*) (* INDIQUE la POSITION COURANTE dans le FICHIER specifie *) (*-------------------------------------------------------*) UNIT Position: FUNCTION(df :RFile) :INTEGER; BEGIN IF df = NONE THEN writeln("ERREUR Position : Fichier inexistant") FI; IF NOT df.Opened THEN writeln("ERREUR Position : Fichier pas ouvert") FI; RESULT := df.Position END Position; (*-----------------------------------------*) (* INDIQUE la LONGUEUR du FICHIER specifie *) (*-----------------------------------------*) UNIT FileLen: FUNCTION(df :RFile) :INTEGER; BEGIN IF df = NONE THEN writeln("ERREUR FileLen : Fichier inexistant") FI; IF NOT df.Opened THEN writeln("ERREUR FileLen : Fichier pas ouvert") FI; RESULT := df.Length END FileLen; BEGIN (* FileSystem *) System := NEW RFile; System.Next, System.Prev := System; END FileSystem; (*------------------------------------------------------*) (* MODULE contenant la declaration d'une BASE de DONNEE *) (* c.a.d. : RELATION, FICHIER DONNEES, FICHIER INDEX *) (*------------------------------------------------------*) UNIT HandlerOfRelations:FileSystem CLASS(PageSize, TreeHeight, HalfPageSize : INTEGER); (*-----------------------------------------------------*) (* MODULE GENERIQUE d'un FICHIER de DONNEES de la BASE *) (*-----------------------------------------------------*) UNIT DataFile :CLASS; VAR df :RFile; (* DESCRIPTEUR du FICHIER *) VAR FreePlace:INTEGER; (* POSITION du dernier EMPLACEMENT LIBRE *) (*-----------------------------------------------------------*) (* DEPLACEMENT de la POSITION de LECTURE du fichier au DEBUT *) (*-----------------------------------------------------------*) UNIT Reset:PROCEDURE; BEGIN CALL Fseek(df,1) END Reset; (*-------------------------------------------------*) (* AJOUT au fichier de DONNEES d'un enregistrement *) (*-------------------------------------------------*) UNIT AddRec : PROCEDURE(Rec :ARRAYOF INTEGER;OUTPUT DataRef :INTEGER); VAR AuxRec: ARRAYOF INTEGER; (* Tableau auxiliaire pour lire la Position du nouvel emplacement libre *) BEGIN IF FreePlace=0 THEN (* AJOUT en FIN de fFICHIER *) DataRef:=FileLen(df); ELSE (* AJOUT a l'EMPLACEMENT LIBRE *) DataRef:=FreePlace; CALL Fseek(df,DataRef); ARRAY AuxRec dim(LOWER(Rec):UPPER(Rec)); AuxRec:=Fget(df); FreePlace:=AuxRec(1); (* NOUVEL EMPLACEMENT LIBRE *) FI; (* ECRITURE de l'enregistrement *) CALL Fseek(df,DataRef); CALL Fput(df,Rec) END AddRec; (*-------------------------------------------------------*) (* SUPPRESSION du fichier de DONNEES d'un enregistrement *) (*-------------------------------------------------------*) UNIT DelRec: PROCEDURE(DataRef :INTEGER); VAR AuxRec: ARRAYOF INTEGER; BEGIN CALL Fseek(df,DataRef); ARRAY AuxRec dim (1:df.RecLen); AuxRec(1):=FreePlace; CALL Fput(df,AuxRec); FreePlace:=DataRef (* NOUVEL EMPLACEMENT LIBRE *) END DelRec; (*--------------------------------------------------------------*) (* RECHERCHE d'un ENREGISTREMENT dans le FICHIER de DONNEES *) (* renvoie sa Position dans le fichier ou -1 si il n'y est pas. *) (*--------------------------------------------------------------*) UNIT FindRec:PROCEDURE(Rec :ARRAYOF INTEGER;OUTPUT DataRef :INTEGER); VAR AuxRec: ARRAYOF INTEGER, i, Place: INTEGER, trouve : BOOLEAN; BEGIN ARRAY AuxRec DIM(LOWER(Rec):UPPER(Rec)); CALL Reset; WHILE (NOT Feof(df) AND NOT trouve) DO DataRef := Position(df); AuxRec:= Fget(df); FOR i:=LOWER(AuxRec) TO UPPER(AuxRec) DO trouve := (AuxRec(i)=Rec(i)); IF NOT trouve THEN EXIT FI OD; IF (trouve AND FreePlace <> 0) THEN (* RECHERCHE SI ce n'est pas un enregistrement EFFACE qui correspond au tuple *) Place:=FreePlace; WHILE NOT Place=0 (* POUR CHAQUE emplacement LIBRE *) DO IF DataRef = Place THEN trouve := FALSE; EXIT ELSE CALL Fseek(df,Place); AuxRec:=Fget(df); Place:=AuxRec(1) FI OD; (* REPOSITIONNEMENT TETE de LECTURE *) CALL Fseek(df,DataRef+df.RecLen) FI OD; IF NOT trouve THEN (* L'ENREGISTREMENT n'est pas dans le FICHIER *) DataRef:=-1 FI; END FindRec; BEGIN FreePlace:=0 (* AUCUN EMPLACEMENT LIBRE a la creation *) END DataFile; (*-------------------------------------------------------*) (* MODULE GENERIQUE d'une relation de la BASE DE DONNEES *) (*-------------------------------------------------------*) UNIT Relation : DataFile CLASS ; VAR Indexs :ARRAYOF IndexFile; (* Tableau des INDEXs lies au fichier de donnees *) (*---------------------------------*) (* CLASSE generique d'une RELATION *) (*---------------------------------*) UNIT Tuple : CLASS; END Tuple; (*-------------------------------------------------------*) (* FONCTION GENERIQUE de conversion d'une relation en *) (* TABLEAU d'ENTIERS pour la sauvegarde dans un fichier. *) (*-------------------------------------------------------*) UNIT VIRTUAL TupleToArray:FUNCTION(T: Tuple):ARRAYOF INTEGER; BEGIN END TupleToArray; (*---------------------------------------------------------*) (* FONCTION GENERIQUE de conversion d'un tableau d'entiers *) (* en objet de type TUPLE. *) (*---------------------------------------------------------*) UNIT VIRTUAL ArrayToTuple : FUNCTION(A :ARRAYOF INTEGER):Tuple; END ArrayToTuple; (*--------------------------------------------*) (* INSERTION d'un TUPLE au FICHIER de DONNEES *) (*--------------------------------------------*) UNIT InsertTuple :PROCEDURE(T: Tuple); VAR AuxRec : ARRAYOF INTEGER, i,DataRef:INTEGER; BEGIN AuxRec := TupleToArray(T); (* AJOUT au FICHIER de DONNEES *) CALL AddRec(AuxRec,DataRef); IF Indexs <> NONE THEN (* Pour chaque INDEX lie a la RELATION *) (* MISE a JOUR *) FOR i:=1 TO UPPER(Indexs) DO IF Indexs(i)<>NONE THEN (* AJOUT d'une NOUVELLE CLE *) CALL Indexs(i).AddKey(Indexs(i).KeyOf(T),DataRef) FI OD FI; END InsertTuple; (*----------------------------------------------*) (* SUPPRESSION d'un TUPLE du FICHIER de DONNEES *) (*----------------------------------------------*) UNIT DeleteTuple :PROCEDURE(T: Tuple); VAR AuxRec :ARRAYOF INTEGER, i,DataRef :INTEGER; BEGIN (* RECHERCHE de la POSITION du tuple dans la BASE a partir *) (* de l'INDEX PRIMAIRE Indexs(1). *) DataRef := Indexs(1).FindKey(Indexs(1).KeyOf(T)); CALL Indexs(1).DelKey(Indexs(1).KeyOf(T),DataRef); (* LECTURE du TUPLE dans la BASE *) CALL Fseek(df,DataRef); AuxRec := Fget(df); (* SUPRESSION du tuple de la BASE *) CALL DelRec(DataRef); (* SUPPRESSION des differentes CLES dans les autres indexs *) FOR i:=UPPER(Indexs) DOWNTO 2 DO CALL Indexs(i).DelKey(Indexs(i).KeyOf(T),DataRef) OD END DeleteTuple; (*---------------------------------*) (* RECHERCHE d'un TUPLE de la BASE *) (*---------------------------------*) UNIT FindTuple :PROCEDURE(T: Tuple;OUTPUT Position : INTEGER); VAR AuxRec :ARRAYOF INTEGER, i,DataRef :INTEGER; BEGIN AuxRec := TupleToArray(T); CALL FindRec(AuxRec,DataRef); Position := DataRef; END FindTuple; (*-------------------------------------------------------------*) (* MODULE GENERIQUE d'un FICHIER d'INDEX de la BASE de DONNEES *) (* implemente sous forme de B ARBRE. *) (*-------------------------------------------------------------*) UNIT IndexFile:DataFile COROUTINE; (*---------------------------------------------------------------*) (* PAGE contenu dans le B ARBRE est qui est le type des ELEMENTS *) (* SAUVEGARDES sur le FICHIER. *) (*---------------------------------------------------------------*) UNIT Page:CLASS; VAR ItemsOnPage, (* NOMBRES de PAGES FILLES *) LessPageRef :INTEGER, (* POSITION dans le FICHIER de la PAGE des cles INFERIEURES a la PREMIERE cle de celui-ci. *) ItemsArray :ARRAYOF Item; (* TABLEAU des cles contenues dans cette PAGE *) BEGIN ARRAY ItemsArray dim (1:PageSize) END Page; (*-------------------------------------------------------------*) (* FONCTION de CONVERSION d'un enregistrement du FICHIER INDEX *) (* en page du B-arbre correspondant. *) (*-------------------------------------------------------------*) UNIT RecToPage:FUNCTION(A :ARRAYOF INTEGER) :Page; VAR P :Page, It :Item, i, j :INTEGER; BEGIN P:=NEW Page; P.ItemsOnPage,j := A(1); P.LessPageRef := A(2); ARRAY P.ItemsArray dim (1:PageSize); FOR i := 1 TO j DO It := NEW Item; It.ky := RecToKey(A, 3+(i-1)*(KeySize+2) ) ; It.PageRef := A(i*(KeySize+2)+1); It.DataRef := A(i*(KeySize+2)+2); P.ItemsArray(i) := It; OD; RESULT :=P END RecToPage; (*----------------------------------------------------------------*) (* FONCTION de CONVERSION d'une PAGE du B-ARBRE en enregistrement *) (* du FICHIER INDEX correspondant. *) (*----------------------------------------------------------------*) UNIT PageToRec : FUNCTION (P: Page): ARRAYOF INTEGER; VAR AuxRec : ARRAYOF INTEGER, It: Item, i : INTEGER; BEGIN ARRAY AuxRec dim(1:(PageSize*(KeySize+2)+2)); AuxRec(1) := P.ItemsOnPage; AuxRec(2) := P.LessPageRef; FOR i := 1 TO P.ItemsOnPage DO It:=P.ItemsArray(i); CALL KeyToRec(It.ky,AuxRec, 3+(i-1)*(KeySize+2) ); AuxRec(i*(KeySize+2)+1) := It.PageRef; AuxRec(i*(KeySize+2)+2) := It.DataRef; OD; RESULT := AuxRec END PageToRec; UNIT Item : CLASS ; VAR ky: key, (* CLE du tuple concerne *) PageRef, (* POSITION dans le FICHIER INDEX de la PAGE RACINE contenant les CLES SUPERIEURES a ce tuple ci *) DataRef :INTEGER; (* POSITION dans le FICHIER de DONNEES du tuple concerne *) END Item; (*------------------------------------------------------------------*) (* MODULE GENERIQUE de CLE de TUPLE defini ulterieurement dans les *) (* classes heritantes. *) (*------------------------------------------------------------------*) UNIT Key : CLASS; END Key; VAR KeySize : INTEGER; (* Taille de la cle de Items *) (*--------------------------------------*) (* FONCTION GENERIQUE renvoyant pour un *) (* tuple donne la cle correspondante. *) (*--------------------------------------*) UNIT VIRTUAL KeyOf:FUNCTION(t :Tuple) :key; END KeyOf; (*------------------------------------------------------*) (* TEST de COMPARAISON GENERIQUE de deux cles de tuples *) (*------------------------------------------------------*) UNIT VIRTUAL Leq:FUNCTION(key1, key2 :key) :Boolean; END Leq; (*------------------------------------------------------------*) (* FONCTION GENERIQUE de TRANSFORMATION d'une serie d'entiers *) (* en la CLE correspondante. *) (*------------------------------------------------------------*) UNIT VIRTUAL RecToKey : FUNCTION(A :ARRAYOF INTEGER, j :INTEGER) :Key; BEGIN END RecToKey; (*---------------------------------------------------------*) (* FONCTION GENERIQUE de TRANSFORMATION d'une CLE de tuple *) (* en une serie d'entiers. *) (*---------------------------------------------------------*) UNIT VIRTUAL KeyToRec:PROCEDURE(ky :Key, A :ARRAYOF INTEGER, j :INTEGER); BEGIN END KeyToRec; UNIT SearchStep: CLASS; VAR PageRef,RefOnPage : INTEGER, updated : BOOLEAN; END SearchStep; VAR StackOfPages: ARRAYOF Page, (* Pile de Pages *) Finger: INTEGER, (* Indice *) Path: ARRAYOF SearchStep, AuxRec : ARRAYOF INTEGER, Ak : Key, PageRef : INTEGER; (*------------------------------------------------------------------*) (* INSERTION de la cle ky au FICHIER d'INDEX, DataRef correspondant *) (* a la Position du tuple dans le fichier de donnees. *) (*------------------------------------------------------------------*) UNIT AddKey:PROCEDURE(INPUT ky:key,DataRef:INTEGER); VAR depth, PageRef, i : INTEGER, AddItem, AuxItem, itm2 : Item, IncreaseHeight : BOOLEAN, NewRoot : Page, AuxRec : ARRAYOF INTEGER; UNIT Search : PROCEDURE (INPUT itm1 : Item, PageRef:INTEGER; OUTPUT include : BOOLEAN, itm2 :Item); VAR NextPageRef, ItemRef : INTEGER, inclde : BOOLEAN, item2 : Item, AuxPage : Page; UNIT Insert : PROCEDURE; VAR OldPage, RightPage : Page, AuxRec : ARRAYOF INTEGER, AuxItmArr, AuxItmArr2 : ARRAYOF Item, RightPageRef, i : INTEGER; BEGIN OldPage := StackOfPages(Finger); IF OldPage.ItemsOnPage < PageSize THEN CALL UpdatePage (item2, ItemRef, OldPage); Path(Finger).RefOnPage := ItemRef + 1; include := FALSE; ELSE include := TRUE; OldPage.ItemsOnPage := HalfPageSize; Path(Finger).updated := TRUE; RightPage := NEW Page; RightPage.ItemsOnPage := HalfPageSize; ARRAY RightPage.ItemsArray dim (1:PageSize); AuxItmArr := OldPage.ItemsArray; AuxItmArr2 := RightPage.ItemsArray; IF ItemRef = HalfPageSize THEN FOR i := 1 to HalfPageSize DO AuxItmArr2(i):=AuxItmArr(i+HalfPageSize) OD; itm2:= item2; ELSE IF ItemRef < HalfPageSize THEN FOR i := 1 TO HalfPageSize DO AuxItmArr2(i) := AuxItmArr(i+HalfPageSize) OD; itm2 := AuxItmArr(HalfPageSize); FOR i := HalfPageSize-1 DOWNTO ItemRef+1 DO AuxItmArr(i+1) := AuxItmArr(i) OD; AuxItmArr(ItemRef+1) := item2; ELSE itm2 := AuxItmArr(HalfPageSize+1); FOR i := HalfPageSize+2 TO ItemRef DO AuxItmArr2(i-HalfPageSize-1) := AuxItmArr(i) OD; AuxItmArr2(ItemRef-HalfPageSize) := item2; FOR i := ItemRef+1 TO PageSize DO AuxItmArr2(i-HalfPageSize) := AuxItmArr(i) OD; FI; FI; (* StackOfPages(finger) := OldPage; *) CALL Fseek(df,Path(Finger).PageRef); CALL Fput(df,PageToRec(StackOfPages(Finger))); RightPage.LessPageRef := itm2.PageRef; AuxRec :=PageToRec(RightPage); CALL AddRec(AuxRec,RightPageRef); itm2.PageRef :=RightPageRef; FI END Insert; BEGIN (* Search*) IF PageRef = -1 THEN include := TRUE; itm2 := itm1; itm2.PageRef := -1; ELSE Finger, depth := Finger+1; CALL GetPage (PageRef); AuxPage := StackOfPages (Finger); CALL SearchPage (AuxPage, itm1, NextPageRef, ItemRef); CALL Search(itm1, NextPageRef, include, item2); IF include THEN CALL Insert; FI; Finger := Finger -1; FI; END Search; BEGIN (*AddKey*) Path(1).updated := TRUE; AuxItem := NEW Item; AuxItem.ky := ky; AuxItem.DataRef := DataRef; AuxItem.PageRef := -1; Finger := 0; CALL Search(AuxItem, Path(1).PageRef, IncreaseHeight, AddItem); IF IncreaseHeight THEN NewRoot := NEW Page; NewRoot.ItemsOnPage := 1; NewRoot.LessPageRef := Path(1).PageRef; ARRAY NewRoot.ItemsArray dim (1:PageSize); NewRoot.ItemsArray(1) := AddItem; IF depth+1 > TreeHeight THEN RAISE TreeHeight_Overflow FI; FOR i := 1 TO depth DO StackOfPages(i+1) := StackOfPages(i); Path(i+1) := Path(i); OD; StackOfPages(1) := NewRoot; Path(1) := NEW SearchStep; Path(1).RefOnPage := 1; Path(1).updated := TRUE; AuxRec :=PageToRec(NewRoot); CALL AddRec(AuxRec, PageRef); Path(1).PageRef := PageRef; Finger := depth+1 ELSE Finger := depth FI (* IncreaseHeight *); END AddKey; (*-------------------------------------------------------------------*) (* RECHERCHE de la cle Ky IMMEDIATEMENT INFERIEURE a la CLE indique *) (* par Path, DataRef correspond a la POSITION du TUPLE associe a la *) (* CLE dans le fichier de donnees. *) (*-------------------------------------------------------------------*) UNIT PrevKey : PROCEDURE (OUTPUT ky:key, DataRef:INTEGER); VAR AuxPage : Page, AuxRec : ARRAYOF INTEGER, PageRef, NextPageRef, RefOnPage : INTEGER; BEGIN RefOnPage := Path(Finger).RefOnPage; PageRef:=Path(Finger).PageRef; AuxPage:=StackOfPages(Finger); IF AuxPage.LessPageRef = -1 THEN IF RefOnPage <> 1 THEN RefOnPage := RefOnPage -1; Path(Finger).RefOnPage := RefOnPage ELSE IF Finger = 1 THEN ky:=AuxPage.ItemsArray(RefOnPage).ky; DataRef:=AuxPage.ItemsArray(RefOnPage).DataRef; RAISE signal11; RETURN; ELSE RefOnPage := 0; WHILE Finger <> 1 AND RefOnPage = 0 DO Finger := Finger-1; Auxpage := StackOfPages(Finger); RefOnPage := Path(Finger).RefOnPage OD; IF Finger = 1 AND RefOnPage = 0 THEN ky:=AuxPage.ItemsArray(1).ky; DataRef:=AuxPage.ItemsArray(1).DataRef; RAISE signal11; RETURN; FI; FI; FI (* RefOnPage <> 1 *); ELSE IF RefOnPage = 1 THEN NextPageRef := AuxPage.LessPageRef; Path(Finger).RefOnPage := 0 ELSE RefOnPage := RefOnPage -1; NextPageRef := AuxPage.ItemsArray(RefOnPage).PageRef; Path(Finger).RefOnPage := RefOnPage FI; WHILE NextPageRef <> -1 DO Finger := Finger +1; PageRef := NextPageRef; CALL GetPage(PageRef); AuxPage := StackOfPages(Finger); RefOnPage, Path(Finger).RefOnPage := Auxpage.ItemsOnPage; NextPageRef := AuxPage.ItemsArray(RefOnPage).PageRef OD; FI; ky:=AuxPage.ItemsArray(RefOnPage).ky; DataRef:=AuxPage.ItemsArray(RefOnPage).DataRef END PrevKey; (*-----------------------------------------------------*) (* RECHERCHE de la CLE la plus petite du fichier INDEX *) (*-----------------------------------------------------*) UNIT MinKey : PROCEDURE (OUTPUT k:Key, DataRef : INTEGER); VAR PageRef : INTEGER, AuxPage : Page, AuxItem : Item; BEGIN Finger :=1; DO AuxPage := StackOfPages(Finger); PageRef := AuxPage.LessPageRef; Path(Finger).RefOnPage := 0; IF PageRef = -1 THEN EXIT FI; Finger := Finger +1; CALL GetPage(PageRef); OD; AuxItem := AuxPage.ItemsArray(1); k := AuxItem.ky; DataRef := AuxItem.DataRef; Path(Finger).RefOnPage := 1 END MinKey; UNIT MaxKey : PROCEDURE( OUTPUT k:Key, DataRef: INTEGER); VAR PageRef, n : INTEGER, AuxPage : Page; BEGIN Finger :=1; DO AuxPage := StackOfPages(Finger); Path(Finger).RefOnPage, n := AuxPage.ItemsOnPage; PageRef := AuxPage.ItemsArray(n).PageRef; IF PageRef = -1 THEN EXIT FI; Finger := Finger+1; CALL GetPage(PageRef) OD; k := AuxPage.ItemsArray(n).Ky; DataRef := AuxPage.ItemsArray(n).DataRef END MaxKey; (*-------------------------------------------------------------------*) (* RECHERCHE de la cle Ky IMMEDIATEMENT SUPERIEURE a la cle indique *) (* par Path, DataRef correspond a la Position du tuple associe a la *) (* cle dans le fichier de donnees. *) (*-------------------------------------------------------------------*) UNIT NextKey: PROCEDURE (OUTPUT ky:key,DataRef:INTEGER); VAR AuxPage : Page, AuxItem : Item, PageRef,NextPageRef, RefOnPage : INTEGER; BEGIN RefOnPage := Path(Finger).RefOnPage; PageRef := Path(Finger).PageRef; AuxPage:=StackOfPages(Finger); IF AuxPage.LessPageRef = -1 THEN WHILE Finger <> 1 AND RefOnPage = AuxPage.ItemsOnPage DO Finger := Finger - 1; AuxPage := StackOfPages(Finger); RefOnPage := Path(Finger).refOnPage OD; IF RefOnPage = AuxPage.ItemsOnPage THEN AuxItem := AuxPage.ItemsArray(RefOnPage); DataRef := AuxItem.DataRef; ky := AuxItem.ky; RAISE signal12; RETURN; ELSE RefOnPage := RefOnPage+1; Path(Finger).RefOnPage := RefOnPage FI; ELSE NextPageRef := AuxPage.ItemsArray(RefOnPage).PageRef; WHILE NextPageRef <> -1 DO Finger := Finger+1; PageRef := NextPageRef; CALL GetPage(PageRef); AuxPage := StackOfPages(Finger); Path(Finger).refOnPage := 0; NextPageRef := AuxPage.LesspageRef OD; RefOnPage := 1; Path(Finger).RefOnPage := 1 FI; AuxItem := AuxPage.ItemsArray(RefOnPage); DataRef := AuxItem.DataRef; ky := AuxItem.ky END NextKey; (*--------------------------------------------------------------------*) (* SUPPRESSION de la cle ky au FICHIER d'INDEX, DataRef correspondant *) (* a la Position du tuple dans le fichier de donnees. *) (*--------------------------------------------------------------------*) UNIT DelKey : PROCEDURE (INPUT ky:key,DataRef:INTEGER); VAR DataRef1: INTEGER, k: key, underflw:BOOLEAN; UNIT remove : PROCEDURE(OUTPUT underflw:BOOLEAN); VAR AuxPage,AuxPage1 :Page, i,ItemsOnPage,RefOnPage,NextPageRef :INTEGER; BEGIN AuxPage:=StackOfPages(Finger); i:=Finger; Path(Finger).updated:=TRUE; RefOnPage := Path(Finger).RefOnPage; IF AuxPage.LessPageRef <> -1 THEN NextPageRef := AuxPage.ItemsArray(RefOnPage).PageRef; WHILE NextPageRef <> -1 DO Finger := Finger+1; CALL GetPage(NextPageRef); AuxPage1 := StackOfPages(Finger); Path(Finger).RefOnPage := 0; NextPageRef := AuxPage1.LessPageRef OD; Path(Finger).updated:=TRUE; Path(Finger).RefOnPage := 1; AuxPage.ItemsArray(RefOnPage).ky := AuxPage1.ItemsArray(1).ky; AuxPage.ItemsArray(RefOnPage).DataRef:= AuxPage1.ItemsArray(1).DataRef; StackOfPages(i):=AuxPage; AuxPage:= AuxPage1; RefOnPage:=1; FI; ItemsOnPage:= AuxPage.ItemsOnPage -1; FOR i:=RefOnPage TO ItemsOnPage DO AuxPage.ItemsArray(i):=AuxPage.ItemsArray(i+1) OD; AuxPage.ItemsOnPage:= ItemsOnPage; StackOfPages(Finger):=AuxPage; IF ItemsOnPage1 THEN AuxPage:=StackOfPages(Finger); Path(Finger).updated:=TRUE ; Path(Finger-1).updated:=TRUE ; AuxPage1:=StackOfPages(Finger-1); RefOnPage:=Path(Finger-1).RefOnPage; IF RefOnPage< AuxPage1.ItemsOnPage THEN k:=RefOnPage+1; Itm:=AuxPage1.ItemsArray(k); PageRef:=Itm.PageRef; CALL Fseek(df,PageRef); AuxRec:=Fget(df); AuxPage2:=RecToPage(AuxRec); Itm.PageRef:=AuxPage2.LessPageRef; AuxPage.ItemsArray(AuxPage.ItemsOnPage+1):=Itm; n:=AuxPage2.ItemsOnPage-HalfPageSize; IF n>0 THEN n:=entier((n-1)/2); Itm:=AuxPage2.ItemsArray(n+1); Itm.PageRef:=PageRef; AuxPage1.ItemsArray(k):=Itm; FOR i:=1 TO n DO AuxPage.ItemsArray(HalfPageSize+i):= AuxPage2.ItemsArray(i) OD; AuxPage.ItemsOnPage:=HalfPageSize+n; StackOfPages(Finger):=AuxPage; StackOfPages(Finger-1):=AuxPage1; k:=AuxPage2.ItemsOnPage-(n+1); FOR i:=1 TO k DO AuxPage2.ItemsArray(i):= AuxPage2.ItemsArray(n+1+i) OD; AuxPage2.ItemsOnPage:=k; AuxRec:=PageToRec(AuxPage2); CALL Fseek(df,PageRef); CALL Fput(df,AuxRec); ELSE (*AuxPage2.ItemsOnPage=HalfPageSize tzn. n=0*) FOR i:=1 TO HalfPageSize DO AuxPage.ItemsArray(HalfPageSize+i):= AuxPage2.ItemsArray(i) OD; AuxPage.ItemsOnPage:=PageSize; FOR i:=RefOnPage+2 TO AuxPage1.ItemsOnPage DO AuxPage1.ItemsArray(i-1):= AuxPage1.ItemsArray(i) OD; AuxPage1.ItemsOnPage:=AuxPage1.ItemsOnPage-1; StackOfPages(Finger-1):=AuxPage1; StackOfPages(Finger):=AuxPage; CALL DelRec(PageRef); IF AuxPage1.ItemsOnPage0*) ELSE IF RefOnPage>1 THEN Itm:=AuxPage1.ItemsArray(RefOnPage-1); PageRef:=Itm.PageRef; ELSE PageRef:=AuxPage1.LessPageRef; FI; CALL Fseek(df,PageRef); AuxRec:=Fget(df); AuxPage2:=RecToPage(AuxRec); Itm:=AuxPage1.ItemsArray(RefOnPage); Itm.PageRef:=AuxPage.LessPageRef; n:=AuxPage2.ItemsOnPage-HalfPageSize; IF n>0 THEN n:=entier((n-1)/2); k:=AuxPage.ItemsOnPage; FOR i:=1 TO n+1 DO AuxPage.ItemsArray(k+n+2-i):= AuxPage.ItemsArray(k+1-i) OD; AuxPage.ItemsArray(n+1):=Itm; AuxPage.ItemsOnPage:=k+n+1; Itm:=AuxPage2.ItemsArray(HalfPageSize+n+1); Itm.PageRef:=PageRef; AuxPage1.ItemsArray(RefOnPage):=Itm; FOR i:=1 TO n DO AuxPage.ItemsArray(i):= AuxPage2.ItemsArray(HalfPageSize+1+i+n) OD; AuxPage.ItemsOnPage:=HalfPageSize+n; AuxPage2.ItemsOnPage:= HalfPageSize+n; StackOfPages(Finger-1):=AuxPage1; StackOfPages(Finger):=AuxPage; AuxRec:=PageToRec(AuxPage2); CALL Fseek(df,PageRef); CALL Fput(df,AuxRec); ELSE AuxPage2.ItemsArray(HalfPageSize+1):=Itm; FOR i:=1 TO HalfPageSize-1 DO AuxPage2.ItemsArray(HalfPageSize+1+i):= AuxPage.ItemsArray(i) OD; AuxPage1.ItemsOnPage:=AuxPage1.ItemsOnPage-1; AuxPage2.ItemsOnPage:=PageSize; StackOfPages(Finger-1):=AuxPage1; StackOfPages(Finger):=AuxPage2; Path(Finger-1).RefOnPage:=RefOnPage-1; CALL DelRec(Path(Finger).PageRef); Path(Finger).PageRef:=PageRef; IF AuxPage1.ItemsOnPage0*) FI ELSE AuxPage:=StackOfPages(1); IF AuxPage.ItemsOnPage=0 THEN CALL DelRec(Path(1).PageRef); IF AuxPage.LessPageRef<>-1 THEN i:=2; WHILE Path(i)<>NONE DO Path(i-1):=Path(i); StackOfPages(i-1):=StackOfPages(i); i:=i+1 OD ELSE writeln("erreur1"); FI; FI FI; END underflow; BEGIN (*DelKey*) k:=ky; DataRef1:=FindKey(k); DO IF k=ky AND DataRef=DataRef1 THEN CALL remove(underflw); WHILE underflw DO CALL underflow(underflw) OD; RETURN ELSE IF k<>ky or DataRef1= -1 THEN writeln("erreur2") ELSE CALL NextKey(k,DataRef1) FI FI OD END DelKey; UNIT FindKey:FUNCTION (k : key): INTEGER; VAR PageRef, i : INTEGER, AuxPage : Page, Itms : ARRAYOF Item, k1 : Key; BEGIN Finger := 1; PageRef := Path(Finger).PageRef; DO CALL GetPage( PageRef ); AuxPage := StackOfPages(Finger); Itms := AuxPage.ItemsArray; FOR i := AuxPage.ItemsOnPage DOWNTO 1 DO k1 := Itms(i).ky; IF leq(k1, k) THEN Path(Finger).RefOnPage := i; IF leq(k, k1) THEN RESULT := Itms(i).DataRef; RETURN FI; PageRef := Itms(i).PageRef; EXIT; ELSE IF i =1 THEN PageRef := AuxPage.LessPageRef; Path(Finger).RefOnPage := 0; FI; FI; OD; IF PageRef = -1 THEN IF Path(Finger).RefOnPage = 0 THEN Path(Finger).RefOnPage :=1 FI; RESULT := -1; EXIT (*FindKey*) ELSE Finger := Finger+1 FI; OD; END FindKey; UNIT SearchKey: PROCEDURE(INPUT k:key;OUTPUT DataRef : INTEGER); BEGIN DataRef := FindKey(k); IF DataRef = -1 THEN CALL NextKey(k,DataRef) FI END SearchKey; UNIT GetPage : PROCEDURE(PageRef : INTEGER); VAR AuxRec : ARRAYOF INTEGER; BEGIN IF Path(Finger) = NONE THEN Path(Finger) := NEW SearchStep; Path(Finger).Updated := FALSE; Path(Finger).PageRef := PageRef-1; FI; IF Path(Finger).Updated THEN AuxRec := PageToRec(StackOfPages(Finger)); CALL Fseek(df, Path(Finger).PageRef); CALL Fput(df,AuxRec); FI; CALL Fseek(df, PageRef); AuxRec := Fget(df); StackOfPages(Finger) := RecToPage(AuxRec); Path(Finger) := NEW SearchStep; Path(Finger).PageRef := PageRef; Path(Finger).updated := FALSE; END GetPage ; UNIT UpdatePage : PROCEDURE (INPUT AuxItem : Item, ItemRef : INTEGER, AuxPage : Page); VAR AuxItmArr : ARRAYOF Item, n,i: INTEGER; BEGIN AuxPage.ItemsOnPage, n := AuxPage.ItemsOnPage +1; FOR i := n DOWNTO ItemRef +2 DO AuxItmArr := AuxPage.ItemsArray; AuxItmArr(i) := AuxItmArr(i-1) OD; AuxPage.ItemsArray(ItemRef+1) := AuxItem; Path(Finger).Updated := TRUE; END UpdatePage ; UNIT order : FUNCTION (i1, i2 : Item) : BOOLEAN; VAR k1,k2 :key, n : INTEGER; BEGIN k1 := i1.ky; k2 := i2.ky; IF Leq(k2,k1) THEN IF Leq(k1, k2) THEN n := i1.DataRef - i2.DataRef; IF n=0 THEN RAISE Signal14 FI; RESULT := n<0; ELSE RESULT := FALSE FI ELSE IF NOT Leq(k1, k2) THEN ELSE RESULT := TRUE FI FI END order; UNIT SearchPage : PROCEDURE (INPUT P :Page, it :Item; OUTPUT NextPageRef, ItemRef :INTEGER); VAR Itms : ARRAYOF Item, it1 : Item; BEGIN Itms :=P.ItemsArray; FOR ItemRef := P.ItemsOnPage DOWNTO 1 DO it1 := Itms(ItemRef); IF order(it1, it) THEN NextPageRef := it1.PageRef; RETURN FI OD; ItemRef := 0; NextPageRef := P.LessPageRef; END SearchPage ; BEGIN (*IndexFile*) Finger :=1; ARRAY StackOfPages dim(1:TreeHeight); ARRAY Path dim (1:TreeHeight); StackOfPages(1) := NEW Page; StackOfPages(1).ItemsOnPage := 0; StackOfPages(1).LessPageRef := -1; ARRAY StackOfPages(1).ItemsArray dim (1: PageSize); Path(1):= NEW SearchStep; Path(1).PageRef := 1; Path(1).RefOnPage := 0; END IndexFile; END Relation; END HandlerOfRelations; BEGIN (* MAIN *) PREF HandlerOfRelations(4,8,2) BLOCK CONST (* couleur: la definition de ces couleurs varie avec le mode ‚cran *) (* il est possible celles ci ne corespondent pas … leurs d‚finition *) Noir = 0, Rouge = 1, Vert = 2, Jaune = 3, Bleu = 4, Magenta = 5, Cyan = 6, Blanc = 7, (* attribut carateres *) Normal = 0, Gras = 1, Clignotant = 5, Inverse = 7, Cache = 8, (* code retour clavier *) Fgauche = -75, Fdroite = -77,Fhaut = -72, Fbas = -80, ESC = 27, RETOUR = 13, BKSPACE = 8; (* definition des procedures ‚cran et clavier *) (*detection d'une touche *) UNIT inchar : IIuwgraph FUNCTION : INTEGER; VAR i : INTEGER; BEGIN DO RESULT := inkey; IF RESULT =/= 0 THEN EXIT FI OD; END inchar; (*efface l'‚cran et place le curseur en position (1,1) *) UNIT cls : PROCEDURE; BEGIN write( CHR(27),"[2J"); CALL GotoXY(1,1) END Cls; (* positionne le curseur en colonne x et ligne y *) UNIT GotoXY : PROCEDURE(x, y: INTEGER); VAR a,b,c,d : CHAR, i,j : INTEGER; BEGIN i := y DIV 10; j := y MOD 10; a := CHR(48+i); b := CHR(48+j); i := x DIV 10; j := x mod 10; c := CHR(48+i); d := CHR(48+j); write(CHR(27),"[",a,b,";",c,d,"H") END GotoXY; (* definition des couleurs du caracteres et du fon *) UNIT SetColor : PROCEDURE(font,back : INTEGER); BEGIN write(CHR(27),"[","3",CHR(48+font),";4",CHR(48+back),"m"); END SetColor; UNIT Text_attr : PROCEDURE(Plus, Attr : INTEGER); BEGIN IF (Plus = 0) THEN write(CHR(27),"[0m") FI; write(CHR(27),"[",CHR(48+Attr),"m"); END Text_Attr; (***) (* classe de base d'affichage d'une fiche … l'‚cran *) UNIT Base_Fiche : CLASS; VAR Titre :STRING; UNIT VIRTUAL Touche_Aff : PROCEDURE; BEGIN END Touche_Aff; UNIT Affiche : PROCEDURE; (* procedure d'affichage de la base graphique *) (* permetant la saisie comme la consultation *) BEGIN CALL setcolor(cyan,bleu); CALL GotoXY(10,5); (* taille du titre: 20 caracteres *) write(" ",titre," "); CALL GotoXY(10,6); write(" "); CALL setcolor(vert,bleu); CALL GotoXY(10,7); write(" Auteur : "); CALL GotoXY(10,8); write(" Titre : "); CALL GotoXY(10,9); write(" Editeur: "); CALL GotoXY(10,10); write(" Annee : "); CALL GotoXY(10,11); write(" Sujet : "); CALL GotoXY(10,12); write(" NøInv : "); CALL GotoXY(10,13); write(" "); CALL GotoXY(10,14); CALL setcolor(rouge,bleu); CALL touche_aff; CALL GotoXY(10,15); write(" "); END affiche; END Base_Fiche; UNIT Fiche_Cons : Base_Fiche CLASS; UNIT VIRTUAL Touche_Aff : PROCEDURE; BEGIN END Touche_Aff; UNIT Put_Champs :PROCEDURE; BEGIN IF (L.INV.Ak = NONE) THEN RETURN; FI; CALL Put_Chaine(20,7,L.INV.AutLeng,L.INV.Ak.Author); CALL Put_Chaine(20,8,L.INV.TitLeng,L.INV.Ak.Title); CALL Put_Chaine(20,9,L.INV.PubLeng,L.INV.Ak.Publisher); CALL Put_Entier(20,10,4,L.INV.Ak.Year); CALL Put_Chaine(20,11,L.INV.SubjLeng,L.INV.Ak.Subject); CALL Put_Entier(20,12,5,L.INV.Ak.NoInv); END Put_Champs; BEGIN Titre := " CONSULTATION LIVRE "; CALL Affiche; CALL Put_Champs; END Fiche_Cons; UNIT Fiche_Saisie : Base_Fiche CLASS; UNIT VIRTUAL Touche_Aff : PROCEDURE; BEGIN write(" [ÄÙ]: Validation. [Esc]: Abandon de la saisie. "); END touche_aff; UNIT Read_Champs :FUNCTION : BOOLEAN; VAR Code_Saisie : INTEGER; BEGIN DO CALL say("Entrer le Nom de l'Auteur"); DO Code_Saisie := Read_Chaine(20,7,L.INV.AutLeng,L.INV.Ak.Author); IF Code_Saisie = 1 THEN EXIT EXIT; ELSE IF Code_Saisie = 2 THEN CALL say( "Saisie Obligatoire du nom de l'auteur"); write(CHR(7),CHR(7)); ELSE EXIT; FI; FI; OD; CALL say("Entrer le Titre du livre"); DO Code_Saisie := Read_Chaine(20,8,L.INV.TitLeng,L.INV.Ak.Title); IF Code_Saisie = 1 THEN EXIT EXIT; ELSE IF Code_Saisie = 2 THEN CALL say( "Saisie Obligatoire du titre de l'oeuvre"); write(CHR(7),CHR(7)); ELSE EXIT; FI; FI; OD; CALL say("Entrer le Nom de l'Editeur"); DO Code_Saisie := Read_Chaine(20,9,L.INV.PubLeng,L.INV.Ak.Publisher); IF Code_Saisie = 1 THEN EXIT EXIT; ELSE IF Code_Saisie = 2 THEN CALL say( "Saisie Obligatoire du Nom de l'Editeur !"); write(CHR(7),CHR(7)); ELSE EXIT; FI; FI; OD; CALL say("Entrer l'Annee de Parution de l'Oeuvre"); DO Code_Saisie := Read_Entier(20,10,4); IF Code_saisie = -1 THEN EXIT EXIT; ELSE IF Code_Saisie = -2 THEN CALL say( "Saisie Obligatoire de l'annee de parution !"); write(CHR(7),CHR(7)); ELSE L.INV.Ak.Year := Code_Saisie; EXIT; FI; FI; OD; CALL say("Entrer le Theme de l'Oeuvre"); DO Code_Saisie := Read_Chaine(20,11,L.INV.SubjLeng,L.INV.Ak.Subject); IF Code_saisie = 1 THEN EXIT EXIT; ELSE IF Code_Saisie = 2 THEN CALL say( "Saisie Obligatoire du Theme de l'oeuvre !"); write(CHR(7),CHR(7)); ELSE EXIT; FI; FI; OD; CALL say("Entrer le Numero d'inventaire du livre"); DO Code_Saisie := Read_Entier(20,12,5); IF Code_saisie = -1 THEN EXIT EXIT; ELSE IF Code_Saisie = -2 THEN CALL say( "Saisie Obligatoire du Nø Inventaire !"); write(CHR(7),CHR(7)); ELSE L.INV.Ak.NoInv := Code_Saisie; Code_Saisie := 0; EXIT EXIT; FI; FI; OD; OD; IF Code_Saisie = 0 THEN RESULT := TRUE FI; END Read_Champs; BEGIN Titre := " FICHE SAISIE LIVRE "; CALL Affiche; ok := Read_Champs; END Fiche_Saisie; UNIT Read_Entier : FUNCTION(x,y,longueur : INTEGER) : INTEGER; VAR val : INTEGER; BEGIN CALL Text_Attr(0,Gras); CALL GotoXY(x,y); FOR i := 1 TO longueur DO write("Û"); OD; i := 0; CALL Text_Attr(0,Inverse); CALL GotoXY(x,y); DO val := inchar; CALL GotoXY(x+i,y); CASE val WHEN ESC : RESULT := -1; RETURN; WHEN RETOUR : IF i = 0 THEN RESULT := -2; FI; RETURN; WHEN BKSPACE, FGauche : IF (i = 0) THEN write(CHR(7)) ELSE i := i-1; CALL Text_Attr(0,Gras); CALL GotoXY(x+i,y); write("Û"); CALL Text_Attr(0,Inverse); RESULT := ENTIER(RESULT / 10) FI; OTHERWISE IF (i = longueur) THEN write(CHR(7)) ELSE IF (val > 47 AND val < 58) THEN write(CHR(val)); i := i + 1; RESULT := RESULT* 10 + (val - 48); ELSE write(CHR(7)); FI; FI; ESAC; OD; END Read_Entier; UNIT Put_Entier : PROCEDURE(x,y,longueur : INTEGER;val : INTEGER); VAR c: CHAR; BEGIN CALL Text_Attr(0,Gras); CALL GotoXY(x,y); FOR i := 1 TO longueur DO write("Û") OD; longueur := longueur - 1; CALL GotoXY(x+longueur,y); CALL Text_Attr(0,Inverse); DO c := CHR(48+(val MOD 10)); write(c); longueur := longueur - 1; CALL GotoXY(x+longueur,y); val := val DIV 10; IF val = 0 THEN EXIT FI; OD; END Put_Entier; UNIT Read_Chaine : FUNCTION(x,y,longueur :INTEGER; OUTPUT ch : ARRAYOF CHAR) : INTEGER; VAR val: INTEGER; BEGIN ARRAY ch DIM (1:longueur); CALL Text_Attr(0,Gras); CALL GotoXY(x,y); FOR i := 1 TO longueur DO write("Û"); OD; i := 0; CALL Text_Attr(0,Inverse); CALL GotoXY(x,y); DO val := INCHAR; CALL GotoXY(x+i,y); CASE val WHEN ESC : RESULT := 1; RETURN; WHEN RETOUR : IF i = 0 THEN RESULT := 2 FI; RETURN; WHEN BKSPACE, FGauche : IF (i = 0) THEN write(CHR(7)) ELSE i := i-1; CALL Text_Attr(0,Gras); CALL GotoXY(x+i,y); write("Û"); CALL Text_Attr(0,Inverse) FI; WHEN Fdroite : IF (i = longueur - 1) THEN write(CHR(7)) ELSE write(CHR(32)); i := i + 1; ch(i) := CHR(32) FI; OTHERWISE IF (i = longueur) THEN write(CHR(7)); ELSE IF (val >=32 AND val <=125) THEN write(CHR(val)); i := i + 1; ch(i) := CHR(val) ELSE write(CHR(7)) FI; FI; ESAC; OD; END Read_chaine; UNIT Put_chaine : PROCEDURE(x,y,Longueur : INTEGER;ch : ARRAYOF CHAR); BEGIN CALL Text_Attr(0,Gras); CALL GotoXY(x,y); FOR i := 1 TO longueur - 1 DO write("Û") OD; CALL GotoXY(x,y); CALL Text_Attr(0,Inverse); i := 1; DO IF (i > UPPER(ch)) ORIF (ORD(ch(i)) = RETOUR) ORIF (i > Longueur - 1) THEN EXIT fi; write(ch(i)); i := i+1; OD; END Put_chaine; UNIT say : PROCEDURE(phrase : string); BEGIN CALL SetColor(noir,cyan); CALL GotoXY(1,25); write( " "); CALL GotoXY(2,25); write(phrase); CALL Text_Attr(0,normal); END say; VAR ok : BOOLEAN, L : Library, INFO : ARRAYOF INTEGER, infofile : RFile, extrem : BOOLEAN, i : INTEGER, f : Base_Fiche, menu : CoMenu, DataRef : INTEGER; UNIT Library: CLASS; VAR New_Base : BOOLEAN, INV : Inventory; UNIT Inventory : Relation CLASS; VAR AutLeng, TitLeng, Publeng, SubjLeng : INTEGER; VAR i : INTEGER; UNIT Fiche : Tuple CLASS; VAR Author, Title, Publisher, Subject : ARRAYOF CHAR, Year, NoInv : INTEGER; BEGIN ARRAY Author dim(1:AutLeng); Author(1) := CHR(13); ARRAY Title dim (1:TitLeng); Title(1) := CHR(13); ARRAY Publisher dim (1:Publeng); Publisher(1) := CHR(13); ARRAY Subject dim (1:SubjLeng); Subject(1) := CHR(13); END Fiche; UNIT VIRTUAL TupleToArray : FUNCTION(F : Fiche):ARRAYOF INTEGER; VAR AuxRec :ARRAYOF INTEGER, i,cpt :INTEGER; BEGIN ARRAY AuxRec DIM (1:137); FOR i := 1 TO AutLeng DO AuxRec(i) := ORD(F.Author(i)); IF ORD(F.Author(i)) = 13 THEN EXIT FI OD; cpt := AutLeng; FOR i := 1 TO TitLeng DO AuxRec(cpt+i) := ORD(F.Title(i)); IF ORD(F.Title(i)) = 13 THEN EXIT FI OD; cpt := cpt + TitLeng; FOR i := 1 TO Publeng DO AuxRec(cpt+i) := ORD(F.Publisher(i)); IF ORD(F.Publisher(i)) = 13 THEN EXIT FI OD; cpt := cpt + Publeng; FOR i := 1 TO SubjLeng DO AuxRec(cpt+i) := ORD(F.Subject(i)); IF ORD(F.Subject(i)) = 13 THEN EXIT FI OD; cpt := cpt + SubjLeng; AuxRec(cpt+1) := F.Year; AuxRec(cpt+2) := F.NoInv; RESULT := AuxRec; END TupleToArray; UNIT VIRTUAL ArrayToTuple : FUNCTION (A :ARRAYOF INTEGER) :Fiche; VAR f: Fiche, i, cpt :INTEGER; BEGIN f := NEW Fiche; FOR i := 1 TO AutLeng DO f.Author(i) := CHR(A(i)); IF A(i) = 13 THEN EXIT FI OD; cpt := AutLeng; FOR i := 1 TO TitLeng DO f.Title(i) := CHR(A(cpt+i)); IF ORD(f.Title(i)) = 13 THEN EXIT FI OD; cpt := cpt + TitLeng; FOR i := 1 TO Publeng DO f.Publisher(i) := CHR(A(cpt+i)); IF ORD(f.Publisher(i)) = 13 THEN EXIT FI OD; cpt := cpt + Publeng; FOR i := 1 TO SubjLeng DO f.Subject(i) := CHR(A(cpt+i)); IF ORD(f.Subject(i)) = 13 THEN EXIT FI OD; cpt := cpt + SubjLeng; f.Year := A(cpt+1); f.NoInv := A(cpt+2); RESULT := f END ArrayToTuple; UNIT NoInvCatalogue : IndexFile COROUTINE; UNIT cleNo :Key CLASS; VAR NoInv : INTEGER; BEGIN END cleNo; UNIT VIRTUAL KeyOf:FUNCTION (f :Fiche) :cleNo; BEGIN RESULT := NEW cleNo; RESULT.NoInv := f.NoInv; END KeyOf; UNIT VIRTUAL Leq : FUNCTION (k1,k2 : cleNo) : BOOLEAN; BEGIN RESULT := TRUE; IF (k1.NoInv > k2.NoInv) THEN RESULT := FALSE FI END Leq; UNIT VIRTUAL KeyToRec :PROCEDURE(ky:cleNo, A :ARRAYOF INTEGER; j :INTEGER); BEGIN A(j) := ky.NoInv END KeyToRec; UNIT VIRTUAL RecToKey : FUNCTION(A: ARRAYOF INTEGER,j:INTEGER): cleNo; BEGIN RESULT := NEW cleNo; RESULT.NoInv := A(j); END RecToKey; VAR Akey_NoInv : cleNo; BEGIN (* NoInvCatalogue *) (* OUVERTURE du FICHIER INDEX *) KeySize := 1; Akey_NoInv := NEW cleNo; IF New_Base THEN df := MakeFile(UNPACK("NoInv.idx"),2+(PageSize*(KeySize+2))); ELSE df := OpenFile(UNPACK("NoInv.idx"),2+(PageSize*(KeySize+2))); Path(1).PageRef := INFO(1); Path(1).RefOnPage := 1; CALL Fseek(df,Path(1).PageRef); AuxRec := Fget(df); StackOfPages(1) := RecToPage(AuxRec); KILL(AuxRec); FI; RETURN; (* FERMETURE DU FICHIER INDEX *) FOR i := 1 TO TreeHeight DO IF Path(i) = NONE THEN EXIT FI; IF Path(i).updated THEN CALL Fseek(df,Path(i).PageRef); CALL Fput(df,PageToRec(StackOfPages(i))); Path(i).updated := FALSE FI OD; INFO(1) := Path(1).PageRef; CALL CloseFile(df) END NoInvCatalogue; UNIT AuthorsCatalogue : IndexFile COROUTINE; UNIT cleA :Key CLASS; VAR Author :ARRAYOF CHAR, NoInv : INTEGER; BEGIN ARRAY Author dim (1:AutLeng); END cleA; UNIT VIRTUAL KeyOf:FUNCTION (f :Fiche) :cleA; BEGIN RESULT := NEW cleA; RESULT.Author := COPY(f.Author); RESULT.NoInv := f.NoInv; END KeyOf; UNIT VIRTUAL Leq : FUNCTION (k1,k2 : cleA) : BOOLEAN; VAR i: INTEGER; BEGIN RESULT := TRUE; FOR i := 1 to AutLeng DO IF ORD(k1.Author(i)) =13 THEN RETURN ELSE IF ORD(k2.Author(i)) = 13 THEN RESULT := FALSE; RETURN FI FI; IF ORD(k1.Author(i)) =/= ORD(k2.Author(i)) THEN IF ORD(k1.Author(i)) > ORD(k2.Author(i)) THEN RESULT := FALSE FI; RETURN FI; OD; IF (k1.NoInv > k2.NoInv) THEN RESULT := FALSE FI END Leq; UNIT VIRTUAL KeyToRec :PROCEDURE(ky:cleA, A :ARRAYOF INTEGER; j :INTEGER); VAR i : INTEGER; BEGIN FOR i := 1 TO AutLeng DO A(j+i-1) := ORD(ky.Author(i)) OD; A(j+AutLeng) := ky.NoInv END KeyToRec; UNIT VIRTUAL RecToKey : FUNCTION(A: ARRAYOF INTEGER,j:INTEGER): cleA; BEGIN RESULT := NEW cleA; FOR i := 1 TO AutLeng DO RESULT.Author(i) := CHR(A(j+i-1)) OD; RESULT.NoInv := A(j+AutLeng); END RecToKey; VAR Akey_Author : cleA; BEGIN (* AuthorsCatalogue *) (* OUVERTURE du FICHIER INDEX *) KeySize := AutLeng + 1; Akey_Author := NEW cleA; IF New_Base THEN df := MakeFile(unpack("Authors.idx"),2+(PageSize*(KeySize+2))); ELSE df := OpenFile(unpack("Authors.idx"),2+(PageSize*(KeySize+2))); Path(1).PageRef := INFO(2); Path(1).RefOnPage := 1; CALL Fseek(df,Path(1).PageRef); AuxRec := Fget(df); StackOfPages(1) := RecToPage(AuxRec); KILL(AuxRec); FI; RETURN; (* FERMETURE DU FICHIER INDEX *) FOR i := 1 TO TreeHeight DO IF Path(i) = NONE THEN EXIT FI; IF Path(i).updated THEN CALL Fseek(df,Path(i).PageRef); CALL Fput(df,PageToRec(StackOfPages(i))); Path(i).updated := FALSE FI OD; INFO(2) := Path(1).PageRef; CALL CloseFile(df) END AuthorsCatalogue; VAR CA :AuthorsCatalogue, CInv : NoInvCatalogue, NBindexs : INTEGER, Ak : Fiche; BEGIN (* Inventory *) IF New_Base THEN df := MakeFile(UNPACK("LIBRARY.DAT"),137) ELSE df := OpenFile(UNPACK("LIBRARY.DAT"),137) FI; NBindexs := 2; ARRAY Indexs DIM (1:NBindexs); AutLeng := 25; TitLeng := 50; Publeng := 40; SubjLeng := 20; Ak := NEW Fiche; Indexs(1),CInv := NEW NoInvCatalogue; Indexs(2),CA := NEW AuthorsCatalogue; END Inventory; UNIT OpenLIB : PROCEDURE; BEGIN infofile := OpenFile(UNPACK("library.bas"),3); INFO := Fget(InfoFile); INV := NEW Inventory; INV.FreePlace := INFO(3); END OpenLIB; UNIT MakeLIB : PROCEDURE; BEGIN infofile := MakeFile(UNPACK("library.bas"),3); INV := NEW Inventory; END MakeLIB; UNIT CloseLIB : PROCEDURE; VAR i : INTEGER; BEGIN CALL cls; CALL Text_Attr(0,Gras); writeln("> FIN DU PROGRAMME BIBLIOTHEQUE."); CALL CloseFile(INV.df); FOR i := 1 TO INV.NBindexs DO ATTACH(INV.Indexs(i)) OD; INFO(3) := INV.FreePlace; CALL Frewind(InfoFile); CALL Fput(InfoFile,INFO); CALL CloseFile(InfoFile); CALL ENDRUN; END CloseLIB; BEGIN (* Library *) ARRAY INFO dim (1:3); CALL cls; CALL setcolor(noir,vert); CALL GotoXY(2,1); write("ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ» "); CALL GotoXY(2,2); write("º ABDILLAHI Ibrahim º "); CALL GotoXY(2,3); write("º AMBAUD Richard º "); CALL GotoXY(2,4); write("º AMIGO Patrick º "); CALL GotoXY(2,5); write("º BRIGIDO Angel º "); CALL GotoXY(2,6); write("º COSTES Francois º "); CALL GotoXY(2,7); write("º COUDERC Christophe º "); CALL GotoXY(2,8); write("º CUESTA Mireille º "); CALL GotoXY(2,9); write("º IBARBIDE Sandrine º "); CALL GotoXY(2,10); write("ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ "); CALL setcolor(blanc,rouge); CALL GotoXY(35,12); write(" GESTION "); CALL GotoXY(36,13); write(" D'UNE "); CALL GotoXY(33,14); write(" BIBLIOTHEQUE "); CALL setcolor(magenta,bleu); CALL GotoXY(8,23); write("ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿"); CALL GotoXY(8,24); write("³ Voulez-vous utilisez une nouvelle base de donn‚es (O/N) ? : ³"); CALL GotoXY(8,25); write("ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ"); CALL GotoXY(70,24); CALL setcolor(blanc,noir); DO i := INCHAR; CASE i WHEN ESC : CALL cls; CALL GotoXY(1,1); writeln("Sortie [ESCAPE], retour au systeme."); CALL ENDRUN; WHEN 79,89, 111,121 : (* OUI *) write("O"); New_Base := TRUE; CALL MakeLIB; EXIT; WHEN 78,110 : (* NON *) write("N"); New_Base := FALSE; CALL OpenLIB; EXIT; OTHERWISE write(CHR(7)); ESAC; OD; CALL GotoXY(1,25); FOR i:=1 to 25 DO writeln; OD; CALL CLS; END Library; UNIT CoMenu : COROUTINE; CONST nbchoix = 4; VAR tchoix : ARRAYOF string, choix,i : INTEGER; UNIT mov_choix: PROCEDURE(No: INTEGER); BEGIN CALL setcolor(blanc,noir); CALL affchoix(34,choix+5,tchoix(choix)); choix := choix+No; IF (choix > nbchoix) THEN choix := 1; ELSE IF (choix = 0) THEN choix := nbchoix; FI; FI; CALL text_attr(1,inverse); CALL affchoix(34,choix+5,tchoix(choix)); CASE (choix) WHEN 1: CALL say( "Ajouter des livres … la librairie."); WHEN 2: CALL say( "Suprimer des livres de la librairie."); WHEN 3: CALL say( "Rechercher un livre … partir des catalogues (auteurs/sujets)."); WHEN 4: CALL say( "Quitter "); ESAC; END mov_choix; UNIT affchoix : PROCEDURE(x,y : INTEGER;ch : string); VAR i : INTEGER; BEGIN CALL GotoXY(x,y); write(ch); END affchoix; BEGIN (* CoMenu *) ARRAY tchoix DIM (1:nbchoix); tchoix(1) := "AJOUTER "; tchoix(2) := "SUPPRIMER "; tchoix(3) := "RECHERCHER"; tchoix(4) := "QUITTER "; choix := 1; RETURN; DO CALL cls; CALL setcolor(jaune,noir); CALL GotoXY(1,5); writeln(" ÚÄÄÄÄMenuÄÄÄÄ¿"); writeln(" ³ ³"); writeln(" ³ ³"); writeln(" ³ ³"); writeln(" ³ ³"); writeln(" ÀÄÄÄÄÄÄÄÄÄÄÄÄÙ"); CALL GotoXY(1,5); CALL setcolor(blanc,noir); FOR i := 1 TO nbchoix DO CALL affchoix(34,i+5,tchoix(i)); OD; CALL mov_choix(0); DO i := INCHAR; CASE i WHEN Fhaut : CALL mov_choix(-1); WHEN Fbas : CALL mov_choix(1); WHEN ESC : CALL mov_choix(4-choix); DETACH; EXIT; WHEN RETOUR : DETACH; EXIT; OTHERWISE REPEAT; ESAC; OD; OD; END CoMenu; HANDLERS WHEN Del_Rec_Inexistant: RETURN; WHEN Signal11 : extrem := TRUE; RETURN; WHEN Signal12 : extrem := TRUE; RETURN; END HANDLERS; (*******************************************************************) (******************** programme principal **************************) (*******************************************************************) BEGIN CALL Text_Attr(0,Normal); CALL cls; L := NEW Library; Menu := NEW CoMenu; DO ATTACH(menu); CASE Menu.choix WHEN 1: (* INSERTION de TUPLES dans la BASE *) CALL cls; DO f := NEW Fiche_Saisie; IF ok THEN CALL L.INV.InsertTuple(L.INV.Ak); CALL say( "INSERTION REALISEE, Taper une touche pour continuer"); i := INCHAR; KILL(f); ELSE EXIT FI; OD; KILL(f); WHEN 2: (* DESTRUCTION de TUPLES de la BASE *) DO CALL say( "No inventaire du livre a supprimer ?: [ESC] = Abandon"); L.INV.Ak.NoInv := Read_Entier(40,25,5); IF (L.INV.Ak.NoInv =/= -1) AND (L.INV.Ak.NoInv =/= -2) THEN L.INV.CInv.AKey_NoInv := L.INV.CInv.KeyOf(L.INV.Ak); DataRef := L.INV.CInv.FindKey(L.INV.CInv.AKey_NoInv); IF (DataRef = -1) THEN write(chr(7)); CALL say( "SUPPRESSION DE LIVRE INEXISTANT !!!. taper une touche"); i := INCHAR; ELSE writeln("DATAREF = ",dataref); CALL L.INV.DeleteTuple(L.INV.Ak); CALL say( "SUPPRESSION REALISEE !!!. taper une touche"); i := INCHAR; FI; ELSE EXIT; FI OD; WHEN 3: (* RECHERCHE de TUPLES dans la BASE *) WHEN 4: (* CONFIRMATION DE LA SORTIE *) CALL setcolor(blanc,noir); CALL cls; write(chr(7)); CALL setcolor(blanc,rouge); CALL Gotoxy(13,10); write(" CONFIRMER LA SORTIE DU PROGRAMME "); CALL Gotoxy(13,11); write(" "); CALL Gotoxy(13,12); write(" SORTIR ( O / N ) ? "); CALL setcolor(blanc,noir); DO i := INCHAR; CASE i WHEN 79,111 : (* OUI = "O" ou "o" *) CALL L.CloseLIB; WHEN 78,110 : (* NON = "N" ou "n" *) CALL GotoXY(59,12); CALL cls; EXIT; OTHERWISE write(CHR(7)); (*REPEAT*) ESAC; OD; ESAC; CALL Menu.mov_choix(0); OD; END; END BIBLIOTHEQUE (****************************************************************************)