Net::Delicious - OOP for the del.icio.us API

Net-Delicious documentation Contained in the Net-Delicious distribution.

Index

Code Index:

NAME

Top

Net::Delicious - OOP for the del.icio.us API

SYNOPSIS

Top

  use Net::Delicious;
  use Log::Dispatch::Screen;

  my $del = Net::Delicious->new({user => "foo",
				 pswd => "bar"});

  foreach my $p ($del->recent_posts()) {
      print $p->description()."\n";
  }

DESCRIPTION

Top

OOP for the del.icio.us API

PACKAGE METHODS

Top

__PACKAGE__->new(\%args || Config::Simple)

Arguments to the Net::Delicious object may be defined in one of three ways :

* As a single hash reference
* As a reference to a Config::Simple object
* As a path to a file that may be read by the Config::Simple.

The first option isn't going away any time soon but should be considered as deprecated. Valid hash reference arguments are :

* user

String. required

Your del.icio.us username.

* pswd

String. required

Your del.icio.us password.

* updates

String.

The path to a directory where the timestamp for the last update to your bookmarks can be recorded. This is used by the all_posts method to prevent abusive requests.

Default is the current user's home directory; If the home directory can not be determined Net::Delicious will use a temporary directory as determined by File::Temp.

* debug

Boolean.

Add a Log::Dispatch::Screen dispatcher to log debug (and higher) notices. Notices will be printed to STDERR.

Config::Simple options are expected to be grouped in a "block" labeled delicious. Valid options are :

* user

String. required

Your del.icio.us username.

* pswd

String. required

Your del.icio.us password.

* updates

String.

The path to a directory where the timestamp for the last update to your bookmarks can be recorded. This is used by the all_posts method to prevent abusive requests.

Default is the current user's home directory, followed by a temporary directory as determined by File::Temp.

* xml_parser

String.

You may specify one of three XML parsers to use to handle response messages from the del.icio.us servers. You many want to do this if, instead of Perl-ish objects, you want to access the raw XML and parse it with XPath or XSLT or some other crazy moon language.

* simple

This uses XML::Simple to parse messages. If present, all successful API method calls will return, where applicable, Net::Delicious::* objects.

* libxml

This uses XML::LibXML to parse messages. If present, all successful API method calls will return a XML::LibXML::Document object.

Future releases may allow responses parsed with libxml to be returned as Net::Delicious::* objects.

* xpath

This uses XML::XPath to parse messages. If present, all successful API method calls will return a XML::XPath object.

Future releases may allow responses parsed with XML::XPath to be returned as Net::Delicious::* objects.

The default value is simple.

* force_xml_objects

Boolean.

Set to true if you are using XML::Simple to parse response messages from the del.icio.us servers but want to return the object's original data structure rather than Net::Delicious::* objects.

Default is false.

* endpoint

String.

Set the endpoint for all API calls.

There's no particular reason you should ever need to set this unless, say, this module falls horribly out of date with the API itself. Anyway, now you can.

Default is https://api.del.icio.us/v1/

* debug

Boolean.

Add a Log::Dispatch::Screen dispatcher to log debug (and higher) notices. Notices will be printed to STDERR.

Returns a Net::Delicious object or undef if there was a problem creating the object.

It is also possible to set additional config options to tweak the default settings for API call parameters and API response properties. Please consult the POD for Net::Delicious::Config for details.

UPDATE METHODS

Top

$obj->update()

Returns return the time of the last update formatted as a W3CDTF string.

POST METHODS

Top

$obj->add_post(\%args)

Makes a post to del.icio.us.

Valid arguments are :

* url

String. required

Url for post

* description

String.

Description for post.

* extended

String.

Extended for post.

* tags

String.

Space-delimited list of tags.

* dt

String.

Datestamp for post, format "CCYY-MM-DDThh:mm:ssZ"

* shared

Boolean. (Technically, you need to pass the string "no" but N:D will handle 1s and 0s.)

Make the post private. Default is true.

* replace

Boolean. (Technically, you need to pass the string "no" but N:D will handle 1s and 0s.)

Don't replace post if given url has already been posted. Default is true.

Returns true or false.

$obj->delete_post(\%args)

Delete a post from del.icio.us.

Valid arguments are :

* url

String. required

Returns true or false.

$obj->posts_per_date(\%args)

