#!/usr/bin/perl -T require 5.001; use strict; # Hochperformanter Error-Generator # use CGI::Carp qw( fatalsToBrowser ); # gibt sehr schoen alle Fehlermeldungen auf den Browser. # Sollte in der Release-Version auskommentiert sein! use DB_File; # fuer die Berkeley-DB # use BerkeleyDB; # nanu, bei SuSE nicht dabei? # use Benchmark; # nur zum Testen use DBI; # fuer den MySQL - Zugriff ( Statistik JHF ): # wenn auskommentiert, "schreibe_statistik" bitte nicht aufrufen! # (Der Aufruf steht am Ende von sub bearbeite_anfrage, er wird # durch "$statistik_schreiben = 1;" eingeschaltet.) # Anm.: Die erweiterte Suche mit der Moeglichkeit, Seiten, in denen # bestimmte Begriffe enthalten sind, auszuschliessen, laesst es # weiterhin nicht sehr sinnvoll erscheinen, alle Suchbegriffe # in ein und denselben statistischen Topf zu werfen. # Uebrigens, glaube ich, funktioniert die Routine hier ohnehin nicht. =head1 NAME i_sucheneu.pl - Schnelle erweiterte Suche ueber Indizes in den www.Wohnmobile.net Diskussionsforen =head1 DESCRIPTION ausfuehrlich beschrieben im Artikel von Brian Slesinsky bei Webmonkey: http://www.webmonkey.com/code/97/16/index2a.html =head1 AUTHOR Brian Slesinsky, Ulrich Hoppenheit =cut # vom Systemverwalter zu setzende Variablen --------------------------------------------------------------# my $debug = 0; # Wie gesagt: nur zum Debuggen. my $mega_debug = 0; # Vorsicht, es kommen Megabytes! my $ausfuehrungsdauer_zeigen = 1; # Ein schoenes Feature - solange es schnell geht my $warnungen_zeigen = 0; # Feedback auf unlogische Eingaben. Offenbart in dieser Version leider noch # unsere Behandlung der Umlaute. Sieht dann unprofessionell aus. my $statistik_schreiben = 0; # kontrolliert den Aufruf der MySQL Statistikschreiberoutine my $jhf_cgiurl = "http://www.wohnmobile.net/cgi/forum/i_suche.htm"; # URL dieses Skripts my $jhf_sitename = "www.wohnmobile.net"; my $jhf_indexroot = "/var/suchfix"; # Suchindex - Rootverzeichnis, z.B. "/var/httpdhelpers" my $jhf_indexname = "index.db"; # Dateiname des Suchindex, der Pfad wird kombiniert aus # $jhf_sitename und Formulardaten wie $stamm u. $rubrik my $jhf_neues_forum = "http://www.wohnmobile.net/forum"; # fuer die festen Links auf die 8 Foren und das Stylesheet my $bg_htbody = "/image/BG.JPG"; # HTML my $col_bg_formular ="#c8e9fd"; # RGB HG-Farbe erweitertes Formular my $col_bg_forumlink_stat ="#c8e9fd"; # RGB HG-Farbe statische Links (oben) my $col_bg_forumlink_dyn ="#c8e9fd"; # RGB HG-Farbe dynamische Links (unten) # Schriftfarben my $col_aktuelle = "#ff6600"; # Schriftfarbe aktuelle Seitenzahl bei den Trefferlinks my $col_errmsg = "#ff6600"; # Fehler werden in dieser Farbe ausgegeben my $ein_maxchar = 1024; # max. Anzahl der Zeichen in einem String von Suchbegriffen # my $ein_maxwords = 32; # max. Anzahl der Begriffe in einem Array von Suchbegriffen # my $ein_minlength = 2; # min. Anzahl der Zeichen in einem Suchbegriff my %jhf_titel = ( # Umsetzung von $rubrik in korrekte Ueberschriften nachrichten => 'Wohnmobile.net', ); my $sql_dbdriver = "mysql"; # in sub schreibe_statistik {} my $sql_dsn = "wohnmobile"; # DSN, hier: Datenbankname my $sql_dbuser = "jupp"; my $sql_dbpw = "nek2"; # ENDE vom Systemverwalter zu setzende Variablen ----------------------------------------------------------# # vom Autor zu setzende Variablen my $uh_skript_name = "SuchFix"; my $uh_skript_version = "v.0.22"; my $uh_icke = "Ulrich Hoppenheit, Berlin"; # ENDE vom Autor zu setzende Variablen # weitere globale Variablen my $anfang_zeit = (times)[0]; # Zur Erfassung der Ausfuehrungsdauer my $ende_zeit; # aus dem (einfachen) Formular: # "such_E" ^= "suche einfach" my $such_E; # $FORM{ "suchbegriff" }; deutsche Sonderzeichen werden umschrieben my $such_E_orig; # = $such_E; geben wir unveraendert in der Antwort zurueck my $such_E_enc; # = $such_E; URL-kodiert fuer Links auf Treffer oder "erweitert" my $such_E_string; # Benutzerausgabe mit eingefuegtem AND und OR # aus dem erweiterten Formular: my $such_A; my $such_A_orig = ""; # Felder fuer die erweiterte Suche, die Entsprechungen my $such_O; my $such_O_orig = ""; # befinden sich im erweiterten Formular my $such_N; my $such_N_orig = ""; my $such_A_enc = ""; # fuer GET-Methode URL-kodierte Suchbegriffe my $such_O_enc = ""; my $such_N_enc = ""; # aus beiden Formularen: my $uh_bool; # $FORM{ "uh_bool" }; (einfache Suche) : "AND" oder "OR" # (erweiterte Suche): "nix" my $treff_max; # soviel Treffer werden pro Seite angezeigt my $treff_offset = 0; # zu $treff_max zu addieren - fuer z.B. "Treffer 26 bis 50" my $rubrik; # $FORM{ "rubrik" }; Dies ist der Ordnername, nicht der Titel my $titel; # $titel = $jhf_titel{ $rubrik }; Das ist der Titel my $stamm = ""; # $FORM{ "stamm" }; z.B. "forum/" oder "wwwboard/" my $indexpfad = ""; # = $jhf_indexroot . "/" . $jhf_sitename . "/" . $stamm . $rubrik ."/"; # Anmerkung: Der Schraegstrich am Ende von $stamm steht genau deswegen da, # weil der Wert beim alten Forum leer ist. So bleibt $indexpfad auch beim # alten Forum sauber. Zwar ignorieren bash und Perl doppelte Schraegstriche, # aber eine andere Umgebung koennte da pingeliger sein... # in sub lies_formular {} my $buffer; # die gesamte Information des Formulars in einem String my %FORM; # in zaehle_datensaetze {} # und ausgabe_treffer {} my %db; # unser gebundener Berkeley-DB Hash my %zaehler = (); # Ergebnismengen my %zaehler_eins = (); my %zaehler_zwei = (); my %zaehler_drei = (); my $ref_zaehler; # Globale Referenzen auf die jeweils verwendete Ergebnismenge my $ref_quelle; # (Eigentlich wuerden drei Stueck genuegen. Vielleicht bleibt aber my $ref_quelle2; # das Programm lesbarer, wenn wir vier Referenzen verwenden) my $ref_ziel; my $pages = ""; # $db{ lc $word }; -> gefundene Seitennummern, z.B. "-110-165-186-430". my $page = ""; # jeweils zugewiesene einzelne Seitennummer, z.B.: "-110" my $word; # ein einzelner Suchbegriff my @words; # alle Suchbegriffe my $ref_words; # Globale Referenz auf die jeweils verwendeten Wortliste my @words_orig; # alle Suchbegriffe _mit_ deutschen Sonderzeichen my @words_AND; # Arrays von Suchbegriffen my @words_OR; my @words_NOT; # in sammle_AND {} # und sammle_AND_OR {} my $trefferanzahl = 0; # Trefferzaehler my $workurl; # zum Vervollstaendigen der Links auf die gefundenen Seiten my $trefferansage; my $uh_errmsg = ""; # Zur Fehlerausgabe an Benutzer - Suche wird nicht duchgefuehrt my $uh_warnung = ""; # Nur nur Warnung - Suche wird aber trotzdem durchgefuehrt ############################################################################### -- Anfang Hauptprogramm -- ## # # Formular lesen &lies_formular; $uh_bool = $FORM{ "uh_bool" }; $stamm = $FORM{ "stamm" }; $rubrik = $FORM{ "rubrik" } ? $FORM{ "rubrik" } : ""; $treff_max = $FORM{ "treff_max" } ? $FORM{ "treff_max" } : 0; $treff_offset = $FORM{ "treff_offset" } ? $FORM{ "treff_offset" } : 0; # abhaengige Werte zuweisen $indexpfad = $jhf_indexroot . "/" . $jhf_sitename . "/" . $stamm . $rubrik ."/"; $workurl = "http://" . $jhf_sitename . "/" . $stamm . "/nachrichten/"; $titel = $FORM{ "rubrik" } ? $jhf_titel{ $rubrik } : ""; # Es wurde die Methode "GET" verwendet? - (Benutzer hat auf einen Treffermengenlink oder auf "erweitert" geklickt) if( $ENV{ "REQUEST_METHOD" } eq "GET" ) { if( $FORM{ "suche" } && $FORM{ "suche" } eq "erweitert" ) { # Benutzer hat auf "erweitert" geklickt # und bekommt ein (fast) leeres Formular. if( $FORM{ suchbegriff } ) { # eventuell vorhandene Werte uebernehmen $such_A_orig = $uh_bool eq "AND" ? $FORM{ suchbegriff } : ""; $such_O_orig = $uh_bool eq "OR" ? $FORM{ suchbegriff } : ""; } &ausgabe_kopf_erweitert; # erweiterten Formularkopf ausgeben &ausgabe_debug_info if $debug; # Debug-Info ggf. ausgeben &ausgabe_debug_info_extra if $mega_debug; # und einen Fuss ohne Trefferanzeige print "
 
