package Search::Circa::Annuaire; # module Search::Circa::Annuaire : See Search::Circa # Copyright 2000 A.Barbet alian@alianwebserver.com. All rights reserved. # $Log: Annuaire.pm,v $ # Revision 1.7 2002/08/19 10:17:13 alian # Correct bug in previous version: @l = ... || return undef # # Revision 1.6 2002/08/17 18:19:02 alian # - Minor changes to all code suite to tests # # Revision 1.5 2001/10/28 16:28:46 alian # - Add some debug info on level 3 # # Revision 1.4 2001/10/28 12:23:23 alian # - Correction d'un warning sur l'affichage du titre de la categorie racine # # Revision 1.3 2001/08/26 23:12:10 alian # - Add POD documentation # - Add CreateDirectory method use strict; use DBI; use Search::Circa; use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION); require Exporter; @ISA = qw(Exporter Search::Circa); @EXPORT = qw(); $VERSION = ('$Revision: 1.7 $ ' =~ /(\d+\.\d+)/)[0]; # Default display of item link $Circa::Annuaire::Ts = '"
  •   ".($indiceG+1)." - $titre $description
    Url: $url Last update: $last_update
  • \n"'; # default display of category link $Circa::Annuaire::Tc='"

    $nom_complet

    \n"'; #------------------------------------------------------------------------------ # new #------------------------------------------------------------------------------ sub new { my $class = shift; my $self = $class->SUPER::new; bless $self, $class; $self->{nbResultPerPage} = 10; $self->{SCRIPT_NAME} = $ENV{'SCRIPT_NAME'} || "search.cgi"; return $self; } #------------------------------------------------------------------------------ # create_annuaire #------------------------------------------------------------------------------ sub create_annuaire { my ($self, $idr, $masque, $path)=@_; # On previent que on genere des pages statiques $self->{_create} = 1; # racine des fichiers crees my $orig = $path."/".$idr.'/'; # On charge la liste des categories my $rt = $self->categorie->loadAll($idr); # Pour chaque categorie, on cree la page correspondante foreach my $categorie (keys %$rt) { my $f; if ($categorie != 0) { my $parent = $categorie; while ($$rt{$parent}[1]) { if ($f) { $f = $$rt{$parent}[1]."/".$f; } else {$f = $$rt{$parent}[1]; } $parent = $$rt{$parent}[1]; } # Creation du repertoire (recursif) if ($f) { $f = $orig.$f; } else { $f=$orig; } my @l = split(/\//, $f); push(@l,$categorie); $self->CreateDirectory(@l); # Creation du fichier $f .= '/'.$categorie.'/index.html'; } else { $f= $orig.'/index.html'; } print "Create $f ($$rt{$categorie}[0])\n"; open(FILE, ">$f") || die "Can't create $f:$!\n"; print FILE $self->GetContentOf($masque, $idr, $categorie); close(FILE); } $self->{_create} = 0; } #------------------------------------------------------------------------------ # CreateDirectory #------------------------------------------------------------------------------ sub CreateDirectory { my ($self, @l) = @_; my $o; foreach (@l) { if ($_) { $o.='/'.$_; if (!-e $o) { print "Creation de $o\n"; mkdir($o, 0755); } } } } #------------------------------------------------------------------------------ # GetContentOf #------------------------------------------------------------------------------ sub GetContentOf { my ($self, $masqueOrig, $id, $categorie,$templateS,$templateC,$first)=@_; if (!$categorie) {$categorie=0;} if (!$id) {$id=1;} if (!$templateC) { $templateC = $Circa::Annuaire::Tc; } if (!$templateS) { $templateS = $Circa::Annuaire::Ts; } $self->trace(3,"Search::Circa::Search->GetContentOf $id $categorie"); my ($masque) = $self->categorie->get_masque($id,$categorie) || $masqueOrig; $masque = $masqueOrig if ((!$masque || !-r $masque) && $masqueOrig); $masque = $CircaConf::TemplateDir."/circa.htm" if (!$masque or !-r $masque); my @catess = $self->GetCategoriesOf($categorie,$id); return undef if (!@catess); my $titre = shift @catess; if (!$titre) { $titre='';} $self->trace(3,"Search::Circa::Search->GetContentOf $categorie => $titre"); my ($sites,$liens) = $self->GetSitesOf($categorie,$id,$templateS,$first); return undef if (!$sites and !$liens); # Substitution dans le template my ($c1,$c2); if (@catess) { $c1 = join(' ',@catess[0..$#catess/2]) || ' '; $c2 = join(' ',@catess[($#catess/2)+1..$#catess]) || ' '; } else { ($c1,$c2)=(' ',' '); } my %vars = ('resultat' => $sites || ' ', 'categories1' => $c1, 'categories2' => $c2, 'titre' => '

    Annuaire

    ' .'

    '.($titre || ' ').'

    ', 'listeLiensSuivPrec'=> $liens || ' ', 'words' => ' ', 'categorie' => $categorie || 0, 'id' => $id, 'nb' => 0); # Affichage du resultat return $self->fill_template($masque,\%vars); } #------------------------------------------------------------------------------ # GetCategoriesOf #------------------------------------------------------------------------------ sub GetCategoriesOf { my ($self,$id,$idr,$template)=@_; $self->trace(3,"Search::Circa::Search->GetCategoriesOf $id $idr"); $idr=1 if !$idr; $id=0 if !$id; $template = $Circa::Annuaire::Tc if !$template; my (@buf,%tab,$titre); # On charge toutes les categories my $ref = $self->categorie->loadAll($idr);; if (ref($ref)) { %tab = %$ref;} else { $self->trace(1,"Search::Circa::Search->GetCategoriesOf after". " loadAll $idr"); return undef; } foreach my $key (keys %tab) { my $nom_complet; my ($nom,$parent)=($tab{$key}[0],$tab{$key}[1]); $nom_complet=$self->categorie->getParent($key,%tab); my $links; # Le lien des categorie est != dans le cas de la generation # et quand c'est fait a la volee if ($self->{_create}) { $links = $key; } else { $links = $self->get_link_categorie($key, $idr, 0);} if ( ($parent==$id) and ($key != 0)) {push(@buf,eval $template);} } if ($#buf==-1) {$buf[0]="

    Plus de catégorie

    ";} my $nom_complet=$self->categorie->getParent($tab{$id}[1],%tab); if ($self->{_create}) { $titre = "$nom_complet"; } else { $titre = "get_link_categorie($tab{$id}[1], $idr, 0) ."\">$nom_complet"; } unshift(@buf,$titre); $self->trace(3,"Search::Circa::Search->GetCategoriesOf End: $id=> $buf[0]"); return @buf; } #------------------------------------------------------------------------------ # GetSitesOf #------------------------------------------------------------------------------ sub GetSitesOf { my ($self,$id,$idr,$template,$first)=@_; $self->trace(3,"Search::Circa::Search->GetSitesOf $id $idr"); if (!$idr) {$idr=1;} if (!$id) {$id=0;} if (!$template) {$template=$Circa::Annuaire::Ts;} my ($buf,$buf_l); my $requete = " select url,titre,description,langue,last_update from ".$self->{PREFIX_TABLE}.$idr."links where categorie=$id and browse_categorie='1' and parse='1'"; my $sth = $self->{DBH}->prepare($requete); if (!$sth->execute()) { $self->trace(1,"Search::Circa::Search-> GetSitesOf ". "Erreur $requete:$DBI::errstr\n"); return undef; } my ($facteur,$indiceG)=(100,0); while (my ($url,$titre,$description,$langue,$last_update) = $sth->fetchrow_array) { $indiceG++; if ($last_update eq '0000-00-00 00:00:00') {$last_update='?';} if (defined($first)) { if ($indiceG>$first and ($indiceG<($first+$self->{nbResultPerPage}))){ $buf.= eval $template; } if (!(($indiceG-1)%$self->{nbResultPerPage})) { if (($indiceG-1)==$first) { $buf_l.=((($indiceG-1)/$self->{nbResultPerPage})+1).' -';} else { $buf_l .= '' .((($indiceG-1)/$self->{nbResultPerPage})+1).'-';} } } else { $buf.= eval $template;} } if ($indiceG>$self->{nbResultPerPage} and defined($first)) {chop($buf_l);$buf_l='

    <'.$buf_l.'>

    ';} if (!$buf) {$buf="

    Pas de pages dans cette catégorie

    ";} if (wantarray()) {return ($buf,$buf_l);} else {return $buf;} } #------------------------------------------------------------------------------ # get_link_categorie #------------------------------------------------------------------------------ sub get_link_categorie { my ($self,$no_categorie,$id,$first) = @_; if (!defined($first)) { $first = 0; } if (defined($no_categorie)) {return $self->{SCRIPT_NAME}."?categorie=$no_categorie&id=$id&first=$first";} else {return $self->{SCRIPT_NAME}."?id=$id&first=$first";} } #------------------------------------------------------------------------------ # POD DOCUMENTATION #------------------------------------------------------------------------------ =head1 NAME Circa::Annuaire - Create html pages for annuaire =head1 SYNOPSIS # Create Search::Circa::Annuaire object my $annuaire = new Search::Circa::Annuaire; # Connect appli if (!$annuaire->connect($user,$pass,$db,"localhost")) {die "Erreur à la connection MySQL:$DBI::errstr\n";} # Create all page in /tmp/annuaire directory for # account 1 with defaut file $masque $annuaire->create_annuaire(1, $masque, "/tmp/annuaire"); # Disconnect appli $annuaire->close; =head1 DESCRIPTION =head1 VERSION $Revision: 1.7 $ =head1 Public Class Interface =over =item create_annuaire =item GetContentOf =item GetCategoriesOf =item GetSitesOf =back =head1 Private Class Interface =over =item get_link_categorie =item CreateDirectory =back =head1 AUTHOR Alain BARBET alian@alianwebserver.com =cut