Get a list of dates with the number of posts at each date.

Valid arguments are :

* tag

String.

Filter by this tag.

Returns a list of Net::Delicious::Date objects when called in an array context.

Returns a Net::Delicious::Iterator object when called in a scalar context.

$obj->recent_posts(\%args)

Get a list of most recent posts, possibly filtered by tag.

Valid arguments are :

* tag

String.

Filter by this tag.

* count

Int.

Number of posts to return. Default is 20; maximum is 100

Returns a list of Net::Delicious::Post objects when called in an array context.

Returns a Net::Delicious::Iterator object when called in a scalar context.

$obj->all_posts()

Returns a list of Net::Delicious::Post objects when called in an array context.

Returns a Net::Delicious::Iterator object when called in a scalar context.

If no posts have been added between calls to this method, it will return an empty list (or undef if called in a scalar context.)

$obj->posts(\%args)

Get a list of posts on a given date, filtered by tag. If no date is supplied, most recent date will be used.

Valid arguments are :

* tag

String.

Filter by this tag.

* dt

String.

Filter by this date.

Returns a list of Net::Delicious::Post objects when called in an array context.

Returns a Net::Delicious::Iterator object when called in a scalar context.

TAG METHODS

Top

$obj->tags()

Returns a list of tags.

$obj->rename_tag(\%args)

Renames tags across all posts.

Valid arguments are :

* old

String. required

Old tag

* new

String. required

New tag

Returns true or false.

$obj->all_posts_for_tag(\%args)

This is a just a helper method which hides a bunch of API calls behind a single method.

Valid arguments are :

* tag

String. required

The tag you want to retrieve posts for.

Returns a list of Net::Delicious::Post objects when called in an array context.

Returns a Net::Delicious::Iterator object when called in a scalar context.

BUNDLE METHODS

Top

$obj->bundles()

Returns a list of Net::Delicious::Bundle objects when called in an array context.

Returns a Net::Delicious::Iterator object when called in a scalar context.

$obj->set_bundle(\%args)

Valid arguments are :

* bundle

String. required

The name of the bundle to set.

* tags

String. required

A space-separated list of tags.

Returns true or false

$obj->delete_bundle(\%args)

Valid arguments are :

* bundle

String. required

The name of the bundle to set

Returns true or false

HELPER METHODS

Top

$obj->logger()

Returns a Log::Dispatch object.

$obj->config(@args)

This is just a short-cut for calling the current object's internal Config::Simple param method. You may use to it to get and set config parameters although they will not be saved to disk when the object is destroyed.

$obj->username()

Returns the del.icio.us username for the current object.

$obj->password()

Returns the del.icio.us password for the current object.

$object->user_agent()

This returns the objects internal LWP::UserAgent in case you need to tweak timeouts, proxies, etc.

By default the UA object enables the proxy_env glue.

ERRORS

Top

Errors are logged via the object's logger method which returns a Log::Dispatch object. If you want to get at the errors it is up to you to provide it with a dispatcher.

VERSION

Top

1.13

DATE

Top

$Date: 2008/03/03 16:55:04 $

AUTHOR

Top

Aaron Straup Cope <ascope@cpan.org>

SEE ALSO

Top

http://del.icio.us/doc/api

NOTES

Top

This package implements the API in its entirety as of DATE.

LICENSE

Top

Copyright (c) 2004-2008, Aaron Straup Cope. All Rights Reserved.

This is free software, you may use it and distribute it under the same terms as Perl itself.

Net-Delicious documentation Contained in the Net-Delicious distribution. 
# $Id: Delicious.pm,v 1.71 2008/03/03 16:55:04 asc Exp $

package Net::Delicious;
use strict;

$Net::Delicious::VERSION = '1.14';


use Net::Delicious::Constants qw (:pause :response :uri);
use Net::Delicious::Config;

use HTTP::Request;
use LWP::UserAgent;
use URI;

use Log::Dispatch;
use Data::Dumper;

use Time::HiRes;

# All this, just to keep track
# of update/all_posts stuff...

use IO::AtomicFile;
use FileHandle;
use File::Temp;
use File::Spec;
use Date::Parse;
use English;