" . "
\n
 
\n
$uh_skript_name" . " $uh_skript_version - $uh_icke

\n" . "\n\n\n\n\n"; } else { # Benutzer hat auf einen Treffermengenlink geklickt &bearbeite_anfrage; # Suchanfrage bearbeiten } } # wurde die Methode "POST" verwendet? - Benutzer hat auf "submit" gedrueckt else { # Suchanfrage bearbeiten &bearbeite_anfrage; } # ############################################################################### -- Ende Hauptprogramm -- ## sub bearbeite_anfrage { dbmopen( %db, ( $indexpfad . $jhf_indexname ), undef ) or &fehler_kein_index; # or die "$uh_skript_name: Index konnte nicht eroeffnet werden: $!:\n" . $indexpfad . $jhf_indexname; if( $uh_bool eq "nix" ) { # erweiterte Verarbeitung ------------------------------------------------------------------------- # $such_A = $FORM{ "such_A" }; # Werte aus dem Formular zuweisen $such_O = $FORM{ "such_O" }; $such_N = $FORM{ "such_N" }; $such_A = length $such_A >= $ein_maxchar ? substr $such_A, 0, $ein_maxchar : $such_A; # Laenge begrenzen $such_O = length $such_O >= $ein_maxchar ? substr $such_O, 0, $ein_maxchar : $such_O; $such_N = length $such_N >= $ein_maxchar ? substr $such_N, 0, $ein_maxchar : $such_N; $such_A_enc = $such_A_orig = $such_A; # $such_A_enc: URL-kodiert, $such_O_enc = $such_O_orig = $such_O; # $such_A_orig: Benutzerfeedback $such_N_enc = $such_N_orig = $such_N; $such_A =~ tr/A-Z/a-z/; # Umlaute auch verkleinern und uebersetzen, damit $such_A =~ s//ae/g; # sie in jeder Schreibweise auffindbar sind $such_A =~ s//oe/g; $such_A =~ s//ue/g; $such_A =~ s//ss/g; $such_O =~ tr/A-Z/a-z/; $such_O =~ s//ae/g; $such_O =~ s//oe/g; $such_O =~ s//ue/g; $such_O =~ s//ss/g; $such_N =~ tr/A-Z/a-z/; $such_N =~ s//ae/g; $such_N =~ s//oe/g; $such_N =~ s//ue/g; $such_N =~ s//ss/g; # Suchbegriffe fuer GET-Methode URL-kodieren $such_A_enc =~ s/[&+%=]/sprintf("%%%0X",ord("$&"))/eg; # mehr schlecht als recht! $such_O_enc =~ s/[&+%=]/sprintf("%%%0X",ord("$&"))/eg; # es erfasst die wenigsten $such_N_enc =~ s/[&+%=]/sprintf("%%%0X",ord("$&"))/eg; # aller hohen ASCII-Codes. $such_A_enc =~ s/\s+/+/g; $such_O_enc =~ s/\s+/+/g; # alle whitespaces+ zu "+" $such_N_enc =~ s/\s+/+/g; # Arrays zum Suchen @words_AND = ( $such_A =~ /[\w]+/g ); # Zeichen aussieben @words_OR = ( $such_O =~ /[\w]+/g ); # \w = alphanumerische Zeichen und Unterstrich @words_NOT = ( $such_N =~ /[\w]+/g ); # Hashes zum Suchen # man koennte auch hashes von Suchbegriffen nehmen anstatt der Arrays #my %words_AND = ( $such_A =~ /[\w]+/g ); # \w = alphanumerische Zeichen und Unterstrich #my %words_OR = ( $such_O =~ /[\w]+/g ); #my %words_NOT = ( $such_N =~ /[\w]+/g ); # Suchbegriffe bereinigen: unnnoetige Rechenzeit und Fehler vermeiden: # (ginge mit den hashes wahrscheinlich effizienter) my $m=0; my $n=0; for ( $n=0; $n < scalar( @words_OR ); $n++ ) { for ( $m=$n+1; $m < scalar( @words_OR ); $m++ ) { # Alle Doubletten aus OR entfernen if ( $words_OR[$n] eq $words_OR[$m] ) { splice ( @words_OR, $m--, 1 ); # "$m--": Wichtig, sonst fehlt der naechste Wert } } } for ( $n=0; $n < scalar( @words_AND ); $n++ ) { for ( $m=$n+1; $m < scalar( @words_AND ); $m++ ) { # Alle Doubletten aus AND entfernen if ( $words_AND[$n] eq $words_AND[$m] ) { splice ( @words_AND, $m--, 1 ); } } } for ( $n=0; $n < scalar( @words_AND ); $n++ ) { for ( $m=0; $m < scalar( @words_OR ); $m++ ) { # Alle OR - Worte, die schon if ( $words_AND[$n] eq $words_OR[$m] ) { # bei AND vorkamen, aus OR entfernen splice ( @words_OR, $m--, 1 ); } } } for ( $n=0; $n < scalar( @words_NOT ); $n++ ) { for ( $m=$n+1; $m < scalar( @words_NOT ); $m++ ) { # Alle Doubletten aus NOT entfernen if ( $words_NOT[$n] eq $words_NOT[$m] ) { splice ( @words_NOT, $m--, 1 ); } } } for ( $n=0; $n < scalar( @words_NOT ); $n++ ) { for ( $m=0; $m < scalar( @words_AND ); $m++ ) { # NOT - Worte kommen in AND vor if ( $words_AND[$m] eq $words_NOT[$n] ) { # Fehler - Ergebnismenge leer $uh_errmsg = "Keine Dokumente verfügbar, die \"$words_NOT[$n]\" enthalten und gleichzeitig nicht enthalten."; last; # Schleife verlassen } } for ( $m=0; $m < scalar( @words_OR ); $m++ ) { # NOT Worte aus OR bis auf letztes entfernen if ( 1 < scalar( @words_OR ) && $words_OR[$m] eq $words_NOT[$n] ) { $uh_warnung .= "\"$words_NOT[$n]\" ist sowohl unter \"einem der Begriffe\" als auch bei \"ohne die Begriffe\" aufgeführt.
\n"; splice ( @words_OR, $m--, 1 ); } } } if( scalar( @words_OR == 1) ) { # es gibt genau ein OR - Wort for ( $n=0; $n < scalar( @words_NOT ); $n++ ) { for ( $m=0; $m < scalar( @words_OR ); $m++ ) { # dieses kommt in NOT vor: Fehler if ( $words_OR[$m] eq $words_NOT[$n] ) { $uh_errmsg = "Keine Dokumente verfügbar, die \"$words_NOT[$n]\" enthalten und gleichzeitig nicht enthalten."; last; } } } } # Antwort - Kopf (erweitert) ausgeben &ausgabe_kopf_erweitert; if( $uh_warnung && $warnungen_zeigen ) { print "

