IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Programmation et administration système Perl Discussion :

Besoin d'aide pour faire fonctionner un script Perl pour un photomaton sous Linux.


Sujet :

Programmation et administration système Perl

  1. #1
    Nouveau Candidat au Club
    Profil pro
    Inscrit en
    Mai 2013
    Messages
    1
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Mai 2013
    Messages : 1
    Points : 1
    Points
    1
    Par défaut Besoin d'aide pour faire fonctionner un script Perl pour un photomaton sous Linux.
    Bonjour,
    Je souhaite réaliser un photomaton en m’appuyant sur un script Perl que j'ai trouvé sur un autre site, mais je n'y connais rien du tout en programmation .

    Ce script participe à mon projet de réaliser un photomaton avec un ordinateur sous Linux et le programme Cheese pour piloter la webcam. Comme je ne dispose que d'un ordinateur portable je souhaite désactiver toutes les touches du clavier excepté la touche espace qui donne l'ordre à Cheese de déclencher une "photo".

    Pour exécuter ce script, j'ai l'environnement suivant:
    • Xubuntu 12.04 i686 avec un noyau 3.2.0-44-generic
    • perl 5, version 14, subversion 2 (v5.14.2)
    • xkeycaps 2.47-4 (xmodpamp)
    • xdotool 1:2.20110530.1-3ubuntu1
    • cheese 3.4.1-0ubuntu2.1 (que je souhaite "piloter" uniquement via la touche espace)


    Ci-dessous le code original
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
    131
    132
    133
    134
    135
    136
    137
    138
    139
    140
    141
    142
    143
    144
    145
    146
    147
    148
    149
    150
    151
    152
    153
    154
    155
    156
    157
    158
    159
    160
    161
    162
    163
    164
    165
    166
    167
    168
    169
    170
    171
    172
    173
    174
    175
    176
    177
    178
    179
    180
    181
    182
    183
    184
    185
    186
    187
    188
    189
    190
    191
    192
    193
    194
    195
    196
    197
    198
    199
    200
    201
    202
    203
    204
    205
    206
    207
    208
    209
    210
    211
    212
    213
    214
    215
    216
    217
    218
    #!/bin/env perl
    use warnings;
    use strict;
    use Data::Dumper;
    my $lastmod="2006/05/25";
    my $datemod="2011/03/29";
    my $defaultpassword="mypassword";
    my $progname=$0;
    $progname =~ s%.*/%%g;
     
    sub usage($)
    {
      my ($exitcode)=@_;
     
      print STDERR <<END_OF_USAGE ;
    usage for $progname
    $progname [-xy=XX,YY]
    			  [-p|password thepassword]
    			  [-stars|-visible|-visible=maxlen]
    			  [-message]
    			  [-w|-withmouse]
    			  [-help]
     
    $progname was written by:Chris Sincock
    (this version $datemod)
    Copyright (C) 2006 Chris Sincock
     -withmouse option added 2008 Andrew Oakley under GPL
     adapted by PAB to work with cheese to do a photobooth !
     
    This is free software; see the GNU GPL license for copying conditions.
    There is NO warranty; not even for MERCHANTABILITY or FITNESS FOR
    A PARTICULAR PURPOSE
     
     
    If you specify -password or -stars it will default to not telling you
     what password to type
    If you do not specify -password or -stars or -vis, it will tell you
     what password to type and the password will be $defaultpassword
     
    You can clear whatever has already been typed by hitting <Return>
    END_OF_USAGE
     
      exit($exitcode);
    }
     
     
    my $password=$defaultpassword;
    my $message="Type the password to quit\n:";
    my $true=1;
    my $false=0;
    my $noshow=$false;
    my $withmouse=$false;
    my $maxshownlength=30;
    my $defaults_changed=$false;
    my $defaults_changed_vis=$false;
     
    my @startpos=(50,50);
     
    while (@ARGV)
    {
      my $arg=shift @ARGV;
      if($arg =~ /^-xy=(\d+),(\d+)$/i)
      {
        @startpos=($1,$2);
      }
      elsif($arg =~ /^(-|--)(h|help|usage|[?])$/i)
      {
        usage(0);
      }
      elsif($arg =~ /^(-|--)(p|pass|password)$/i)
      {
        if(!@ARGV)
        {
          print STDERR "missing argument\n";
          usage(-1);
        }
        $password=shift @ARGV;
        $defaults_changed=$true;
      }
      elsif($arg =~ /^(-|--)(s|stars)$/i)
      {
        $noshow="stars";
        $defaults_changed=$true;
      }
      elsif($arg =~ /^(-|--)(w|withmouse)$/i)
      {
        $withmouse=$true;
        $defaults_changed=$true;
        $defaults_changed_vis=$true;
      }
      elsif($arg =~ /^(-|--)(v|vis|visible)(=(\d+)|)$/i)
      {
        $noshow=$false;
        if(length($4))
        {
          $maxshownlength=$4;
        }
        $defaults_changed=$true;
        $defaults_changed_vis=$true;
      }
      elsif($arg =~ /^(-|--)(m|msg|message)$/i)
      {
        if(!@ARGV)
        {
          print STDERR "missing argument\n";
          usage(-1);
        }
        $message=shift @ARGV;
        if(length($message))
        {
          $message.="\n";
        }
        $defaults_changed=$true;
      }
      else
      {
        usage(-1);
      }
    }
    if(!$defaults_changed)
    {
      $noshow=$false;
    }
    if((!$defaults_changed || $defaults_changed_vis))
    {
      $message="Type password to quit\n";
    }
     
    use Gtk2 -init;
    my $w  = new Gtk2::Window -popup;
    my $l  = new Gtk2::Label $message;
    my $eb = new Gtk2::EventBox;
    my $gdkwin;
    my $grabstatus;
    my $typed="";
     
    sub do_grab()
    {
      system "xdotool search --onlyvisible --classname 'Cheese' windowactivate --sync key F11";
      system "xmodmap -e 'keycode 37 = ' ";
      system "xmodmap -e 'keycode 105 = ' ";
      $grabstatus= Gtk2::Gdk->keyboard_grab(
          $gdkwin,$true,Gtk2::Gdk::X11->get_server_time($gdkwin) );
      if($grabstatus ne "success")
      {
        $l->set_text("keyboard grab failed");
      }
      if($withmouse)
      {
        $grabstatus= Gtk2::Gdk->pointer_grab(
           $gdkwin,$true,['button-press-mask','button-release-mask'],undef,undef,Gtk2::Gdk::X11->get_server_time($gdkwin));
        if($grabstatus ne "success")
        {
          $l->set_text("pointer grab failed");
        }
      }
    }
     
    sub do_ungrab()
    {
      system "xmodmap -e 'keycode 37 = Control_L NoSymbol Control_L'";
      system "xmodmap -e 'keycode 105 = Control_R NoSymbol Control_R'";
      Gtk2::Gdk->keyboard_ungrab(Gtk2::Gdk::X11->get_server_time($gdkwin));
      if($withmouse)
      {
         Gtk2::Gdk->pointer_ungrab(Gtk2::Gdk::X11->get_server_time($gdkwin));
      }
    }
     
    sub do_keypress(@)
    {
      my ($widg,$evt)=@_;
      my $kv = $evt->keyval;
      my $cs = Gtk2::Gdk->keyval_name($kv);
     
      if($cs =~ /Return|Enter/)
      {
        if($typed eq $password)
        {
          do_ungrab();
          Gtk2->main_quit;
        }
        else
        {
          $typed="";
        }
      }
      elsif($cs =~ /space/)
      {
        system "xdotool search --onlyvisible --classname 'Cheese' windowactivate --sync key space";
      }
      elsif(length($cs) == 1 && $cs =~ /[[:print:]]/)
      {
        $typed .= $cs;
      }
      my $showtyped=$typed;
      if($noshow eq "stars")
      {
        $showtyped =~ s/[^*]/*/g;
      }
      elsif($noshow)
      {
        $showtyped="";
      }
      if(length($showtyped) > $maxshownlength)
      {
        $showtyped=substr($showtyped,0,$maxshownlength);
      }
      $l->set_text($message.$showtyped);
    }
    $w->add($eb);
    $eb->add($l);
    $w->add_events( [ qw(key_press_mask) ]);
    $w->signal_connect('key_press_event', 669cc01ce3a2f62b9ad1e9ea2aeb4789562db6a2amp;do_keypress);
    $w->signal_connect('realize', sub { $w->window->move(@startpos); });
    $w->signal_connect('map', sub { $gdkwin=$w->window; do_grab(); });
    $w->show_all;
    Gtk2->main;
    Lorsque je le lance dans mon terminal j'ai une erreur à la ligne 214:
    $ perl keylock.pl
    Bareword found where operator expected at keylock.pl line 214, near "669cc01ce3a2f62b9ad1e9ea2aeb4789562db6a2amp"
    (Missing operator before cc01ce3a2f62b9ad1e9ea2aeb4789562db6a2amp?)
    syntax error at keylock.pl line 214, near "669cc01ce3a2f62b9ad1e9ea2aeb4789562db6a2amp"
    syntax error at keylock.pl line 214, near "do_keypress)"
    Execution of keylock.pl aborted due to compilation errors.
    J'ai modifié la ligne 214 comme suit:
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    $w->signal_connect('key_press_event', '669cc01ce3a2f62b9ad1e9ea2aeb4789562db6a2amp';do_keypress);
    Mais j'ai toujours une erreur en retour:
    syntax error at keylock.pl line 214, near "'669cc01ce3a2f62b9ad1e9ea2aeb4789562db6a2amp';"
    syntax error at keylock.pl line 214, near "do_keypress)"
    Execution of keylock.pl aborted due to compilation errors.
    En observant les autres lignes du script j'ai tenté de remplacer le ; par une simple , :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    $w->signal_connect('key_press_event', '669cc01ce3a2f62b9ad1e9ea2aeb4789562db6a2amp', do_keypress);
    Cette fois ci j'ai une erreur à la ligne 173 :
    Can't call method "keyval" on an undefined value at keylock.pl line 173.
    Bref vous l'avez compris je suis incapable de m'en sortir tout seul sur ce coup là c'est pourquoi je viens vous demander de l'aide pour pouvoir faire fonctionner ce script.

    Cordialement,
    Laurent.

  2. #2
    Membre éclairé
    Profil pro
    Inscrit en
    Août 2008
    Messages
    505
    Détails du profil
    Informations personnelles :
    Localisation : France, Puy de Dôme (Auvergne)

    Informations forums :
    Inscription : Août 2008
    Messages : 505
    Points : 712
    Points
    712
    Par défaut
    A la ligne 173, je mettrais un test pour savoir s'il y'a vraiment eu un événement. Quelque chose du genre
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    return if( not defined $evt);
    Après, un code qui a déjà autant d'erreur, je ne sais pas trop ce qu'il fait en attendre.

Discussions similaires

  1. Réponses: 0
    Dernier message: 06/07/2013, 14h09
  2. Réponses: 10
    Dernier message: 23/05/2007, 15h55
  3. pb pour faire fonctionner un script
    Par developman dans le forum Général JavaScript
    Réponses: 2
    Dernier message: 31/12/2006, 14h30
  4. Besoin d'aide pour faire fonctionner un Script d'upload d'images
    Par PaoOo dans le forum EDI, CMS, Outils, Scripts et API
    Réponses: 5
    Dernier message: 15/06/2006, 21h24
  5. Réponses: 2
    Dernier message: 11/07/2002, 08h31

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo