Xchat - script perl away

0/5 (7 avis)

Snippet vu 13 830 fois - Téléchargée 29 fois

Commenter

Contenu du snippet

Un petit script codé en perl pour xchat remplissant les fonctions d'away.

Ce n'est pas une creation mais une adaptation de la fonction away du script hyperion.

J'ai modifié 2 3 trucs et l'ai francisée.

Mettez le script ci-dessous dans un fichier nommé 'away.pl' et enregistrez le dans le repertoire de xhat ( ~/.xchat2/ sous linux )

Source / Exemple : 


#!/usr/bin/perl -w
# Away Script pour x-chat basé sur le script Hyperion
# Version 1.0 du 14/07/2005

###############################################################################################"
# CONFIGURATION
###############################################################################################"

# chemin du fichier conservant les logs
$hlog_file = "~/.hyperion.awaylog";

# complément du pseudo à utiliser lors du passage en absence
$haway_nick = "[away]";

# raison par defaut de l'absence
$hdefreason = "parti, donc plus la c'est à dire absent !";

# effacer les logs apres les avoir lus
$hautoclear = 1;

###############################################################################################"

sub make_my_time;
sub hyp_log;
sub wide_msg;
sub join_handler;
sub privmsg_handler;
sub goaway_handler;
sub comeback_handler;
sub vlog_handler;
sub clog_handler;

$hreason=$hdefreason;

IRC::register("Away", "1.00", "", "");

IRC::print "\002\0034:: Chargement du script: Away v1.0 ::\n";

IRC::add_command_handler("away", "goaway_handler");
IRC::add_command_handler("back", "comeback_handler");
IRC::add_command_handler("vlog", "vlog_handler");
IRC::add_command_handler("clog", "clog_handler");

IRC::add_message_handler("PRIVMSG", "privmsg_handler");
IRC::add_print_handler("Join", "join_handler");

IRC::print "\002\0034Away - Les commandes\n\n";
IRC::print "\002\0033/away [raison]      -- Se mettre absent\n";
IRC::print "\002\0033/back               -- Etre de retour\n";
IRC::print "\002\0033/vlog               -- Voir les logs\n";
IRC::print "\002\0033/clog               -- Effacer les logs\n";

sub make_my_time {
	($sec, $mun, $hr, $mday, $mon, $yr, $wday, $yday, $isdist) = localtime(time);
	return sprintf("%02d:%02d:%02d %02d/%02d/%04d", $hr, $min, $sec, $mon + 1, $mday, $yr + 1900);
}

sub hyp_log {
	open HALOG, ">>$hlog_file";
	printf HALOG "%s: %s\n", make_my_time(), @_;
	close HALOG;
}

sub wide_msg {
	my $text = join(' ', @_);
	my @channels = IRC::channel_list();
	while (@channels) {
		$nick = pop(@channels);
		$serv = pop(@channels);
		$chan = pop(@channels);
		$es = IRC::get_info(3);
		$deb = substr($chan, 0, 1);
		IRC::send_raw "PRIVMSG $chan :$text\n";
		if ($deb eq "#") {
			IRC::command_with_server(sprint_f("/notice %s %s %s", $chan, $nick, $text), $serv);
		}
	}
}

sub join_handler {
	$line = join(' ', @_);
	$line =~ s/\s+/ /g;
	@ar = split ' ', $line;
}

sub privmsg_handler 
{
	if ($haway == 0) {
		return 0;
	}
	my $line = shift(@_);
	my $n = IRC::get_info(1);
	$line =~ /:(.*)!(.*@.*) .*:(.*)/;
	my $u= $1;
	my $l= $2;
	my $m= $3;
	$n.= "\$";
	if($l =~ / $n/) {
		hyp_log "[$u] $m";
		IRC::send_raw "PRIVMSG $u : Je suis absent ($hreason) mais vos messages en privé seront enregistrés.\n";
		return 1;
	}
	return 0;
}

sub goaway_handler
{
	$hreason = shift(@_);
	if ($haway == 1) {
		IRC::print "\002\0034:: VOUS ETES DEJA ABSENT ::\n";
		return 1;
	}
	hyp_log "-- ABSENCE --";
	IRC::print "\002\0034:: PASSAGE EN ABSENCE ::\n";
	if(!$hreason) {
		$hreason = $hdefreason;
	}
	wide_msg "s'absente ($hreason) mais vos messages en privé seront enregistrés.";
	$hold_nick = IRC::get_info(1);
	@servers = IRC::server_list();
	foreach (@servers) {
		IRC::command_with_server(sprintf("/nick %s%s", $hold_nick, $haway_nick), "$_");
	}
	$haway = 1;
	return 1;
}