Hinweis:

$uh_warnung
\n"; } if( ! $uh_errmsg ) { # erweiterte Suche durchfuehren &erweiterte_suche; } # sonst Fehlermeldung ausgeben elsif( $warnungen_zeigen ) { print "

$uh_errmsg

\n"; } # d.h., die Angabe "$warnungen_zeigen = 0;" unterdrueckt auch # die Rueckmeldung eventueller sinnloser Benutzereingaben } else { # herkoemmliche Verarbeitung -------------------------------------------------------------------------- # # urspruengliche Eingabe festhalten $such_E = $FORM{ "suchbegriff" }; $such_E = length $such_E >= $ein_maxchar ? substr $such_E, 0, $ein_maxchar : $such_E; # Laenge begrenzen $such_E_orig = $such_E_enc = $such_E; # parallele Suchbegriffe, f. Feedback u. GET-Methode # Suchworte umschreiben $such_E =~ tr/A-Z/a-z/; # Umlaute auch verkleinern und uebersetzen, damit $such_E =~ s//ae/g; # sie in jeder Schreibweise auffindbar sind $such_E =~ s//oe/g; $such_E =~ s//ue/g; $such_E =~ s//ss/g; # Array zum Suchen # Zeichen aussieben @words = ( $such_E =~ /[\w]+/g ); # \w = alphanumerische Zeichen und Unterstrich # Array mit deutschen Sonderzeichen fuers Feedback bei der Antwort @words_orig = ( $such_E_orig =~ /[\w]+/g ); # Suchstring zur Anzeige mit AND - OR formatieren $such_E_string = join( '" ' . $uh_bool . ' "', @words_orig ) if $uh_bool; # Suchbegriffe fuer die Methode GET kodieren $such_E_enc =~ s/[&+%=]/sprintf("%%%0X",ord("$&"))/eg; # mehr schlecht als recht! $such_E_enc =~ s/\s+/+/g; # alle whitespaces+ zu "+" # Antwort - Kopf (einfach) ausgeben &ausgabe_kopf; # einfache Suche durchfuehren &einfache_suche; } # Dokument abschliessen: &ausgabe_fuss; dbmclose( %db ); # Suchstatistik fuer jhf &schreibe_statistik if $statistik_schreiben; } # ########################################################################### -- Ende sub bearbeite_anfrage -- ## sub numerisch { $a <=> $b; } sub titel_literal { my $a_titel = $jhf_titel{ $a }; my $b_titel = $jhf_titel{ $b }; $a_titel cmp $b_titel; } sub lies_formular { # Get the input if ( $ENV{ 'REQUEST_METHOD' } eq "GET" ) { $buffer = $ENV{ 'QUERY_STRING' }; } elsif ($ENV{ 'REQUEST_METHOD' } eq "POST" ) { read( STDIN, $buffer, $ENV{ 'CONTENT_LENGTH' } ); } # Split the name-value pairs my @pairs = split( /&/, $buffer ); foreach my $pair (@pairs) { ( my $name, my $value ) = split( /=/, $pair ); # Originalfassung: # $value =~ s/%[0-9a-fA-F]{2}/ /g; $value =~ tr/+/ /; $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; $FORM{ $name } = $value; } } sub erweiterte_suche { print "erweiterte_suche:
\n" if $debug; if( scalar( @words_AND ) ){ print "AND gefragt
\n" if $debug; $ref_words = \@words_AND; # $ref_word auf @words_AND richten $ref_ziel = \%zaehler_eins; # $ref_ziel auf %zaehler_eins richten - Grundmenge &zaehle_datensaetze; # fuegt Schluessel ggf.hinzu, inkrementiert Zaehler $ref_quelle = \%zaehler_eins; # Ergebnis uebernehmen $ref_ziel = \%zaehler_zwei; &sammle_AND; # schaufelt Eintraege aus %$ref_zaehler mit # genuegend hohem Zaehler in %$ref_ziel if( !(scalar( @words_OR )) ){ print "kein OR gefragt
\n" if $debug; $ref_zaehler = \%zaehler_zwei; # %zaehler_zwei enthaelt finale Referenz } else { print "und OR gefragt
\n" if $debug; $ref_words = \@words_OR; # Referenz auf @words_OR richten $ref_ziel = \%zaehler_drei; &zaehle_datensaetze; # fuegt Schluessel ggf.hinzu, inkrementiert Zaehler $ref_ziel = \%zaehler_zwei; # %zaehler_zwei - Ergebnismenge AND $ref_quelle2 = \%zaehler_drei; # %zaehler_drei - Ergebnismenge OR &verschneide_datensaetze; # vereinigt die Treffermengen in %$ref_ziel $ref_quelle = \%zaehler_zwei; # Schnittmenge $ref_ziel = \%zaehler; # Ergebnis &sammle_AND_OR; # schaufelt Eintraege aus %$ref_zaehler mit # genuegend hohem Zaehler in %$ref_ziel $ref_zaehler = \%zaehler; # %zaehler enthaelt finale Referenz } } else { print "kein AND, aber OR gefragt
\n" if $debug; $ref_words = \@words_OR; # Referenz auf @words_OR richten $ref_ziel = \%zaehler_eins; # %zaehler_eins - erste Ergebnismenge &zaehle_datensaetze; # fuegt Schluessel ggf.hinzu, inkrementiert Zaehler $ref_quelle = \%zaehler_eins; $ref_ziel = \%zaehler_zwei; &sammle_AND_OR; # schaufelt Eintraege aus %$ref_zaehler mit # genuegend hohem Zaehler in %$ref_ziel $ref_zaehler = \%zaehler_zwei; # %zaehler_zwei enthaelt finale Referenz } if( scalar( @words_NOT ) ) { print "NOT gefragt
\n" if $debug; undef %zaehler_eins; # leeren, sonst komische Ergebnisse! $ref_words = \@words_NOT; # Referenz auf @words_NOT richten $ref_ziel = \%zaehler_eins; # %zaehler_eins - Ergebnismenge NOT &zaehle_datensaetze; # fuegt Schluessel ggf.hinzu, inkrementiert Zaehler $ref_quelle = \%zaehler_eins; $ref_ziel = $ref_zaehler; &loesche_datensaetze # entfernt Eintraege aus %$ref_zaehler } &ausgabe_treffer; # nimmt $ref_zaehler zur Ausgabe } sub zaehle_datensaetze { # Treffer fuer relevante Seiten zaehlen for $word ( @$ref_words ) { # Alle Suchbegriffe werden probiert. Wenn ein Begriff als Schluessel # in %db auftaucht, erhaelt $pages einen Wert zugewiesen, z.B.: $pages = $db{ $word }; # "-110-165-186-430-625-630-648-941-1719-1740-1764" # Ansonsten bekommt $pages den Wert undef: if( $pages ) { # error_log nicht unnoetig fuellen for $page ( $pages =~ /(-\d+)/g ) { # $pages wird zerlegt in Einzelwerte: "-110" "-165" usw., # $page bekommt den jeweiligen Wert zugewiesen. # Solange $page einen Wert besitzt, laeuft die Schleife $$ref_ziel{ $page }++; # %$ref_ziel bekommt entweder einen neuen Schluessel mit dem Wert 1, } # oder der Wert eines bestehenden Schluessels wird inkrementiert } } # %$ref_ziel enthaelt nun als Schluessel alle relevanten Verweise } # mit der Anzahl der gefundenen Begriffe im jeweiligen Wert sub verschneide_datensaetze { # Schnittmengenbildung fuer AND_OR: zwei hashes vergleichen for $page( keys %$ref_ziel ) { # 1. Ergebnis, z.B. aus AND, sowie spaetere Ergebnismenge if( exists $$ref_quelle2{ $page } ){ # 2. Ergebnis, z.B. aus OR, mit 1. Ergebnis verschneiden. $$ref_ziel{ $page }++; # Die Information, wie viele Treffer aus der Bedingung der } # 2. Ergebnismenge eine Seite enthielt, wird durch das } # einfache Inkrementieren hier verworfen } sub loesche_datensaetze { # NOT-Funktion: zwei hashes vergleichen for $page( keys %$ref_ziel ) { # 1. Ergebnis aus AND und/oder OR, sowie spaetere Ergebnismenge if( exists $$ref_quelle{ $page } ){ # 2. Ergebnis aus NOT: Wenn es da einen der Schluessel aus 1. gibt, delete $$ref_ziel{ $page }; # dann wollen wir ihn aus dem 1. Ergebnis entfernen. $trefferanzahl--; } } } sub sammle_AND { # schaufelt Eintraege aus %$ref_quelle mit genuegend hohem Zaehler in %$ref_ziel $trefferanzahl = 0; for $page ( sort numerisch keys %$ref_quelle ) { if( $$ref_quelle{ $page } == scalar( @$ref_words ) ) # wenn sie genau so viele Zaehler hat wie es AND Worte { # in der Abfrage gibt, kommt sie in die Ergebnisliste $$ref_ziel{ $page } = $$ref_quelle{ $page }; $trefferanzahl++; # Trefferzaehler inkrementieren } } } sub sammle_AND_OR { # schaufelt Eintraege aus %$ref_quelle mit genuegend hohem Zaehler in %$ref_ziel $trefferanzahl = 0; for $page ( sort numerisch keys %$ref_quelle ) { if( $$ref_quelle{ $page } >= ( 1 + scalar( @words_AND ) ) ) # wenn sie mindestens einen Zaehler mehr hat { # als AND voraussetzt, kommt sie $$ref_ziel{ $page } = $$ref_quelle{ $page }; # in die Ergebnisliste. $trefferanzahl++; } } } sub ausgabe_treffer { # schreibt Eintraege aus %$ref_zaehler ins Antwort - Dokument print "

