Beefy Boxes and Bandwidth Generously Provided by pair Networks
Clear questions and runnable code
get the best and fastest answer
 
PerlMonks  

netblogger

by rendler (Pilgrim)
on Jan 09, 2005 at 01:52 UTC ( #420618=sourcecode: print w/replies, xml ) Need Help??
Category: Web Stuff
Author/Contact Info Robert Rendler
Description: Simple blogging client that uses Net::Blogger, thus supporting all blogs that it supports. It has features for local post/template storage and editing, spell checking, previewing and regexp replaces.
.bloggerc
blogname = blogname
username = username
password = password

editor  = vim -S $VIMRUNTIME/syntax/html.vim

# speller & preview are optional.
speller = aspell -H -c
preview = lynx -force_html

server = http://www.blogger.com/api
appkey = ffffff9bffffffda3157ffffff8c7844fffffff2ffffffedffffffe37cfff
+fffcfffffff9d54ffffff830affffffafffffff8c1221fffffff84e2bffffffe0
.bloggere
#!/usr/bin/perl -w
# 
# $Id: .bloggere, v0.2 -- 10/01/2005 16:30:12
# Robert Rendler <rendler at gmail dot com>
# 
use strict;

# For Replaces::playing(), remove them if you don't want it including 
+the
# actual func.
use Xmms::Remote;
use MP3::Info;
use IPC::Open2;
use HTML::Entities;

$Replaces::home = 'http://members.iinet.net.au/~rendler/';

# These replaces get saved to your locally stored posts. Say a call to
# playing(), you'd want the output from the func (current playing song
+) to be
# put into the original stored post that way it's only interpreted onc
+e.
%Replaces::Orig::replaces = (
    '\[playing\]' =>
        q(Replaces::playing()),
);

