root/del.icio.us.B.B/trunk/del.icio.us.B.B.pl

#!/usr/bin/perl
########################################################################
my $USAGE = <<'PERLHEREDOC';
* del.icio.us Best Before - Enable you to time-limited bookmarking
        Version 1.00 (Release 704)
        Programmed by Piroli YUKARINOMIYA <piroli at magicvox dot net>
        Open MagicVox.net - http://www.magicvox.net/
PERLHEREDOC
########################################################################
$|++;
use strict;
use warnings;
use lib './extlib';
use POSIX;
use LWP::UserAgent;
use XML::Simple;

### Set your del.icio.us account
use constant DELICIOUS_USERNAME =>  'username';
use constant DELICIOUS_PASSWORD =>  'password';

### 
# undef     Delete the post
# ''        Delete the Time-Limt tag (not yet implemented)
# 'newtag'  Replace the Time-Limit tag with the newly specified tag (not yet implemented)
use constant ACTION_WHEN_EXPIRED => undef;

### More configurations ...
use constant RECENT_POSTS_NUM =>    '10';
use constant MARK_DIRNAME =>        './mark';
use constant UPDATE_FILENAME =>     'update';

### Set some constants definition
my $DELICIOUS_DOMAIN =              'api.del.icio.us';
my $DELICIOUS_PROTOCOL =            'https';
use constant DELICIOUS_PORT =>      '443';
use constant DELICIOUS_REALM =>     'del.icio.us API';

### Global variables
my $ua;
my $xmlparser;
my $posts = {};

########################################################################
### Proceeding
########################################################################
showUsage ();
setupProgram ();
InitUserAgent ();
InitXmlParser ();
if (isUpdatedPosts ()) {
    retrieveRecentPosts ();
}
checkMarkFiles ();
updateExpiredPosts ();
exit;

########################################################################
### Functions
########################################################################

### Show usages
sub showUsage {
    printf STDERR $USAGE;
}

### Setup program
sub setupProgram {
    mkdir MARK_DIRNAME unless -d MARK_DIRNAME;
}

### Initialize LWP::UserAgent
sub InitUserAgent {
    $ua = new LWP::UserAgent
        or die 'Failed to create <LWP::UserAgent>';
    # Setup my credentials
    $ua->credentials (
            "$DELICIOUS_DOMAIN:".DELICIOUS_PORT,
            DELICIOUS_REALM,
            DELICIOUS_USERNAME, DELICIOUS_PASSWORD
    );
}

### Initialize XML::Simple
sub InitXmlParser {
    $xmlparser = new XML::Simple (forcearray => 1)
        or die 'Failed to create <XML::Simple>';
}

### Step 0 - Last time
sub isUpdatedPosts {
    my $res = getContent ("$DELICIOUS_PROTOCOL://$DELICIOUS_DOMAIN/v1/posts/update")
        or return 0;
    my $data = $xmlparser->XMLin ($res);
    defined $data->{time}
        or return 0;

    my $update = read1Line (UPDATE_FILENAME) || '';
    $update eq $data->{time}
        and return 0;

    makeMark (UPDATE_FILENAME, $data->{time});
    1;
}

### Step 1 - Retrieving the recent posts
sub retrieveRecentPosts {
    printf STDERR "* Retrieving the recent %d post(s) on del.icio.us\n", RECENT_POSTS_NUM;
    my $res = getContent ("$DELICIOUS_PROTOCOL://$DELICIOUS_DOMAIN/v1/posts/recent?count=". RECENT_POSTS_NUM)
        or return;

    my $data = $xmlparser->XMLin ($res);
    my $data_posts = $data->{post};
    foreach my $data_post (@$data_posts) {
        foreach my $tag (split /\s+/, $data_post->{tag}) {
            if (defined tag2timelimit ($tag)) {
                # This post is a Time-Limit Bookmark
                $posts->{$data_post->{href}} = $data_post;

                makeMark ($data_post->{hash}, $data_post->{href});

                printf STDERR ".";
                last;
            }
        }
    }
    printf STDERR "\n";
}

### Step 2 - Checking the mark files
sub checkMarkFiles {
    printf STDERR "* Checking the mark files - %s\n", MARK_DIRNAME;
    if (opendir (MARK_DH, MARK_DIRNAME)) {
        foreach my $filename (readdir MARK_DH) {
            next unless $filename =~ m!^[0-9a-fA-F]{32}$!;
            my $href = read1Line ($filename)
                or next;
            # The post in this mark file has not been retrieved
            if (! defined $posts->{$href}) {
                if (! retrievePost ($href)) {
                    # This post may be deleted
                    removeMark ($filename);
                }
            }
        }
        closedir MARK_DH;
    }
    printf STDERR "\n";
}