$trefferanzahl Treffer

\n\n"; if( $trefferanzahl ) { # keine leeren Listen ausgeben print "
    \n"; my $i = 0; SCHLEIFE: for $page ( sort numerisch keys %$ref_zaehler ) { for( $$ref_zaehler{ $page } ) { last SCHLEIFE if( ++$i > $treff_max + $treff_offset ); if( $i > $treff_offset ) { my $verweis = $db{ $page }; $verweis =~ s/href=".\//href="$workurl/g; print "
  1. $verweis
  2. \n"; } } } print "
\n"; } } sub einfache_suche { print "einfache_suche:
\n" if $debug; my $such_E_pruef = $such_E; $such_E_pruef =~ s/\s//g; # \s = Whitespace if( $such_E_pruef ne "" ) { # leere Abfrage vermeiden - diese Pruefung koennte auch entfallen $ref_words = \@words; # Referenz auf @words richten - nur eine Eingabe fuer AND oder OR if ( $uh_bool eq "AND" ) { print "AND ausgewaehlt
\n" if $debug; $ref_ziel = \%zaehler_eins; # $ref_ziel auf %zaehler_eins richten &zaehle_datensaetze; # fuegt Schluessel ggf.hinzu, inkrementiert Zaehler $ref_quelle = \%zaehler_eins; # Ergebnis aus &zaehle_datensaetze $ref_ziel = \%zaehler_zwei; &sammle_AND; # schaufelt Eintraege aus %$ref_quelle mit # genuegend hohem Zaehler in %$ref_ziel $ref_zaehler = \%zaehler_zwei; # %zaehler_zwei enthaelt finale Referenz } elsif ( $uh_bool eq "OR" ) { print "OR ausgewaehlt
\n" if $debug; $ref_ziel = \%zaehler_eins; # %zaehler_eins - erste Ergebnismenge &zaehle_datensaetze; # fuegt Schluessel ggf.hinzu, inkrementiert Zaehler $ref_quelle = \%zaehler_eins; $ref_ziel = \%zaehler_zwei; &sammle_AND_OR; # inkrementiert Eintraege in %$ref_ziel $ref_zaehler = \%zaehler_zwei; # %zaehler_zwei enthaelt finale Referenz } else { die "$uh_skript_name $uh_skript_version: Boolescher Wert nicht verfuegbar"; } } &ausgabe_treffer; # Treffer ausgeben } sub ausgabe_trefferlinks { # Aufruf in &ausgabe_fuss{} print "\n"; my $erste; my $letzte = ( $trefferanzahl - 1 ) / $treff_max; # nicht durch 0 teilen, d.h. Benutzer my $aktuelle = $treff_offset ? $treff_offset / $treff_max + 1 : 1; # nicht zu dummen Spaessen verleiten my $i; if( $uh_bool eq "nix" ) { # erweiterte Suche ######################### for( $i = 0; $i < $aktuelle -1 ; $i++ ) { # Links auf Nummern unter aktueller ausgeben $erste = $i * $treff_max; print "" . ( $i+1 ) . "\n"; } print "$aktuelle\n"; # aktuelle Nummer ohne Link for( $i = $aktuelle; $i <= $letzte; $i++ ) { # Links auf Nummern ueber aktueller ausgeben $erste = $i * $treff_max; print "" . ( $i+1 ) . "\n"; } } elsif( $uh_bool eq "AND" || $uh_bool eq "OR" ) { # einfache Suche ########################### for( $i = 0; $i < $aktuelle -1 ; $i++ ) { # Links auf Nummern unter aktueller ausgeben $erste = $i * $treff_max; print "" . ( $i+1 ) . "\n"; } print "$aktuelle\n"; # aktuelle Nummer ohne Link for( $i = $aktuelle; $i <= $letzte; $i++ ) { # Links auf Nummern ueber aktueller ausgeben $erste = $i * $treff_max; print "" . ( $i+1 ) . "\n"; } } else { die "$uh_skript_name $uh_skript_version: Boolescher Wert nicht verfuegbar"; } print "\n"; } sub ausgabe_links_andere_foren { # gibt Suchlinks auf die jeweils anderen Foren aus my $rubrik_pruef; print "
" . "
" . "\n"; if( $stamm eq "wwwboard/" ) { # ich wurde aus dem altem Forum aufgerufen print "\n" . ""; if( $uh_bool eq "nix" ) { # erweiterte Suche for $rubrik_pruef ( sort titel_literal keys %jhf_titel ) { print "\n"; } } else { # einfache Suche for $rubrik_pruef ( sort titel_literal keys %jhf_titel ) { print "\n"; } } } else { # d.h.: ( $stamm ne "wwwboard/" ) # ich wurde aus einem der neuen Foren aufgerufen print "\n" . ""; if( $uh_bool eq "nix" ) { # erweiterte Suche for $rubrik_pruef ( sort titel_literal keys %jhf_titel ) { if( $rubrik ne $rubrik_pruef ) { # aktuelles Forum weglassen print "\n"; } } } else { # einfache Suche for $rubrik_pruef ( sort titel_literal keys %jhf_titel ) { if( $rubrik ne $rubrik_pruef ) { # aktuelles Forum weglassen print "\n"; } } } } print "
" . "Das alte Diskussionsforum wurde durchsucht.
" . "Suche nach diesen Begriffen in den neuen Foren:
" . $jhf_titel{ $rubrik_pruef } . "" . $jhf_titel{ $rubrik_pruef } . "
" . "Das Diskussionsforum " . $titel . " wurde durchsucht.
" . "Suche nach diesen Begriffen in den anderen Foren:
" . $jhf_titel{ $rubrik_pruef } . "" . $jhf_titel{ $rubrik_pruef } . "
" . "
" . "
\n"; } sub schreibe_statistik { (my $sec,my $min,my $hour,my $mday,my $mon,my $year,my $wday,my $yday,my $isdst) = localtime(time); my $month = ($mon + 1); $year += 1900; my $uh_date = ""; $uh_date = sprintf( "%04d-%02d-%02d %02d:%02d:%02d:",$year,$month,$mday,$hour,$min,$sec ); my $dbHandle = ( DBI->connect( "DBI:$sql_dbdriver:$sql_dsn","$sql_dbuser","$sql_dbpw" ) ); foreach my $term (my @terms) { my $sql = "INSERT INTO suche_forum_stat (datum, suchbegriffe, forum_id) VALUES ('$uh_date','$term','$rubrik');"; my $statementHandle = $dbHandle->prepare( $sql ); $statementHandle->execute() || die $statementHandle->errstr; } $dbHandle->disconnect(); } sub ausgabe_kopf_erweitert { &ausgabe_kopf_gemeinsam; print <Diskussionsforum $titel

