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

Langage Perl Discussion :

Stop process dans console windows des services avec un script perl dans Windows 7 64-Bit


Sujet :

Langage Perl

  1. #1
    Membre à l'essai
    Homme Profil pro
    Technicien réseaux et télécoms
    Inscrit en
    Février 2012
    Messages
    15
    Détails du profil
    Informations personnelles :
    Sexe : Homme

    Informations professionnelles :
    Activité : Technicien réseaux et télécoms
    Secteur : Conseil

    Informations forums :
    Inscription : Février 2012
    Messages : 15
    Points : 10
    Points
    10
    Par défaut Stop process dans console windows des services avec un script perl dans Windows 7 64-Bit
    Bonjour à tous,

    J'ai un problème d'arrêt de services dans la console des services sous Win 7 64-bit.

    Je me suis inspiré de ce poste:
    http://stackoverflow.com/questions/2...dows-7-64-bit/

    j'ai fait une ligne de code dans la clé de registre qui est:
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    C:\Perl64\bin\perl.exe -I "C:\infoG\Create-Windows-service" "C:\infoG\Create-Windows-service\service.pl" --run
    mon script perl est le suitant:
    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
    219
    220
    221
    222
    223
    224
    225
    226
    227
    228
    229
    230
    231
    232
    233
    234
    235
    236
    237
    238
    239
    240
    241
    242
    243
    244
    245
    246
    247
    248
    249
    250
    251
    252
    253
    254
    255
    256
    257
    258
    259
    260
    261
    262
    263
    264
    265
    266
    267
    268
    269
    270
    271
    272
    273
    274
    275
    276
    277
    278
    279
    280
    281
    282
    283
    284
    285
    286
    287
    288
    289
    290
    291
    292
    293
    294
    295
    296
    297
    298
    299
    300
    301
    302
    303
    304
    305
    306
    307
    308
    309
    310
    311
    312
    313
    314
    315
    316
    317
    318
    319
    320
    321
    322
    323
    324
    325
    326
    327
    328
    329
    330
    331
    332
    333
    334
    335
    336
    337
    338
    339
    340
    341
    342
    343
    344
    345
    346
    347
    348
    349
    350
    351
    352
    353
    354
    355
    356
    357
    358
    359
    360
    361
    362
    363
    364
    365
    366
    367
    368
    369
    use warnings;
    use strict;
    use File::ChangeNotify;
    use Switch;
    use File::Basename;
    use Text::CSV;
     
    use Win32;
    use Win32::Daemon;
     
    $| = 1;
     
    my $watcher =
        File::ChangeNotify->instantiate_watcher
            ( directories => [ 'C:\infoG\Create-Windows-service' ],
                filter  => qr/\.csv$/
            );
     
    main();
     
    use constant SERVICE_NAME => 'Four01';
    use constant SERVICE_DESC => 'dossier Four01';
     
    sub main
    {
        # Get command line argument - if none passed, use empty string
        my $opt = shift (@ARGV) || "";
     
        # Check command line argument
        if ($opt =~ /^(-i|--install)$/i)
        {
            install_service(SERVICE_NAME, SERVICE_DESC);
        }
        elsif ($opt =~ /^(-r|--remove)$/i)
        {
            remove_service(SERVICE_NAME);
        }
        elsif ($opt =~ /^(--run)$/i)
        {
            # Redirect STDOUT and STDERR to a log file
            # Derive the name of the file from the name of the program
            # The log file will be in the scripts directory, with extension .log
            my ($cwd,$bn,$ext) =
                ( Win32::GetFullPathName($0) =~ /^(.*\\)(.*)\.(.*)$/ ) [0..2] ;
            my $log = $cwd . $bn . ".log"; 
            # Redirect STDOUT and STDERR to log file
            open(STDOUT, ">> $log") or die "Couldn't open $log for appending: $!\n";
            open(STDERR, ">&STDOUT");
            # Autoflush, no buffering
            $|=1;
     
            # Register the events which the service responds to
            Win32::Daemon::RegisterCallbacks( {
                start       =>  \&Callback_Start,
                running     =>  \&Callback_Running,
                stop        =>  \&Callback_Stop,
                pause       =>  \&Callback_Pause,
                continue    =>  \&Callback_Continue,
            } );
            my %Context = (
                last_state => SERVICE_STOPPED,
                start_time => time(),
            );
            # Start the service passing in a context and indicating to callback
            # using the "Running" event every 2000 milliseconds (2 seconds).
            # NOTE: the StartService method with in 'callback mode' will block, in other
            # words it won't return until the service has stopped, but the callbacks below
            # will respond to the various events - START, STOP, PAUSE etc...
            Win32::Daemon::StartService( \%Context, 2000 );
     
            # Here the service has stopped
            close STDERR; close STDOUT;
        }
        else
        {
            print "No valid options passed - nothing done\n";
        }
    }
     
    sub Callback_Running
    {
        my( $Event, $Context ) = @_;
     
        # Note that here you want to check that the state
        # is indeed SERVICE_RUNNING. Even though the Running
        # callback is called it could have done so before
        # calling the "Start" callback.
        if( SERVICE_RUNNING == Win32::Daemon::State() )
        {
            # ... process your main stuff here...
            # ... note that here there is no need to
            #     change the state
     
            # For now just print hello to the STDOUT, which goes to the log file
            print "Hello! Start demon\n";
     
            $Context->{last_state} = SERVICE_RUNNING;
            Win32::Daemon::State( SERVICE_RUNNING );
     
            while ( my @events = $watcher->wait_for_events() ) { 
     
                print "new event\n";
                for my $event ( @events ) {
     
                    my $path_url = $event->path();
                    my $ev = $event->type();
                    print $path_url, ' - ', $ev, "\n";
                    print $path_url, ' - ', $ev, "\n";
     
                    my($filename, $dirs, $suffix) = fileparse($path_url);
                    print "filename: ", $filename, ' - ',"dirs: ", $dirs, ' - ', "suffix: ", $suffix, "\n";
     
                    my $file_out = "create.html";
     
                    #"create", "modify", "delete", or "unknown".
     
                    switch($ev){
                        case "create"     { 
                            print "info: create\n"; 
                            my ($ref_tab) = parce_csv($dirs,  $filename, $path_url);
                            my (@tableau) = @{$ref_tab};
                            #print "@$_\n" for @array;
                            print "tableau: --->","\n";
                            print "@$_\n" for @tableau;
                            create_htm($dirs,  $file_out, $ref_tab);
                        }
                        case "modify"     { 
                            print "info: modify\n";
                            my ($ref_tab) = parce_csv($dirs,  $filename);
                            my (@tableau) = @{$ref_tab};
                            #print "@$_\n" for @array;
                            print "tableau: --->","\n";
                            print "@$_\n" for @tableau;
                            create_htm($dirs,  $file_out, $ref_tab);
                        }
                        case "delete"     { print "info: delete\n" }
                        case "unknown"    { print "info: unknown\n" }
                        else              { print "info: autre\n" }
                    }
                }
            }
        }
    }   
     
    sub Callback_Start
    {
        my( $Event, $Context ) = @_;
        # Initialization code
        # ...do whatever you need to do to start...
     
        print "Starting...\n";
     
        $Context->{last_state} = SERVICE_RUNNING;
        Win32::Daemon::State( SERVICE_RUNNING );
    }
     
    sub Callback_Pause
    {
        my( $Event, $Context ) = @_;
     
        print "Pausing...\n";
     
        $Context->{last_state} = SERVICE_PAUSED;
        Win32::Daemon::State( SERVICE_PAUSED );
    }
     
    sub Callback_Continue
    {
        my( $Event, $Context ) = @_;
     
        print "Continuing...\n";
     
        $Context->{last_state} = SERVICE_RUNNING;
        Win32::Daemon::State( SERVICE_RUNNING );
    }
     
    sub Callback_Stop
    {
        my( $Event, $Context ) = @_;
     
        print "Stopping...\n";
     
        $watcher->reset();
     
        $Context->{last_state} = SERVICE_STOPPED;
        Win32::Daemon::State( SERVICE_STOPPED );
     
        # We need to notify the Daemon that we want to stop callbacks and the service.
        Win32::Daemon::StopService();
    }
     
    sub install_service
    {
        my ($srv_name, $srv_desc) = @_;
        my ($path, $parameters);
     
        # Get the program's full filename, break it down into constituent parts
        my $fn = Win32::GetFullPathName($0);
        my ($cwd,$bn,$ext) = ( $fn =~ /^(.*\\)(.*)\.(.*)$/ ) [0..2] ;
     
        # Determine service's path to executable based on file extension
        if ($ext eq "pl")
        {
            # Source perl script - invoke perl interpreter
            $path = "\"$^X\"";
            # Parameters include extra @INC directories and perl script
            # @INC directories must not end in \ otherwise perl hangs
            my $inc = ($cwd =~ /^(.*?)[\\]?$/) [0];
            # The command includes the --run switch needed in main()
            $parameters = "-I " . "\"$inc\"" . " \"$fn\" --run";
        }
        elsif ($ext eq "exe")
        {
            # Compiled perl script - invoke the compiled script
            $path = "\"$fn\"";
            $parameters = "";
        }
        else
        {
            # Invalid file type?
            die "Can not install service for $fn,
            file extension $ext not supported\n";
        }
     
        # Populate the service configuration hash
        # The hash is required by Win32::Daemon::CreateService
        my %srv_config = (
            name         => $srv_name,
            display      => $srv_name,
            path         => $path,
            description  => $srv_desc,
            parameters   => $parameters,
            service_type => SERVICE_WIN32_OWN_PROCESS,
            start_type   => SERVICE_AUTO_START,
        );
        # Install the service
        if( Win32::Daemon::CreateService( \%srv_config ) )
        {
            print "Service installed successfully\n";
        }
        else
        {
            print "Failed to install service\n";
        }
    }
     
    sub remove_service
    {
        my ($srv_name, $hostname) = @_;
        $hostname ||= Win32::NodeName();
        if ( Win32::Daemon::DeleteService ( $srv_name ) )
        {
            print "Service uninstalled successfully\n";
        }
        else
        {
            print "Failed to uninstall service\n";
        }
    }
     
    sub parce_csv {
        my($folder_file, $my_file, $my_url) = @_;
     
        my (@tableau2D);
     
        print "sub parce_csv: ", ' - ',"folder_file: ", $folder_file, ' - ', "my_file: ", $my_file, "\n";
        print "sub parce_csv: ", ' - ',"my_url: ", $my_url, "\n";
     
        my $csv = Text::CSV->new({ sep_char => ';' });
     
        my $file = $my_url or die "Need to get CSV file on the command line\n";
     
        my $iter_ligne = 0;
        open(my $data, '<:utf8', $file) or die "Could not open '$file' $!\n";
        while (my $line = <$data>) {
     
            chomp $line;
            if ($csv->parse($line)) {
     
                my @fields = $csv->fields();
     
                $tableau2D[$iter_ligne] = [ @fields ];
     
                #$sum += $fields[2];
                my $arrSize = @fields;
                my $i = 0;
                for my $field ( @fields ) {
     
                    if ($i==($arrSize-1)) {
                        print $field, "\n";
                    }
                    else {
                        print $field, " - ";
                    }
                    $i++;
                }
     
            } else {
                warn "Line could not be parsed: $line\n";
            }
     
            $iter_ligne++;
            print "iter_ligne : ","$iter_ligne\n";
     
        }
        #print "$sum\n";
     
        print "tableau int2D: --->","\n";
        print "@$_\n" for @tableau2D;
     
        return \@tableau2D;
    }
     
    sub create_htm {
        my(@args) = @_;
     
        my $cmdString = $args[0];
        my $file=$args[1];
        my $ref = $args[2];
        my @tab = @$ref;    
     
        print "tableau create_htm: --->","\n";
        print "@$_\n" for @tab;
     
        chdir($cmdString)|| die "Error: could not '$cmdString'"; 
        if (-e $file) #if the file exists 
        { 
            print "re-ecriture HLM\n";
        } 
        open(my $FILE, ">$file") or die "Cannot open $file: $!"; ## >> means +append to the end of file. 
     
        my $re = $file;
     
        print $FILE '<!DOCTYPE html>';
        print $FILE '<html>';
        print $FILE '<head>';
        print $FILE '   <meta name="robots" content="noindex,nofollow">';
        print $FILE '   <title>HTML auto</title>';
        print $FILE '<script type="text/javascript">';
        print $FILE 'var refreshTime= 2*2;';
        #rafréchissement
        print $FILE '    var foo = document.write(\'<meta http-equiv="refresh" content="\'+refreshTime+\';url=',$re,' ">\');';
        print $FILE '</script>';
        print $FILE '</head>';
        print $FILE '<body>';
     
        print $FILE '<h1>My First Heading</h1>';
     
        print $FILE '<p>My first paragraph.</p>';
     
        print $FILE '<table style="width:100%">';
        foreach my $row (@tab) {
            print $FILE '<tr>';
            foreach my $element (@$row) {
                print $FILE '<td>';
                print $FILE $element;
                print $FILE '</td>';
            }
            print $FILE '</tr>';
        }
        print $FILE '</table>';
     
        print $FILE '</body>';
        print $FILE '</html>';  
     
        close($FILE); 
     
        print "Your html has been created"; 
    }
    lorsque j’essaie d'arrêter le service avec la commande stop du panel de commande des services, j'ai une erreur:
    Nom : Capture - arrêt.JPG
