1#!/usr/local/bin/perl 2 3# Copyright (C) 2012 Morten Grouleff 4# 5# Derived from "tv_grab_dk_dr_2009" by Thomas Horsten <thomas@horsten.com> 6# 7# This program is free software: you can redistribute it and/or modify 8# it under the terms of the GNU General Public License as published by 9# the Free Software Foundation, either version 3 of the License, or 10# (at your option) any later version. 11# 12# This program is distributed in the hope that it will be useful, 13# but WITHOUT ANY WARRANTY; without even the implied warranty of 14# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15# GNU General Public License for more details. 16# 17# You should have received a copy of the GNU General Public License 18# along with this program. If not, see <http://www.gnu.org/licenses/>. 19# 20 21###################################################################### 22# Udover XMLTV kræves Parse::RecDescent og DateTime, som på 23# Debian / Ubuntu kan installeres med: 24# sudo aptitude install libparse-recdescent-perl libdatetime-perl 25# 26# Kun testet på Linux. Beta version :) 27# Kommentarer til: Thomas Horsten <thomas@horsten.com> 28# 29# History 30# Per Baekgaard <baekgaard@b4net.dk> 2009-08-13 20:39 CEST 31# - Minor changes supporting the released version on dr.dk 32# 33# Morten Grouleff (morten@grouleff.com) 34# - Rewritten to use the new JSON api instead of screenscraping from the html. 35# 36# 37# $Id: tv_grab_dk_dr,v 1.14 2015/06/22 15:56:12 knowledgejunkie Exp $ 38 39use strict; 40use warnings; 41 42use open qw/:std :utf8/; 43 44use JSON; 45use XMLTV; 46use XMLTV::ProgressBar; 47use XMLTV::Options qw/ParseOptions/; 48use XMLTV::Configure::Writer; 49 50use LWP::UserAgent; 51use IO::Scalar; 52 53use DateTime; 54 55# TODO: This ought be in a config file, I suppose. But for now, it lives here. 56my @title_fixups = (); # regexp => [ $title, $subtitle ]. Or when prefixed with "#", regexp => [ $title, #$episode-num ]. 57# DR renames stuff...: 58push @title_fixups, ['^Historien om\s+(.+)$', [ '\'Historien om\'', '$1']]; 59push @title_fixups, ['^DR2\s*Premiere\s+(.+)$', ['\'DR2 Premiere\'', '$1']]; 60# Extract episode number if possible: 61push @title_fixups, ['^(.+)\s*\(\s*(\d{1,3})\s*\)(\s*.*)$', ['$1 . $3', '#$2']]; 62push @title_fixups, ['^(.+)\s*(\(\d+\:\d+\))(\s*.*)$', ['$1 . $3', '#$2']]; # episode num copy 63# Move to sub-title, when " - " or " : " is in title. 64push @title_fixups, ['^(.+)\s*\:\s+(.+)$', ['$1', '$2']]; 65push @title_fixups, ['^(.+)\s+\-\s+(.+)$', ['$1', '$2']]; 66 67my $debug = 0; # Plenty of extra output. 68 69my $grabber_name = 'tv_grab_dk_dr'; 70my $id_prefix = '.dr.dk'; 71 72# FR#109 my $default_root_url = 'http://www.dr.dk/tv/oversigt/json/guide/'; 73my $default_root_url = 'http://www.dr.dk/tjenester/program-guide/json/guide/'; 74 75my %grabber_tags = ( 'source-info-url' => 76 # FR109 'http://www.dr.dk/tv/oversigt/json/guide/', 77 'http://www.dr.dk/tjenester/program-guide/json/guide/', 78 'source-info-name' => 79 'DR TV Oversigt', 80 'generator-info-name' => 81 'XMLTV', 82 'generator-info-url' => 83 'http://niels.dybdahl.dk/xmltvdk/', 84 ); 85 86# Time zone the server uses 87my $server_tz = 'Europe/Copenhagen'; 88my $LocalTZ = DateTime::TimeZone->new( name => $server_tz ); 89 90sub config_stage 91{ 92 my( $stage, $conf ) = @_; 93 my $result; 94 95 $stage eq "start" || die "Unknown stage $stage"; 96 97 my $writer = new XMLTV::Configure::Writer( OUTPUT => \$result, 98 encoding => 'utf-8' ); 99 if( $stage eq 'start' ) { 100 $writer->start( { grabber => $grabber_name } ); 101 $writer->start_selectone( { 102 id => 'accept-copyright-disclaimer', 103 title => [ [ 'Acceptér ansvarsfraskrivelse', 'da'], 104 [ 'Accept disclaimer', 'en'] ], 105 description => [ [ "Data fra DR's programoversigt er " . 106 "beskyttet af loven om ophavsret, " . 107 "og må kun anvendes til personlige, " . 108 "ikke-kommercielle formål. " . 109 "Dette programs forfatter(e) kan ikke " . 110 "holdes ansvarlig for evt. misbrug.", 'da' ], 111 [ "Data from DR's program guide is " . 112 "protected by copyright law and may " . 113 "only be used for personal, non-commercial " . 114 "purposes. The author(s) " . 115 "of this program accept no responsibility " . 116 "for any mis-use.", 117 'en' ] ] } ); 118 $writer->write_option( { 119 value=>'reject', 120 text=> [ [ 'Jeg accepterer IKKE betingelserne', 'da'], 121 [ 'I do NOT accept these conditions', 'en'] ] } ); 122 $writer->write_option( { 123 value=>'accept', 124 text=> [ [ 'Jeg accepterer betingelserne', 'da'], 125 [ 'I accept these conditions', 'en'] ] } ); 126 $writer->end_selectone(); 127 $writer->start_selectone( { 128 id => 'include-radio', 129 title => [ [ 'Medtag radio-kanaler', 'da'], 130 [ 'Include radio channels', 'en'] ], 131 description => [ [ "DR's programoversigt indeholder " . 132 "radiokanaler, du kan her vælge " . 133 "om de skal medtages i listen.", 'da' ], 134 [ "DR's program guide includes radio " . 135 "channels, here you can choose whether " . 136 "to include them.", 'en' ] ] } ); 137 $writer->write_option( { 138 value=>'0', 139 text=> [ [ 'Udelad radio-kanaler', 'da'], 140 [ 'Exclude radio channels', 'en'] ] } ); 141 $writer->write_option( { 142 value=>'1', 143 text=> [ [ 'Medtag radio-kanaler', 'da'], 144 [ 'Include radio channels', 'en'] ] } ); 145 $writer->end_selectone(); 146 147 $writer->write_string( { 148 id => 'root-url', 149 title => [ [ 'Root URL for grabbing data', 'en' ], 150 [ 'Grund-URL for grabberen', 'da' ] ], 151 description => [ [ 'Provide the URL of DR\'s program guide ' . 152 'data data engine, ' . 153 'including the trailing slash.', 'en' ], 154 [ 'Indtast URL\'en på DR\'s tv-oversigs data ' . 155 'engine, inklusive den ' . 156 'efterfølgende skråstreg.', 'da' ] ], 157 default => $default_root_url } ); 158 159 $writer->write_string( { 160 id => 'episode-in-subtitle', 161 title => [ [ 'Should we include the episode number as default subtitle', 'en' ], 162 [ 'Indsæt afsnits-nr som undertitel?', 'da' ] ], 163 description => [ [ ' When set, insert the episode number as a subtitle with the configured string as prefix. ' . 164 ' when there is a subtitle already, prepend the episode number, ' . 165 ' Leave empty to disable this feature.', 'en' ], 166 [ ' Denne tekst vælger hvad der skal indsættes i undertitlen foran afsnitsnummeret. ' . 167 ' Når der er en undertitel i forvejen, indsættes dette blot før denne.' . 168 ' Sæt til tom for at slå indsættelsen fra. ', 'da' ] ], 169 default => '' } ); 170 171 } 172 $writer->end( 'select-channels' ); 173 174 return $result; 175} 176 177sub getUrl($) { 178 my ( $url ) = @_; 179 my $ua = LWP::UserAgent->new; 180 $ua->agent("xmltv/$XMLTV::VERSION"); 181 my $req = HTTP::Request->new(GET => $url); 182 $req->header('Accept' => 'Accept=text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8'); 183 my $encoding = 'utf-8'; 184 $req->header('Accept-Charset' => $encoding); 185 my $res = $ua->request($req); 186 if ($res->is_success) { 187 if ($res->header('Content-Type') && $res->header('Content-Type') =~ /[^\/]+\/[^\/]+\;\s*charset=(.*)$/) { 188 $encoding = $1; 189 } 190 return $res->decoded_content(charset => $encoding); 191 } 192 else { 193 print STDERR "Error: " . $res->status_line . " on url: " . $url . "\n"; 194 return 0; 195 } 196} 197 198sub list_channels($$) 199{ 200 my( $conf, $opt ) = @_; 201 my $chanlist = &get_channel_list($conf); 202 #print Dumper $chanlist; 203 my $result=""; 204 my $fh = new IO::Scalar \$result; 205 my $oldfh = select( $fh ); 206 my $writer = new XMLTV::Writer(OUTPUT => $fh, encoding => 'utf-8'); 207 $writer->start(\%grabber_tags); 208 $writer->write_channels($chanlist); 209 $writer->end(); 210 select( $oldfh ); 211 $fh->close(); 212 213 #print "RESULT:\n$result\n"; 214 return $result; 215} 216 217sub get_channel_list($) 218{ 219 my ( $conf ) = @_; 220 my $drlist = get_dr_channel_list($conf); 221 #print Dumper $drlist; 222 my %chanlist = (); 223 foreach my $chan (@$drlist) { 224 my $shortid = $chan->{'Id'}; 225 $shortid =~ s/^[wr]\_//; 226 my $id = $shortid . $id_prefix; 227 # tv_validate_file barfs if ID contains + as for d3+.dr.dk 228 $id =~ s/\+/plus/g; 229 $chanlist{$id}->{'id'} = $id; 230 $chanlist{$id}->{'_dr_listing_id'} = $chan->{'Id'}; 231# $chanlist{$id}->{'icon'} = [{ 'src'=>$conf->{'root-url'}->[0] . 232# "Images/Logos/" . $shortid . 233# ".gif" }]; 234 $chanlist{$id}->{'_source_url'} = $chan->{'sourceUrl'}; 235 my $chan_lang; # = $dr_language_codes{$chan->{'country_code'}}; 236 $chan_lang = 'da'; # unless $chan_lang; 237 $chanlist{$id}->{'_lang'} = $chan_lang; 238 $chanlist{$id}->{'display-name'} = 239 [ [ $chan->{'Name'}, $chan_lang ]]; 240 $chanlist{$id}->{'_name'} = $chan->{'name'}; 241 } 242 243 return \%chanlist; 244} 245 246sub get_dr_channel_list($) 247{ 248 my ( $conf ) = @_; 249 my @types = ('tv'); 250 if ($conf->{'include-radio'}[0] eq '1') { 251 push (@types, 'radio'); 252 } 253 my @results = (); 254 foreach my $type (@types) { 255 print STDERR "TYPE: $type\n" if $debug; 256 my $url = $conf->{'root-url'}->[0] . 'channels?mediaType=' . $type; 257 # http://www.dr.dk/tjenester/program-guide/json/guide/channels?mediaType=tv 258 print STDERR "Get: $url\n" if $debug; 259 my $content = getUrl($url) || return 0; 260 print STDERR "Got: $content\n" if $debug; 261 my $channels = (); 262 eval { 263 $channels = from_json( $content, { utf8 => 1 } ); 264 1; 265 } or do { 266 warn "Failed to get channels: $_"; 267 }; 268 #print Dumper $parsed; 269 my $c = $channels->{'Channels'}; 270 push(@results, @$c); 271 } 272 return \@results; 273} 274 275sub json_date_to_xmltv($) 276{ 277 # Format: \/Date(1352178000000)\/ -> 20090613123456 +0100 278 my ($d) = @_; 279 if ($d =~ m/Date\((\d+)([+-]\d\d\d\d)?\)/ ) { 280 my ( $epoch_milliseconds, $timezone ) = ( $1, $2 ); 281 my $dt = DateTime->from_epoch( epoch => $epoch_milliseconds / 1000 ); 282 if ($timezone) { 283 $dt->set_time_zone($timezone); 284 } 285 $dt->set_time_zone($LocalTZ); 286 return $dt->format_cldr('yyyyMMddHHmmss ZZZ'); 287 } else { 288 return 0; 289 } 290} 291 292sub get_schedules($$$) 293{ 294 my ($conf, $chan, $date ) = @_; 295 296 my @schedules = (); 297 298 my $url = $conf->{'root-url'}->[0] . 299 'schedule?startTimesectionId=1&days=' . $date . '&channelid=' . $chan->{'_dr_listing_id'} . '&oneTimesectionOnly=false&mediaType=tv'; 300 # http://www.dr.dk/tjenester/program-guide/json/guide/schedule?startTimesectionId=1&days=0&channelid=w_DR2&oneTimesectionOnly=false&mediaType=tv 301 print STDERR "Get: $url\n" if $debug; 302 my $content = getUrl($url) || return 0; 303 print STDERR "Got: $content\n" if $debug; 304 305 my @results = (); 306 307 my $parsed = (); 308 eval { 309 $parsed = from_json( $content, { utf8 => 1 } ); 310 1; 311 } or do { 312 # Ignoring failed json parses. 313 }; 314 315 if (!$parsed || ("HASH" ne ref $parsed)) { 316 &warning("(BUG?) Parser barfed while processing channel " . 317 $chan->{'_name'}. " date ". $date . " (empty result?) URL: $url\n"); 318 print STDERR "Content: $content\n"; 319 print STDERR Dumper $parsed; 320 return \@results; 321 } elsif ( ("ARRAY" ne ref ($parsed->{'TimeSection'} )) ) { 322 &warning("(BUG?) Parser barfed while processing channel " . 323 $chan->{'_name'}. " date ". $date . " (empty result?) URL: $url\n"); 324 &warning("Result type: " . ref ($parsed) . "\n"); 325 print STDERR "Content: $content\n"; 326 print STDERR Dumper $parsed; 327 return \@results; 328 } 329 330 foreach my $section (@{$parsed->{'TimeSection'}}) { 331 foreach my $listing (@{$section->{'Programs'}}) { 332 my %p = (); 333 # attributes 334 $p{'channel'} = $chan->{'id'}; 335 $p{'start'} = json_date_to_xmltv($listing->{'StartDateTime'}); 336 $p{'stop'} = json_date_to_xmltv($listing->{'EndDateTime'}); 337 338 my $title = $listing->{'Title'}; 339 if (@title_fixups && defined $title) { 340 my $subtitle = ''; 341 my $episodenum; 342 for my $fixup (@title_fixups) { 343 my $match = $fixup->[0]; 344 #print "Inspecting '$title' for match $match\n"; 345 if ($title =~ m/$match/i) { 346 # The fixups contains backrefs to the regexp result. Don't make a match here, it will ruin it. 347 my $placements = $fixup->[1]; 348 #print "Matched, applying '" . $placements->[0] . "', '" . $placements->[1] . "'\n"; 349 $title = eval $placements->[0] if defined $placements->[0]; 350 if (defined $placements->[1]) { 351 my $str = $placements->[1]; 352 if (substr($str, 0, 1) eq '#') { 353 my $e = eval substr($str, 1); 354 if ($e =~ m/(\d+)\:(\d+)/) { 355 $episodenum = $1; 356 $p{'episode-num'} = [ [ " . " . ($1 - 1) . "/" . $2 . " . ", "xmltv_ns" ] ]; 357 } else { 358 $episodenum = $e; 359 $p{'episode-num'} = [ [ " . " . ($e - 1) . " . ", "xmltv_ns" ] ]; 360 } 361 } else { 362 $subtitle .= eval $placements->[1]; 363 } 364 } 365 } 366 } 367 368 ######################################## 369 # Sæt afsnitsnummer ind først i subtitle, hvis ønsket. 370 my $episode_in_subtitle = $conf->{'episode-in-subtitle'}; 371 if (defined $episode_in_subtitle && defined $episode_in_subtitle->[0]) { 372 if (defined $episodenum) { 373 if ($subtitle eq '') { 374 $subtitle = $episode_in_subtitle->[0] . ' ' . $episodenum; 375 } else { 376 $subtitle = $episode_in_subtitle->[0] . ' ' . $episodenum . ': ' . $subtitle; 377 } 378 } 379 } 380 381 if ($subtitle ne '') { 382 $p{'sub-title'} = [ [ $subtitle, 383 $chan->{'_lang'} ] ]; 384 } 385 } 386 387 my @title; 388 push (@title, [ $title, $chan->{'_lang'} ]); 389 if ($listing->{'OriginalTitle'}) { 390 my $original_lang = 'en'; # guess_original_language($listing); 391 if (!$original_lang) { 392 $original_lang = 'en'; 393 } 394 push (@title, [ $listing->{'OriginalTitle'}, $original_lang ]); 395 } 396 $p{'title'} = \@title; 397 398 my $description; 399 if ($listing->{'HasDescription'} eq 'true' || $listing->{'HasDescription'} == 1) { 400 my $desc_url = $conf->{'root-url'}->[0] . 'ProgramDetails/?id=' . $listing->{'Id'} . '&days=' . $date . '&channelid=' . $chan->{'_dr_listing_id'} . '&mediaType=tv'; 401 # http://www.dr.dk/tjenester/program-guide/json/guide/ProgramDetails/?id=dr.dk/mas/whatson/216871786813&days=0&channelid=w_DR2&mediaType=tv 402 print STDERR "Get: $desc_url\n" if $debug; 403 my $desc_content = getUrl($desc_url); 404 if ($desc_content) { 405 my $json; 406 eval { 407 $json = from_json( $desc_content, { utf8 => 1 } ); 408 $description = $json->{'Description'} . ' '; 409 $description =~ s/\<br\>/. /g; 410 $description =~ s/\s*\n\s*/. /g; 411 1; 412 } or do { 413 # Ignoring failed json parses, leaving desc empty. 414 }; 415 } 416 } 417 418 ######################################## 419 # punchline som ekstra beskrivelse. 420 if ($listing->{'Punchline'}) { 421 my $pl = $listing->{'Punchline'}; 422 # Der er nogle gange linjeskift i 423 # punchlines, hvilket XMLTV ikke bryder 424 # sig om. 425 $pl =~ s/\s*\n\s*/. /g; 426 $pl =~ s/\<br\>/. /g; 427 $description .= $pl; 428 } 429 430 if ($description) { 431 $p{'desc'} = [ [ $description, $chan->{'_lang'} ] ]; 432 } 433 434 ######################################## 435 # Genudsendelse, HD, etc. 436 if ($listing->{'IsRerun'} eq 'true' || $listing->{'IsRerun'} == 1) { 437 $p{'previously-shown'} = {}; 438 } 439 if ($listing->{'DisplayHD'}) { 440 $p{'video'}{'quality'} = 'HDTV'; 441 } 442 443 if ($listing->{'Display16_9'}) { 444 $p{'video'}{'aspect'} = '16:9'; 445 } 446 447 ######################################## 448 # Genre/kategori 449 # Her bruges genre_text, vi kunne også 450 # bruge genre_code og have en tabel 451 # til at få i det mindste den generelle 452 # kategori på engelsk (farver i MythTV!) 453 # TODO: Fix engelske kategorier 454 if ($listing->{'Category'} && 455 $listing->{'Category'} ne 'Ukategoriseret' && 456 $listing->{'Category'} ne 'Ukendt' && 457 $listing->{'Category'} ne 'Andre') { 458 $p{'category'} = [ [ $listing->{'Category'}, 'da']]; 459 } 460 461 ######################################## 462 # URL 463 if ($listing->{'ProgramSeriesSiteUrl'}) { 464 $p{'url'} = [ $listing->{'ProgramSeriesSiteUrl'} ]; 465 } 466 467 # Sanity checks.. 468 if (!$p{'start'}) { warning("No 'START' attribute"); next; } 469 if (!$p{'stop'}) { warning("No 'START' attribute"); next; } 470 if (!$p{'title'}) { warning("No 'TITLE' attribute"); next; } 471 472 #print Dumper \%p; 473 push(@results, \%p); 474 } 475 } 476 return \@results; 477} 478 479my $opt; 480my $conf; 481( $opt, $conf ) = ParseOptions( { 482 grabber_name => $grabber_name, 483 capabilities => [qw/baseline manualconfig tkconfig apiconfig/], 484 stage_sub => \&config_stage, 485 listchannels_sub => \&list_channels, 486 #load_old_config_sub => \&load_old_config, 487 version => '$Id: tv_grab_dk_dr,v 1.14 2015/06/22 15:56:12 knowledgejunkie Exp $', 488 description => "TV Oversigten fra Danmarks Radios (2012) ". 489 "(www.dr.dk/tjenester/programoversigt)", 490 } ); 491 492 493 494my %writer_args = ( encoding => 'utf-8' ); 495if (defined $opt->{'output'}) { 496 my $fh = IO::File->new($opt->{'output'}, ">:utf8"); 497 die "Cannot write to $opt->{'output'}" if not $fh; 498 $writer_args{'OUTPUT'} = $fh; 499} 500my $writer = new XMLTV::Writer(%writer_args); 501 502$writer->start(\%grabber_tags); 503 504#print "Grabbing channel list\n"; 505my $chanlist = &get_channel_list($conf) || die "Couldn't get channel list"; 506 507# Check channels specified are valid 508my @channels = (); 509foreach my $cid (@{$conf->{'channel'}}) { 510 my $chan = $chanlist->{$cid}; 511 if (!$chan) { 512 warn("Unknown channel ".$cid." in config file\n"); 513 } else { 514 $writer->write_channel($chan); 515 push (@channels, $cid); 516 } 517} 518 519# data uses offset from today in days. 520for (my $c=0; $c<$opt->{'days'}; $c++) { 521 foreach my $cid (@channels) { 522 my $chan = $chanlist->{$cid}; 523 if (!$chan) { 524 &warning("Unknown channel $cid\n"); 525 } else { 526 #print "ID: $cid Name: " . 527 #$chan->{'display-name'}[0][0]."\n"; 528 my $day = $c; 529 $day += $opt->{offset} if ($opt->{offset}); 530 my $schedules = get_schedules($conf, $chan, $day); 531 if ("ARRAY" ne ref($schedules)) { 532 warn("Schedules for $cid on day $c not valid - empty?\n"); 533 next; 534 } 535 foreach my $s (@$schedules) { 536 #print Dumper $s; 537 if ("HASH" ne ref($s)) { 538 warn("Weird listing:\n"); 539 print STDERR Dumper $s; 540 } else { 541 $writer->write_programme($s); 542 } 543 } 544 } 545 } 546} 547$writer->end(); 548 549=pod 550 551=head1 NAME 552 553tv_grab_dk_dr - Grab TV listings for Denmark. 554 555=head1 SYNOPSIS 556 557tv_grab_dk_dr --help 558 559tv_grab_dk_dr --configure [--config-file FILE] [--gui OPTION] 560 561tv_grab_dk_dr [--config-file FILE] [--output FILE] [--days N] 562[--offset N] [--quiet] 563 564tv_grab_dk_dr --capabilities 565 566tv_grab_dk_dr --version 567 568=head1 DESCRIPTION 569 570Output TV listings for several channels available in Denmark. The 571data comes from dr.dk. The grabber now uses a JSON API to retrieve data 572and no longer relies on parsing HTML. 573 574First run B<tv_grab_dk_dr --configure> to choose, which channels you want 575to download. Then running B<tv_grab_dk_dr> with no arguments will output 576listings in XML format to standard output. 577 578B<--configure> Prompt for which channels, and write the configuration file. 579 580B<--config-file FILE> Set the name of the configuration file, the 581default is B<~/.xmltv/tv_grab_dk_dr.conf>. This is the file written by 582B<--configure> and read when grabbing. 583 584B<--gui OPTION> Use this option to enable a graphical interface to be used. 585OPTION may be 'Tk', or left blank for the best available choice. 586Additional allowed values of OPTION are 'Term' for normal terminal output 587(default) and 'TermNoProgressBar' to disable the use of Term::ProgressBar. 588 589B<--output FILE> Write to FILE rather than standard output. 590 591B<--days N> Grab N days. The default is one week. 592 593B<--offset N> Start N days in the future. The default is to start 594from today. 595 596B<--quiet> Suppress the progress messages normally written to standard 597error. 598 599B<--capabilities> Show which capabilities the grabber supports. For more 600information, see L<http://wiki.xmltv.org/index.php/XmltvCapabilities> 601 602B<--version> Show the version of the grabber. 603 604B<--help> Print a help message and exit. 605 606=head1 SEE ALSO 607 608L<xmltv(5)>. 609 610=head1 AUTHOR 611 612This version of tv_grab_dk_dr was written by Morten Grouleff <morten at grouleff dot com> 613 614=cut 615 616