Erweiterte Suche

Zeige max.
  Seiten mit
allen Begriffen: ( und )
einem der Begriffe:
ohne die Begriffe:
ENDE } #/ Ende - sub ausgabe_kopf_erweitert {} # # ------------------------------------------------------------------------------------- # sub ausgabe_kopf_gemeinsam { # Aufruf in &ausgabe_kopf{} und &ausgabe_kopf_erweitert{} ### JHF rausgenommen 25.07.2005 von hier ... # print < # #www.Wohnmobile.net Diskussionsforum - Suche # # # # # # # # # # # # #ENDE ### JHF ... bis hier und ersetzt ab hier ... print("Content-type: text/html\n\n"); my @JHF_aZeilen = (""); open(JHFDATEI, ") { push(@JHF_aZeilen,$_); } close(JHFDATEI); for(@JHF_aZeilen) { print $_; } ### JHF ... bis hier if( !$debug ) { print '' . "\n" . '\n\n muss sein, Netscape 4 "\n
 
" . # erkennt stylesheet sonst nicht "$uh_skript_name $uh_skript_version - $uh_icke" . "
 
 "; # Ausgabe endet hier ----------------------------------------- # Ausgabe endet &ausgabe_debug_info if $debug; # Debug-Info ausliefern &ausgabe_debug_info_extra if $mega_debug; ### JHF gendert 25.07.2005 von hier ### JHF alt: print "\n
