unit MrCinemaCinefilCommon;
(***************************************************
partie commune aux scripts MrCinema et Cinefil
nécessite les modules StringUtils7552.pas et StringUtils1.pas
version 1.7
***************************************************)

uses
	StringUtils7552;

const
	cinefil_id = 0;                                                // identifiants
	mrcinema_id = 1;
//
	CinefilBase = 'http://www.cinefil.com';
	CinefilUrl  = CinefilBase + '/cinefil2005/';
{ recherche: les films sont triés par année (décroissante)}
	CinefilUrlLook = CinefilUrl + 'CFM_Recherches/films.cfm?lachaine2=';
	
var
// note FormatUTF8 est déclaré dans StringUtils7552 (integer)
	filmok, debug: Boolean; 
 	MovieName, firstcall, abort, batchlogfic, debugrep, msgano: string;
	batchlog, confbatch: TstringList;
	calledBy, BatchMode, FormatTitre: integer;
	bestpoids, maxcount, pagemax: Integer;
	PageNext, PagePrev, bestadr, besttxt, lookreal, lookmovie, looktxt: String;

//------------------------------------------------------------------------------
// recherche du film (cinéfil)
// MovieName = nom du film cherché (tel que saisi, cad non formaté)
//------------------------------------------------------------------------------
procedure AnalyzePageCinefil;
var
	Address, Page, Line, Value, str, PageFilm, urlfilm: string;
	pagenum, i: integer; 
	memo: TStringList;

begin
	pagenum := 0;                                             // compteur de pages
// init adresse 1ère recherche 	
	Address := CinefilUrlLook+FormatMovieName3(MovieName);
	repeat
// traitement page courante
	PageNext := '';
	PagePrev := '';
	pagenum := pagenum + 1;
	memoAdr := TStringList.Create;                           // init liste de mémo
	memoTxt := TStringList.Create;
	Page := GetPage(UrlEncode(Address));
	if debug then
		DumpPage(debugrep+'choixCinefil'+IntToStr(pagenum)+'.txt', Page);   // debug
// 1.3 détection automatique UTF8/ASCII
	str := '<B>&nbsp;RÃ©sultat&nbsp;';
	if Pos(str, Page) > 0 then FormatUTF8 := 1
	else
	begin
		str := '<B>&nbsp;Résultat&nbsp;';
		if Pos(str, Page) > 0 then FormatUTF8 := 0
		else Page := '';
	end;
	if Page <> '' then		
		Page := TextAfter(Page, str);     // infos utiles
	if Page = '' then
	begin
		LogMessage('Cinéfil: erreur lecture page de recherche '+IntToStr(pagenum)); // non trouvé = erreur
		memoAdr.Free;
		memoTxt.Free;
		exit;
	end;
// recherche pages précédente et suivante 
	Line := TextBefore(Page, '</TD>', '');            // Line = url's << < page1 page2 ... > >>
	Page := RemainingText;
	if Pos('HREF', AnsiUpperCase(Line)) = 0 then Line := '';           // 1 seule page 
	while Line <> '' do
	begin   
		Value := TextBefore(Line, '/a>', '');            // Value = url page xxx
		Delete(Line, 1, Pos('</a>', Line)+4);            // Line = les suivantes
// ignorer les "retours rapides" (<< et >>) pour ne pas confondre avec < et > 
		if Pos('><<<', Value) > 0 then continue; 
		if Pos('>>><', Value) > 0 then continue; 
		if Pos('><<', Value) > 0 then           
		begin                                           // Value = url page précédente
			PagePrev := GetUrl(Value, '', CinefilBase);
			memoAdr.Add(PagePrev);
			memoTxt.Add('<<< page précédente'); 
		end;
		if Pos('>><', Value) > 0 then
			PageNext := GetUrl(Value, '', CinefilBase);   // Value = url page suivante 
	end;  {while line <> ''}                                        
// mémo des films de cette page
	urlfilm := 'HREF=''../fichefilm.cfm?ref=';
	memo := TStringList.Create;
	memo.Text := StringReplace(Page, '</TR>', crlf);  // separe lignes
	for i := 0 to memo.Count-1 do            
	begin 
	Line := memo.GetString(i);    
	PageFilm := GetUrl(Line, urlfilm, CinefilUrl);
	if PageFilm = '' then continue;     // pas d'url = autre chose ou ligne vide
	memoAdr.Add(PageFilm);
