#!/usr/bin/perl
# by Jonathan Eisenzopf. v1.0 19991020
# Copyright (c) 1999 Jupitermedia Corp. All Rights Reserved.
# See http://www.webreference.com/perl for more information
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.


use strict;
use lib '/www/webref/cgi-bin/perl';
use CGI qw/:standard *table/;
use LWP::Simple;
use CGI::Carp;
use XML::RSS;

my $rss = new XML::Parser;

my %languages = (
    'af'    => 'Afrikaans',
    'sq'    => 'Albanian',
    'eu'    => 'Basque',
    'be'    => 'Belarusian',
    'bg'    => 'Bulgarian',
    'ca'    => 'Catalan',
    'zh-cn' => 'Chinese (Simplified)',
    'zh-tw' => 'Chinese (Traditional)',
    'hr'    => 'Croatian',
    'cs'    => 'Czech',
    'da'    => 'Danish',
    'nl'    => 'Dutch',
    'nl-be' => 'Dutch (Belgium)',
    'nl-nl' => 'Dutch (Netherlands)',
    'en'    => 'English',
    'en-au' => 'English (Australia)',
    'en-bz' => 'English (Belize)',
    'en-ca' => 'English (Canada)',
    'en-ie' => 'English (Ireland)',
    'en-jm' => 'English (Jamaica)',
    'en-nz' => 'English (New Zealand)',
    'en-ph' => 'English (Phillipines)',
    'en-za' => 'English (South Africa)',
    'en-tt' => 'English (Trinidad)',
    'en-gb' => 'English (United Kingdom)',
    'en-us' => 'English (United States)',
    'en-zw' => 'English (Zimbabwe)',
    'fo'    => 'Faeroese',
    'fi'    => 'Finnish',
    'fr'    => 'French',
    'fr-be' => 'French (Belgium)',
    'fr-ca' => 'French (Canada)',
    'fr-fr' => 'French (France)',
    'fr-lu' => 'French (Luxembourg)',
    'fr-mc' => 'French (Monaco)',
    'fr-ch' => 'French (Switzerland)',
    'gl'    => 'Galician',
    'gd'    => 'Gaelic',
    'de'    => 'German',
    'de-at' => 'German (Austria)',
    'de-de' => 'German (Germany)',
    'de-li' => 'German (Liechtenstein)',
    'de-lu' => 'German (Luxembourg)',
    'el'    => 'Greek',
    'hu'    => 'Hungarian',
    'is'    => 'Icelandic',
    'in'    => 'Indonesian',
    'ga'    => 'Irish',
    'it'    => 'Italian',
    'it-it' => 'Italian (Italy)',
    'it-ch' => 'Italian (Switzerland)',
    'ja'    => 'Japanese',
    'ko'    => 'Korean',
    'mk'    => 'Macedonian',
    'no'    => 'Norwegian',
    'pl'    => 'Polish',
    'pt'    => 'Portuguese',
    'pt-br' => 'Portuguese (Brazil)',
    'pt-pt' => 'Portuguese (Portugal)',
    'ro'    => 'Romanian',
    'ro-mo' => 'Romanian (Moldova)',
    'ro-ro' => 'Romanian (Romania)',
    'ru'    => 'Russian',
    'ru-mo' => 'Russian (Moldova)',
    'ru-ru' => 'Russian (Russia)',
    'sr'    => 'Serbian',
    'sk'    => 'Slovak',
    'sl'    => 'Slovenian',
    'es'    => 'Spanish',
    'es-ar' => 'Spanish (Argentina)',
    'es-bo' => 'Spanish (Bolivia)',
    'es-cl' => 'Spanish (Chile)',
    'es-co' => 'Spanish (Colombia)',
    'es-cr' => 'Spanish (Costa Rica)',
    'es-do' => 'Spanish (Dominican Republic)',
    'es-ec' => 'Spanish (Ecuador)',
    'es-sv' => 'Spanish (El Salvador)',
    'es-gt' => 'Spanish (Guatemala)',
    'es-hn' => 'Spanish (Honduras)',
    'es-mx' => 'Spanish (Mexico)',
    'es-ni' => 'Spanish (Nicaragua)',
    'es-pa' => 'Spanish (Panama)',
    'es-py' => 'Spanish (Paraguay)',
    'es-pe' => 'Spanish (Peru)',
    'es-pr' => 'Spanish (Puerto Rico)',
    'es-es' => 'Spanish (Spain)',
    'es-uy' => 'Spanish (Uruguay)',
    'es-ve' => 'Spanish (Venezuela)',
    'sv'    => 'Swedish',
    'sv-fi' => 'Swedish (Finland)',
    'sv-se' => 'Swedish (Sweden)',
    'tr'    => 'Turkish',
    'uk'    => 'Ukranian'
                 );

