Popup en perl

Fermé
Signaler
Messages postés
1521
Date d'inscription
mardi 14 août 2007
Statut
Membre
Dernière intervention
3 avril 2010
-
Messages postés
1521
Date d'inscription
mardi 14 août 2007
Statut
Membre
Dernière intervention
3 avril 2010
-
Bonjour,

Voila je cherche a faire un popup qui aura pour but d'afficher simplement un message style transfert effectué.

Je ne sais pas s'il existe un module bref je cherche dépannez moi svp

merci d'avance

4 réponses

Messages postés
21331
Date d'inscription
jeudi 4 novembre 2004
Statut
Modérateur, Contributeur sécurité
Dernière intervention
30 octobre 2019
3 562
Messages postés
1521
Date d'inscription
mardi 14 août 2007
Statut
Membre
Dernière intervention
3 avril 2010
22
oui je vien de voir désolé de pas avoir répondu j'étais tellement sur mon problème que je l'ai résolut sans regarder si j'avais une réponse je vais le mettre en résolut.

par contre merci pour le lien mais comment ferais tu pour l'adapter a ce code stp?

Interface.pl

#!/usr/bin/perl
use warnings;
use Carp;
use strict;
 
use Tk;
use Tk::Photo;
use Tk::PNG;
 
use Connexion; 
 
# Connexion au serveur ftp
my $file = '/home/seb/workspace/Islo/Configuration';
my $ObjetConnexion = new Connexion($file);
 
 
#Création de la fenêtre principale
my $fenetre = MainWindow->new();
 
#Définition de la taille min de la fenêtre
$fenetre->minsize( '500', '300' );
 
#Définition du title de la fenêtre
$fenetre->title("Islo People");
 
#Création de la barre de menu
my $barre_menu = $fenetre->Frame( -relief => 'groove', -borderwidth => 2 );
 
#Création de la barre du menu général
my $menu_gen = $barre_menu->Menubutton(
    -text      => 'Menu',
    -font      => '{Garamond} 10',
    -tearoff   => 0,
    -menuitems => [
        [   'command' => 'Quitter',
            -font     => '{Garamond} 10',
            -command  => [\&Quitter, $ObjetConnexion],
        ]
    ]
);
 
#  Création d'un cadre
my $frame1
    = $fenetre->Frame()->pack( -side => "bottom", -padx => 0, -pady => 0 );
 
#Affichage du menu général à gauche
$menu_gen->pack( -side => 'left' );
 
#Affichage de la barre de menu en haut de la fenêtre
$barre_menu->pack( -side => 'top', -anchor => 'n', -fill => 'x' );
 
my $ObjImage = $fenetre->Photo(
    -format => "png",
    -file   => "/home/seb/Desktop/Islo_people/logo.png"
);
my $bouton2 = $fenetre->Button( -image => $ObjImage )->pack();
 
#parcourir
my $chemin;
my $BoutonParcourir = $frame1->Button(
    -text    => 'Parcourir',
    -command => [ \&Chemin, $fenetre, \$chemin ],
)->pack();
 
# Envoyer
my $BoutonEnvoyer = $frame1->Button( 
  -text => 'Envoyer',
    -command => sub {
        $ObjetConnexion->Transfert($chemin);
    },
  
)->pack();
 
 
 
#my $status_var =0;
 
#$frame1->ProgressBar(
#            -borderwidth => 10,
#            -relief => 'sunken',
#            -width => 35,
#           -length => 500,
#           -padx => 0,
#           -pady => 0,
#           -variable => \$status_var,
#            -colors => [0, 'green'],
#            -resolution => 0,
#           -blocks => 50,
#           -anchor => 'w',
#           -from =>'0',
#           -to => '100'
#          )->pack(
#                  -padx => 10,
#                  -pady => 10,
##                  -fill => 'both'
#                 );
 
# La boucle dans laquelle la variable de ProgressBar change
 
#for (my $lostime = 0 ; $lostime < 101 ; $lostime += 5)
#{
#    sleep 1 ;
#    $status_var=$lostime ;
 
# l'instruction suivante permet la prise en compte
# des changements de valeurs de $status_var dans Perl/Tk,
# ici  le widget Progressbar
 
#   $fenetre->update;
# }
 
# sleep 5;
#print "Fin de l'exemple update \n";
# $fenetre->destroy;
 
#Création de notre barre de statut à l'aide d'un Label
#my $barre_statut = $fenetre->Label(-relief => 'groove', -text => "Islo people", -font => '{Garamond} 10');
 
#On l'ajoute en bas de la fenêtre afin de lui donner l'effet barre de statut
#$barre_statut->pack( -side => 'bottom', -fill => 'both');
 
MainLoop;
 
