Документ взят из кэша поисковой машины. Адрес оригинального документа : http://xmm.vilspa.esa.es/calibration/ept/perlscripts/extras.pl Дата изменения: Fri Aug 4 16:34:41 2006 Дата индексирования: Sun Apr 10 14:06:00 2016 Кодировка: Поисковые слова: http astrokuban.info astrokuban

#!/usr/bin/perl

# Aufruf mit MozEx - View Source -
#
# f:\\www\dl24\cgi\extras.exe %t
#
#
#
# mit (pp -o extras.exe extras.pl) .exe erstellen



use HTTP::Request::Common qw(POST);
use LWP::UserAgent;

use polilib;

my $file = $ARGV[0];


#my $DOMAIN = 'dharbarth.dyndns.org:8080';
my $DOMAIN = 'www.dl24.de';
my $URL_TO_CGI = 'http://' . $DOMAIN . '/relaunch/cgi/admin/admin.pl';


# Debug
#$file = 'C:\\mozex.source.aa80536b236bdcd33e3b1408d09e0e8b.1092243855228.html';


print "Extra Test($file):\n\n";
my $extras = parse_page($file);
#print_extras($extras);
send_extras($extras);
print "\n\nend\n";
;
exit;



# --------------------------------------------------------------------------------


sub send_extras
{

# ruft skript auf: BSP: admin.pl?anzahl=3&txt1=Klima&txt2=Dosenhalter&preis1=23&preis2=64

my $extras = shift; # ->Arr->Hash

my $counter = 1;
my %pairs;

foreach $e( @$extras ) # Paare zusammenbauen
{
$pairs{'txt'. $counter} = $e->{'txt'};
$pairs{'preis'. $counter} = $e->{'preis'};
$counter++;
}

$pairs{'anzahl'} = $counter;
$pairs{'aktion'} = 'extras_in_temp';

print "\n------------$counter---------\n";

# Posten
my $ua = LWP::UserAgent->new();
my $anf = POST $URL_TO_CGI ,[%pairs];

# Antwort vom Server
my $response = $ua->request($anf)->as_string;

savef('extra_response.html',\$response);
print $response;
}



sub parse_page
{
# parst ExtraSeite (auf bdk-finanz.de)
#
# return \@extras (txt + preis);

my $file = shift;

open TMPL,"<$file" or (print("Couldn't open $file ") && && exit);
my $page = join "", ();
close TMPL;

my @extras;
my $counter = 1;
while ($page =~ m/
(.+?) # Extra_txt
<\/td>
.*?
# Preis
.*?
(<\!--.*?Auspr.+?gungen.*?--> # AusprДgungen
(.*?)
<\!--ENDE \s AusprДgungen \s -->
)

/gsx) {

my %extra;
$extra{'txt'} = $1;
$extra{'preis'} = $2;
$extra{'auspraegung'} = $4;
$extra{'auspraegung'} =~ s/\s+//;
$extra{'txt'} =~ s/"/ґ/g; #
$extra{'txt'} =~ s/\s{2,}/ /g; # Leerzeichen weg
$extra{'txt'} =~ s/^\s|\s$//g; # Leerzeichen weg



# AusprДgung -> zu normalen Extras verarbeiten -> selber Preis wie Oberbegriff
if ($extra{'auspraegung'} ne '') {
while ($extra{'auspraegung'} =~ m/(.+?)<\/td>/gs) {

my %auspr;
$auspr{'txt'} = $1;
$auspr{'preis'} = $extra{'preis'};

$auspr{'txt'} =~ s/....\s+(.+?)/$1/; # noch zu viel MЭll dran !?

print $auspr{'txt'} . "\t\t\t" . $auspr{'preis'} ."\n";
push @extras, \%auspr;
}
} else {

print $extra{'txt'} . "\t\t\t" . $extra{'preis'} ."\n";
push @extras, \%extra;
}


#print "\n->" . $extra{'auspraegung'} if $extra{'auspraegung'} ne '';
#print "\n->" . $extra{'txt'} . "<-\n->" . $extra{'auspraegung'} . "<-\n\n";

$counter++
#$counter++ == 5 and print "vorzeitiges ende ....." and last;
}
# Debug
#print header();
#print $ap;
#savef('test.html',\$ap);

print "\n$counter Extras gefunden\n\n";
#exit;

return \@extras;
}

#sub parse_page
#{
# my $file = shift;
#
# open TMPL,"<$file" or (print("Couldn't open $file ") && && exit);
# my $page = join "", ();
# close TMPL;
#
# my @extras;
# my $counter = 1;
# while ($page =~ m/
# (.+?) # Extra_txt
# <\/td>
# .*?
# # Preis
# .*?
# (<\!--.*?Auspr.+?gungen.*?--> # AusprДgungen
# (.*?)
# <\!--ENDE \s AusprДgungen \s -->
# )
#
# /gsx) {
#
# my %extra;
# $extra{'txt'} = $1;
# $extra{'preis'} = $2;
# $extra{'auspraegung'} = $4;
# $extra{'txt'} =~ s/\s{2,}/ /g; # Leerzeichen weg
# $extra{'txt'} =~ s/^\s|\s$//g; # Leerzeichen weg
#
# push @extras, \%extra;
#
# #print "\n->" . $extra{'auspraegung'} if $extra{'auspraegung'} ne '';
#
# #print "\n->" . $extra{'txt'} . "<-\n->" . $extra{'auspraegung'} . "<-\n\n";
#
# $counter++
# #$counter++ == 5 and print "vorzeitiges ende ....." and last;
# }
#
# print "\n$counter Extras gefunden\n\n";
#
# return \@extras;
#}




sub print_extras
{
# Debug
my $extras = shift; # ->Arr->Hash

my $counter = 1;
foreach $e( @$extras )
{
print "\n" . $counter++ . " ->";
print $e->{'txt'};
print "<-\n->";
print $e->{'preis'};
print "<-\n\n";
}
}