bin/flickrer at master · lhl/bin · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
#!/sw/bin/perl -w

###
# flickrer
#
# script to be run on cron to automatically u/l to Flickr
#
# @author     Leonard Lin <lhl@usc.edu>
# @version    v0.1
# @date       November 17, 2004
# @notes
#             requires:
#               File::Basename
#               File::Copy
#               LWP::UserAgent
#               Flickr::Upload


### Variables ###
my $email    = 'email';
my $password = 'password';

# Pre-Processing command
my $prep     = 'sips -Z 1200';

# File Locations
my $dropbox  = '/dropbox/path';
my $sentbox  = '/sentbox/path';


### Shouldn't need to edit below this line ###
use strict;

# Check to see if there's a copy already running (not itself)
open(CMD, 'ps auxw |');
while(<CMD>) {
  if(/flickrer/ && /perl -w/) {
    my @x = split;

    # Already Running
    if($x[1] != $$) {
      die "flickrer appears to be running already/still\n";
    }
  }
}

## Dropbox Processing
use File::Basename;
use File::Copy;
use LWP::UserAgent;
use Flickr::Upload qw(upload);

my $ua = LWP::UserAgent->new;
my $photo;

# Read files
opendir(DIR, $dropbox) or die "Can't opendir $dropbox: $!";
my @photos = grep { -f }             # plain file
            map  { "$dropbox/$_" }  # full path
            grep { !/^\./ }         # no dot files
            readdir(DIR);

foreach $photo (@photos) {
  # move to .filename
  (my $b, my $d) = fileparse($photo);
  rename($photo, "$d.$b") or
    warn "Couldn't rename $photo to $d.$b: $!\n";
  $photo = "$d.$b";

  # Pre-process
  if($prep) {
    system("$prep $photo");
  }

  # Upload
  upload(
    $ua,
    'photo' => $photo,
    'email' => $email,
    'password' => $password,

    # Everyone can view
    'is_public' => 1,
    'is_friend' => 1,
    'is_family' => 1,

    # OPTIONAL: 'tags' 'title' , 'description'
  ) or die "Failed to upload $photo";

  move($photo, "$sentbox/$b")
    or die "move failed: $!";
}

### end of script


### Flickr API test code
# use Flickr::API;
# use XML::Parser::Lite::Tree::XPath;
#
# my $api = new Flickr::API({'key' => 'd91b35b9a5f75a161fd60b6361b41f34'});
# my $xp  = new XML::Parser::Lite::Tree::XPath();
# my $rsp = $api->execute_method('flickr.contacts.getList',
#                                { 'email' => $email,
#                                  'password' => $password,
#                                });
# if ($rsp->{success}) {
#   $xp->set_tree($rsp->{tree});
#
#   my @nodes = $xp->select_nodes('/*');
#   ## DEBUG
#   use Data::Dumper;
#   print $rsp->{_content};
#   print Dumper(@nodes);
# }