Affichages : 306
Taille : 31,2 Ko

    Que faut-il que je fasse pour pur pouvoir arrâter le service correctement ?

    D'avance merci de vos réponses.

  2. #2
    Membre chevronné Avatar de dmganges
    Homme Profil pro
    Retraité. Ne recherche pas un emploi.
    Inscrit en
    Septembre 2011
    Messages
    1 392
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 71
    Localisation : France, Hérault (Languedoc Roussillon)

    Informations professionnelles :
    Activité : Retraité. Ne recherche pas un emploi.
    Secteur : Service public

    Informations forums :
    Inscription : Septembre 2011
    Messages : 1 392
    Points : 2 044
    Points
    2 044
    Par défaut
    Bonjour,
    As-tu vu ceci ?

    La page est obsolète (Framework 1.1 Service Pack 1), assure-toi d'avoir le dernier 4.5.2 je crois...

    As-tu essayé en créant le service avec Sc.exe ?

  3. #3
    Membre à l'essai
    Homme Profil pro
    Technicien réseaux et télécoms
    Inscrit en
    Février 2012
    Messages
    15
    Détails du profil
    Informations personnelles :
    Sexe : Homme

    Informations professionnelles :
    Activité : Technicien réseaux et télécoms
    Secteur : Conseil

    Informations forums :
    Inscription : Février 2012
    Messages : 15
    Points : 10
    Points
    10
    Par défaut
    Salut dmganges,

    Je te remercie de ta contribution à la résolution de mon problème.

    Ne suis pas un expert en frameworck...

    j'ai uniquement le 4.5.2
    Nom : Capture frame 4.5.2.JPG