' . "\n\n" } } sub ausgabe_kopf { &ausgabe_kopf_gemeinsam; print <Suche nach "$such_E_string":
Zeige max.Seiten mit
erweiterte Suche
ENDE } # Ende - sub ausgabe_kopf {} # # ------------------------------------------------------------------------------------- # sub ausgabe_fuss { if( !$trefferanzahl ) { # Sorry, nix gefunden! $trefferansage = "

Keine Übereinstimmungen.

"; } elsif( $trefferanzahl > $treff_max ) { # mehr Treffer $trefferansage = "

Treffer " . ( $treff_offset+1 ) . " - " . ( $treff_max+$treff_offset < $trefferanzahl ? $treff_max+$treff_offset : $trefferanzahl ) . "
von $trefferanzahl

"; } else { # hoffentlich genau gewuenschte Anzahl $trefferansage = "

( $trefferanzahl Treffer )

"; } # Ausgabe beginnt -------------------------------------------- # Ausgabe beginnt print "\n
\n\n"; # erspart alle "center" -Varianten print "$trefferansage\n\n"; if( 0 < $treff_max && # Trefferlinks ausgeben nur, wenn keine Division $treff_max < $trefferanzahl ) { # durch 0 droht, und nur, wenn die Trefferanzahl &ausgabe_trefferlinks; # es erforderlich macht print "\n
 
"; } if( $ausfuehrungsdauer_zeigen ) { # Verarbeitungszeit ausgeben $ende_zeit = (times)[0]; printf "Suchdauer: %.2f Sekunden
 
\n", 0.01 + $ende_zeit - $anfang_zeit; } # &ausgabe_links_andere_foren; # Suchlinks auf die andern Foren ausgeben print "\n
\n\n" . # neue
\n\n\n"; # HTML ordentlich beenden print "\n\n"; # HTML ordentlich beenden ### JHF eingefgt 25.07.2005 von hier ... my @JHF_aZeilen = (""); open(JHFDATEI, ") { push(@JHF_aZeilen,$_); } close(JHFDATEI); for(@JHF_aZeilen) { print $_; } ### JHF ... bis hier } sub ausgabe_debug_info_extra { # wird aufgerufen aus ausgabe_fuss {} print "
\n"; while( ( my $schluessel, my $wert ) = each %db ) { $wert =~ s/-/ -/g; print "$schluessel => $wert

\n\n"; } print "
\n"; if( $ausfuehrungsdauer_zeigen ) { print "
\n"; $ende_zeit = (times)[0]; printf "
%.2f s

\n", 0.01 + $ende_zeit - $anfang_zeit; } } sub ausgabe_debug_info { # wird aufgerufen aus ausgabe_fuss {} print "
\n"; print '%ENV: ' . %ENV . "
\n
\n"; while( ( my $schluessel, my $wert ) = each %ENV ) { print '$ENV: ' . $schluessel . ' => ' . $wert . "
\n"; } print "
\n"; print "
\n"; print '%FORM: ' . %ENV . "
\n
\n"; while( ( my $schluessel, my $wert ) = each %FORM ) { print '$FORM: ' . $schluessel . ' => ' . $wert . "
\n"; } print "
\n"; print "
\n"; print "\$buffer: $buffer
\n"; print "\$uh_bool: \"$uh_bool\"
\n"; print "\$such_E: $such_E
\n"; print "\$such_E_orig: $such_E_orig
\n"; print "\$such_E_string: $such_E_string
\n"; print "\$such_E_enc: $such_E_enc
\n"; print "
\n"; print 'scalar( @words ): ' . scalar( @words ) . "
\n"; foreach $word ( @words ) { print "\$word: $word
\n"; } print "
\n"; print 'scalar( @words_AND ): ' . scalar( @words_AND ) . "
\n"; foreach $word ( @words_AND ) { print "\$word_AND: $word
\n"; } print "
\n"; print 'scalar( @words_OR ): ' . scalar( @words_OR ) . "
\n"; foreach $word ( @words_OR ) { print "\$word_OR: $word
\n"; } print "
\n"; print 'scalar( @words_NOT ): ' . scalar( @words_NOT ) . "
\n"; foreach $word ( @words_NOT ) { print "\$word_NOT: $word
\n"; } print "
\n"; print "Indexdatei: $indexpfad$jhf_indexname
\n"; print "\$workurl: $workurl
\n"; print "\$rubrik: $rubrik
\n"; print "
\n"; print '%jhf_titel: ' . %jhf_titel . "
\n"; while( ( my $schluessel, my $wert ) = each %jhf_titel ) { print "\$jhf_titel: $schluessel => $wert
\n"; } print "
\n"; my $debug_pages = $pages; # Kein Whitespace in $pages: sehr browserfeindlich! $debug_pages =~ s/-/ -/g; print "\$pages: $debug_pages
\n"; print "
\n"; print '%zaehler: ' . %zaehler . "
\n"; while( ( my $schluessel, my $wert ) = each %zaehler ) { print '$zaehler: ' . $schluessel . ' => ' . $wert . "
\n"; } print "
\n"; print '%zaehler_eins: ' . %zaehler_eins . "
\n"; while( ( my $schluessel, my $wert ) = each %zaehler_eins ) { print '$zaehler_eins: ' . $schluessel . ' => ' . $wert . "
\n"; } print "
\n"; print '%zaehler_zwei: ' . %zaehler . "
\n"; while( ( my $schluessel, my $wert ) = each %zaehler_zwei ) { print '$zaehler_zwei: ' . $schluessel . ' => ' . $wert . "
\n"; } print "
\n"; print '%zaehler_drei: ' . %zaehler . "
\n"; while( ( my $schluessel, my $wert ) = each %zaehler_drei ) { print '$zaehler_drei: ' . $schluessel . ' => ' . $wert . "
\n"; } print "
\n"; print "
\n"; if( $ausfuehrungsdauer_zeigen ) { print "
\n"; $ende_zeit = (times)[0]; printf "
%.2f s