# These replaces are expanded each and everytime you post/repost, that
+ way
# should something need to be changed you can just make the changes he
+re, then
# repost and the place holders will be expanded to the new values and 
+reposted.
%Replaces::Temp::replaces = (
    '\b([dD]cow(facehed)?)\b' =>
        q(qq(<a href="http://dcow.blogspot.com/">$1</a>)),

    '([Tt]cow)\b' =>
        q(qq(<a href="http://tcow.blogspot.com/">$1</a>)),

    '\bSlashdot\b' =>
        q(q(<a href="http://slashdot.org/">Slashdot</a>)),

    '\bCPAN\b' =>
        q(q(<a href="http://www.cpan.org/">CPAN</a>)),

    '\bGloom\b' =>
        q(q(<a href="http://www.planetgloom.com/">Gloom</a>)),


    '\[home://([^:]+):([^\]]+)\]' => 
        q(qq(<a href="$Replaces::home$2">$1</a>)),

    '\[img://(\S+)(\.[^\]]+)\]' =>
        q(qq(<div align="center"><a href="${Replaces::home}images/$2">
+<img src="${Replaces::home}images/$1_thumb$2" /></a></div>)),

    '\[cpan://([^\]]+)\]' =>
        q(qq(<a href="http://search.cpan.org/search?mode=module&query=
+$1">$1</a>)),

    '\[fm://([^\]]+)\]' =>
        q(qq(<a href="http://freshmeat.net/projects/$1/">$1</a>)),

    '\[a://([^:]+):([^\]]+)\]' =>
        q(qq(<a href="$2">$1</a>)),


    '\*(arrow|grin|conf|cool|cry|eek|evil|ex|frown|idea|lol|mad|green|
+neutral|\?|razz|red|roll|sad|smile|sup|twist|wink)\*' =>
        q(Replaces::smiles($1)),
);


sub Replaces::smiles {
    my $smile  = shift;
    my %smiles = (
        'arrow' => 'arrow',     'grin'    => 'biggrin',  'conf' => 'co
+nfused', 'cool'  => 'cool',
        'cry'   => 'cry',       'eek'     => 'eek',      'evil' => 'ev
+il',     'ex'    => 'exclaim',
        'frown' => 'frown',     'idea'    => 'idea',     'lol'  => 'lo
+l',      'mad'   => 'mad',
        'green' => 'mrgreen',   'neutral' => 'neutral',  '?'    => 'qu
+estion', 'razz'  => 'razz',
        'red'   => 'redface',   'roll'    => 'rolleyes', 'sad'  => 'sa
+d',      'smile' => 'smile',
        'sup'   => 'surprised', 'twist'   => 'twisted',  'wink' => 'wi
+nk',
    );
    
    return $smiles{$smile} ? qq(<img src="${Replaces::home}images/smil
+es/$smiles{$smile}.gif" />) : '';
}


sub Replaces::playing {
    my $file;
    my %info;
    my @formats = (
        q#'(' . (%{artist} && %{title} ? '%a ' . (%{album} ? " %A " 
+: '-') . ' %t' : '%f') . ')'#,
        q#'(' . (%{artist} && %{title} ? '%a - %t' : '%f') . ')'#
    );
    my $format  = 0;
    my $remote  = Xmms::Remote->new;


    # Get filename for any currently playing file.
    if ($remote->is_running && $remote->is_playing) {
            $file = $remote->get_playlist_file( $remote->get_playlist_
+pos );
    } else {
        my $pid = (split /\n/, `/bin/ps --no-heading -Cmpg123,ogg123 o
+ %p`)[0];
        $pid =~ s#\D##g if defined $pid;
        return '' if !$pid;

        open PROC_CMDLINE, "/proc/$pid/cmdline" or die "Replaces::play
+ing(); Couldn't open proc file: '$!'\n";
        chomp( my $cmdline = <PROC_CMDLINE> );
        close PROC_CMDLINE;

        if (my ($psfile) = $cmdline =~ /([^\000]+)\000$/) {
            my ($name, $ext) = $psfile =~ m#([^/]+)\.([^.]+)$#;

            if ($psfile !~ m#^/# && -l "/proc/$pid/cwd") {
                $psfile = readlink("/proc/$pid/cwd") . "/$psfile";
            }

            $file = $psfile;
        }
    }

    $info{size} = -s $file;
    $info{size} = sprintf "%.1f", $info{size} / 1024 / 1024; 

    $info{name} = lc $file;
    $info{name} =~ s#.*/##;
    $info{name} =~ s#\.([^.]+)$##;

    if (lc $1 eq 'mp3' || lc $1 eq 'mp2') {
        my $info = get_mp3info($file);
        my $tag  = get_mp3tag($file);

        $info{artist} = $tag->{ARTIST};
        $info{album}  = $tag->{ALBUM};
        $info{title}  = $tag->{TITLE};
        $info{track}  = $tag->{TRACK};

        $info{kbps} = $info->{BITRATE};
        $info{hz}   = $info->{FREQUENCY};
        $info{time} = sprintf "%d:%0.2d", $info->{MM}, $info->{SS};

    } elsif (lc $1 eq 'ogg') {
        open2 \*INFO_READ, \*INFO_WRITE, 'ogginfo', $file or die "Repl
+aces::playing(): couldn't run ogginfo: '$!'\n";
        while (<INFO_READ>) {
            chomp;
            if (/Average bitrate: (\d+)/) {
                $info{kbps} = $1;
            } elsif (/Playback length: (\S+)/) {
                $info{time} = $1;
                $info{time} =~ s#(\d+\.\d+)#sprintf("%0.2d",int($1))#e
+g;
                $info{time} =~ s#[ms]##g;
            } elsif (/Rate: (\d+)/) {
                $info{hz} = $1;
                $info{hz} = $info{kbps} / 1000;
            } elsif (/(ARTIST|ALBUM|TRACK|TITLE)=(.*)/) {
                $info{lc $1} = lc $2;
            }
        }

        close INFO_WRITE;
        close INFO_READ;
    }

    $format = $formats[$format];
    $format =~ s#(?:\%{([^}]+)})#\$info{$1}#g;
    local $_ = eval $format;


    s#\%a#$info{artist}#eg;
    s#\%A#$info{album}#eg;
    s#\%t#$info{title}#eg;
    s#\%n#$info{track}#eg;
    s#\%f#$info{name}#eg;
    s#\%T#$info{time}#g;
    s#\%k#$info{kbps}kbps#g;
    s#\%h#$info{hz}#g;
    s#\%s#$info{size}#g;

    encode_entities($_);
    return qq(<div align="right">$_</div>);
}
netblogger
#!/usr/bin/perl -w
# 
# $Id: netblogger, v0.1 -- 07/01/2005 22:44:17
# Robert Rendler <rendler at gmail dot com>
# 
use strict;
use Net::Blogger;
use File::Temp;
use Term::ReadKey;
use constant {
    NEW     => 0,
    EDIT    => 1,
    REPOST  => 2,
    PREVIEW => 3,
};

my $config = "$ENV{HOME}/.bloggerc";
my $replaf = "$ENV{HOME}/.bloggere";
my $data   = "$ENV{HOME}/.blogger";

require $replaf if -f $replaf;

my %config; config();
my $blogger; blog();


