logo

Knowledge Is Power

 
 

- Reinit des nouveaux posts -

- Recherche -

Messages Privés - Derniers posts
S'enregistrer - Login - Liste des membres
Vous logger : Login Pass

Programmation - Scripting, langages interprétés >> [perl] Script d'upload (Mechanize) Newtopic | Reply
poster txt
casskroot
Inscrit le 01-11-2003
Posté le 21-05-2011 11:51

Salut,

je me suis fait un script pour automatiser l'upload de vidéos chez rutube mais j'ai un petit soucis. Le script fonctionne mais fait ramer mon PC.
Avant d'utiliser ce script, j'utilise un autre script qui découpe mes vidéos en fichiers de 300Mo maximum et les place dans un dossier du nom de la vidéo. Une fois le découpage fait, je place un fichier description.txt dans le dossier qui contient la description de la vidéo et un fichier tags.txt qui contient la liste de tags.
Le script récupère ces informations, compte le nombre de vidéos présentes dans le dossier et les upload avec les informations correspondantes.
Le nom du dossier à traiter est passé en paramètre.

Le script fonctionne bien si j'envoie des petits fichiers mais fait énormément ramer le PC avec des fichiers de taille conséquente.

Est-ce que quelqu'un aurait une idée de l'origine du problème ?

Code:
#!/usr/bin/perl -w
use strict;
use WWW::Mechanize;
use HTTP::Cookies;
use Cwd;

my $m = WWW::Mechanize->new;

# On rempli et valide le formulaire de login
$m->post("http://rutube.ru/login.html");
$m->form_number(2);
my %CONF = (
rm => $m->value('rm'),
redirect=> '',
style => '',
nick => '***************************',
pass => '***************************',
openid => '',
);
$m->set_fields(%CONF);
$m->agent_alias("Linux Mozilla");
$m->submit();
die $m->res->status_line unless $m->success;

my ( $nbrep, $nbfic, $fichier, $dossier, $CWD, $description, $tags, $NbFichiers, $titre, $i) = ( 0, 0, undef, $ARGV[0], cwd() );

opendir my $dir, $dossier or die "$dossier n'existe pas !";

#On charge la description du fichier à envoyer
open(DESCRIPTION,"$CWD/${dossier}description.txt") || die ("Erreur d'ouverture de description") ;
while (<DESCRIPTION>)
{
$description .= $_;
}

#On charge les tags du fichier à envoyer
open(TAGS,"$CWD/${dossier}tags.txt") || die ("Erreur d'ouverture de tags") ;
while (<TAGS>)
{
$tags .= $_;
}
#On supprime les accents des tags et on ajoute une virgule entre chaque mot clef
$tags =~ s#ÀÁÂÃÄÅàáâãäåÒÓÔÕÖØòóôõöøÈÉÊËèéêëÇçÌÍÎÏìíîïÙÚÛÜùúûüÿÑñ#aaaaaaaaaaaaooooooooooooeeeeeeeecciiiiiiiiuuuuuuuuynn#;
$tags =~ s# #,#;

#On compte le nombre de fichiers à envoyer
my @files = readdir $dir;
foreach $fichier (@files)
{
if ( $fichier =~ /.avi/ )
{
$NbFichiers++;
}
}
closedir $dir;

#Le titre de la vidéo sera le nom du dossier. On supprime les éventuels accents et slashs.
$titre = $dossier;
$titre =~ s#ÀÁÂÃÄÅàáâãäåÒÓÔÕÖØòóôõöøÈÉÊËèéêëÇçÌÍÎÏìíîïÙÚÛÜùúûüÿÑñ#aaaaaaaaaaaaooooooooooooeeeeeeeecciiiiiiiiuuuuuuuuynn#;
$titre =~ s#/##;

#On rempli le formulaire d'upload et on le valide pour chaque fichier à envoyer
foreach $fichier (@files)
{
if ( $fichier =~ /.avi/ )
{
$i++;
$fichier = "$CWD/$dossier$fichier";

$m->post("http://uploader.rutube.ru/upload.html");
$m->form_number(2);
my %UPLOAD = (
save => $m->value('save'),
xdf => $m->value('xdf'),
way => '1',
data => $fichier,
title => "$titre ($i/$NbFichiers)",
comment => $description,
category => '13',
tags => $tags,
access => '0',
comments_hide => '',
abused => '',
published => 1,
report => 0,
);

$m->set_fields(%UPLOAD);
print "Envoi de $titre ($i/$NbFichiers) en cours...\n";
$m->submit();
die $m->res->status_line unless $m->success;
print "Vidéo $titre ($i/$NbFichiers) envoyée.\n"
}
}



