Beefy Boxes and Bandwidth Generously Provided by pair Networks
There's more than one way to do things
 
PerlMonks  

netblogger

by rendler (Pilgrim)
on Jan 09, 2005 at 01:52 UTC ( [id://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;
}

Back to Code Catacombs

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?

www.com | www.net | www.org
Node Status?
node history
Node Type: sourcecode [id://420618]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? • Last hour • Other CB clients
Other Users?
Others exploiting the Monastery: (2)
As of 2024-04-19 19:28 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found