### Step 3 - Update the expired posts on del.icio.us
sub updateExpiredPosts {
    printf STDERR "* Updating the expired posts on del.icio.us\n";
    foreach my $href (keys %$posts) {
        my $remove_mark = 1;
        my $data_post = $posts->{$href};
        foreach my $tag (split /\s+/, $data_post->{tag}) {
            if (defined (my $expires = tag2timelimit ($tag))) {
                if (isExpired ($data_post->{time}, $expires)) {
                    if (defined ACTION_WHEN_EXPIRED) {
                        updatePostTags ($href, ACTION_WHEN_EXPIRED);
                        print "v";
                    } else {
                        deletePost ($href);
                        print "x";
                    }
                } else {
                    $remove_mark = 0;
                    print '.';
                }
                last;
            }
        }
        removeMark ($data_post->{hash})
            if $remove_mark;
    }
    print "\n";
}

### Get content in the specified URL
sub getContent {
    my $url = shift;
    my $res = $ua->get ($url);
    sleep 1;
    if (! $res->is_success) {
        printf STDERR "\tFailed to get %s\n\tStatus: %s\n",
                $url ,$res->status_line;
        return undef;
    }
    $res->content;
}

### Update with the latest informatio from del.icio.us
sub retrievePost {
    my $href = shift;
    my $res = getContent ("$DELICIOUS_PROTOCOL://$DELICIOUS_DOMAIN/v1/posts/get?url=". encode_url ($href))
        or return;

    my $data = $xmlparser->XMLin ($res);
    my $data_posts = $data->{post};
    foreach my $data_post (@$data_posts) {
        foreach my $tag (split /\s+/, $data_post->{tag}) {
            if (defined tag2timelimit ($tag)) {
                # The post in this mark file has not been retrieved
                $posts->{$data_post->{href}} = $data_post;

                printf STDERR ".";
                return 1;
            }
        }
        # only 1 post should be returned.
    }
    0;
}

### Delete a post on del.icio.us
sub deletePost {
    my $href = shift;
    my $res = getContent ("$DELICIOUS_PROTOCOL://$DELICIOUS_DOMAIN/v1/posts/delete?url=". encode_url ($href))
        or return;
    # useless to check the response
}

### Update a post on del.icio.us
sub updatePostTags {
    # not yet implemented
}

### Encode for URL
sub encode_url {
    my $str = shift;
    $str =~ s!([^0-9a-zA-Z_.~-])!sprintf '%%%02X', ord ($1)!eg;
    $str;
}

### is expired ?
sub isExpired {
    my $posted = shift;
    my $expire = shift;
    $posted le POSIX::strftime ('%Y-%m-%dT%H:%M:%SZ', gmtime (time - $expire));
}

### Make a mark file for the post
sub makeMark {
    my $hash = shift;
    my $href = shift;
    if (open (MARK_FH, ">". MARK_DIRNAME. "/$hash")) {
        print MARK_FH "$href";
        close MARK_FH;
    }
}

### Remove a mark file for the post
sub removeMark {
    my $hash = shift;
    my $filepath = MARK_DIRNAME. "/$hash";
    unlink $filepath
        if -f $filepath;
}

### Read 1 line from the file
sub read1Line {
    my $filename = shift;
    my $ret = undef;
    if (open (FILE_FH, "<". MARK_DIRNAME. "/$filename")) {
        $ret = <FILE_FH>;
        close FILE_FH;
    }
    $ret;
}

### Retrieve the expiring time from tag.
sub tag2timelimit {
    my $tag = shift;
    if ($tag =~ m!^bb(\d+)s(?:ec(?:onds?)?)?$!i) {
        return $1; # seconds
    }
    elsif ($tag =~ m!^bb(\d+)m(?:in(?:utes?)?)?$!i) {
        return $1 * 60; # minutes
    }
    elsif ($tag =~ m!^bb(\d+)h(?:ours?)?$!i) {
        return $1 * 60 * 60; # hours
    }
    elsif ($tag =~ m!^bb(\d+)d(?:ays?)?$!i) {
        return $1 * 60 * 60 * 24; # days
    }
    elsif ($tag =~ m!^bb(\d+)w(?:eeks?)?$!i) {
        return $1 * 60 * 60 * 24 * 7; # week
    }
    elsif ($tag =~ m!^bb(\d+)m(?:onths?)?$!i) {
        return $1 * 60 * 60 * 24 * 30; # month
    }
    elsif ($tag =~ m!^bb(\d+)y(?:ears?)?$!i) {
        return $1 * 60 * 60 * 24 * 365; # year
    }
    elsif ($tag =~ m!^bb$!i) {
        return $1 * 60 * 60 * 24 * 3; # (default)
    }
    undef;
}

__END__