Task2nzb ou Transformer le fichier task de pan en fichier nzb(Newsbin)

Ce principe est heureusement rendu obsolete par la version 0.90 de pan, qui exporte automatiquement les taches sous forme de fichier nzb.

Le gros problème de ma vie : c’est sympa de pouvoir télé-charger des choses sur les news, surtout des photos qui bougent . Mais voila, il n’y a pas d’outils qui me convienne. J’en ai essayer plein, brag, suck... etc. Puis un jour je suis tomber sur pan : Graphique, rapide (pour le télé-chargement). Malheureusement il n’est pas d’une stabilité exemplaire.

D’un autre cote il y a les fichiers NZB avec tout plein d'utilitaires pour télé-charger et bien sur aucun outil pour les générera partir des news. Évidement la plus part du temps les fichiers NZB sont générés par le poster lui même

Et puis un jour je me suis dit :

Oui, je sais ! Je devrais arrêté de penser à des petites bulles avec des flèches la nuit. Bref encore un truc cool à faire en Perl.

• Utilisation des modules SAX de perl
• J’ai crée un dtd pour tasks.xml (Je l’ai pas trouvé sur internet).

On s’appuie sur le fait que :

• la task list de pan ne contienne que des fichiers à télé-charger,
• Les fichiers nzb contiennent des informations inutiles.

xml.tgz

D’une simplicite exemplaire.

#!/usr/bin/perl -w
 
use strict;
use XML::SAX::Machines qw(Pipeline);
 
my $output_string;
my $parser = Pipeline( Task2Nzb => \*STDOUT );
 
$parser->parse_uri(shift);

Je ferais un truc un peu plus propre une autre fois.

package Task2Nzb;
use Data::Dumper;
 
 
use base qw(XML::SAX::Base);
 
my $state = {};
my $tdata = '';
my $h = {};
 
 
 
sub start_element {
 my ($self, $el) = @_;
 $state->{$el->{Name}}++;
 if ($el->{Name} eq 'tasks') {
  $el->{Name} =  $el->{LocalName} = 'nzb';
  $el->{Attributes} =
   {
    'xmlns' => {
		'LocalName' => 'xmlns',
		'Value' => "http://www.newzbin.com/DTD/2003/nzb",
		'Name' => 'xmlns',
	       }
   };
  return $self->start_elm($el);
 }
 return if $el->{Name} eq 'save';
 return if $el->{Name} eq 'message_identifier';
 return if $el->{Name} eq 'message_id';
 return if $el->{Name} eq 'readable_name';
 
 
 return if $el->{Name} eq 'path';
 return if $el->{Name} eq 'server';
 return if $el->{Name} eq 'lines';
 return if $el->{Name} eq 'bytes';
 return if $el->{Name} eq 'source';
 return if $el->{Name} eq 'number';
 return if $el->{Name} eq 'group';
 if ($el->{Name} eq 'nzb') {
  print "$el ", Dumper($el);
  die;
 }
 $self->SUPER::start_element($el);
}
 
sub end_element {
 my ($self, $el) = @_;
 $state->{$el->{Name}}--;
 return if $el->{Name} eq 'server';
 return if $el->{Name} eq 'path';
 return if $el->{Name} eq 'message_identifier';
 return if $el->{Name} eq 'lines';
 return if $el->{Name} eq 'bytes';
 return if $el->{Name} eq 'source';
 return if $el->{Name} eq 'number';
 if ($el->{Name} eq 'save') {
  $el->{Name} = 'file';
  $el->{Attributes} =
   {
    'subject' => {
		'Value' => @{$h->{sub}}[0],
		'Name' => 'subject',
	       }
   };
  $self->start_elm($el);
  $self->make_groups();
  $self->make_segments();
  $self->end_elm($el);
  $h = {};
  return;
 }
 if ($el->{Name} eq 'message_id') {
  push @{$h->{msg_id}}, $tdata;
  $tdata = '';
  return;
 }
 if ($el->{Name} eq 'readable_name') {
#remove space in subject
  $tdata =~ y/ /_/;
  push @{$h->{sub}}, $tdata;
  $tdata = '';
  return;
 }
 if ($el->{Name} eq 'group') {
  $h->{group}->{$tdata} = 1;
  $tdata = '';
  return;
 }
 $self->SUPER::end_element($el);
}
 
