Saturday, May 09, 2009

Blogging for perl geeks

Hi, there. For a while I've been trying to return back to bloggingwithout much success. I don't like what's going on with LJ. It'scrappy these days. Have a personal blog there, mostly in Russian,don't want to turn it into an IT blog. Many months ago startedlooking for a new hosting and chose blogger for that. Made a fewposts, but html is killing me, composer sucks too.

What the hell, I can not blog using some simple syntax. That'sjust wrong.

Here is my first post from my own blogging software - pod2blog.

Yes, you heard me right. I use perl's Plain Old Documentation (POD)for blogging.

It was a little bit harder than I thought would be, but works:

    #!perl    use 5.008;    use strict;    use warnings;    use utf8;    use YAML::Any qw();    use LWP::UserAgent;    my $ua = LWP::UserAgent->new;    my $file = shift;    my $parser = MyParser->new;    $parser->parse_from_file( $file );    push_to_blogger( $parser->{'entry'} );    sub push_to_blogger {        my $entry = shift;        my $request = HTTP::Request->new();        $request->method( 'POST' );        $request->uri('http://www.blogger.com/feeds/19258261/posts/default');        $request->header( 'Content_Type' => 'application/atom+xml' );        $request->header( 'GData-Version' => 2 );        $request->header( 'Authorization' => 'GoogleLogin auth='. auth_token() );        $request->content( $entry->as_xml );        my $res = $ua->request( $request );        print $res->dump;    }    { my $cache = undef;    sub auth_token {        return $cache if $cache;        my $opt = config();        my $res = $ua->post( 'https://www.google.com/accounts/ClientLogin', [            Email  => $opt->{'email'},            Passwd => $opt->{'password'},            service => 'blogger',            accountType => 'GOOGLE',            source => 'ruz_at_cpan-pod2blog-1',        ] );        my ($auth) = ($res->content =~ /^Auth=(.*?)$/m)            or die "Couldn't authenticate: ". $res->dump;        return $cache = $auth;    } }    { my $cache;    sub config {        return $cache if $cache;        require File::HomeDir;        require File::Spec;        require YAML::Any;        $cache = YAML::Any::LoadFile( File::Spec->catfile(            File::HomeDir->my_home, '.blogger.yml'        ) );        return $cache;    } }    use Pod::Parser;    package MyParser;    use base qw(Pod::Parser);    use XML::LibXML;    sub begin_input {        my $self = shift;        use XML::Atom::Entry;        $self->{'entry'} = XML::Atom::Entry->new( Namespace => 'http://www.w3.org/2005/Atom' );        my $doc = $self->{'doc'} = XML::LibXML->createDocument( "1.0", "UTF-8" );        my $root = $self->{'in'} = $doc->createElement('div');        $doc->setDocumentElement( $root );    }    sub end_input {        my $self = shift;        $self->{'entry'}->content(            $self->{'doc'}->documentElement->toString,        );        return $self->{'entry'};    }    sub command {         my ($self, $command, $paragraph, $line_num) = @_;        if ($command eq 'head1') {            my $expansion = $self->interpolate($paragraph, $line_num);            $self->{'entry'}->title( $expansion );        }        elsif ( $command eq 'tags' ) {            $self->{'entry'}->add_category( {term => $_, scheme => 'http://www.blogger.com/atom/ns#'} )                foreach map { s/^\s+//;s/\s+$//;$_ } split /,/, $paragraph;        }    }    sub verbatim {         my ($self, $para, $line_num) = @_;        my $e;        if ( $self->{'last'} && $self->{'last'}->nodeName eq 'pre' ) {            $e = $self->{'last'};        } else {            $e = $self->{'last'} = $self->{'doc'}->createElement('pre');        }        $e->appendTextNode( $para );        $self->{'in'}->appendChild( $e );        return $e;    }    sub textblock {         my ($self, $paragraph, $line_num) = @_;        my %parse_opts = (            -expand_seq => 'interior_sequence',            -expand_text => sub { return $_[0]->{'doc'}->createTextNode( $_[1] ) },        );        my $expansion = $self->parse_text( \%parse_opts, $paragraph, $line_num );        my $e = $self->{'last'} = $self->{'doc'}->createElement('p');        $e->appendChild( $_ ) foreach $expansion->children;        $self->{'in'}->appendChild( $e );        return $e;    }    sub interior_sequence {         my ($self, $cmd, $arg, $node) = @_;        if ( $cmd eq 'B' ) {            my $e = $self->{'doc'}->createElement('strong');            $e->appendChild( $_ ) foreach $node->parse_tree->children;            return $e;        }        return $arg;    }    sub parse_from_file {        my $self = shift;        my $fname = $_[0];        # XXX: set publish time        return $self->SUPER::parse_from_file( @_ );    }

1 comment:

  1. the newlines are gone in your formatting.

    ReplyDelete