#!/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 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 '; # 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 '; } ### 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 = ; 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__