// séparer le réalisateur du reste avant HTMLRemoveTags
	Line := StringReplace(Line, '</a>', sepchar1);  // après le titre
	memoTxt.Add(FormatText(Line));  // [année] nom du film sepchar1 de réalisateur 
	end;         {for i}
	memo.Free;
	if PageNext <> '' then           
	begin                                        
		memoAdr.Add(PageNext);
		memoTxt.Add('>>> page suivante'); 
	end;
	if memoAdr.Count = 0 then
	begin
		LogMessage('Cinéfil: aucun film trouvé pour "'+MovieName+'"');
		memoAdr.Free;
		memoTxt.Free;
		exit;
	end;
	if BatchMode > 0 then
	begin                          
// mode batch : recherche du meilleur poids pour les films de cette page                     
		LookBest(cinefil_id);
		if (bestpoids = maxcount) or (PageNext = '') or (pagenum > pagemax) then
// poids max ou pas de page next ou max pages lues: on arrête
		begin     
			if bestpoids > 0 then                  // on a trouvé quelque chose
			begin                        
				if bestpoids < maxcount then               // infos partielles
						LogMessage('Cinéfil: '+looktxt+' retenu '+besttxt+' (poids='+IntToStr(bestpoids)+')');
				AnalyzePageFilmCinefil(bestadr);                            // page film
			end else
				LogMessage('Cinéfil: pas de correspondance pour '+looktxt);
			break;               // on sort
		end else
// sinon, on va chercher s'il y a mieux dans pagenext
		Address := PageNext;          	
	end else
	begin                                         
// mode normal 
		Address := SelectMovie('Films (Cinéfil)');
		if Address <> '' then
		begin
			if (Address <> PageNext) and (Address <> PagePrev) then
			begin
				AnalyzePageFilmCinefil(Address);                          // page film
				break;                                                    // on sort
			end;   
		end else
			LogMessage('Cinéfil: aucun film sélectionné'); 
	end;
	until (Address = '');
	memoAdr.Free;
	memoTxt.Free;
end;

//------------------------------------------------------------------------------
// analyse de la page du film (Cinéfil)
//------------------------------------------------------------------------------
procedure AnalyzePageFilmCinefil(Address: string);
var
	Page, Table, Value, Value2, str: string;
	BeginPos: Integer;
 
begin                
	Page := GetPage(Address);
	if debug then
		DumpPage(debugrep+'filmCinefil.txt', Page);    // debug
// 1.3 détection automatique UTF8/ASCII 
// 1.7 changement de mot clé
	str := 'programmÃ©';
	if Pos(str, Page) > 0 then FormatUTF8 := 1
	else
	begin
		str := 'programmé';
		if Pos(str, Page) > 0 then FormatUTF8 := 0
		else Page := '';
	end;
	if Page <> '' then		
//		1.5 
   		Page := TextBetween(Page, '<DIV ALIGN="left">', '</DIV>');  // vire le début
	if Page = '' then
	Begin
		LogMessage('Cinéfil: erreur lecture page film');
		exit;
	end;
	filmok := True;                                         // ça y est, c'est bon
	if calledBy = cinefil_id then SetField(fieldURL, Address);
	if CanSetPicture then
	begin  