\n", 0.01 + $ende_zeit - $anfang_zeit; } } sub fehler_kein_index { # leider noch nicht obsolet print "Content-type:text/html\n\n" . "Serverfehler" . "\n\n" . "\n" . "
\n" . "

Möglicher Fehler bei der Parameterübergabe

\n\n" . "Wenn Sie diese Mitteilung sehen, befindet sich möglicherweise noch\n" . "eine alte Version des Suchformulars im Cache Ihres Browsers.
\n" . "
\n" . (($debug) ? ( "Index: $indexpfad$jhf_indexname
\n" . "Indexroot: $jhf_indexroot
\n" . "Sitename: $jhf_sitename
\n" . "Stamm: $stamm
\n" . "Rubrik: $rubrik
\n" . "Bool: $uh_bool
\n" . "
\n" ) : "" ). "Sie können zunächst versuchen, die\n" . "www.Wohnmobile.net- Startseite\n" . "aufzurufen, und dann auf den \"Aktualisieren\"- Knopf Ihres Browsers\n" . "zu drücken. Wenn daraufhin die Suche erneut fehlschägt, liegt\n" . "möglicherweise ein serverseitiger Fehler vor.\n
\n
" . "Für eine kurze entsprechende\n" . "Mitteilung " . "wären wir Ihnen dankbar.
\n
\n" . "Ihr Wohnmobile.net - Team
\n
\n" . "
\n"; # exit 1; # Besser nicht aufrufen: kann in bestimmten Faellen laut Lit. den Serverprozess beenden. # Dies scheint bei "s07_test" nicht zuzutreffen, und ist laut Literatur bei # Verwendung des Apache Moduls mod_perl auch nicht zu befuerchten. # Trotzdem immerhin: goto PROGRAMMENDE; } PROGRAMMENDE: __END__