while (1) {
    options(
        '[N]ew Entry'    => sub { entryPost('newest', NEW) },
        '[L]ist Entry'   => sub { entryList('postid') },
        '[E]dit Entry'   => \&entryEdit,
        '[D]elete Entry' => \&entryDel,
        'D[o]wnload'     => \&entryDownload,
        '[R]epost All'   => \&repostAll,
        '[T]emplate'     => \&template,
        '[Q]uit'         => sub { exit },
    );
}



sub entryPost {
    my ($file, $mode, $id) = @_;

    launch('editor', "$data/$file");

    while (1) {
        my $ans = options(
            '[E]dit'         => sub { launch('editor', "$data/$file") 
+},
            $config{speller} ? ( '[S]pell Check'  => sub { launch('spe
+ller', "$data/$file") } ) : (),
            $config{preview} ? ( 'P[r]eview'      => sub { entryPostFi
+le($file, PREVIEW, $id) } ) : (),
            '[P]ost'         => sub { entryPostFile($file, $mode, $id)
+ },
            '[B]ack'         => '',
        );

        return if $ans =~ /^[pb34]$/;
    }
}


sub entryPostFile {
    my ($file, $mode, $id) = @_;
    my ($post, $orig);

    open FILE, "$data/$file" or die "Couldn't open '$data/$file': $!\n
+";

    while (my $l1 = my $l2 = <FILE>) {

        for my $string (keys %Replaces::Temp::replaces) {
            $l1 =~ s#$string#eval($Replaces::Temp::replaces{$string})#
+eg;
            
            $l1 =~ s#<\s*?\$\s+(.*?)\s+\$\s*?\>#eval($1)#eg;
        }

        for my $string (keys %Replaces::Orig::replaces) {
            $l1 =~ s#$string#eval($Replaces::Orig::replaces{$string})#
+eg;
            $l2 =~ s#$string#eval($Replaces::Orig::replaces{$string})#
+eg;

            $l1 =~ s#\[\s*?\$\s+(.*?)\s+\$\s*?\]#eval($1)#eg;
            $l2 =~ s#\[\s*?\$\s+(.*?)\s+\$\s*?\]#eval($1)#eg;
        }

        $post .= $l1;
        $orig .= $l2
    }

    close FILE;

    if ($mode == NEW) {
        my $postid = $blogger->newPost(postbody => \$post, publish => 
+1) || die $blogger->LastError();
        print "Posted with an ID of '$postid'.\nSaving post to '$data/
+$postid'.\n";

        open BLOG, ">$data/$postid" or die "Couldn't open '$data/$post
+id': $!\n";
        print BLOG $orig;
        close BLOG;

        # Remove the original edit copy.
        unlink "$data/$file";

    } elsif ($mode == EDIT || $mode == REPOST) {
        $blogger->editPost(postbody => \$post, postid => $id, publish 
+=> 1) || die $blogger->LastError();
        print "Post '$id' reposted.\n";

    } elsif ($mode == PREVIEW) {
        open PREV, ">$data/preview" or die "Couldn't open '$data/previ
+ew': $!\n";
        print PREV $post;
        close PREV;

        launch('preview', "$data/preview");
    }
}


# authorName, userid, status, content, postid, lastModified, postDate,
+ url, dateCreated
sub entryList {
    my $key = shift;
    my ($ok, @p) = $blogger->getRecentPosts(numposts => $config{numpos
+ts} || 20);
    die $blogger->LastError() if !$ok;

    for my $post (@p) {
        my ($width) = GetTerminalSize();
        printf "[%s] %s\n", $post->{$key}, substr $post->{content}, 0,
+ $width - (length($post->{$key}) + 4);
    }
}


sub entryDownload {
    my $key = shift;
    my ($ok, @p) = $blogger->getRecentPosts(numposts => 20); # Hack Bl
+ogger/API/Core.pm (about line 483)
    die $blogger->LastError() if !$ok;                       # to be a
+ble to get a higher numposts.

    for my $post (@p) {
        my $postf = "$data/$post->{postid}";

        unless (-f $postf) {
            print "Making hardcopy at '$postf'.\n";

            open BLOG, ">$postf" or die "Couldn't open '$postf': $!\n"
+;
            print BLOG $post->{content};
            close BLOG;
        }
    }
}


sub entryEdit {
    my $id    = getAnswer('Enter post ID', '^\d+$');
    my $post  = $blogger->getPost($id) || die $blogger->LastError();
    my $postf = "$data/$id";

    unless (-f $postf) {
        print "You don't have a local hardcopy of the post.\nSaving on
+e to '$postf'.\n";

        open BLOG, ">$postf" or die "Couldn't open '$postf': $!\n";
        print BLOG $post->{content};
        close BLOG;
    }

    entryPost($id, EDIT, $id)
}


sub entryDel {
    my $id = getAnswer('Enter post ID', '^\d+$');
    $blogger->deletePost(postid => $id, publish => 1) || die $blogger-
+>LastError();

    print "Post '$id' deleted.\n";
}


sub repostAll {
    opendir DIR, $data or die "Couldn't opendir '$data': $!\n";

    for my $file (readdir DIR) {
        next unless -f $file && $file =~ /^\d+/;

        entryPostFile($file, REPOST, $file);
    }
}


sub template {
    while (1) {
        print "Template:\n";

        my $opt = options(
            '[E]dit'    => '',
            '[P]ost'    => '',
            '[B]ack'    => '',

        );

        unless ($opt =~ /^[b3]$/) {
            my $type = getAnswer('Which template [main|archiveIndex]',
+ '^main|archiveIndex$');

            $opt =~ /^[e1]$/ ? tempEdit($type) : tempPost($type);
        } else {
            return;
        }

    }
}


sub tempEdit {
    my $type  = shift;
    my $tfile = "$data/template$type";

    unless (-f $tfile) {
        print "You don't have a local hardcopy of the '$type' template
+.\nSaving one to '$tfile'.\n";

        my $temp = $blogger->getTemplate(type => $type) || die $blogge
+r->LastError();

        open TEMP, ">$tfile" or die "Couldn't open '$tfile': $!\n";
        print TEMP $temp;
        close TEMP;
    }

    launch('editor', $tfile);
}


sub tempPost {
    my $type  = shift;
    my $tfile = "$data/template$type";

    unless (-f $tfile) {
        return print "You don't have a local hardcopy of the '$type' t
+emplate.\nEither create one or Edit an existing one first.\n\n";
    }

    open TEMP, $tfile or die "Couldn't open '$tfile': $!\n";
    my $temp = do { local $/; <TEMP>; };
    close TEMP;

    $blogger->setTemplate(template => \$temp, type => $type) || die $b
+logger->LastError();

    print "The '$type' template has been set.\n\n";
}


sub launch {
    my ($key, @options) = @_;
    die "No such key '$key' for launch!\n" unless $config{$key};

    system ((split /\s+/, $config{$key}), @options);
}


sub options {
    my @options = @_;
    my ($i, $valid, $ans, @do, %key);

    print "\n";

    for my $opt (0 .. $#options/2) {
        $options[0] =~ s#\[(\S+)\]#$1#; # Remove the codes
+ if it's not portable for you.
        printf "%d. %s\n", ++$i, shift @options;
        push @do, shift @options;
        $key{lc $1} = $i;
    }

    while (1) {
        chomp($ans = <STDIN>);

        my $ok;
        if ($ans =~ /^\d+$/ && $ans gt 0 && $ans le $i) {
            $ok = $ans - 1;
        } elsif (grep /^\Q$ans\E$/i, keys %key) {
            $ok = $key{lc $ans} - 1;
        }

        if (defined $ok) {
            print "\n";
            $do[$ok]() if ref $do[$ok] eq 'CODE';
            return lc $ans;
        }
    }
}


sub getAnswer {
    my ($question, $valid) = @_;

    while (1) {
        print "$question: ";
        chomp(my $ans = <STDIN>);
        if ($ans =~ /$valid/) {
            print "\n";
            return $ans;
        }
    }
}


sub blog {
    $blogger = Net::Blogger->new(appkey => $config{appkey});

    $blogger->Username($config{username}) || die $blogger->LastError()
+;
    $blogger->Password($config{password}) || die $blogger->LastError()
+;
    $blogger->BlogId($blogger->GetBlogId(blogname => $config{blogname}
+)) || die $blogger->LastError();
}


sub config {
    my @need = qw(blogname username password editor server appkey);
    %config  = hashy($config);

    map { die "Missing '$_' from config file!\n" if !$config{$_} } @ne
+ed;
}


sub hashy {
    my $file = shift;
    my %hash;

    open FH, $file or die "Couldn't open '$file': $!\n";

    while (<FH>) {
        chomp;
        next unless m/ = /;
        my ($key, $value) = split /\s+=\s+/, $_, 2;

        if ($key && $value) {
            $hash{$key} = $value;
        }
    }

    close FH;

    return %hash;
}
Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: sourcecode [id://420618]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others exploiting the Monastery: (3)
As of 2019-12-15 21:02 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found

    Notices?