sub new {
        my $pkg  = shift;
        my $args = shift;
    
        #
        
        my $self = {
                    '__wait'    => 0,
                    '__paused'  => 0,
                   };
        
        #
        #

        my $cfg = undef;

        if (ref($args) eq "Config::Simple") {
                $cfg = $args;
        }

        elsif (ref($args->{cfg}) eq "Config::Simple") {
                $cfg = $args->{cfg};
        }

        elsif (-f $args->{cfg}) {
                eval {
                        require Config::Simple;
                        $cfg = Config::Simple->new($args->{cfg});
                };

                if ($@) {
                        warn "Failed to load config $args->{cfg}, $@";
                        return;
                }
        }

        else {
                $cfg = Net::Delicious::Config->mk_config($args);

                if (! $cfg) {
                        warn "Failed to create internal config object, $!";
                        return;
                }
        }
                
        Net::Delicious::Config->merge_configs($cfg);
        $self->{'__cfg'} = $cfg;

        #
        #
        #

        my $parser_cfg = $cfg->param("delicious.xml_parser");
        my $parser_pkg = undef;

        if ($parser_cfg eq "libxml") {
                $parser_pkg = "XML::LibXML";
        }

        elsif ($parser_cfg eq "xpath") {
                $parser_pkg = "XML::XPath";
        }

        else {
                $parser_pkg = "XML::Simple";
        }
        
        eval "require $parser_pkg";

        if ($@) {
                warn "Failed to load XML parser $parser_pkg, $@";
                return;
        }

        $parser_pkg->import();

        #
        #
        #

        bless $self, $pkg;

        #

        if ($self->config("delicious.debug")) {
                require Log::Dispatch::Screen;
                $self->logger()->add(Log::Dispatch::Screen->new(name      => "debug",
                                                                min_level => "debug",
                                                                stderr    => 1));
        }

        #
        
        return $self;
}


sub update {
        my $self = shift;

        my $res = $self->_execute_method("delicious.posts.update"); 
        return ($res) ? $res->{time} : undef;
}


sub add_post {
    my $self = shift;
    my $args = shift;

    my $res = $self->_execute_method("delicious.posts.add", $args);

    if (! $self->_use_rsp_parser()) {
            return $res;
    }

    return $self->_isdone($res);
}


sub delete_post {
    my $self = shift;
    my $args = shift;

    my $res = $self->_execute_method("delicious.posts.delete", $args);

    if (! $self->_use_rsp_parser()) {
            return $res;
    }

    return $self->_isdone($res);
}


sub posts_per_date {
    my $self = shift;
    my $args = shift;

    my $res = $self->_execute_method("delicious.posts.dates", $args);

    if (! $res) {
            return;
    }

    if (! $self->_use_rsp_parser()) {
            return $res;
    }

    my $dates = $self->_getresults($res, "date");
    return $self->_buildresults("Date", $dates);
}


sub recent_posts {
        my $self = shift;
        my $args = shift;
        
        my $res = $self->_execute_method("delicious.posts.recent", $args);
        
        if (! $res) {
                return;
        }
        
        if (! $self->_use_rsp_parser()) {
                return $res;
        }
        
        my $posts = $self->_getresults($res, "post");
        return $self->_buildresults("Post", $posts);
}


sub all_posts {
        my $self = shift;

        if (! $self->_is_updated()) {
                $self->logger()->info("posts have not changed since last call");
                return;
        }

        my $res = $self->_execute_method("delicious.posts.all");

        if (! $res) {
                return;
        }

        if (! $self->_use_rsp_parser()) {
                return $res;
        }
        
        my $posts = $self->_getresults($res, "post");
        return $self->_buildresults("Post", $posts);
}


sub posts {
        my $self = shift;
        my $args = shift;
        
        #

        my $res = $self->_execute_method("delicious.posts.get", $args);
        
        if (! $res) {
                return;
        }
    
        if (! $self->_use_rsp_parser()) {
                return $res;
        }
        
        #
        
        my $posts = $self->_getresults($res, "post");
        return $self->_buildresults("Post", $posts);
}


sub tags {
        my $self = shift;

        my $res = $self->_execute_method("delicious.tags.get");

        if (! $res) {
                return;
        }

        if (! $self->_use_rsp_parser()) {
                return $res;
        }

        #

        my $tags = $self->_getresults($res, "tag");
        return $self->_buildresults("Tag", $tags);
}