sub comeback_handler
{
	if($haway == 0) {
		IRC::print "\002\0034:: VOUS N'ETES PAS ABSENT ::\n";
		return 1;
	}
	IRC::print "\002\0034:: RETOUR DE VOTRE ABSENCE ::\n";
	@servers = IRC::server_list();
	foreach (@servers) {
		IRC::command_with_server(sprintf("/nick %s", $hold_nick), "$_");
	}
	$haway = 0;
	wide_msg "est de retour!";
	hyp_log "-- RETOUR --";
	return 1;
}

sub vlog_handler {
	IRC::print "\n\002\0034:: MESSAGES EN ABSENCE ::\n";
	open HVLOG, "<$hlog_file";
	while(<HVLOG>) {
		IRC::print $_;
	}
	close HVLOG;
	IRC::print "\002\0034:: FIN DES MESSAGES ::\n\n";
	if($hautoclear == 1) {
		clog_handler;
	}
	return 1;
}

sub clog_handler {
	open HVLOG, ">$hlog_file";
	close HVLOG;
	IRC::print "\002\0034:: LES MESSAGES EN ABSENCE ONT ETE SUPPRIMES ::\003\n";
	return 1;
}

A voir également

Ajouter un commentaire Commentaires
Sizlaa Messages postés 58 Date d'inscription mardi 2 novembre 2004 Statut Membre Dernière intervention 20 septembre 2005
8 août 2005 à 00:23
Pour un début en Perl, je trouve ce code pas trop mal ^^.
Je n'ai pas grand chose a ajouter car PaDa a déjà tout dit ;|.
Pour passer a GTK il faut déjà avoir de bonnes bases en perl sinon tu seras vite déborder (c'est juste un conseil).
Enfin bon, c'est quand même "cool" qu'il y ait enfin un code source en perl
Ceci dit Bonne continuation
++
cs_PaDa Messages postés 1804 Date d'inscription mardi 15 juillet 2003 Statut Membre Dernière intervention 22 septembre 2009 6
19 juil. 2005 à 12:06
okay no pb ;)
lumesh Messages postés 564 Date d'inscription jeudi 21 février 2002 Statut Membre Dernière intervention 7 novembre 2008
19 juil. 2005 à 11:33
"Ce n'est pas une creation mais une adaptation de la fonction away du script hyperion." ...

en fait vois tu g surtout adapté le gros script de base à mes besoins.
De plus il deconnait grave donc g modifier en sorte que cela fonctionne ....

Le perl je n'y connai keudale, mais tt langage de script il est possible tres rapidement de modifier un code sans vraiment connaitre la synthaxe (au pire le net est la pr nous aider).

Petit a petit bon j'apprendrai le perl. Etant sous nux je pense qu'il est becessaire de le connairtre.

Suite ua prochain episode.
cs_PaDa Messages postés 1804 Date d'inscription mardi 15 juillet 2003 Statut Membre Dernière intervention 22 septembre 2009 6
18 juil. 2005 à 18:34
sympa..
j'ai pas pu tester, j'ai pas Xchat sur ce pc, je le ferai prochainement..
J'ai qq questions cependant :
- pourquoi rester a l'ancienne lib IRC:: et pas la nouvelle lib Xchat:: (qui est encore développée, documentée, suivie..)
- GTK ? et sous windows ? :/// GTK "bave" avec ma version de Xchat perso lorsque le texte défile.. enfin j'ai testé ca y a qq mois, le salon défile, et la bordure de fenêtre inférieure finit par pourir tout l'écran.. :/
- ca ca me parait "dangereux", du moins ca peut poser souci :
my $n = IRC::get_info(1); #[...]
$n.= "\$";
if($l =~ / $n/) {
Tu n'échappes pas les potentiels meta chars dans le IRC::getinfo(1), cela dit je ne sais pas ce que représente ce truc, j'ai la flemme de vérif sur xchat.org ^^
Au cas ou, il existe une possibilité d'échappement "global" du texte dans une regex, par les metachars \Q...\E (ca évitera ptet des reconnaissances foireuses, a toi de juger si c'est utile, j'ai pas forcément bien pigé..)
- pas trop pigé la fonction join_handler
- pourquoi déclarer toutes tes sous-routines en haut, en plus de la déclaration effective ? c'est une question naïve..
cs_tofu Messages postés 1726 Date d'inscription vendredi 12 septembre 2003 Statut Membre Dernière intervention 13 juin 2009 1
14 juil. 2005 à 23:14
Pour un début c'est déjà bien, perso à part planter/reboot xchat j'arrive pas à grd chose en perl :D
S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (lumesh)