// affiche: test s'il y a un grand format
		Value := TextBetween(Page, 'javascript:ZoomPhoto(''', '''');
		if Value = '' then                    // sinon test s'il y a un petit format
			Value := TextBetween(Page, '<IMG class=photo SRC=''', '''');     
		if Value <> '' then 
			GetPicture(Value)
		else 
		begin
			if (calledBy <> cinefil_id) then  
			begin    
				Value := 'Cinéfil: pas d''affiche prévue pour "'+MovieName+'"';
				if BatchMode > 0 then                
					LogMessage(Value)
				else
					ShowInformation(Value);
			end;
		end;
	end;       {CanSetPicture}
	if calledBy = mrcinema_id then exit;           // MrCinéma: affiche uniquement 
// pays année et durée
	Value := TextBetween(Page, '<font class="smallnoir">', '<BR>');
	Page := RemainingText;
	Value := StringReplace(Value, '-&nbsp;', sepchar1);     // sépare les champs 
	Value := FormatText(Value);                             // supprime les tags
	Value := StringReplace(Value, crlf, '');                // et les crlf (1.6)
	Value2 := Trim(TextBefore(Value, sepchar1, ''));        // pays (plusieurs possibles)
	Value := RemainingText;
	SetField(fieldCountry, Value2);
	Value2 := Trim(TextBefore(Value, sepchar1, ''));        // année
	Value := RemainingText;
	SetField(fieldYear, Value2);
	Value2 := Trim(TextBefore(Value, sepchar1, ''));        // durée heuresHminutes        
	BeginPos := Pos('H', AnsiUpperCase(Value2));
	Value2 := IntToStr(StrToInt(Left(Value2, BeginPos-1), 0) * 60 + StrToInt(Copy(Value2, BeginPos+1, 2), 0));
	SetField(fieldLength, Value2);
// titre original ou traduit
	Value := TextBetween(Page, '<font class="noir"><font class="rouge16"><B>', '</B>');
	Page := RemainingText;
	Value := FormatText(Value);
// titre original éventuel
	Value2 := FormatText(TextBetween(Page, '<BR>Titre original :<font class="smallrouge"> <B>', '</B>'));
	Value2 := TranslateText(Value2, FormatTitre);
	Value := TranslateText(Value, FormatTitre);
	if (Value2 = '') or (Value = Value2) then              // 1er titre = original
	begin
		SetField(fieldOriginalTitle, Value);
		SetField(fieldTranslatedTitle, '');   
	end else
	begin                                                  // traduit + original
		Page := RemainingText;
		SetField(fieldOriginalTitle, Value2);
		SetField(fieldTranslatedTitle, Value); 
	end; 
// catégorie et réalisateur (un/une catégorie de réalisateur)
	Value := TextBetween(Page, '<font class="noir"><BR>', '<BR>');
	Page := RemainingText;
	Value := StringReplace(Value, crlf, '');               // virer les crlf (1.6)
	Value2 := FormatText(TextAfter(Value, '<B>'));            // réalisateur(s)
	SetField(fieldDirector, Value2);
	Value := FormatText(TextBefore(Value, '<B>', ''));         // un/une catégorie(s)
	BeginPos := Pos('UN', AnsiUpperCase(Value));                  // virer l'article
	if BeginPos = 1 then
	begin
		BeginPos := Pos(' ', Value);
		Delete(Value, 1, BeginPos);
	end;
	BeginPos := LastPos('DE', AnsiUpperCase(Value));            // virer 'de' ou d'
	if BeginPos = 0 then
		BeginPos := LastPos('D''', AnsiUpperCase(Value));	
	if BeginPos > 0 then
		Value := Left(Value, BeginPos -1);
	SetField(fieldCategory, Trim(Value));
// acteurs
	Value := TextBefore(Page, '<font class=noir12>', '');
	Page := RemainingText;
	Value := FormatText(TextBetween(Value, 'avec', crlf));
	SetField(fieldActors, Value);   
// description
	Value := FormatText(TextBefore(Page, '<TABLE', ''));
	SetField(fieldDescription, Value);
end;

//------------------------------------------------------------------------------
// recherche du film correspondant à lookmovie/lookreal (mode batch)
// mémorisation de bestpoids, bestadr et besttxt
//------------------------------------------------------------------------------
procedure LookBest(id: integer);
var
	Value, Address, realisateur, name: string;
	filmnum, poids, i: integer;
	
begin
// rechercher dans la liste mémorisée le nom du film/réalisateur demandé
// attention: memoTxt. déjà passé dans FormatText donc plus de tags et en ascii
	for filmnum := 0 to memoTxt.Count -1 do
	begin
		Address := memoAdr.GetString(filmnum);
		if (Address = PageNext) or (Address = PagePrev) then continue;     // sauf page prev/next    
		Value := memoTxt.GetString(filmnum);      
		if id = cinefil_id then                      
// fiche Cinéfil
		begin                                        // [année] nom du film de réalisateur 
			name := TextBetween(Value, ']', sepchar1);   // nom du film
			realisateur := RemainingText;                // de réalisateur(s)   
			realisateur := TextAfter(realisateur, 'de');
		end else
		begin                                        
// fiche MrCinema
  	  name := TextBefore(Value, sepchar1 , '');  // nom du film
 	  	Value := RemainingText;                    // de réalisateur (année facultative)
			realisateur := TextAfter(Value, 'de');     // attention: pas de TextBetween 
 	  	Value := TextBefore(realisateur, '(', ''); 
			if Value <> '' then realisateur := Value; 		
		end;
		realisateur := FormatRealisateur(realisateur);  // réalisateur (peut être '')
		name := CleanString(name);                      // nom du film
// poids réalisateur(s)	
// ignorer si poids = 0 et les 2 champs non vides
		poids := CompareWords(lookreal, realisateur);
		if (lookreal = '') or (realisateur = '') or (poids > 0) then
		begin