Comme d'habitude, je vous remercie d'avance pour vos réponses .

A plus.

_________________________


[ Ce Message a été édité par: casskroot le 2011-05-21 11:53 ]
profil | mail | edit | quote
Shiva
Inscrit le 14-07-2002
Avatar
Posté le 23-05-2011 14:03

Je pense que c'est parce que lorsque le script fait:

Code:
data		=> $fichier 



il va mettre le contenu du fichier dans le formulaire et donc 300Mo à écrire cela fait logiquement ramer surtout qu'il doit garder le contenu en mémoire pendant qu'il l'introduit. Il faudrait pour faire "mieux" une connexion et envoyer avec genre en mode sockets pour que cela rame moins, enfin je suis pas sûr.
_________________________
On paye pour voir, pour entendre, quand est ce que l’on va devoir payer pour respirer ?
profil | edit | quote
casskroot
Inscrit le 01-11-2003
Posté le 11-06-2011 13:48

Salut Shiva, merci pour la réponse.
Le problème semble bien être celui que tu signales. Est-ce que ça signifie que la librairie a été codé de façon u peu "brutale" (ça me semble bizarre de charger un fichier complet en mémoire plutôt que d'en lire des tronçons au fur et à mesure des besoins) ou bien c'est une contrainte liée à perl (je connais pas trop ce langage mais ça m'étonnerait).


Mise à jour du script :
- Ajout de la numérotation du nom des vidéos pour les vidéos en plusieurs parties.
- Conversion des textes des titres, tags et descriptions en caractères HTML pour éviter les problèmes d'accents.
- Déplacement des fichiers uploadés une fois l'uplaod effectué avec succès.

Code:
#!/usr/bin/perl
use strict;
use encoding "utf-8";

use WWW::Mechanize;
use HTTP::Cookies;
use Cwd;
use Encode;
use HTML::Entities;

use POSIX qw(strftime);

my $m = WWW::Mechanize->new;

# On rempli et valide le formulaire de login
$m->post("http://rutube.ru/login.html");
$m->form_number(2);
my %CONF = (
rm => $m->value('rm'),
redirect=> '',
style => '',
nick => '**********************************************',
pass => '**********************************************',
openid => '',
);
$m->set_fields(%CONF);
$m->agent_alias("Linux Mozilla");

$m->submit();
die $m->res->status_line unless $m->success;

my ( $nbrep, $nbfic, $fichier, $dossier, $CWD, $description, $tags, $NbFichiers, $titre, $i) = ( 0, 0, undef, $ARGV[0], cwd() );

opendir my $dir, $dossier or die "$dossier n'existe pas !";

#On charge la description du fichier à envoyer
open(DESCRIPTION,"$CWD/${dossier}description.txt") || die ("Erreur d'ouverture de description") ;
while (<DESCRIPTION>)
{
$description .= $_;
}

#On charge les tags du fichier à envoyer
open(TAGS,"$CWD/${dossier}tags.txt") || die ("Erreur d'ouverture de tags") ;
while (<TAGS>)
{
$tags .= $_;
}
#On ajoute une virgule entre chaque mot clef
$tags =~ s# #,#g;

$description = decode_utf8($description);

#On compte le nombre de fichiers à envoyer
my @files = readdir $dir;
foreach $fichier (@files)
{
if ( $fichier =~ /.avi/ )
{
$NbFichiers++;
}
}
closedir $dir;

#Le titre de la vidéo sera le nom du dossier. On supprime les éventuels slashs.
$titre = $dossier;
$titre =~ s#/##g;

#On rempli le formulaire d'upload et on le valide pour chaque fichier à envoyer
foreach $fichier (@files)
{
if ( $fichier =~ /.avi/ )
{
$i++;
$fichier = "$CWD/$dossier$fichier";
$m->post("http://uploader.rutube.ru/upload.html");
$m->form_number(2);
my
PLOA;D = (
save => $m->value('save'),
xdf => $m->value('xdf'),
way => '1',
data => encode_utf8($fichier),
title => encode_entities("$titre ($i/$NbFichiers)"),
comment => encode_entities($description),
category => '13',
tags => encode_entities($tags),
access => '0',
comments_hide => '',
abused => '',
published => 1,
report => 0,
);

$m->set_fields(
PLOA;D);
print strftime "[%H:%M:%S] ", localtime;
print "Envoi de $titre ($i/$NbFichiers) en cours...\n";
$m->submit();
die $m->res->status_line unless $m->success;
print strftime "[%H:%M:%S] ", localtime;
print "Vidéo $titre ($i/$NbFichiers) envoyée.\n"
}
}
#On déplace le dossier contenant les vidéos une fois l'upload effectué
rename("$CWD/$dossier", "$CWD/00 - Ok/$dossier")



_________________________


[ Ce Message a été édité par: casskroot le 2011-06-11 13:48 ]
profil | mail | edit | quote
Shiva
Inscrit le 14-07-2002
Avatar
Posté le 17-06-2011 09:23

J'ai trouvé cela qui pourrait résoudre le problème (j'ai pas testé) mais par contre cela n'utilise pas Mechanize.


Code:
#!/usr/bin/perl --

use strict;
use warnings;

use LWP 5.825;

my $url = "http://foo/upload";
my $file = __FILE__;#"foo/bar";

my $ua = LWP::UserAgent->new;
$HTTP::Request::Common::DYNAMIC_FILE_UPLOAD = 1;

use HTTP::Request::Common;
my $req = POST(
$url,
Content_Type => 'multipart/form-data',
Content => [ file => [$file] ],
);

# set up callback
{
my $gen = $req->content();
die unless ref($gen) eq "CODE";
my $i = 0;
$req->content(
sub {
my $chunk = &$gen(); # get chunk of data
warn $i++;
return $chunk; # send it to $url
}
);

#use Data::Dumper;die print Data::Dumper->new([($ua,$req, $gen)])->Ind
+ent(1)->Deparse(1)->Dump;
}

my $res = $ua->request($req); #do it
print $res->status_line;


_________________________
On paye pour voir, pour entendre, quand est ce que l’on va devoir payer pour respirer ?
profil | edit | quote
casskroot
Inscrit le 01-11-2003
Posté le 20-06-2011 13:23

Salut, Mechanize utilise LWP qui utilise HTTP. $HTTP::Request::Common::DYNAMIC_FILE_UPLOAD = 1;
est donc bien la réponse magique, je te remercie.
J'ai quelques autres modifications à apporter au script puis je le reposterai ici au cas où ça intéresse des gens.


A plus.
_________________________

profil | mail | edit | quote
Newtopic | Reply

Online : Agustinbluts, AgustinPhine, Agustinwhase, Bbbarrige, BbbUnsels, best canadian pharcharmy online, canadian pharmacy online for viagra, Cevbraics, Cevvifura, Donaldjem, DonaldJinna, ebuyuhiphapu, edeuohuv, elewafuz, eolabizuliwax, eunagidez, euwbiku, generic cialis canadian, inacotob, inaxuuwapia, Jorgeviomb, Juanitamache, Juanitarhync, KevinAeron, KevinExicy, Ksbvgainty, Lmldneefe, Lnbikayany, Lnbiunsemi, MarcusAgock, MartinMoigh, ohobaso, ojeyovegoxuet, Ralphcak, RalphSiree, Romeotab, SonjaBrisk, SonjaNuS, SonjaOrigh, ubeirufqufow, uromueboe, utenesecig, uyiumof, uzazitehousoo, Vtbunelay, Vvbfrunse, yatsonizayad et 107 Guests


Retour Index NewFFR Repository : http://taz.newffr.com
Cagades à Stick : http://alcane.newffr.com
Forum HTML et Archive -> ici
ForumFR Sql/Xml (2006/04) (SF pas à jour du tout...) - Alive since 2001 Newffr.com
Pour toute plainte ou problème -> Contacter Borax, Hyatus, Tweakie ou Stick par message privé (ou Gueulez sur le forum :) )
Retour haut de page