#Définition de la fonction de fermeture de l'application
sub Quitter 
{
    my ( $ObjetConnexion ) = @_;
    $ObjetConnexion->FermerConnexion();
    exit(0);
}
 
sub Chemin 
{
    my ( $fenetre, $RefChemin ) = @_;
 
    ${$RefChemin} = $fenetre->getOpenFile( -initialdir => '/home', );
 
    return;
}


Connexion.pm

package Connexion;
 
use strict;
use Carp;
use warnings;
use Net::FTPSSL;    # FTP
use Config::Std;    # Parser fichier de configuration 
 
our @ISA     = qw(Exporter);
our @EXPORT  = qw / ConnectionFTP Transfert FermerConnexion /;
our $VERSION = '0.01';
 
# Constructeur
sub new 
{
    my ( $class, $FichierConfig ) = @_;
 
# reference anonyme vers une table de hachage vide 
    my $self = {};
 
    unless ( defined $FichierConfig ) 
    {
        croak("Fichier de configuration non defini\n");
    }
 
    read_config $FichierConfig => my %config;
 
    $self->{Config} = $config{PARAMETERS};
 
    # Etat de la connexion
    $self->{etat} = 0;
 
# on indique que cette reference est liée au package (à la class) $class qui
#faudra utiliser.
    bless( $self, $class );
 
    #Connection au FTP
    my $ftps = Net::FTPSSL->new(
        $self->{Config}{server},
        Port  => $self->{Config}{port},
        Debug => 1
    ) or return $self;
 
    # Si la connection n'est pas effectué $etat prend la valeur faux
    $ftps->login( $self->{Config}{user}, $self->{Config}{mdp} )
        or return $self;
 
    # Connexion OK
    $self->{etat} = 1;
    $self->{FTP}  = $ftps;
 
    #on retourne la référence vers la table de hachage ainsi contruite.
    return $self;
}
 
sub Transfert 
{
    my ( $self, $fichier ) = @_;
    	
    # Transfert du fichier
    if ( $self->{etat} == 1 ) 
    {
    	$self->{FTP}->cwd("/photographes");
        $self->{FTP}->put($fichier);
        if ($self->{FTP}->get($fichier)) 
        {
        	Alert
        }
        else 
        {
        	Alert
        }
    }
    else 
    {
        warn "Transfert impossible, connexion non etablie\n";
    }
    return;
}
 
sub VerifierExtension 
{
    my ($TonFichier) = @_;
 
    unless ( scalar(@_) == 1 ) 
    {
        croak('Usage : VerifierExtension("Monfichier.jpeg");');
    }
 
    # Verification de l'extension
    unless ( -e $TonFichier and $TonFichier =~ m{(?:jpe?g|raw)$} ) 
    {
        croak(
            "Mauvaise extension pour le fichier $TonFichier\nAutorise : jpeg, raw\n"
        );
    }
 
    return;
}
 
sub FermerConnexion 
{
    my ($self) = @_;
 
    $self->{FTP}->quit() if ( $self->{etat} == 1 );
 
    return;
}
 
1;



en fait jveux faire afficher les alertes (popup) quand le fichier est bien envoyé ou s'il ne l'a pas été.
Y'a écrit alert dans connexion.pm c'est la que je souhaite les déclenché.
Mais je ne vois pas comment faire pourrais tu m'aider svp?
merci d'avance
Messages postés
21331
Date d'inscription
jeudi 4 novembre 2004
Statut
Modérateur, Contributeur sécurité
Dernière intervention
30 octobre 2019
3 562
Re,

Au début de Connexion.pm tu ajoutes
use Tk;

Ensuite où tu dois mettre les alertes, inspire toi de lien que je t'ai donné

Sinon tu peux tester
my $msg=MainWindow->new;
$msg->geometry("250x50+0+0");
$msg->title("Transfert fichiers");
$msg->Button(-text => "Fin", -command => sub{exit})->pack(-side=>'left',-expand=>1);
$msg->Button(-text => "Continuer", -command => \&fonction)->pack(-side=>'right',-expand=>1);

sub fonction{# à toi d'écrire la fonction
        print "ok\n";
}
MainLoop;

Messages postés
1521
Date d'inscription
mardi 14 août 2007
Statut
Membre
Dernière intervention
3 avril 2010
22
je ne peut pas mettre ca dans interface.pl ?

my $msg=MainWindow->new;
$msg->geometry("250x50+0+0");
$msg->title("Transfert fichiers");
$msg->Button(-text => "Fin", -command => sub{exit})->pack(-side=>'left',-expand=>1);
$msg->Button(-text => "Continuer", -command => \&fonction)->pack(-side=>'right',-expand=>1);

sub fonction Alerte{blabla
}