sub rename_tag {
        my $self = shift;
        my $args = shift;

        my $res = $self->_execute_method("delicious.tags.rename", $args);

        if (! $self->_use_rsp_parser()) {
                return $res;
        }

        return $self->_isdone($res);
}


sub all_posts_for_tag {
        my $self = shift;
        my $args = shift;

        if (! $self->_use_rsp_parser()) {
                $self->logger()->error("This method does not work with the XML parser settings you have chosen");
                return;
        }
        
        $args ||= {};
        
        if (! $args->{tag}) {
                $self->logger()->error("You must specify a tag");
                return;
        }

        my $it = $self->posts_per_date({tag => $args->{tag}});

        if (! $it) {
                return;
        }

        my @posts = ();

        while (my $dt = $it->next()) {

                my @links = $self->posts({tag => $args->{tag},
                                          dt  => $dt->date()});

                if (wantarray) {
                        push @posts, @links;
                }
                
                else {
                        map {
                                push @posts, $_->as_hashref();
                        } @links;
                }
        }

        if (wantarray) {
                return @posts;
        }

        return $self->_buildresults("Post", \@posts);
}


sub bundles {
        my $self = shift;
        
        my $res = $self->_execute_method("delicious.tags.bundles.all");

        if (! $self->_use_rsp_parser()) {
                return $res;
        }
        
        my $bundles = $self->_getresults($res, "bundle");
        $bundles    = $bundles->[0];
        
        if (ref($bundles) ne "HASH") {
                $self->logger()->error("failed to parse response");
                return;
        }

        # argh....

        my @data = ();

        if (exists($bundles->{name})) {
                @data = $bundles;
        }
        
        else {
                @data = map { 
                        {name => $_,tags => $bundles->{$_}->{'tags'} }
                } keys %$bundles;
        }
        
        #
        
        return $self->_buildresults("Bundle", \@data);
}


sub set_bundle {
        my $self = shift;
        my $args = shift;
        
        my $res = $self->_execute_method("delicious.tags.bundles.set", $args);

        if (! $self->_use_rsp_parser()) {
                return $res;
        }

        return $self->_isdone($res);
}


sub delete_bundle {
        my $self = shift;
        my $args = shift;
        
        my $res = $self->_execute_method("delicious.tags.bundles.delete", $args); 

        if (! $self->_use_rsp_parser()) {
                return $res;
        }

        return $self->_isdone($res);
}


sub logger {
        my $self = shift;
        
        if (ref($self->{'__logger'}) ne "Log::Dispatch") {
                my $log = Log::Dispatch->new();
                $self->{'__logger'} = $log;
        }
        
        return $self->{'__logger'};    
}


sub config {
        my $self = shift;
        return $self->{'__cfg'}->param(@_);
}


sub username {
        my $self = shift;
        return $self->config("delicious.user");
}


sub password {
        my $self = shift;
        return $self->config("delicious.pswd");
}


sub user_agent {
        my $self = shift;
        
        if (ref($self->{'__ua'}) ne "LWP::UserAgent") {
                my $ua = LWP::UserAgent->new();
                $ua->agent(sprintf("%s, %s", __PACKAGE__, $Net::Delicious::VERSION));
                $ua->env_proxy(1);

                $self->{'__ua'} = $ua;
        }
        
        return $self->{'__ua'};
}

#
# Private methods
#

sub _read_update {
        my $self = shift;
        
        my $path = $self->_path_update();

        if (! -f $path) {
                return time();
        }

        my $fh = FileHandle->new($path);
        
        if (! $fh) {
                $self->logger()->error("unable to open '$path' for reading, $!");
                return 0;
        }
        
        my $time = $fh->getline();
        chomp $time;
        
        $fh->close();
        return $time;
}

sub _write_update {
        my $self = shift;
        my $time = shift;
        
        my $path = $self->_path_update();
        my $fh   = IO::AtomicFile->open($path,"w");
        
        if (! $fh) {
                $self->logger()->error("unable to open '$path' for writing, $!");
                return 0;
        }
        
        $fh->print($time);
        $fh->close();
        
        return 1;
}

sub _is_updated {
        my $self = shift;
        
        my $last    = $self->_read_update();
        my $current = $self->update();
        
        $self->_write_update($current);
        
        return ($last) ? (str2time($current) > str2time($last)) : 1;
}