# MAIN
if (param('ACTION') eq 'Fetch') {
    print header;
    &fetch_rss(param('rss_url')) if param('rss_url');
    &print_form;
} elsif (param('ACTION') eq 'Build RSS') {
    &generate_RSS;
} else {
    print header;
    &print_form;
}


# SUBROUTINES
sub fetch_rss {
    my $url = shift;
    my $data = get($url);
    return "Error fetching $url" unless $data;
    my $rss = new XML::RSS;
    eval { $rss->parse($data) };
    return "Error parsing RSS file: $@" if $@;

    # set channel params
    param(-name=>'ctitle', -value=>$rss->channel('title'));
    param(-name=>'cdesc',   -value=>$rss->channel('description'));
    param(-name=>'clink',   -value=>$rss->channel('link'));
    if ($rss->channel('language') =~ /\S+/) {
        param(-name=>'clang', -value=>$rss->channel('language'));
    } else {
        param(-name=>'clang', -value=>'en-us');
    }

    # set image params
    param(-name=>'ititle',  -value=>$rss->image('title'));
    param(-name=>'iurl',    -value=>$rss->image('url'));
    param(-name=>'ilink',   -value=>$rss->image('link'));

    # set text input params
    param(-name=>'tititle', -value=>$rss->textinput('title'));
    param(-name=>'tidesc',  -value=>$rss->textinput('description'));
    param(-name=>'tiname',  -value=>$rss->textinput('name'));
    param(-name=>'tilink',  -value=>$rss->textinput('link'));

    # set item params
    for (my $i=0; $i < @{$rss->{'items'}}; $i++) {
        my $item = $rss->{'items'}->[$i];
        param(-name=>"item".($i+1)."_title", -value=>$item->{'title'});
        param(-name=>"item".($i+1)."_link", -value=>$item->{'link'});
    }
}

sub generate_RSS {
    # create instance of XML::RSS
    my $rss = new XML::RSS (version => '0.91');

    # channel
    $rss->channel(
                  'title'       => param('ctitle'),
                  'link'        => param('clink'),
                  'description' => param('cdesc'),
                  'language'    => param('clang')
                  );

    # image
    if (param('iurl') =~ /\S+/) {
        $rss->image(
                    'title' => param('ititle'),
                    'url'   => param('iurl'),
                    'link'  => param('ilink')
                    );
    }

    # textinput
    if (param('tilink')) {
        $rss->textinput(
                        'title'       => param('tititle'),
                        'description' => param('tidesc'),
                        'name'        => param('tiname'),
                        'link'        => param('tilink')
                        );
    }

    # items
    for (my $i=1; $i <= 15; $i++) {
        $rss->add_item(
                       'title' => param("item".$i."_title"),
                       'link'  => param("item".$i."_link")
                       );
    }

    # print RSS
    print header('text/xml');
    print $rss->as_string;
}