// + (poids du film)x1000
// on refuse poids(réalisateur) = 0 si nom du film approximatif (poids <> 100)
			i := CompareWords(lookmovie, name);
			if (poids > 0) or (i = 100) then poids := poids + (i * 1000);
		end;
		if (poids > 1000) and (poids > bestpoids) then       // résultat des courses
// il faut quand même qu'il y ait au moins 1 mot du titre	!!! 
		begin                                                  // courant = meilleur
			bestpoids := poids;
			bestadr := Address;
			besttxt := '"'+StringReplace(memoTxt.GetString(filmnum), sepchar1, '')+'"';
			if bestpoids = maxcount then break;   // exact match: inutile de continuer
		end;
	end;    {for filmnum}          
end;

//------------------------------------------------------------------------------
// initialisations pour batch mode (nom+réalisateur)
//------------------------------------------------------------------------------
procedure initBatchLook;
begin
	lookreal := GetField(fieldDirector);                // réalisateur(s) peut être ''
	lookmovie := MovieName;                             // nom du film
	looktxt := '"'+lookmovie+'/'+lookreal+'"';          // pour les messages
	lookreal := FormatRealisateur(lookreal);            // formatages
	lookmovie := CleanString(lookmovie);    
	bestpoids := 0;                                     // init meilleur poids
	maxcount := 100100;                                 // poids maximum
	pagemax := 2;                                       // lire au maximum 3 pages
	bestadr := '';                                      // mémo adresse page trouvée
	besttxt := '';                                      // et nom du film/réalisateur
end;

//------------------------------------------------------------------------------
// formatage realisateur
//------------------------------------------------------------------------------
function FormatRealisateur(str: string) :string;
begin
	str := CleanString(str);         
// supprimer les 'et' pour ne garder que les noms
// ce serait dommage de sélectionner une fiche parce qu'il y a seulement 'et' en commun !
	str := StringReplace(str, ' et ', ' ');
	str := StringReplace(str, ' & ', ' ');
	result := str;
end;

//------------------------------------------------------------------------------
// valorisation de msgano (mode normal) ou ajout dans la log (mode batch)
//------------------------------------------------------------------------------
procedure LogMessage(m: string);
begin
	if BatchMode > 0 then 
		AddToLog('fiche '+GetField(fieldNumber)+': '+m)
	else
		msgano := m;
end;

//------------------------------------------------------------------------------
// initialisation de la log
//------------------------------------------------------------------------------
procedure initBatchLog;
begin
	batchlog := TStringList.Create;  
	batchlog.Add('démarrage mode batch');
	batchlog.Add('poids = xxxyyy avec xxx poids du nom du film et yyy poids du réalisateur');
	batchlog.Add('chaque poids = pourcentage du nombre de mots cherchés/trouvés');
	batchlog.Add('100 = correspondance exacte');
	batchlog.Add(StringOfChar('*',80));
	batchlog.SaveToFile(batchlogfic);
// message pour confirmation
	confbatch := TStringList.Create;
	confbatch.Add('Vous avez sélectionné le mode batch:');
	confbatch.Add('Avez-vous sauvegardé votre base?');
	confbatch.Add('');
	confbatch.Add('En fin de traitement:'); 
	confbatch.Add('- consultez le fichier '+batchlogfic+' pour les erreurs/infos');
	confbatch.Add('- les films trouvés seront cochés, les autres non (pour la sélection)');
	confbatch.Add(' (voir: outils/préférences/liste des films/cases à cocher)');
	confbatch.Add(''); 
	confbatch.Add('confirmez votre choix');	
end;	

//------------------------------------------------------------------------------
// ajoute un message dans la log et sauvegarde sur disque
// (parce que je ne sais pas quand ça finit...)
//------------------------------------------------------------------------------
procedure AddToLog(m: string);
begin
	batchlog.Add(m);
	batchlog.SaveToFile(batchlogfic);
end;

//------------------------------------------------------------------------------
// formatage du nom du film (Cinéfil)
//------------------------------------------------------------------------------
function FormatMovieName3(str: string) :string;
begin
// une petite édition avant de formater           
	str := StringReplace(str, ' & ', ' et ');
// remplacer les apostrophes, tirets et points par des blancs       
	str := StringReplace(str, '''', ' ');        
	str := StringReplace(str, '.', ' ');   
 	str := StringReplace(str, '-', ' ');   
	result := FormatMovieName(str);
end;
                             
end.