sub start_dtd {
 my ($self, $data) = @_;
 my $dat = {
          'SystemId' => 'http://www.newzbin.com/DTD/nzb/nzb-0.9.dtd',
          'PublicId' => '-//newzBin//DTD NZB 0.9//EN',
          'Name' => 'nzb'
        };
 $self->SUPER::start_dtd($dat);
}
 
sub end_dtd {
 my ($self, $data) = @_;
 
# die;
 $self->SUPER::end_dtd($data);
}
 
sub comment {
 my ($self, $data) = @_;
# print Dumper($data);
 
}
sub element_decl {
 my ($self, $data) = @_;
 return;
}
 
#sub entity_reference     { my ($self, $data) = @_; die;}
#sub notation_decl	     { my ($self, $data) = @_; die;}
#sub unparsed_entity_decl { my ($self, $data) = @_; die;}
#sub attlist_decl	     { my ($self, $data) = @_; die;}
#sub doctype_decl	     { my ($self, $data) = @_; die;}
#sub xml_decl	     { my ($self, $data) = @_; die;}
#sub entity_decl	     { my ($self, $data) = @_; die;}
#sub attribute_decl	     { my ($self, $data) = @_; die;}
#sub warning		     { my ($self, $data) = @_; die;}
#sub error		     { my ($self, $data) = @_; die;}
#sub fatal_error          { my ($self, $data) = @_; die;}
 
sub characters {
 my ($self, $chars) = @_;
# print "dump: ", Dumper($state), "\n";
 return if $state->{server};
 return if $state->{path};
 return if $state->{lines};
 return if $state->{bytes};
 return if $state->{number};
# print "dump: ", Dumper($chars), "\n";
 if ($state->{message_id}) {
  return if (length $chars->{Data} == 1);
  $tdata .= $chars->{Data};
  return;
 }
 if ($state->{readable_name}) {
  if (length $chars->{Data} == 1) {
   $tdata .= sprintf('&#x%x',ord($chars->{Data}));
  } else {
   my $str = $chars->{Data};
   $str =~ s/[^\000-\177]/sprintf('&#x%x',ord($&))/ge;
   $tdata .= $str;
   die if $tdata =~ /[^\000-\177]/;
  }
 }
 if ($state->{group}) {
  $tdata .= $chars->{Data};
  return;
 }
 return;
# my $out = $chars->{Data};
# $out =~ s/ +/ /g;
# $out =~ s/\s+/ /g;
# return if $out =~ /^\s+/;
# $self->SUPER::characters({Data => $out});
}
 
sub ignorable_whitespace {
 my ($self, $chars) = @_;
 my $out = $chars->{Data};
 print "Ignore\n";
 $self->SUPER::ignorable_whitespace($out);
}
 
sub make_groups {
 my $self = shift;
 my $groups = {};
 my $group = {};
 $groups->{Name} = 'groups';
 $group->{Name} = 'group';
 $self->start_elm($groups);
 foreach my $g (sort keys %{$h->{group}}  ) {
  $self->SUPER::start_element($group);
  $self->SUPER::characters({Data => $g});
  $self->end_elm($group);
 }
 $self->end_elm($groups);
}
 
sub make_segments {
 my $self = shift;
 my $segs = {};
 my $seg = {};
 $segs->{Name} = 'segments';
 $seg->{Name} = 'segment';
 $self->start_elm($segs);
 my $i = 1;
 foreach my $id (@{$h->{msg_id}}  ) {
  $seg->{Attributes} =
   {
    'number' => {
		'Value' => $i++,
		'Name' => 'number',
	       }
   };
  $self->SUPER::start_element($seg);
  $self->SUPER::characters({Data => $id});
  $self->end_elm($seg);
 }
 $self->end_elm($segs);
}
 
sub end_elm {
 my ($self, $data) = @_;
 $self->SUPER::end_element($data);
 $self->SUPER::characters({Data => "\n"});
}
 
sub start_elm {
 my ($self, $data) = @_;
 $self->SUPER::start_element($data);
 $self->SUPER::characters({Data => "\n"});
}
 
1;