File Coverage

blib/lib/CGI/RSS.pm

Criterion	Covered	Total	%
statement	67	104	64.4
branch	14	28	50.0
condition	0	8	0.0
subroutine	16	23	69.5
pod	0	8	0.0
total	97	171	56.7

package CGI::RSS;

use strict;
use Date::Manip;
use AutoLoader;
use CGI;
use Carp;
use Scalar::Util qw(blessed);

no warnings;

our $VERSION = '0.9658';
our $pubDate_format = '%a, %d %b %Y %H:%M:%S %z';

# Make sure we have a TZ
unless( eval {Date_TimeZone(); 1} ) {
    $ENV{TZ} = "UTC" if $@ =~ m/unable to determine Time Zone/i;
}

sub pubDate_format {
    my $class_or_instance = shift;
    my $proposed = shift;

    $pubDate_format = $proposed;
    $pubDate_format
}

our @TAGS = qw(
    rss channel item

    title link description

    language copyright managingEditor webMaster pubDate lastBuildDate category generator docs
    cloud ttl image rating textInput skipHours skipDays

    link description author category comments enclosure guid pubDate source

    pubDate url
);

setup_tag($_) for @TAGS;

sub grok_args {
    my $this  = blessed($_[0]) ? shift : __PACKAGE__->new;
    my $attrs = ref($_[0]) eq "HASH" ? shift : undef;

    if( ref($_[0]) eq "ARRAY" ) {
        return ($this,$attrs,undef,$_[0]);
    }

    return ($this,$attrs,join(" ", @_),undef);
}

sub setup_tag {
    my $tag = shift;

    # try to mimick CGI.pm (which is very unfriendly about new tags now)

    no strict 'refs';

    *{ __PACKAGE__ . "::$tag" } = sub {
        my ($this, $attrs, $contents, $subs) = grok_args(@_);
        my $res;

        if( $subs ) {
            $res = join("", map { $this->$tag( ($attrs ? $attrs : ()), $_ ) } @$subs );

        } else {
            $res = "<$tag";

            if( $attrs ) {
                for(values %$attrs) {
                    # XXX: this is a terrible way to do this, better than nothing for now
                    s/(?
                }

                $res .= " " . join(" ", map {"$_=\"$attrs->{$_}\""} keys %$attrs);
            }

            $res .= ">$contents";
        }

        return $res;
    };

    *{ __PACKAGE__ . "::start_$tag" } = sub {
        my ($this, $attrs) = grok_args(@_);
        my $res = "<$tag";

        if( $attrs ) {
            for(values %$attrs) {
                # XXX: this is a terrible way to do this, better than nothing for now
                s/(?
            }

            $res .= " " . join(" ", map {"$_=\"$attrs->{$_}\""} keys %$attrs);
        }

        return $res . ">";
    };

    *{ __PACKAGE__ . "::end_$tag" } = sub { "" };
}

sub AUTOLOAD {
    my $this = shift;
    our $AUTOLOAD;

    if( my ($fname) = $AUTOLOAD =~ m/::([^:]+)$/ ) {
        if( CGI->can($fname) ) {
            *{ __PACKAGE__ . "::$fname" } = sub {
                my $this = shift;
                return CGI->$fname(@_);
            }
        }

        else {
            croak "can't figure out what to do with $fname() call";
        }
    }
}

sub new {
    my $class = shift;
    my $this = bless {}, $class;

    return $this;
}

sub date {
    my $this = shift;

    if( my $pd = ParseDate($_[-1]) ) {
        my $date = UnixDate($pd, $pubDate_format);
        return $this->pubDate($date);
    }

    $this->pubDate(@_);
}

sub header {
    my $this = shift;

    my $charset = "UTF-8";
    my $mime    = "application/xml";

    eval {
        no warnings;
        local $SIG{WARN} = sub{};
        my %opts = @_;
        $charset = $opts{'-charset'} || $opts{charset} || $charset;
        $mime    = $opts{'-type'} || $opts{type} || (@_==1 && $_[0]) || $mime;
    };

    return CGI::header(-type=>$mime, -charset=>$charset) . "\n\n";
}

sub begin_rss {
    my $this = shift;
    my $opts = $_[0];
       $opts = {@_} unless ref $opts;

    # NOTE: This isn't nearly as smart as CGI.pm's argument parsing...
    # I assume I could call it, but but I'm only mortal.

    my $ver = $opts->{version} || "2.0";
    my $ret = $this->start_rss({version=>$ver});
       $ret .= $this->start_channel;
       $ret .= $this->link($opts->{link})        if exists $opts->{link};
       $ret .= $this->title($opts->{title})      if exists $opts->{title};
       $ret .= $this->description($opts->{desc}) if exists $opts->{desc};

    return $ret;
}

sub finish_rss {
    my $this = shift;

    return $this->end_channel . $this->end_rss;
}

"This file is true."

__END__