sub _path_update {
        my $self = shift;
        
        my $file = sprintf(".del.icio.us.%s", $self->config("delicious.user"));

        if (! $self->{'__updates'}){

                my $user_cfg = $self->config("delicious.updates");

                if ($user_cfg) {
                        $self->{'__updates'} = $user_cfg;
                }
                
                elsif (-d (getpwuid($EUID))[7]) {
                        $self->{'__updates'} = (getpwuid($EUID))[7];
                }
                
        
                else {
                        $self->{'__updates'} = File::Temp::tempdir();
                }
        }

        my $root = $self->{'__updates'};
        return File::Spec->catfile($root, $file);
}

sub _execute_method {
        my $self = shift;
        my $meth = shift;
        my $args = shift;

        my $params = $self->_validateinput($meth, $args);

        if (! $params) {
                return 0;
        }

        $meth   =~ /[^\.]+\.(.*)$/;
        my $uri = $1;

        $uri =~ s/\./\//g;

        my $req    = $self->_buildrequest($uri, $args, $params);
        my $res    = $self->_sendrequest($req);

        return $res;
}

sub _validateinput {
        my $self  = shift;
        my $block = shift;
        my $args  = shift;

        if (! $args) {
                $args = {};
        }

        $block =~ s/\./_/g;

        my $rules = $self->config(-block => $block);

        if (! defined($rules)) {
                $self->logger()->error("Unknown error validating user input; unable to find validation rules for $block");
                return undef;
        }

        my @params = ();

        foreach my $param (keys %$rules) {

                my ($required, $type) = split(";", $rules->{$param});

                if (($required) && (! exists($args->{$param}))) {
                        $self->logger()->error("$param is a required parameter");
                        return undef;
                }

                if (($type) && ($type eq "no")) {
                        $self->_mkno($args, $param);
                }

                push @params, $param;
        }

        return \@params;
}

sub _buildrequest {
        my $self   = shift;
        my $meth   = shift;
        my $args   = shift;
        my $params = shift;

        my %query = map {
                $_ => $args->{$_}
        } grep {
                exists($args->{$_}) && $args->{$_}
        } @$params;

        my $endpoint = $self->config("delicious.endpoint");
        my $uri      = URI->new_abs($meth, $endpoint);

        $uri->query_form(%query);

        my $req = HTTP::Request->new(GET => $uri);
        $self->_authorize($req);

        #

        $self->logger()->debug($req->as_string());
        return $req;
}

sub _sendrequest {
        my $self = shift;
        my $req  = shift;
        
        # check to see if we need to take
        # breather (are we pounding or are
        # we not?)
        
        while (time < $self->{'__wait'}) {
                
                my $debug_msg = sprintf("trying not to beat up on service, pause for %.2f seconds\n",
                                        PAUSE_SECONDS_OK);
                
                $self->logger()->debug($debug_msg);
                sleep(PAUSE_SECONDS_OK);
        }

        #
        # send request
        #

        my $res = $self->user_agent()->request($req);
        $self->logger()->debug($res->as_string());
        
        # check for 503 status
        
        if ($res->code() eq PAUSE_ONSTATUS) {
                
                # you are in a dark and twisty corridor
                # where all the errors look the same - 
                # just give up if we hit this ceiling
                
                $self->{'__paused'} ++;
                
                if ($self->{'__paused'} > PAUSE_MAXTRIES) {
                        
                        my $errmsg = sprintf("service returned '%d' status %d times; exiting",
                                             PAUSE_ONSTATUS,PAUSE_MAXTRIES);
                        
                        $self->logger()->error($errmsg);
                        return undef;
                }

                # check to see if the del.icio.us server
                # requests that we hold off for a set amount
                # of time - otherwise wait a little longer
                # than the last time
                
                my $retry_after = $res->header("Retry-After");
                my $debug_msg   = undef;
                
                if ($retry_after ) {
                        $debug_msg = sprintf("service unavailable, requested to retry in %d seconds",
                                             $retry_after);
                } 
                
                else {
                        $retry_after = PAUSE_SECONDS_UNAVAILABLE * $self->{'__paused'};
                        $debug_msg = sprintf("service unavailable, pause for %.2f seconds",
                                             $retry_after);
                }
                
                $self->logger()->debug($debug_msg);
                sleep($retry_after);
                
                # try, try again
                
                return $self->_sendrequest($req);
        }
        
        # (re) set internal timers
        
        $self->{'__wait'}   = time + PAUSE_SECONDS_OK;
        $self->{'__paused'} = 0;
        
        # check for any other HTTP 
        # errors
        
        if ($res->code() ne 200) {
                $self->logger()->error(join(":", $res->code(), $res->message()));
                return undef;
        }
        
        if ($res->content() =~ /^<html/) {
                $self->logger()->error("erp. returned HTML - this is wrong");
                return undef;
        }

        return $self->_parse_xml($res);
}