sub print_form {
    my $ctitle = param('ctitle');
    my $cdesc = param('cdesc');
    my $clink = param('clink');
    my $clang = param('clang') ? param('clang') : 'en-us';
    my $ititle = param('ititle');
    my $iurl = param('iurl');
    my $ilink = param('ilink');
    my $tititle = param('tititle');
    my $tidesc = param('tidesc');
    my $tiname = param('tiname');
    my $tilink = param('tilink');
    my $rss_url = param('rss_url');

    print start_html(-title=>'RSS Creator',
               -BGCOLOR=>'#FFFFFF');

        print h1({-align=>'CENTER'},'RSS Creator');


    print startform(-method=>'GET',
                    -action=>url());


    print table({-border=>undef, -align=>'center'});

    # RSS URL
    print Tr({-align=>'LEFT',-valign=>'MIDDLE'},
             [
              th({-colspan=>2,-BGCOLOR=>'#000000'},
                 font({-color=>'#FFFFFF',-font=>'Arial,Helvetica',-size=>'+1'},
                      'RSS URL)')
                 ),
              td({-align=>'right'},[b('RSS URL(<a target="_new" href="http://www.webreference.com/perl/tools/makerss.html#rss_url">?</a>):'),
                  textfield(-name=>'rss_url',
                             -default=>$rss_url,
                             -size=>50
                            ),
                  submit(-name=>'ACTION',-value=>'Fetch')
                ])
              ]);

    # channel summary
    print Tr({-align=>'LEFT',-valign=>'MIDDLE'},
             [
              th({-colspan=>2,-BGCOLOR=>'#000000'},
                 font({-color=>'#FFFFFF',-font=>'Arial,Helvetica',-size=>'+1'},
                      'Channel Summary')
                 ),
              td({-align=>'right'},[b('Channel Title(<a target="_new" href="http://www.webreference.com/perl/tools/makerss.html#channel_title">?</a>):'),
                  textfield(-name=>'ctitle',
                            -default=>$ctitle,
                            -size=>50
                            )
                  ]),

              td({-align=>'right'},[b('Channel Link(<a target="_new" href="http://www.webreference.com/perl/tools/makerss.html#channel_link">?</a>):'),
                  textfield(-name=>'clink',
                           -default=>$clink,
                           -size=>50
                           )
                  ]),

              td({-align=>'right'},[b('Description(<a target="_new" href="http://www.webreference.com/perl/tools/makerss.html#channel_description">?</a>):'),
                  textarea(-name=>'cdesc',
                           -default=>$cdesc,
                           -rows=>5,
                           -columns=>50
                           )
                  ]),

              td({-align=>'right'},[b('Language(<a target="_new" href="http://www.webreference.com/perl/tools/makerss.html#language">?</a>):'),
                 popup_menu(-name=>'clang',
                             -values=>[sort(keys(%languages))],
                             -default=>$clang,
                             -labels=>\%languages
                             )
                  ])
              ]);

    # channel image
    print Tr({-align=>'LEFT',-valign=>'MIDDLE'},
             [
              th({-colspan=>2,-BGCOLOR=>'#000000'},
                 font({-color=>'#FFFFFF',-font=>'Arial,Helvetica',-size=>'+1'},
                      'Channel Image')
                 ),

              td({-align=>'right'},[b('Image Title(<a target="_new" href="http://www.webreference.com/perl/tools/makerss.html#image_title">?</a>):'),
                  textfield(-name=>'ititle',
                           -default=>$ititle,
                           -size=>50
                           )
                  ]),

              td({-align=>'right'},[b('Image URL(<a target="_new" href="http://www.webreference.com/perl/tools/makerss.html#image_url">?</a>):'),
                  textfield(-name=>'iurl',
                           -default=>$iurl,
                           -size=>50
                           )
                  ]),

              td({-align=>'right'},[b('Image Link(<a target="_new" href="http://www.webreference.com/perl/tools/makerss.html#image_link">?</a>):'),
                  textfield(-name=>'ilink',
                           -default=>$ilink,
                           -size=>50
                           )
                  ])
              ]);


    # channel textarea
    print Tr({-align=>'LEFT',-valign=>'MIDDLE'},
             [
              th({-colspan=>2,-BGCOLOR=>'#000000'},
                 font({-color=>'#FFFFFF',-font=>'Arial,Helvetica',-size=>'+1'},
                      'Text Input')
                 ),

              td({-align=>'right'},[b('Input Title(<a target="_new" href="http://www.webreference.com/perl/tools/makerss.html#input_title">?</a>):'),
                  textfield(-name=>'tititle',
                           -default=>$tititle,
                           -size=>50
                           )
                  ]),

              td({-align=>'right'},[b('Input Name(<a target="_new" href="http://www.webreference.com/perl/tools/makerss.html#input_name">?</a>):'),
                  textfield(-name=>'tiname',
                           -default=>$tiname,
                           -size=>50
                           )
                  ]),

              td({-align=>'right'},[b('Input Link(<a target="_new" href="http://www.webreference.com/perl/tools/makerss.html#input_link">?</a>):'),
                  textfield(-name=>'tilink',
                           -default=>$tilink,
                           -size=>50
                           )
                  ]),

              td({-align=>'right'},[b('Input Desc(<a target="_new" href="http://www.webreference.com/perl/tools/makerss.html#input_description">?</a>):'),
                  textarea(-name=>'tidesc',
                           -default=>$tidesc,
                           -columns=>50,
                           -rows=>5
                           )
                  ])
              ]);

    # channel items
    for (my $i=1; $i<=15; $i++) {
        my %title;
        my %link;
        $title{'name'} = "item".$i."_title";
        $title{'value'} = param($title{'title'});
        $link{'name'} = "item".$i."_link";
        $link{'value'} = param($link{'name'});

        print Tr({-align=>'LEFT',-valign=>'MIDDLE'},
                 [
                  th({-colspan=>2,-BGCOLOR=>'#000000'},

font({-color=>'#FFFFFF',-font=>'Arial,Helvetica',-size=>'+1'},"Item$i")
                     ),

                  td({-align=>'right'},[b('Title(<a target="_new" href="http://www.webreference.com/perl/tools/makerss.html#item_title">?</a>):'),
                     textfield(-name=>$title{'name'},
                               -default=>$title{'value'},
                               -size=>50
                               ),
                     submit(-name=>'ACTION',-value=>'Build RSS')
                     ]),

                  td({-align=>'right'},[b('Link(<a target="_new" href="http://www.webreference.com/perl/tools/makerss.html#item_link">?</a>):'),
                     textfield(-name=>$link{'name'},
                               -default=>$link{'value'},
                               -size=>50
                               ),

                     ])
              ]);
    }
    print end_table;
    print end_form;
}