view release on metacpan or  search on metacpan

bin/picasa  view on Meta::CPAN

#!/usr/bin/perl
use strict;
use warnings;

# PODNAME: picasa
# ABSTRACT: master command for the Picasa Web scripts

use FindBin;
use Pod::Usage;

sub next_command() {
    return unless @ARGV;
    for my $i ( 0 .. $#ARGV) {
        last if $ARGV[$i] eq '--';
        if ($ARGV[$i] !~ /^-/) {
            return splice @ARGV, $i, 1;
        }
    }
}

our $command;
sub dispatch(&) {
    my ($code) = @_;
    
    return sub {
        local @ARGV = @ARGV;
        local $command = next_command;
        $code->();
    };
}

sub run(@) {
    my ($command, @args) = @_;
    return sub {
        exec("$FindBin::Bin/picasa-".$command, @args, @ARGV);
    };
}

sub just($) {
    my $code = shift;
    $code->();
}

sub on($$) {
    return unless $command;
    my ($test_command, $run) = @_;
    if (ref $test_command eq 'ARRAY') {
        for my $test_command (@{ $test_command }) {
            just $run if $command eq $test_command;
        }
    }

    else {
        just $run if $command eq $test_command;
    }
}

just dispatch {
    on [ 'get', 'fetch' ] => dispatch {
        on [ 'photo', 'photos' ] => run 'get', '--kind', 'photo';
        on [ 'album', 'albums' ] => run 'get', '--kind', 'album';
        just run 'get', '--kind', 'album';
    };

    on [ qw( list ls ) ] => dispatch {
        on [ 'photo', 'photos' ]     => run 'list', '--kind', 'photo';
        on [ 'album', 'albums' ]     => run 'list', '--kind', 'album';
        on [ 'tag', 'tags' ]         => run 'list', '--kind', 'tag';
        on [ 'comment', 'comments' ] => run 'list', '--kind', 'comment';
        just run 'list', '--kind', 'album';
    };

    on [ qw( help ) ] => dispatch {
        on [ 'get', 'fetch' ] => run 'get', '--help';
        on [ 'list', 'ls' ]   => run 'list', '--help';
        pod2usage(1);
    };
};

__END__

=pod

=head1 NAME

picasa - master command for the Picasa Web scripts