Affichages : 259
Taille : 22,9 Ko

    Penses-tu que je doives installer en plus le 1.1 ?

    pour réponde pour au sc, la ligne de commande que j'ai faite est:

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    sc create Four01 binpath= "C:\Perl64\bin\perl.exe"
    puis en remplacent dans le cléf "HKEY_LOCAL_MACHINE->SYSTEM->CurrentControlSet->Services->myservice" par :

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    C:\Perl64\bin\perl.exe -I "C:\infoG\Create-Windows-service" "C:\infoG\Create-Windows-service\service.pl" --run
    Je me demandais si d'être dans une boucle infinie pouvait jouer un rôle dans le fait de ne pas pouvoir tuer la tâche.

    voici la boucle en question:
    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
     
    					while ( my @events = $watcher->wait_for_events() ) { 
     
     
    						print "new event\n";
    						for my $event ( @events ) {
     
    							my $path_url = $event->path();
    								my $ev = $event->type();
    								print $path_url, ' - ', $ev, "\n";
    								print $path_url, ' - ', $ev, "\n";
     
    								my($filename, $dirs, $suffix) = fileparse($path_url);
    								print "filename: ", $filename, ' - ',"dirs: ", $dirs, ' - ', "suffix: ", $suffix, "\n";
     
     
    								my $file_out = "create.html";
     
    								#"create", "modify", "delete", or "unknown".
     
    								switch($ev){
    								case "create"     { 
    									print "info: create\n"; 
    									my ($ref_tab) = parce_csv($dirs,  $filename, $path_url);
    									my (@tableau) = @{$ref_tab};
    									#print "@$_\n" for @array;
    									print "tableau: --->","\n";
    									print "@$_\n" for @tableau;
    									create_htm($dirs,  $file_out, $ref_tab);
    								}
    								case "modify"     { 
    									print "info: modify\n";
    									my ($ref_tab) = parce_csv($dirs,  $filename);
    									my (@tableau) = @{$ref_tab};
    									#print "@$_\n" for @array;
    									print "tableau: --->","\n";
    									print "@$_\n" for @tableau;
    									create_htm($dirs,  $file_out, $ref_tab);
    								}
    								case "delete"     { print "info: delete\n" }
    								case "unknown"    { print "info: unknown\n" }
    								else              { print "info: autre\n" }
    								}
     
     
    						}
     
    					}

    d'avance merci.

    Bonne soirée

  4. #4
    Membre chevronné Avatar de dmganges
    Homme Profil pro
    Retraité. Ne recherche pas un emploi.
    Inscrit en
    Septembre 2011
    Messages
    1 392
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 71
    Localisation : France, Hérault (Languedoc Roussillon)

    Informations professionnelles :
    Activité : Retraité. Ne recherche pas un emploi.
    Secteur : Service public

    Informations forums :
    Inscription : Septembre 2011
    Messages : 1 392
    Points : 2 044
    Points
    2 044
    Par défaut
    Bonsoir,

    Citation Envoyé par chrishess
    Penses-tu que je doives installer en plus le 1.1 ?
    Sincèrement NON, je ne suis pas non plus un expert en Framework, j'avais collé le lien seulement parce qu'on y trouvait un embryon d'explication sur la cause connue :
    La classe ServiceBase appelle directement la méthode OnStop du gestionnaire de commandes Service qui est défini dans le ScDispatcherLoop du fichier Advapi32.dll. Après 30 secondes, si le thread ScDispatcherLoop n'est pas prêt à recevoir une nouvelle commande de service à partir du gestionnaire de contrôle de services, le Contrôleur de services Windows marque le service avec la mention « Délai dépassé ». Par conséquent, ce message d'erreur s'affiche.
    et qui pouvait donner une piste...

    Citation Envoyé par chrishess
    Je me demandais si d'être dans une boucle infinie pouvait jouer un rôle dans le fait de ne pas pouvoir tuer la tâche.
    J'ai du mal à me représenter tout ce que fait la boucle infinie... surtout à quelle vitesse elle s'exécute...
    Mais là encore je dirai NON, plus par intuition que par certitude, le gestionnaire des tâches doit avoir une priorité bien supérieure au pgm Perl, et ne devrait pas avoir du mal à le stopper...

    Cependant essaye d'introduire une petite pause dans la boucle du genre :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    while ( my @events = $watcher->wait_for_events() ) { 
     
     						sleep (4);
    						print "new event\n";
    						for my $event ( @events ) {
     
     						...
    4 secondes c'est énorme, si c'est probant tu pourras fignoler à qq millisecondes...
    Sinon je n'ai pas d'autre idée pour le moment

    Edit : Si ça ne donne rien ajoute le Framework 1.1 Service Pack 1, ça serait toujours une porte de fermée... mais ça m'étonnerait...

    [Edit 19:00] Pour faire des sleep inférieurs à une seconde :

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    use Time::HiRes;
      Time::HiRes::sleep(0.1); #.1 seconds
      Time::HiRes::usleep(1); # 1 microsecond.
    http://perldoc.perl.org/Time/HiRes.html

  5. #5
    Membre à l'essai
    Homme Profil pro
    Technicien réseaux et télécoms
    Inscrit en
    Février 2012
    Messages
    15
    Détails du profil
    Informations personnelles :
    Sexe : Homme

    Informations professionnelles :
    Activité : Technicien réseaux et télécoms
    Secteur : Conseil

    Informations forums :
    Inscription : Février 2012
    Messages : 15
    Points : 10
    Points
    10
    Par défaut
    bonsoir,

    J'ai essayé de mettre une pause et juste mis une boucle for (donc itération limité) pour test. Ai du attendre la fin de la boucle pour stopper le service, même si l'ordre est donné durant la boucle.

    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
    219
    220
    221
    use warnings;
    use strict;
    use File::ChangeNotify;
    use Switch;
    use File::Basename;
    use Text::CSV;
     
    use Win32;
    use Win32::Daemon;
     
     
    main();
     
    use constant SERVICE_NAME => 'Four01';
    use constant SERVICE_DESC => 'dossier Four01';
     
     
    sub main
    {
       # Get command line argument - if none passed, use empty string
       my $opt = shift (@ARGV) || "";
     
       # Check command line argument
       if ($opt =~ /^(-i|--install)$/i)
       {
          install_service(SERVICE_NAME, SERVICE_DESC);
       }
       elsif ($opt =~ /^(-r|--remove)$/i)
       {
          remove_service(SERVICE_NAME);
       }
       elsif ($opt =~ /^(--run)$/i)
       {
          # Redirect STDOUT and STDERR to a log file
          # Derive the name of the file from the name of the program
          # The log file will be in the scripts directory, with extension .log
          my ($cwd,$bn,$ext) =
          ( Win32::GetFullPathName($0) =~ /^(.*\\)(.*)\.(.*)$/ ) [0..2] ;
          my $log = $cwd . $bn . ".log"; 
          # Redirect STDOUT and STDERR to log file
          open(STDOUT, ">> $log") or die "Couldn't open $log for appending: $!\n";
          open(STDERR, ">&STDOUT");
          # Autoflush, no buffering
          $|=1;
     
          # Register the events which the service responds to
          Win32::Daemon::RegisterCallbacks( {
                start       =>  \&Callback_Start,
                running     =>  \&Callback_Running,
                stop        =>  \&Callback_Stop,
                pause       =>  \&Callback_Pause,
                continue    =>  \&Callback_Continue,
             } );
          my %Context = (
             last_state => SERVICE_STOPPED,
             start_time => time(),
          );
          # Start the service passing in a context and indicating to callback
          # using the "Running" event every 2000 milliseconds (2 seconds).
          # NOTE: the StartService method with in 'callback mode' will block, in other
          # words it won't return until the service has stopped, but the callbacks below
          # will respond to the various events - START, STOP, PAUSE etc...
          Win32::Daemon::StartService( \%Context, 2000 );
     
          # Here the service has stopped
          close STDERR; close STDOUT;
       }
       else
       {
          print "No valid options passed - nothing done\n";
       }
    }
     
     
    sub Callback_Running
    {
       my( $Event, $Context ) = @_;
     
       # Note that here you want to check that the state
       # is indeed SERVICE_RUNNING. Even though the Running
       # callback is called it could have done so before
       # calling the "Start" callback.
       if( SERVICE_RUNNING == Win32::Daemon::State() )
       {
          # ... process your main stuff here...
          # ... note that here there is no need to
          #     change the state
     
          # For now just print hello to the STDOUT, which goes to the log file
          print "Hello! Start demon\n";
     
    	  for ( my $i = 0; $i < 30; $i++ ) {
     
    		sleep(4);
     
    		print "sleep passed - i=",$i,"\n";
     
    	  }
     
     
     
    		$Context->{last_state} = SERVICE_RUNNING;
    		Win32::Daemon::State( SERVICE_RUNNING );
     
        }
    }   
     
    sub Callback_Start
    {
       my( $Event, $Context ) = @_;
       # Initialization code
       # ...do whatever you need to do to start...
     
       print "Starting...\n";
     
       $Context->{last_state} = SERVICE_RUNNING;
       Win32::Daemon::State( SERVICE_RUNNING );
    }
     
    sub Callback_Pause
    {
       my( $Event, $Context ) = @_;
     
       print "Pausing...\n";
     
       $Context->{last_state} = SERVICE_PAUSED;
       Win32::Daemon::State( SERVICE_PAUSED );
    }
     
    sub Callback_Continue
    {
       my( $Event, $Context ) = @_;
     
       print "Continuing...\n";
     
       $Context->{last_state} = SERVICE_RUNNING;
       Win32::Daemon::State( SERVICE_RUNNING );
    }
     
    sub Callback_Stop
    {
       my( $Event, $Context ) = @_;
     
       print "Stopping...\n";
     
       $Context->{last_state} = SERVICE_STOPPED;
       Win32::Daemon::State( SERVICE_STOPPED );
     
       # We need to notify the Daemon that we want to stop callbacks and the service.
       Win32::Daemon::StopService();
    }
     
     
    sub install_service
    {
       my ($srv_name, $srv_desc) = @_;
       my ($path, $parameters);
     
       # Get the program's full filename, break it down into constituent parts
       my $fn = Win32::GetFullPathName($0);
       my ($cwd,$bn,$ext) = ( $fn =~ /^(.*\\)(.*)\.(.*)$/ ) [0..2] ;
     
       # Determine service's path to executable based on file extension
       if ($ext eq "pl")
       {
          # Source perl script - invoke perl interpreter
          $path = "\"$^X\"";
          # Parameters include extra @INC directories and perl script
          # @INC directories must not end in \ otherwise perl hangs
          my $inc = ($cwd =~ /^(.*?)[\\]?$/) [0];
          # The command includes the --run switch needed in main()
          $parameters = "-I " . "\"$inc\"" . " \"$fn\" --run";
       }
       elsif ($ext eq "exe")
       {
          # Compiled perl script - invoke the compiled script
          $path = "\"$fn\"";
          $parameters = "";
       }
       else
       {
          # Invalid file type?
          die "Can not install service for $fn,
          file extension $ext not supported\n";
       }
     
       # Populate the service configuration hash
       # The hash is required by Win32::Daemon::CreateService
       my %srv_config = (
          name         => $srv_name,
          display      => $srv_name,
          path         => $path,
          description  => $srv_desc,
          parameters   => $parameters,
          service_type => SERVICE_WIN32_OWN_PROCESS,
          start_type   => SERVICE_AUTO_START,
       );
       # Install the service
       if( Win32::Daemon::CreateService( \%srv_config ) )
       {
          print "Service installed successfully\n";
       }
       else
       {
          print "Failed to install service\n";
       }
    }
     
    sub remove_service
    {
       my ($srv_name, $hostname) = @_;
       $hostname ||= Win32::NodeName();
       if ( Win32::Daemon::DeleteService ( $srv_name ) )
       {
          print "Service uninstalled successfully\n";
       }
       else
       {
          print "Failed to uninstall service\n";
       }
    }
    ce qui donne le log suivant :

    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
    Starting...
    Hello! Start demon
    sleep passed - i=0
    sleep passed - i=1
    sleep passed - i=2
    sleep passed - i=3
    sleep passed - i=4
    sleep passed - i=5
    sleep passed - i=6
    sleep passed - i=7
    sleep passed - i=8
    sleep passed - i=9
    sleep passed - i=10
    sleep passed - i=11
    sleep passed - i=12
    sleep passed - i=13
    sleep passed - i=14
    sleep passed - i=15
    sleep passed - i=16
    sleep passed - i=17
    sleep passed - i=18
    sleep passed - i=19
    sleep passed - i=20
    sleep passed - i=21
    sleep passed - i=22
    sleep passed - i=23
    sleep passed - i=24
    sleep passed - i=25
    sleep passed - i=26
    sleep passed - i=27
    sleep passed - i=28
    sleep passed - i=29
    Stopping...
    pour répondre ce que fait la boucle while. D'abord j’initialise ce que je veux surveiller avant la boucle:

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
     my $watcher =
        			File::ChangeNotify->instantiate_watcher
        				( directories => [ 'C:\infoG\Create-Windows-service' ],
        					filter  => qr/\.csv$/
        				);
    Je veux surveiller les fichiers .csv sur un dossier bien précis.

    la boucle while:

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    while ( my @events = $watcher->wait_for_events() ) {
    attente qu'il y ai un événement dans le dossier surveillé (ajout fichier, modifier, supprimer que je traite avec le case:

    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
        						print "new event\n";
        						for my $event ( @events ) {
     
        							my $path_url = $event->path();
        								my $ev = $event->type();
        								print $path_url, ' - ', $ev, "\n";
     
        								my($filename, $dirs, $suffix) = fileparse($path_url);
        								print "filename: ", $filename, ' - ',"dirs: ", $dirs, ' - ', "suffix: ", $suffix, "\n";
     
     
        								my $file_out = "create.html";
     
        								#"create", "modify", "delete", or "unknown".
     
        								switch($ev){
        								case "create"     { 
        									print "info: create\n"; 
        									my ($ref_tab) = parce_csv($dirs,  $filename, $path_url);
        									my (@tableau) = @{$ref_tab};
        									#print "@$_\n" for @array;
        									print "tableau: --->","\n";
        									print "@$_\n" for @tableau;
        									create_htm($dirs,  $file_out, $ref_tab);
        								}
        								case "modify"     { 
        									print "info: modify\n";
        									my ($ref_tab) = parce_csv($dirs,  $filename);
        									my (@tableau) = @{$ref_tab};
        									#print "@$_\n" for @array;
        									print "tableau: --->","\n";
        									print "@$_\n" for @tableau;
        									create_htm($dirs,  $file_out, $ref_tab);
        								}
        								case "delete"     { print "info: delete\n" }
        								case "unknown"    { print "info: unknown\n" }
        								else              { print "info: autre\n" }
        								}
    Le but de traiter l’éventent pour créer un fichier HTML dans le quel il y a les données du ficher csv. La création et la gestion du fichier HTML n'est pas mon problème pour le moment.

    Je connais pas assez bien la boucle while, mais je pense que j'y rentre sans pouvoir y sortir. c'est pour cette raison que je voudrait pouvoir sortir ou tuer la tâche quand je stop le service. Est-ce possible ?

    Dans l'attente de vos réponses.

    D'avance merci.

  6. #6
    Membre chevronné Avatar de dmganges
    Homme Profil pro
    Retraité. Ne recherche pas un emploi.
    Inscrit en
    Septembre 2011
    Messages
    1 392
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 71
    Localisation : France, Hérault (Languedoc Roussillon)

    Informations professionnelles :
    Activité : Retraité. Ne recherche pas un emploi.
    Secteur : Service public

    Informations forums :
    Inscription : Septembre 2011
    Messages : 1 392
    Points : 2 044
    Points
    2 044
    Par défaut
    Bonjour,

    VU !
    Citation Envoyé par chrishess
    Je connais pas assez bien la boucle while, mais je pense que j'y rentre sans pouvoir y sortir. c'est pour cette raison que je voudrait pouvoir sortir ou tuer la tâche quand je stop le service. Est-ce possible ?
    Oui bien sûr !

    Je ne maîtrise pas ce que fait :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
     my $watcher =
        			File::ChangeNotify->instantiate_watcher
        				( directories => [ 'C:\infoG\Create-Windows-service' ],
        					filter  => qr/\.csv$/
        				);
    Mais peu importe...

    A mon avis 2 solutions, mais d'autres en auront probablement de meilleures...
    NB : les 2 solutions utilisent l'interface graphique Tk.

    1 - En passant par l'intermédiaire des threads, il y a un excellent exemple ICI

    J'en ai fait une adaptation, en le simplifiant, pour contrôler la mise en veille d'un écran qui s'éteint dès 2mn d'inactivité du clavier :

    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
    219
    220
    221
    222
    223
    224
    225
    226
    227
    228
    229
    230
    231
    232
    233
    234
    235
    236
    237
    238
    239
    240
    241
    242
    243
    244
    245
    246
    #!/usr/bin/perl
    use strict;
    use warnings;
    use Tk;
    use Tk::LabFrame;
    use threads;                    # Pour créer nos threads
    use threads::shared;            # Pour partager nos données entre threads
    use Time::HiRes qw( sleep );    # Pour faire des sleeps < à une seconde
    use Win32::API;                 # Pour accéder aux API Windows
     
    $Win32::API::DEBUG = 0;
    # Invalidation de la veille d'écran
    my $EcranVeille = new Win32::API("user32", "SystemParametersInfo",'II','I');
    $EcranVeille->Call(17,0);
     
    # Invalidation estompage et extinction écran - doit être appelé régulièrement en sub Prog_Lignes
    my $EcranExtinction = new Win32::API("kernel32", "SetThreadExecutionState",'I','I');
     
    my $RepBase = 'E:\_APPLI\Veille';
    my $Fichier_Flag = File::Spec->catfile( $RepBase, 'Flag.txt' );
     
    # Contient les fonctions à appeler dans le thread si besoin
    my %fonctions_a_lancer_dans_thread = ( 'Veille' => \&Veille, );
     
    #===================================
    # Threads et variables partagées
    #==================================
    my $tuer_thread : shared;              # Permet de tuer le thread proprement
    my $nom_fonction : shared;             # Contient le nom de la fonction à appeler
    my $thread_travail : shared;           # Contient la valeur permettant au thread de lancer une procédure
    my @arguments_thread : shared;         # Contient les arguments à passer à une éventuelle procédure
    my $ref_resultat_fonction : shared;    # Contient le résultat des fonctions lancées dans le thread
    my $CptTmp : shared;									 # Compteur pour mise à jour de $Cpt de label_cpt
     
    $thread_travail = 0;                   # 0 : thread ne fait rien, 1 : il bosse
    $tuer_thread    = 0;                   # 0 : thread en vie, 1 : thread se termine
    $CptTmp = 1;
     
    # Création du thread
    my $thread = threads->create( \&ThreadVeille );
     
    #===================================
    # Debut du code principal Perl Tk
    #==================================
    my $mw = new MainWindow(
      -title      => 'Veille',
      -background => 'white',
    );
    $mw->overrideredirect(1);
    #$mw->protocol( "WM_DELETE_WINDOW", \&fermer_application );
     
    my $Tempo = 58;
    my ( $label_etat, $label_cpt ) = ();
     
    $mw->Button(
    	-text => "Start",
    	-command => sub {
    		$label_etat->configure(	-background => '#00FF00',	);
      	Veille_tk ();
      },
    )->pack(-side => 'left');
     
    $mw->Button(
    	-text => "Stop",
    	-command => sub {
    		$label_etat->configure(	-background => '#FF0000',	);
        Arret();
      },
    )->pack(-side => 'left');
     
    $mw->Button(
    	-text => "Exit",
    	-command => sub {
      	fermer_application ();
      },
    )->pack(-side => 'left');
     
    $label_etat  = $mw->Label(
    	-width => 10,
    	-textvariable => \$Tempo,
    	-justify    	=> 'center',
      -background   => 'blue',
      -relief      	=> 'groove',
    )->pack(-side => 'left');
     
    my $Cpt = 0;
    $label_cpt  = $mw->Label(
    	-width => 8,
    	-textvariable => \$Cpt,
    	-justify    	=> 'center',
      -background   => '#C0C0FF',
      -relief      	=> 'groove',
    )->pack(-side => 'left');
     
    my ($Flag0, $Flag1) = ();
    my $Flag = 1;
    $Flag0 = $mw->Radiobutton(
    		-value						=> 0,
    		-background				=> '#00FF00',
    		-activebackground	=> '#00FF00',
     		-variable					=> \$Flag,
     		-command					=> sub {
     			if (!open(FLAG,'>:utf8', $Fichier_Flag)) {
    				print "Impossible d'ouvrir $Fichier_Flag\n";
    				exit;
    			}
     			$Flag = 0;
     			print FLAG $Flag;
     			close FLAG;
     			$Flag0->configure( -activebackground => '#FF0000', );
     			$Flag1->configure( -activebackground => '#FF0000', );
     			$Flag0->configure( -background => '#FF0000', );
     			$Flag1->configure( -background => '#FF0000', );
     		},
    	)->pack(-side => 'left');
    $Flag1 = $mw->Radiobutton(
    		-value						=> 1,
    		-background				=> '#00FF00',
    		-activebackground	=> '#00FF00',
     		-variable					=> \$Flag,
     		-command					=> sub {
     			if (-f $Fichier_Flag) {
    				unlink  $Fichier_Flag;
    			}
     			$Flag = 1;
     			$Flag0->configure( -activebackground => '#00FF00', );
     			$Flag1->configure( -activebackground => '#00FF00', );
     			$Flag0->configure( -background => '#00FF00', );
     			$Flag1->configure( -background => '#00FF00', );
     		},
    	)->pack(-side => 'left');
     
    # positionner ma fenêtre
    positionner_widget($mw);
     
    # Toutes les 10 secondes, mise à jour de la fenêtre
    $mw->repeat( 10000, sub { $Cpt = $CptTmp; } );
     
    Veille_tk ();
     
    MainLoop;
     
    #================================================
    # notre_processus_leger
    #================================================
    sub ThreadVeille {
     
      # Tourne en rond
      while (1) {
        # demande au thread de travailler
        if ( $thread_travail == 1 ) {
     
          # Lance la procédure
          my @resultat = $fonctions_a_lancer_dans_thread{$nom_fonction}->(@arguments_thread);
          $ref_resultat_fonction = shared_clone( \@resultat );
     
          # demande au thread de dormir
          $thread_travail = 0;
        }
     
        # Terminer le thread
        last if ( $tuer_thread == 1 );
        sleep 58; # N'ayant rien à afficher dans la fenêtre initiale qui ne contient que Stop Start Exit
      }
      return;
    }
     
    sub fermer_application {
     
      # Demande au thread de se terminer
      $tuer_thread = 1;
     
      # On attend que le thread se termine proprement
      $thread->detach();
     
      $EcranVeille->Call(17,1);							# Validation de l'écran de veille
    	$EcranExtinction->Call(2147483648);		# Validation estompage et extinction de l'écran + mise en veille du PC 
    																				# ES_CONTINUOUS = 0x80000000 = 2147483648
    	if (-f $Fichier_Flag) {
    		unlink  $Fichier_Flag;
    	}
      exit;
    }
     
    sub Veille_tk {
      if ( not defined $Tempo ) {
        return;
      }
     
      # On lui donne les arguments
      @arguments_thread = ( $Tempo );
     
      # On lui indique la procédure à appeler
      $nom_fonction = "Veille";
     
      # On va demander au thread de bosser
      $thread_travail = 1;
      return;
    }
     
    sub Veille {
      my ( $Tempo ) = @_;
     
    	while (1) {
    		if ( $thread_travail == 1 ) {
    			$EcranExtinction->Call(2);		# Invalidation estompage et extinction écran	: ES_DISPLAY_REQUIRED = 0x00000002 
    			$EcranExtinction->Call(1);		# Invalidation mise en veille PC 							: ES_SYSTEM_REQUIRED  = 0x00000001 
       		sleep $Tempo;
       		$CptTmp++;
       	} else {
       		sleep $Tempo;
       	}
    	}
    }
     
    sub Arret {
    	# Validation Ecran de veille, estompage et veille
    	$EcranVeille->Call(17,1);
    	$EcranExtinction->Call(2147483648);
    	$thread_travail = 0;
    }
     
    #================================================
    # Positionner la fenêtre automatiquement
    #================================================
    sub positionner_widget {
      my ($widget) = @_;
     
      # Height and width of the screen
      my $largeur_ecran = $widget->screenwidth();
      my $hauteur_ecran = $widget->screenheight();
     
      # update le widget pour récupérer les vraies dimensions
      $widget->update;
      my $largeur_widget = $widget->width;
      my $hauteur_widget = $widget->height;
     
      # On centre le widget en fonction de la taille de l'écran
      my $nouvelle_largeur = int( ( $largeur_ecran - $largeur_widget ) / 2 ); 	# Pas utilisé
      my $nouvelle_hauteur = int( ( $hauteur_ecran - ($hauteur_widget + 40)) ); # 75 c'est pour la barre des tâches
      $widget->geometry( $largeur_widget . "x" . $hauteur_widget . "+0+$nouvelle_hauteur" );
     
      $widget->update;
     
      return;
    }
    En adaptant :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    my $RepBase = 'E:\_APPLI\Veille';
    et en diminuant le temps de veille de ton écran, tu dois pouvoir le tester...

    2 - Plus simple, sans passer par les threads, une variable globale qui contrôle la boucle infinie.
    Une petite fenêtre est crée. C'est du vite fait, pour un exemple... :

    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
    #!/usr/bin/perl
    use strict;
    use warnings;
    use Tk;
    use Tk::LabFrame;
    use Time::HiRes qw( sleep );    # Pour faire des sleeps < à une seconde
     
    #my $RepBase = 'E:\_DEV\DevPerl\chrishess';
    my $FlagStop = 0;
     
    #===========
    # Fenêtre Tk
    #===========
    my $mw = new MainWindow(
      -title      => 'Chrishess',
      -background => 'white',
    );
     
    # Supprime le cadre de la fenêtre
    #$mw->overrideredirect(1);
     
    $mw->Button(
    	-text => "Start",
    	-command => sub {
        Start();
      },
    )->pack(-side => 'left');
     
    $mw->Button(
    	-text => "Stop",
    	-command => sub {
        Arret();
      },
    )->pack(-side => 'left');
     
    $mw->Button(
    	-text => "Exit",
    	-command => sub {
      	Sortie();
      },
    )->pack(-side => 'left');
     
    my $Cpt = 0;
    my $label_cpt  = $mw->Label(
    	-width => 8,
    	-textvariable => \$Cpt,
    	-justify    	=> 'center',
      -background   => '#C0C0FF',
      -relief      	=> 'groove',
    )->pack(-side => 'left');
     
    # positionner ma fenêtre
    #positionner_widget($mw);
     
     
    Start();
     
    MainLoop;
     
    # Boucle infinie tant que $FlagStop == 0
    sub Start {
    	$FlagStop = 0;
    	while ( $FlagStop == 0 ) {
    		$Cpt++;
    		$mw->update;
    		sleep(1);
    	}
    }
     
    sub Arret {
    	$FlagStop = 1;
    }
     
    sub Sortie {
    	exit;
    }
     
    #================================================
    # Positionner la fenêtre automatiquement
    #================================================
    sub positionner_widget {
      my ($widget) = @_;
     
      # Height and width of the screen
      my $largeur_ecran = $widget->screenwidth();
      my $hauteur_ecran = $widget->screenheight();
     
      # update le widget pour récupérer les vraies dimensions
      $widget->update;
      my $largeur_widget = $widget->width;
      my $hauteur_widget = $widget->height;
     
      # On centre le widget en fonction de la taille de l'écran
      my $nouvelle_largeur = int( ( $largeur_ecran - $largeur_widget ) / 2 ); 	# Pas utilisé
      my $nouvelle_hauteur = int( ( $hauteur_ecran - ($hauteur_widget + 40)) ); # 75 c'est pour la barre des tâches
      $widget->geometry( $largeur_widget . "x" . $hauteur_widget . "+0+$nouvelle_hauteur" );
     
      $widget->update;
     
      return;
    }

  7. #7
    Membre chevronné Avatar de dmganges
    Homme Profil pro
    Retraité. Ne recherche pas un emploi.
    Inscrit en
    Septembre 2011
    Messages
    1 392
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 71
    Localisation : France, Hérault (Languedoc Roussillon)

    Informations professionnelles :
    Activité : Retraité. Ne recherche pas un emploi.
    Secteur : Service public

    Informations forums :
    Inscription : Septembre 2011
    Messages : 1 392
    Points : 2 044
    Points
    2 044
    Par défaut
    Bonjour,

    J'ai eu un peu de temps ce matin pour regarder File::ChangeNotify.

    Je n'ai pas le temps de faire un essai complet... mais une piste peut-être :

    Pour arrêter la boucle infinie, il faudrait que dans cette boucle, File::ChangeNotify détecte un fichier d'un nom particulier, ex: STOP.cvs

    L'arrêt du service ne pouvant se faire par le programme lui-même tant que la boucle infinie est en cours,
    l'arrêt consisterait à créer ce STOP.cvs dans le répertoire concerné à partir d'un autre pgm Perl...

    et donc à boucler seulement TANTQUE ce fichier n'est pas détecté.

    Sous toutes réserves... au pif !

  8. #8
    Membre à l'essai
    Homme Profil pro
    Technicien réseaux et télécoms
    Inscrit en
    Février 2012
    Messages
    15
    Détails du profil
    Informations personnelles :
    Sexe : Homme

    Informations professionnelles :
    Activité : Technicien réseaux et télécoms
    Secteur : Conseil

    Informations forums :
    Inscription : Février 2012
    Messages : 15
    Points : 10
    Points
    10
    Par défaut
    Bonsoir,

    Merci des pistes. J'apprécie ton aide.

    Citation Envoyé par dmganges Voir le message
    Je ne maîtrise pas ce que fait :
    J’initialise une surveillance sur un répertoire bien précis "C:\infoG\Create-Windows-service" avec comme filtre sur uniquement les fichiers avec l’extension ".csv".

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    my $watcher =
        			File::ChangeNotify->instantiate_watcher
        				( directories => [ 'C:\infoG\Create-Windows-service' ],
        					filter  => qr/\.csv$/
        				);
    Puis je traite l’éventement de changement d'état dans la boucle (ajout,modification du nom, suppression).


    Les pistes m'ont été utiles, je me suis inspiré des Threads avec:

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    use threads;
    use threads::shared;
    une variable partagée:

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    my $child_exit_flag : shared  = 0;
    et dans le Tread enfant, la boucle de traitement d'événement avec un test de la variable partagée.

    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
    sub child_thread {
        while ( my @events = $watcher->wait_for_events() )  { 
    		if ($child_exit_flag == 1) {
    			return;
    		}	else {			
     
    			print "new event\n";
    			for my $event ( @events ) {
     
    				my $path_url = $event->path();
    					my $ev = $event->type();
    					print $path_url, ' - ', $ev, "\n";
     
    					my($filename, $dirs, $suffix) = fileparse($path_url);
    					print "filename: ", $filename, ' - ',"dirs: ", $dirs, ' - ', "suffix: ", $suffix, "\n";
     
     
    					my $file_out = "create.html";
     
    					#"create", "modify", "delete", or "unknown".
     
    					switch($ev){
    					case "create"     { 
    						print "info: create\n"; 
    						my ($ref_tab) = parce_csv($dirs,  $filename, $path_url);
    						my (@tableau) = @{$ref_tab};
    						#print "@$_\n" for @array;
    						print "tableau: --->","\n";
    						print "@$_\n" for @tableau;
    						create_htm($dirs,  $file_out, $ref_tab);
    					}
    					case "modify"     { 
    						print "info: modify\n";
    						my ($ref_tab) = parce_csv($dirs,  $filename);
    						my (@tableau) = @{$ref_tab};
    						#print "@$_\n" for @array;
    						print "tableau: --->","\n";
    						print "@$_\n" for @tableau;
    						create_htm($dirs,  $file_out, $ref_tab);
    					}
    					case "delete"     { print "info: delete\n" }
    					case "unknown"    { print "info: unknown\n" }
    					else              { print "info: autre\n" }
    					}
     
     
    			}
    		}
    	}	
    }
    et dans la fonction du run [Callback_Running], la création et le détachement du Tread.

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    # Create child thread
    		my $ChildThread = threads->create( \&child_thread );
    		$ChildThread->detach();

    Une partie de mon problème est solutionner {merci !!! des exemples}, c'est l'étape marche-arrêt, mais pas à la relancer... après une pause. Si je suis en pause, je peux l'arrêter sans message d'erreur.

    état pause:Nom : Capture - pause.JPG
Affichages : 269
Taille : 49,6 Ko

    erreur pause:Nom : Capture - pause - erreur.JPG
Affichages : 223
Taille : 38,6 Ko

    voici le code qui permet de faire du marche-arrêt:

    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
    219
    220
    221
    222
    223
    224
    225
    226
    227
    228
    229
    230
    231
    232
    233
    234
    235
    236
    237
    238
    239
    240
    241
    242
    243
    244
    245
    246
    247
    248
    249
    250
    251
    252
    253
    254
    255
    256
    257
    258
    259
    260
    261
    262
    263
    264
    265
    266
    267
    268
    269
    270
    271
    272
    273
    274
    275
    276
    277
    278
    279
    280
    281
    282
    283
    284
    285
    286
    287
    288
    289
    290
    291
    292
    293
    294
    295
    296
    297
    298
    299
    300
    301
    302
    303
    304
    305
    306
    307
    308
    309
    310
    311
    312
    313
    314
    315
    316
    317
    318
    319
    320
    321
    322
    323
    324
    325
    326
    327
    328
    329
    330
    331
    332
    333
    334
    335
    336
    337
    338
    339
    340
    341
    342
    343
    344
    345
    346
    347
    348
    349
    350
    351
    352
    353
    354
    355
    356
    357
    358
    359
    360
    361
    362
    363
    364
    365
    366
    367
    368
    369
    370
    371
    372
    373
    374
    375
    376
    377
    378
    379
    380
    381
    382
    383
    384
    385
    386
    387
    388
    389
    390
    391
    392
    393
    394
    395
    396
    397
    398
    399
    400
    401
    402
    403
    404
    405
    406
    use warnings;
    use strict;
    use File::ChangeNotify;
    use Switch;
    use File::Basename;
    use Text::CSV;
     
    use Win32;
    use Win32::Daemon;
     
    use threads;
    use threads::shared;
     
    $| = 1;
     
     
    my $child_exit_flag : shared  = 0;
     
    my $watcher =
    			File::ChangeNotify->instantiate_watcher
    				( directories => [ 'C:\infoG\Create-Windows-service' ],
    				  filter  => qr/\.csv$/
    				);
     
     
     
    main();
     
    use constant SERVICE_NAME => 'Four01';
    use constant SERVICE_DESC => 'dossier Four01';
     
     
    sub main
    {
       # Get command line argument - if none passed, use empty string
       my $opt = shift (@ARGV) || "";
     
       # Check command line argument
       if ($opt =~ /^(-i|--install)$/i)
       {
          install_service(SERVICE_NAME, SERVICE_DESC);
       }
       elsif ($opt =~ /^(-r|--remove)$/i)
       {
          remove_service(SERVICE_NAME);
       }
       elsif ($opt =~ /^(--run)$/i)
       {
          # Redirect STDOUT and STDERR to a log file
          # Derive the name of the file from the name of the program
          # The log file will be in the scripts directory, with extension .log
          my ($cwd,$bn,$ext) =
          ( Win32::GetFullPathName($0) =~ /^(.*\\)(.*)\.(.*)$/ ) [0..2] ;
          my $log = $cwd . $bn . ".log"; 
          # Redirect STDOUT and STDERR to log file
          open(STDOUT, ">> $log") or die "Couldn't open $log for appending: $!\n";
          open(STDERR, ">&STDOUT");
          # Autoflush, no buffering
          $|=1;
     
          # Register the events which the service responds to
          Win32::Daemon::RegisterCallbacks( {
                start       =>  \&Callback_Start,
                running     =>  \&Callback_Running,
                stop        =>  \&Callback_Stop,
                pause       =>  \&Callback_Pause,
                continue    =>  \&Callback_Continue,
             } );
          my %Context = (
             last_state => SERVICE_STOPPED,
             start_time => time(),
          );
          # Start the service passing in a context and indicating to callback
          # using the "Running" event every 2000 milliseconds (2 seconds).
          # NOTE: the StartService method with in 'callback mode' will block, in other
          # words it won't return until the service has stopped, but the callbacks below
          # will respond to the various events - START, STOP, PAUSE etc...
          Win32::Daemon::StartService( \%Context, 2000 );
     
          # Here the service has stopped
          close STDERR; close STDOUT;
       }
       else
       {
          print "No valid options passed - nothing done\n";
       }
    }
     
     
    sub Callback_Running
    {
       my( $Event, $Context ) = @_;
     
       # Note that here you want to check that the state
       # is indeed SERVICE_RUNNING. Even though the Running
       # callback is called it could have done so before
       # calling the "Start" callback.
       if( SERVICE_RUNNING == Win32::Daemon::State() )
       {
    		# ... process your main stuff here...
    		# ... note that here there is no need to
    		#     change the state
     
    		# For now just print hello to the STDOUT, which goes to the log file
    		print "Hello! Start demon\n";
     
    		$Context->{last_state} = SERVICE_RUNNING;
    		Win32::Daemon::State( SERVICE_RUNNING );
     
    		# Create child thread
    		my $ChildThread = threads->create( \&child_thread );
    		$ChildThread->detach();
     
        }
    }   
     
    sub Callback_Start
    {
       my( $Event, $Context ) = @_;
       # Initialization code
       # ...do whatever you need to do to start...
     
       print "Starting...\n";
     
       $Context->{last_state} = SERVICE_RUNNING;
       Win32::Daemon::State( SERVICE_RUNNING );
    }
     
    sub Callback_Pause
    {
       my( $Event, $Context ) = @_;
     
       print "Pausing...\n";
     
       $child_exit_flag = 1;   
     
       $Context->{last_state} = SERVICE_PAUSED;
       Win32::Daemon::State( SERVICE_PAUSED );
     
    }
     
    sub Callback_Continue
    {
       my( $Event, $Context ) = @_;
     
       print "Continuing...\n";
     
       $child_exit_flag = 0;
     
       $Context->{last_state} = SERVICE_RUNNING;
       Win32::Daemon::State( SERVICE_RUNNING );
     
    }
     
    sub Callback_Stop
    {
       my( $Event, $Context ) = @_;
     
       print "Stopping...\n";
     
       $child_exit_flag = 1;
     
       $Context->{last_state} = SERVICE_STOPPED;
       Win32::Daemon::State( SERVICE_STOPPED );
     
       # We need to notify the Daemon that we want to stop callbacks and the service.
       Win32::Daemon::StopService();
    }
     
     
    sub install_service
    {
       my ($srv_name, $srv_desc) = @_;
       my ($path, $parameters);
     
       # Get the program's full filename, break it down into constituent parts
       my $fn = Win32::GetFullPathName($0);
       my ($cwd,$bn,$ext) = ( $fn =~ /^(.*\\)(.*)\.(.*)$/ ) [0..2] ;
     
       # Determine service's path to executable based on file extension
       if ($ext eq "pl")
       {
          # Source perl script - invoke perl interpreter
          $path = "\"$^X\"";
          # Parameters include extra @INC directories and perl script
          # @INC directories must not end in \ otherwise perl hangs
          my $inc = ($cwd =~ /^(.*?)[\\]?$/) [0];
          # The command includes the --run switch needed in main()
          $parameters = "-I " . "\"$inc\"" . " \"$fn\" --run";
       }
       elsif ($ext eq "exe")
       {
          # Compiled perl script - invoke the compiled script
          $path = "\"$fn\"";
          $parameters = "";
       }
       else
       {
          # Invalid file type?
          die "Can not install service for $fn,
          file extension $ext not supported\n";
       }
     
       # Populate the service configuration hash
       # The hash is required by Win32::Daemon::CreateService
       my %srv_config = (
          name         => $srv_name,
          display      => $srv_name,
          path         => $path,
          description  => $srv_desc,
          parameters   => $parameters,
          service_type => SERVICE_WIN32_OWN_PROCESS,
          start_type   => SERVICE_AUTO_START,
       );
       # Install the service
       if( Win32::Daemon::CreateService( \%srv_config ) )
       {
          print "Service installed successfully\n";
       }
       else
       {
          print "Failed to install service\n";
       }
    }
     
    sub remove_service
    {
       my ($srv_name, $hostname) = @_;
       $hostname ||= Win32::NodeName();
       if ( Win32::Daemon::DeleteService ( $srv_name ) )
       {
          print "Service uninstalled successfully\n";
       }
       else
       {
          print "Failed to uninstall service\n";
       }
    }
     
    sub child_thread {
        while ( my @events = $watcher->wait_for_events() )  { 
    		if ($child_exit_flag == 1) {
    			return;
    		}	else {			
     
    			print "new event\n";
    			for my $event ( @events ) {
     
    				my $path_url = $event->path();
    					my $ev = $event->type();
    					print $path_url, ' - ', $ev, "\n";
     
    					my($filename, $dirs, $suffix) = fileparse($path_url);
    					print "filename: ", $filename, ' - ',"dirs: ", $dirs, ' - ', "suffix: ", $suffix, "\n";
     
     
    					my $file_out = "create.html";
     
    					#"create", "modify", "delete", or "unknown".
     
    					switch($ev){
    					case "create"     { 
    						print "info: create\n"; 
    						my ($ref_tab) = parce_csv($dirs,  $filename, $path_url);
    						my (@tableau) = @{$ref_tab};
    						#print "@$_\n" for @array;
    						print "tableau: --->","\n";
    						print "@$_\n" for @tableau;
    						create_htm($dirs,  $file_out, $ref_tab);
    					}
    					case "modify"     { 
    						print "info: modify\n";
    						my ($ref_tab) = parce_csv($dirs,  $filename);
    						my (@tableau) = @{$ref_tab};
    						#print "@$_\n" for @array;
    						print "tableau: --->","\n";
    						print "@$_\n" for @tableau;
    						create_htm($dirs,  $file_out, $ref_tab);
    					}
    					case "delete"     { print "info: delete\n" }
    					case "unknown"    { print "info: unknown\n" }
    					else              { print "info: autre\n" }
    					}
     
     
    			}
    		}
    	}	
    }
     
     
     
    sub parce_csv {
    	my($folder_file, $my_file, $my_url) = @_;
     
    	my (@tableau2D);
     
       print "sub parce_csv: ", ' - ',"folder_file: ", $folder_file, ' - ', "my_file: ", $my_file, "\n";
       print "sub parce_csv: ", ' - ',"my_url: ", $my_url, "\n";
     
        my $csv = Text::CSV->new({ sep_char => ';' });
     
    	my $file = $my_url or die "Need to get CSV file on the command line\n";
     
        my $iter_ligne = 0;
        open(my $data, '<:utf8', $file) or die "Could not open '$file' $!\n";
        while (my $line = <$data>) {
     
          chomp $line;
          if ($csv->parse($line)) {
     
              my @fields = $csv->fields();
     
    		  $tableau2D[$iter_ligne] = [ @fields ];
     
              #$sum += $fields[2];
    		  my $arrSize = @fields;
    		  my $i = 0;
    		  for my $field ( @fields ) {
     
    			if ($i==($arrSize-1)) {
    				print $field, "\n";
    			}
    			else {
    			  print $field, " - ";
    			}
    			$i++;
    		  }
     
          } else {
              warn "Line could not be parsed: $line\n";
          }
     
    	  $iter_ligne++;
    	  print "iter_ligne : ","$iter_ligne\n";
     
        }
        #print "$sum\n";
     
    	print "tableau int2D: --->","\n";
    	print "@$_\n" for @tableau2D;
     
    	return \@tableau2D;
     
    }
     
    sub create_htm {
     
    	my(@args) = @_;
     
    	my $cmdString = $args[0];
    	my $file=$args[1];
    	my $ref = $args[2];
        my @tab = @$ref;	
     
    	print "tableau create_htm: --->","\n";
    	print "@$_\n" for @tab;
     
     
    	chdir($cmdString)|| die "Error: could not '$cmdString'"; 
    	if (-e $file) #if the file exists 
    	{ 
    	print "re-ecriture HLM\n";
    	} 
    	open(my $FILE, ">$file") or die "Cannot open $file: $!"; ## >> means +append to the end of file. 
     
    	my $re = $file;
     
    	print $FILE '<!DOCTYPE html>';
    	print $FILE '<html>';
    	print $FILE '<head>';
    	print $FILE '	<meta name="robots" content="noindex,nofollow">';
    	print $FILE '	<title>HTML auto</title>';
    	print $FILE '<script type="text/javascript">';
    	print $FILE 'var refreshTime= 2*2;';
    	#rafréchissement
    	print $FILE '    var foo = document.write(\'<meta http-equiv="refresh" content="\'+refreshTime+\';url=',$re,' ">\');';
    	print $FILE '</script>';
    	print $FILE '</head>';
    	print $FILE '<body>';
     
    	print $FILE '<h1>My First Heading</h1>';
     
    	print $FILE '<p>My first paragraph.</p>';
     
    	print $FILE '<table style="width:100%">';
    	foreach my $row (@tab) {
    		print $FILE '<tr>';
          foreach my $element (@$row) {
    		print $FILE '<td>';
    		print $FILE $element;
    		print $FILE '</td>';
    	  }
    		print $FILE '</tr>';
    	}
    	print $FILE '</table>';
     
    	print $FILE '</body>';
    	print $FILE '</html>';  
     
     
    	close($FILE); 
     
    	print "Your html has been created"; 
     
    }
    une idée, de ce qu'il faudrait moddifier pour pour rellancer après une pause ?

    Je me demande comment est relancer la fonction "Callback_Running" après la pause. c'est peut-être là mon problème...

    Bonne soirée

  9. #9
    Membre chevronné Avatar de dmganges
    Homme Profil pro
    Retraité. Ne recherche pas un emploi.
    Inscrit en
    Septembre 2011
    Messages
    1 392
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 71
    Localisation : France, Hérault (Languedoc Roussillon)

    Informations professionnelles :
    Activité : Retraité. Ne recherche pas un emploi.
    Secteur : Service public

    Informations forums :
    Inscription : Septembre 2011
    Messages : 1 392
    Points : 2 044
    Points
    2 044
    Par défaut
    Bonjour,

    Comme le sujet est très intéressant et que je n'écris que des bêtises si je ne teste pas, j'ai fait un essai complet...
    1 - Je dois avoir un pb de droit, car je ne peux lancer perl myservice.pl -i :
    Failed to install service SI je lance de mon compte qui est administrateur
    MAIS Service installed successfully SI je lance dans une invite de commande Administrateur CEPENDANT le pgm ne tourne pas !
    MAIS c'est OK si je lance dans le gestionnaire de service avec les droits Administrateur...

    Donc pour le moment je lance dans le gestionnaire, et j'arrive au même constat que toi :
    - marche-arrêt OK
    - Suspendre OK
    - Reprendre : Le même message que toi, CEPENDANT en réalité le service est reparti.

    2 - Dans ta dernière mouture j'ai dû ajouter :
    Après le :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    # Create child thread
    		my $ChildThread = threads->create( \&child_thread );
    		$ChildThread->detach();
    SINON ça boucle !

    3 - Pour me faciliter la tâche je fais sur des .txt, ma mouture est :

    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
    219
    220
    221
    222
    223
    224
    225
    226
    227
    228
    229
    230
    231
    232
    233
    234
    235
    236
    237
    238
    239
    240
    241
    242
    243
    244
    245
    246
    247
    248
    249
    250
    251
    252
    253
    254
    255
    256
    257
    258
    259
    260
    261
    262
    263
    264
    265
    266
    267
    268
    269
    270
    271
    272
    273
    274
    275
    276
    277
    278
    279
    280
    281
    282
    283
    284
    285
    286
    287
    288
    289
    290
    291
    292
    293
    294
    295
    296
    297
    298
    299
    300
    301
    302
    303
    304
    305
    306
    307
    308
    309
    310
    311
    312
    313
    314
    315
    316
    317
    318
    319
    320
    321
    322
    323
    324
    325
    326
    327
    328
    329
    330
    331
    332
    333
    334
    335
    336
    337
    338
    339
    340
    341
    342
    343
    344
    345
    346
    347
    348
    349
    350
    351
    352
    353
    354
    355
    356
    357
    358
    359
    360
    361
    362
    363
    364
    365
    366
    367
    368
    369
    370
    371
    372
    373
    374
    375
    376
    377
    378
    379
    380
    381
    382
    383
    384
    385
    386
    387
    388
    389
    390
    391
    392
    393
    394
    395
    396
    397
    398
    use warnings;
    use strict;
    use File::ChangeNotify;
    use Switch;
    use File::Basename;
    use Text::CSV;
     
    use Win32;
    use Win32::Daemon;
     
    use threads;
    use threads::shared;
     
    $| = 1;
     
     
    my $child_exit_flag : shared  = 0;
     
    my $watcher =
    			File::ChangeNotify->instantiate_watcher
    				( directories => [ 'E:\SERVICE' ],
    				  filter  => qr/\.txt$/
    				);
     
     
     
    main();
     
    use constant SERVICE_NAME => 'myservice';
    use constant SERVICE_DESC => 'myservice';
     
     
    sub main
    {
       # Get command line argument - if none passed, use empty string
       my $opt = shift (@ARGV) || "";
     
       # Check command line argument
       if ($opt =~ /^(-i|--install)$/i)
       {
          install_service(SERVICE_NAME, SERVICE_DESC);
       }
       elsif ($opt =~ /^(-r|--remove)$/i)
       {
          remove_service(SERVICE_NAME);
       }
       elsif ($opt =~ /^(--run)$/i)
       {
          # Redirect STDOUT and STDERR to a log file
          # Derive the name of the file from the name of the program
          # The log file will be in the scripts directory, with extension .log
          my ($cwd,$bn,$ext) =
          ( Win32::GetFullPathName($0) =~ /^(.*\\)(.*)\.(.*)$/ ) [0..2] ;
          my $log = $cwd . $bn . ".log"; 
          # Redirect STDOUT and STDERR to log file
          open(STDOUT, ">> $log") or die "Couldn't open $log for appending: $!\n";
          open(STDERR, ">&STDOUT");
          # Autoflush, no buffering
          $|=1;
     
          # Register the events which the service responds to
          Win32::Daemon::RegisterCallbacks( {
                start       =>  \&Callback_Start,
                running     =>  \&Callback_Running,
                stop        =>  \&Callback_Stop,
                pause       =>  \&Callback_Pause,
                continue    =>  \&Callback_Continue,
             } );
          my %Context = (
             last_state => SERVICE_STOPPED,
             start_time => time(),
          );
          # Start the service passing in a context and indicating to callback
          # using the "Running" event every 2000 milliseconds (2 seconds).
          # NOTE: the StartService method with in 'callback mode' will block, in other
          # words it won't return until the service has stopped, but the callbacks below
          # will respond to the various events - START, STOP, PAUSE etc...
          Win32::Daemon::StartService( \%Context, 2000 );
     
          # Here the service has stopped
          close STDERR; close STDOUT;
       }
       else
       {
          print "No valid options passed - nothing done\n";
       }
    }
     
     
    sub Callback_Running
    {
       my( $Event, $Context ) = @_;
     
       # Note that here you want to check that the state
       # is indeed SERVICE_RUNNING. Even though the Running
       # callback is called it could have done so before
       # calling the "Start" callback.
       if( SERVICE_RUNNING == Win32::Daemon::State() )
       {
    		# ... process your main stuff here...
    		# ... note that here there is no need to
    		#     change the state
     
    		# For now just print hello to the STDOUT, which goes to the log file
    		print "Hello! Start demon\n";
     
    		$Context->{last_state} = SERVICE_RUNNING;
    		Win32::Daemon::State( SERVICE_RUNNING );
     
    		# Create child thread
    		my $ChildThread = threads->create( \&child_thread );
    		$ChildThread->detach();
    		
    		
    		$child_exit_flag = 0;
    		
     
        }
    }   
     
    sub Callback_Start
    {
       my( $Event, $Context ) = @_;
       # Initialization code
       # ...do whatever you need to do to start...
     
       print "Starting...\n";
     
       $Context->{last_state} = SERVICE_RUNNING;
       Win32::Daemon::State( SERVICE_RUNNING );
    }
     
    sub Callback_Pause
    {
       my( $Event, $Context ) = @_;
     
       print "Pausing...\n";
     
       $child_exit_flag = 1;   
     
       $Context->{last_state} = SERVICE_PAUSED;
       Win32::Daemon::State( SERVICE_PAUSED );
     
    }
     
    sub Callback_Continue
    {
       my( $Event, $Context ) = @_;
     
       print "Continuing...\n";
     
       $child_exit_flag = 0;
     
       $Context->{last_state} = SERVICE_RUNNING;
       Win32::Daemon::State( SERVICE_RUNNING );
     
    }
     
    sub Callback_Stop
    {
       my( $Event, $Context ) = @_;
     
       print "Stopping...\n";
     
       $child_exit_flag = 1;
     
       $Context->{last_state} = SERVICE_STOPPED;
       Win32::Daemon::State( SERVICE_STOPPED );
     
       # We need to notify the Daemon that we want to stop callbacks and the service.
       Win32::Daemon::StopService();
    }
     
     
    sub install_service
    {
       my ($srv_name, $srv_desc) = @_;
       my ($path, $parameters);
     
       # Get the program's full filename, break it down into constituent parts
       my $fn = Win32::GetFullPathName($0);
       my ($cwd,$bn,$ext) = ( $fn =~ /^(.*\\)(.*)\.(.*)$/ ) [0..2] ;
     
       # Determine service's path to executable based on file extension
       if ($ext eq "pl")
       {
          # Source perl script - invoke perl interpreter
          $path = "\"$^X\"";
          # Parameters include extra @INC directories and perl script
          # @INC directories must not end in \ otherwise perl hangs
          my $inc = ($cwd =~ /^(.*?)[\\]?$/) [0];
          # The command includes the --run switch needed in main()
          $parameters = "-I " . "\"$inc\"" . " \"$fn\" --run";
       }
       elsif ($ext eq "exe")
       {
          # Compiled perl script - invoke the compiled script
          $path = "\"$fn\"";
          $parameters = "";
       }
       else
       {
          # Invalid file type?
          die "Can not install service for $fn,
          file extension $ext not supported\n";
       }
     
       # Populate the service configuration hash
       # The hash is required by Win32::Daemon::CreateService
       my %srv_config = (
          name         => $srv_name,
          display      => $srv_name,
          path         => $path,
          description  => $srv_desc,
          parameters   => $parameters,
          service_type => SERVICE_WIN32_OWN_PROCESS,
          start_type   => SERVICE_AUTO_START,
       );
       # Install the service
       if( Win32::Daemon::CreateService( \%srv_config ) )
       {
          print "Service installed successfully\n";
       }
       else
       {
          print "Failed to install service\n";
       }
    }
     
    sub remove_service
    {
       my ($srv_name, $hostname) = @_;
       $hostname ||= Win32::NodeName();
       if ( Win32::Daemon::DeleteService ( $srv_name ) )
       {
          print "Service uninstalled successfully\n";
       }
       else
       {
          print "Failed to uninstall service\n";
       }
    }
     
    sub child_thread {
        while ( my @events = $watcher->wait_for_events() )  { 
    		if ($child_exit_flag == 1) {
    			return;
    		}	else {
    			
    			print "\n\nnew event\n";
    					for my $Event ( @events ) {
    						my $path = $Event->path();
    						my $ev = $Event->type();
    						#my($filename, $dirs, $suffix) = fileparse($path);
    						print $path, ' - ', $ev, "\n";
    						switch($ev){
    							case "create" { 
    								print "info: create\n"; 
    								parcing($path);
          				}
    							case "modify" { 
    								print "info: modify\n";
            				parcing($path);
          				}
    							case "delete"  { print "info: delete\n" }
    							case "unknown" { print "info: unknown\n" }
          				else { print "info: autre\n" }
        				}
    					}
    			
    		}
    	}	
    }
     
    sub parcing {
        my($path) = @_;
        open(my $data, '<:utf8', $path) or die "Could not open '$path' $!\n";
        while (my $line = <$data>) {
            print $line;
        }
    }
    
    =pod
     
    sub parce_csv {
    	my($folder_file, $my_file, $my_url) = @_;
     
    	my (@tableau2D);
     
       print "sub parce_csv: ", ' - ',"folder_file: ", $folder_file, ' - ', "my_file: ", $my_file, "\n";
       print "sub parce_csv: ", ' - ',"my_url: ", $my_url, "\n";
     
        my $csv = Text::CSV->new({ sep_char => ';' });
     
    	my $file = $my_url or die "Need to get CSV file on the command line\n";
     
        my $iter_ligne = 0;
        open(my $data, '<:utf8', $file) or die "Could not open '$file' $!\n";
        while (my $line = <$data>) {
     
          chomp $line;
          if ($csv->parse($line)) {
     
              my @fields = $csv->fields();
     
    		  $tableau2D[$iter_ligne] = [ @fields ];
     
              #$sum += $fields[2];
    		  my $arrSize = @fields;
    		  my $i = 0;
    		  for my $field ( @fields ) {
     
    			if ($i==($arrSize-1)) {
    				print $field, "\n";
    			}
    			else {
    			  print $field, " - ";
    			}
    			$i++;
    		  }
     
          } else {
              warn "Line could not be parsed: $line\n";
          }
     
    	  $iter_ligne++;
    	  print "iter_ligne : ","$iter_ligne\n";
     
        }
        #print "$sum\n";
     
    	print "tableau int2D: --->","\n";
    	print "@$_\n" for @tableau2D;
     
    	return \@tableau2D;
     
    }
     
    sub create_htm {
     
    	my(@args) = @_;
     
    	my $cmdString = $args[0];
    	my $file=$args[1];
    	my $ref = $args[2];
        my @tab = @$ref;	
     
    	print "tableau create_htm: --->","\n";
    	print "@$_\n" for @tab;
     
     
    	chdir($cmdString)|| die "Error: could not '$cmdString'"; 
    	if (-e $file) #if the file exists 
    	{ 
    	print "re-ecriture HLM\n";
    	} 
    	open(my $FILE, ">$file") or die "Cannot open $file: $!"; ## >> means +append to the end of file. 
     
    	my $re = $file;
     
    	print $FILE '<!DOCTYPE html>';
    	print $FILE '<html>';
    	print $FILE '<head>';
    	print $FILE '	<meta name="robots" content="noindex,nofollow">';
    	print $FILE '	<title>HTML auto</title>';
    	print $FILE '<script type="text/javascript">';
    	print $FILE 'var refreshTime= 2*2;';
    	#rafréchissement
    	print $FILE '    var foo = document.write(\'<meta http-equiv="refresh" content="\'+refreshTime+\';url=',$re,' ">\');';
    	print $FILE '</script>';
    	print $FILE '</head>';
    	print $FILE '<body>';
     
    	print $FILE '<h1>My First Heading</h1>';
     
    	print $FILE '<p>My first paragraph.</p>';
     
    	print $FILE '<table style="width:100%">';
    	foreach my $row (@tab) {
    		print $FILE '<tr>';
          foreach my $element (@$row) {
    		print $FILE '<td>';
    		print $FILE $element;
    		print $FILE '</td>';
    	  }
    		print $FILE '</tr>';
    	}
    	print $FILE '</table>';
     
    	print $FILE '</body>';
    	print $FILE '</html>';  
     
     
    	close($FILE); 
     
    	print "Your html has been created"; 
     
    }
    le myservice.log :
    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
    Starting...
    Hello! Start demon
    
    
    new event
    E:\SERVICE/List_9.txt - delete
    info: delete
    
    
    new event
    E:\SERVICE/List_10.txt - create
    info: create
    Fichier List 10Pausing...
    Continuing...
    
    new event
    E:\SERVICE/List_9.txt - create
    info: create
    Fichier List 9
    Malgré le message d'erreur sur Reprendre dans le gestionnaire j'ai pu créer dans la foulée :
    E:\SERVICE/List_9.txt - create

    Citation Envoyé par chrishess
    une idée, de ce qu'il faudrait moddifier pour pour rellancer après une pause ?

    Je me demande comment est relancer la fonction "Callback_Running" après la pause. c'est peut-être là mon problème...
    Donc je n'ai pas tout à fait le même pb, un pb de timing ou de synchro

    @+ pas aujourd'hui, car après 06h30 mon neurone est à plat
    de plus le vendredi c'est intendance...

    [EDIT 06:55] # my($filename, $dirs, $suffix) = fileparse($path); Pas utilisé

Discussions similaires

  1. Réponses: 2
    Dernier message: 27/03/2012, 09h47
  2. Réponses: 2
    Dernier message: 16/10/2011, 15h17
  3. Réponses: 2
    Dernier message: 27/04/2006, 15h22
  4. Message dans la barre des taches avec Timer
    Par avogadro dans le forum Langage
    Réponses: 15
    Dernier message: 29/03/2006, 13h20

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