sub _parse_xml {
        my $self = shift;
        my $res  = shift;

        my $parser = $self->config("delicious.xml_parser");
        my $xml    = undef;

        eval {
                if ($parser eq "libxml") {
                        my $parser = XML::LibXML->new();
                        $xml = $parser->parse_string($res->content());
                }
                
                elsif ($parser eq "xpath") {
                        $xml = XML::XPath->new(xml => $res->content());
                }
                
                else {
                        $xml = XMLin($res->content());                        
                }
        };

        if ($@) {
                $self->logger()->error("failed to parse response with $parser, $@");
                return undef;
        }

        if ($xml eq RESPONSE_ERROR) {
                $self->logger()->error($xml);
                return undef;
        }

        return $xml;
}

sub _authorize {
        my $self = shift;
        my $req  = shift;
        $req->authorization_basic($self->username(), $self->password());
}

sub _ua {
        my $self = shift;
        
        if (ref($self->{'__ua'}) ne "LWP::UserAgent") {
                my $ua = LWP::UserAgent->new();
                $ua->agent(sprintf("%s, %s", __PACKAGE__, $Net::Delicious::VERSION));
                
                $self->{'__ua'} = $ua;
        }
        
        return $self->{'__ua'};
}

sub _getresults {
        my $self = shift;
        my $data = shift;
        my $key  = shift;
        
        if (! exists($data->{$key})) {
                return [];
        }
        
        elsif (ref($data->{ $key }) eq "ARRAY") {
                return $data->{ $key };
        }
        
        else {
                return [ $data->{ $key } ];
        }
}

sub _buildresults {
        my $self    = shift;
        my $type    = shift;
        my $results = shift;
        
        #
        
        $type =~ s/:://g;

        if ($self->config("delicious.use_dev")) {
                # Debugging ... so much hate
                unshift @INC, "./lib";
        }

        my $fclass = join("::", __PACKAGE__, $type);
        eval "require $fclass";
        
        if ($@) {
                $self->logger()->error($@);
                return undef;
        }

        my $count = scalar(@$results);
        
        for (my $i=0; $i < $count; $i++) {
                $results->[$i] = $self->_mk_object_data($type, $results->[$i]);
        }

        if (wantarray) {
                return map { 
                        $fclass->new($_);
                } @$results;
        }
        
        require Net::Delicious::Iterator;
        return Net::Delicious::Iterator->new($fclass,
                                             $results);    
}

sub _mk_object_data {
        my $self    = shift;
        my $type    = shift;
        my $results = shift;

        my $block = lc($type);
        my @props = split("," , $self->config("delicious_properties.$block"));

        my %object_data = map {
                $_ => $results->{$_};
        } @props;

        return \%object_data;
}

sub _use_rsp_parser {
        my $self = shift;

        if ($self->config("delicious.xml_parser") ne "simple") {
                return 0;
        }

        if ($self->config("delicious.force_xml_objects")) {
                return 0;
        }

        return 1;
}

sub _isdone {
        my $self = shift;
        my $res  = shift;

        if (! $res) {
                return 0;
        }
        
        elsif ($res eq RESPONSE_DONE) {
                return 1;
        }
        
        elsif ($res eq RESPONSE_OK) {
                return 1;
        }
        
        elsif ((ref($res) eq "HASH") &&
               (exists($res->{code})) &&
               ($res->{code} eq RESPONSE_DONE)) {
                
                return 1;
        }
        
        else {
                $self->logger()->error("Unknown data structure returned.");
                return 0;
        }
}

# This assumes the default is true (as in not "no")

sub _mkno {
        my $self = shift;
        my $args = shift;
        my $key  = shift;

        if (! exists($args->{$key})) {
                return;
        }

        if ($args->{$key}) {
                delete $args->{$key};
                return;
        }

        $args->{$key} = "no";
        return;
}


return 1;

__END__