File Coverage

blib/lib/Net/SharePoint/Basic.pm
Criterion Covered Total %
statement 179 329 54.4
branch 52 114 45.6
condition 37 121 30.5
subroutine 31 43 72.0
pod 25 25 100.0
total 324 632 51.2


line stmt bran cond sub pod time code
1             package Net::SharePoint::Basic;
2              
3             # Copyright 2018 VMware, Inc.
4             # SPDX-License-Identifier: Artistic-1.0-Perl
5              
6 19     19   1322834 use 5.10.1;
  19         234  
7 19     19   105 use strict;
  19         40  
  19         557  
8 19     19   100 use warnings FATAL => 'all';
  19         37  
  19         768  
9 19     19   11389 use utf8;
  19         281  
  19         110  
10 19     19   8611 use experimental qw(smartmatch);
  19         62140  
  19         106  
11              
12 19     19   1314 use Carp qw(carp croak confess cluck longmess shortmess);
  19         43  
  19         1366  
13 19     19   127 use File::Basename;
  19         41  
  19         1585  
14 19     19   10088 use IO::Scalar;
  19         231794  
  19         878  
15 19     19   11492 use Storable;
  19         57235  
  19         1154  
16              
17 19     19   8571 use Data::UUID;
  19         10826  
  19         1197  
18 19     19   146 use File::Path;
  19         40  
  19         1190  
19 19     19   12922 use JSON::XS;
  19         94109  
  19         1099  
20 19     19   12353 use LWP::UserAgent;
  19         809504  
  19         795  
21 19     19   10212 use POSIX qw(strftime);
  19         121020  
  19         117  
22 19     19   27961 use URI::Escape;
  19         47  
  19         1156  
23              
24 19     19   11789 use Data::Dumper;
  19         130083  
  19         1404  
25              
26 19     19   152 use base 'Exporter';
  19         47  
  19         89399  
27              
28             our @EXPORT = qw(
29             $DEFAULT_SHAREPOINT_TOKEN_FILE $DEFAULT_SHAREPOINT_CONFIG_FILE
30             $DEFAULT_RETRIES $DEFAULT_CHUNK_SIZE $MAX_LOG_SIZE
31             );
32              
33             =head1 NAME
34              
35             Net::SharePoint::Basic - Basic interface to Microsoft SharePoint REST API
36              
37             =head1 VERSION
38              
39             Version 0.11
40              
41             =cut
42              
43             our $VERSION = '0.11';
44              
45             our %PATTERNS = (
46             payload => "grant_type=client_credentials&client_id=%1\$s\@%3\$s&client_secret=%2\$s&resource=%4\$s/%5\$s\@%3\$s&scope=%4\$s/%5\$s\@%3\$s",
47             upload => "https://%1\$s/%2\$s/_api/web/GetFolderByServerRelativeUrl('/%2\$s/Shared Documents/%4\$s')/files/add(overwrite=true,url='%3\$s')",
48             download => "https://%1\$s/%2\$s/_api/web/GetFolderByServerRelativeUrl('/%2\$s/Shared Documents/%4\$s')/files('%3\$s')/\$value",
49             makedir => "https://%1\$s/%2\$s/_api/SP.AppContextSite(\@target)/web/folders/add('Shared Documents/%4\$s')?\@target='https://%1\$s/%2\$s'",
50             delete => "https://%1\$s/%2\$s/_api/web/GetFolderByServerRelativeUrl('/%2\$s/Shared Documents/%3\$s')/recycle",
51             list => {
52             files => "https://%1\$s/%2\$s/_api/web/GetFolderByServerRelativeUrl('/%2\$s/Shared Documents/%3\$s')/Files",
53             folders => "https://%1\$s/%2\$s/_api/web/GetFolderByServerRelativeUrl('/%2\$s/Shared Documents/%3\$s')/Folders",
54             },
55             chunk => {
56             start => "https://%1\$s/%2\$s/_api/web/GetFileByServerRelativeUrl('/%2\$s/Shared Documents/%4\$s/%3\$s')/startupload(uploadId=guid'%5\$s')",
57             continue => "https://%1\$s/%2\$s/_api/SP.AppContextSite(\@target)/web/GetFileByServerRelativeUrl('/%2\$s/Shared Documents/%4\$s/%3\$s')/continueupload(uploadId=guid'%5\$s', fileOffset='%6\$s')?\@target='https://%1\$s/%2\$s'",
58             finish => "https://%1\$s/%2\$s/_api/SP.AppContextSite(\@target)/web/GetFileByServerRelativeUrl('/%2\$s/Shared Documents/%4\$s/%3\$s')/finishupload(uploadId=guid'%5\$s', fileOffset='%6\$s')?\@target='https://%1\$s/%2\$s'",
59             },
60             move => "https://%1\$s/%2\$s/_api/SP.AppContextSite(\@target)/web/GetFileByServerRelativeUrl('/%2\$s/Shared Documents/%3\$s')/moveto(newurl='/%2\$s/Shared Documents/%4\$s', flags=1)?\@target='https://%1\$s/%2\$s'",
61             copy => "https://%1\$s/%2\$s/_api/SP.AppContextSite(\@target)/web/GetFileByServerRelativeUrl('/%2\$s/Shared Documents/%3\$s')/copyto(strnewurl='/%2\$s/Shared Documents/%4\$s', boverwrite=true)?\@target='https://%1\$s/%2\$s'",
62             );
63             our $DEFAULT_SHAREPOINT_TOKEN_FILE = '/var/run/sharepoint.token';
64             our $DEFAULT_SHAREPOINT_CONFIG_FILE = '/etc/sharepoint.conf';
65              
66             our %DEFAULT_SHAREPOINT_POST_PARAMS = (
67             Accept => 'application/json;odata=verbose',
68             Content_Type => 'application/json;odata=verbose',
69             );
70             our $MAX_LOG_SIZE = 500000;
71             our $DEFAULT_CHUNK_SIZE = 200000000;
72             our $DEFAULT_RETRIES = 3;
73              
74             =head1 SYNOPSIS
75              
76             Net::SharePoint::Basic - Basic interface to Microsoft SharePoint REST API.
77              
78             This module provides a basic interface for managing the Shared Documents catalog in the Microsoft SharePoint site via its REST API. In the current version only the following actions are supported:
79              
80             * generating a connection token
81             * upload file or string
82             * download file content and save it
83             * list contents of folder
84             * create new folder
85             * delete file or folder
86              
87             More actions are expected to be added in the future as well as we plan to increase the versatility of the arguments accepted by this module and the sample implementation of a client, 'sp-client', that comes with it.
88              
89             The interface is object oriented. A few constants are exported.
90              
91             The full testing (and naturally the full usage) of the module requires a working SharePoint site configuration. The structure of the configuration file will be described in this manual as well. The sample configuration file provided in this distribution will not work against SharePoint and plays the role of a placeholder only.
92              
93             use Net::SharePoint::Basic;
94              
95             my $sp = Net::SharePoint::Basic->new({config_file => 'sharepoint.conf'});
96             # creates Shared Documents/test
97             my $response = $sp->makedir({retries => 1}, '/test');
98             # uploads a string as Shared Documents/test/teststring
99             $sp->upload({}, '/test/teststring', 'abcd');
100             # uploads a file 'testfile' into Shared Documents/test/
101             $sp->upload({type => 'file'}, '/test/', 'testfile');
102             # downloads contents of a file
103             $sp->download({}, '/test/teststring');
104             # downloads contents and saves it to a file
105             $sp->download({save_file => 'testfile'}, '/test/teststring');
106             # lists contents of a folder
107             $sp->list({}, '/test');
108             # deletes the folder
109             $sp->delete({}, '/test');
110             # moves an object
111             $sp->move({}, '/test-file', '/test-moved-file');
112             # copies an object
113             $sp->copy({}, '/test-moved-file', '/test-file');
114              
115             This module was developed based on the MSDN SharePoint REST API at https://msdn.microsoft.com/en-us/library/office/jj860569.aspx .
116              
117             =head1 EXPORT
118              
119             The following constants (all can be overridden through either configuration file or constructor options) are exported:
120              
121             =over
122              
123             =item $DEFAULT_SHAREPOINT_TOKEN_FILE
124              
125             The default location of the authorization token file (/var/run/sharepoint.token'
126              
127             =item $DEFAULT_SHAREPOINT_CONFIG_FILE
128              
129             The default location of the SharePoint portal configuration (/etc/sharepoint.conf)
130              
131             =item $DEFAULT_RETRIES
132              
133             The default number of retries to perform a REST action (3)
134              
135             =item $DEFAULT_CHUNK_SIZE
136              
137             The default chunk size for uploading large items. (200000000 bytes)
138              
139             =item $MAX_LOG_SIZE
140              
141             The maxium number of logged actions to keep (see C method (500000)
142              
143             =back
144              
145             =head1 CONFIGURATION FILE
146              
147             The module can work with a configuration file of the following format:
148              
149             configuration_option value
150              
151             The lines starting with '#' are ignored. The multiline values can be broken by using a backslash '\' sign. A sample configuration file is provided in the 't/' directory. It will NOT work with a Microsoft SharePoint instance, it is a placeholder file, useful only for internal tests. The default location of the configuration file assumed by the module is /etc/sharepoint.conf . The recognized options in the configuration file are:
152              
153             * module configuration:
154             o token_file - where to store the SharePoint token
155             o max_log_size - maximum log size of $object->{log} (q.v.)
156             o retries - number of retries
157             o chunk_size - size of a chunk for upload in chunks of large files
158             * SharePoint configuration:
159             o sharepoint_client_id - UUID of this client for SharePoint
160             o sharepoint_client_secret - client secret for generating the access token
161             o sharepoint_tenant_id - UUID of the SharePoint tenant
162             o sharepoint_principal_id - UUID of the SharePoint principal
163             o sharepoint_host - the hostname of the SharePoint portal
164             o sharepoint_site - the site to work with in SharePoint
165             o sharepoint_access_url - URL to request the token from
166              
167             =cut
168              
169             =head1 ENVIROMENT VARIABLES
170              
171             The following environment variables control the SharePoint client's behavior, for the purpose of debugging output:
172              
173             * NET_SHAREPOINT_VERBOSE - enable verbose output
174             * NET_SHAREPOINT_DEBUG - enable debug output
175              
176             =cut
177              
178             =head1 SUBROUTINES/METHODS
179              
180             =head2 verbose ($)
181              
182             Utility function printing some extra messages. Newline is automatically appended.
183             Parameters: the message to print (if a verbosity setting is on).
184             Returns: void
185              
186             =cut
187              
188             sub verbose ($) {
189              
190 4     4 1 4109 my $message = shift;
191 4         18 binmode STDERR, ':utf8';
192 4 100 100     104 print STDERR "$message\n" if $ENV{NET_SHAREPOINT_VERBOSE} || $ENV{NET_SHAREPOINT_DEBUG};
193             }
194              
195             =head2 debug ($)
196              
197             Utility function printing some debug messages. Newline is automatically appended.
198             Parameters: the message to print (if a verbosity setting is on).
199             Returns: void
200              
201             =cut
202              
203             sub debug ($) {
204              
205 10     10 1 4571 my $message = shift;
206 10 100       69 print STDERR "$message\n" if $ENV{NET_SHAREPOINT_DEBUG};
207             }
208              
209             =head2 timedebug ($)
210              
211             Utility function printing some debug messages with timestamp prepended. Newline is automatically appended.
212             Parameters: the message to print (if a verbosity setting is on).
213             Returns: void
214              
215             =cut
216              
217             sub timedebug ($) {
218              
219 1     1 1 1449 my $message = shift;
220 1 50       65 (print STDERR localtime(time) . " $message\n") if $ENV{NET_SHAREPOINT_DEBUG};
221             }
222              
223             =head2 version (;$)
224              
225             Utility function returning the version of the package
226             Parameters: Do not exit after printing version (optional)
227             Returns: never.
228              
229             =cut
230              
231             sub version (;$) {
232              
233 1     1 1 1516 print $VERSION, "\n";
234 1 50       10 exit 0 unless shift;
235             }
236              
237             =head2 read_file ($)
238              
239             Utility function that reads file into a string or dies if the file is not available.
240             Parameters: the file to read
241             Returns: the contents of the file as a string
242              
243             =cut
244              
245             sub read_file ($) {
246              
247 2     2 1 1665 my $file = shift;
248              
249 2         8 local $/ = undef;
250 2         10 debug "Reading $file";
251 2 100       105 open(my $mail_fh, '<', $file) or die "Can't read file $file: $!";
252 1         34 my $content = <$mail_fh>;
253 1         10 close $mail_fh;
254              
255 1         9 $content;
256             }
257              
258             =head2 write_file ($$;$)
259              
260             Utility function thgat writes the given string into a file, creating the necessary directories above it if necessary. Dies if the write is unsuccessful.
261             Parameters: the contents
262             the file to write
263             [optional] force binary mode in writing
264             Returns: the file path that was written.
265              
266             =cut
267              
268             sub write_file ($$;$) {
269              
270 1     1 1 1143 my $content = shift;
271 1         3 my $file = shift;
272 1   50     7 my $binary = shift || 0;
273              
274 1         30 my $dir = dirname($file);
275 1 50       168 mkpath($dir) unless -d $dir;
276 1 50   1   38 open my $fh, $binary ? '>:raw' : '>:encoding(utf8)', $file or die "Couldn't open file $file for writing: $!";
  1 50       8  
  1         2  
  1         6  
277 1 50       11496 binmode $fh if $binary;
278 1         9 print $fh $content;
279 1         50 close $fh;
280 1         8 verbose "Wrote file $file";
281 1         5 $file;
282             }
283              
284             =head2 read_config ($)
285              
286             Utility function that reads the sharepoint configuration file of whitespace separated values. See the detailed description of C
287             Parameters: the configuration file
288             Returns: Hash of configuration parameters and their values.
289              
290             =cut
291              
292             sub read_config ($) {
293              
294 5     5 1 99 my $config_file = shift;
295 5         13 my $config = {};
296              
297 5 50       207 open(my $conf_fh, '<', $config_file) or return 0;
298 5         128 while (<$conf_fh>) {
299 40 100       97 next if /^\#/;
300 38 100       161 next unless /\S/;
301 36         72 s/^\s+//;
302 36         133 s/\s+$//;
303 36         130 my ($key, $value) = split(/\s+/, $_, 2);
304 36 100       85 unless ($value) {
305 2         4 $config->{$key} = undef;
306 2         7 next;
307             }
308 34         53 chomp $value;
309 34         132 while ($value =~ /\\$/) {
310 6         12 my $extra_value = <$conf_fh>;
311 6 50       16 next if $extra_value =~ /^\#/;
312 6 50       18 next unless $extra_value =~ /\S/;
313 6         18 $extra_value =~ s/^\s+//;
314 6         20 $extra_value =~ s/\s+$//;
315 6         12 chop $value;
316 6         18 $value =~ s/\s+$//;
317 6         19 $value .= " $extra_value";
318             }
319 34         163 $config->{$key} = $value;
320             }
321 5         61 close $conf_fh;
322 5         35 return $config;
323             }
324              
325             =head2 new ($;$)
326              
327             The constructor. Creates the Net::SharePoint::Basic object
328             Parameters: optional hash with keys corresponding to the configuration file fields. Will override even the given a specific configuration file.
329             Returns: Net::SharePoint::Basic object.
330              
331             =cut
332              
333             sub new ($;$) {
334              
335 8     8 1 2868 my $class = shift;
336 8   100     34 my $opts = shift || {};
337              
338 8         18 my $self = {};
339 8 100       29 if ($opts->{config_file}) {
340 4         15 $self->{config} = read_config($opts->{config_file});
341             }
342             else {
343 4 50       89 $self->{config} = read_config($DEFAULT_SHAREPOINT_CONFIG_FILE)
344             if -f $DEFAULT_SHAREPOINT_CONFIG_FILE;
345             }
346 8   100     47 $self->{config} ||= {};
347 8         17 for my $key (keys %{$opts}) {
  8         36  
348 9 100       27 next if $key eq 'config_file';
349 5 50       14 next unless defined $opts->{$key};
350 5         23 debug "Setting $key to $opts->{$key}";
351 5         16 $self->{config}{$key} = $opts->{$key};
352             }
353 8         31 $self->{token} = { ts => 0 };
354 8         19 $self->{next_guid} = 1;
355 8   66     41 $self->{config}{token_file} ||= $DEFAULT_SHAREPOINT_TOKEN_FILE;
356 8   66     48 $self->{config}{max_log_size} ||= $MAX_LOG_SIZE;
357 8   66     38 $self->{config}{chunk_size} ||= $DEFAULT_CHUNK_SIZE;
358 8   33     41 $self->{config}{retries} ||= $DEFAULT_RETRIES;
359 8   33     79 $ENV{NET_SHAREPOINT_DEBUG} ||= $opts->{debug};
360 8   33     56 $ENV{NET_SHAREPOINT_VERBOSE} ||= $opts->{verbose};
361 8         25 bless $self, $class;
362 8         41 $self;
363             }
364              
365             =head2 dump_config ($)
366              
367             Dumps the supplied config and exits
368             Arguments: the options hash
369             Returns: void
370             Caveat: will dump the credentials as well. Use with caution.
371              
372             =cut
373              
374             sub dump_config ($) {
375              
376 11     11 1 15634 my $self = shift;
377              
378 11         21 for my $opt (keys %{$self->{config}}) {
  11         51  
379 121   50     1810 printf "%-25s %s\n", $opt, $self->{config}{$opt} || 'undef';
380             }
381             }
382              
383             =head2 validate_config ($;@)
384              
385             Validates the configuration for the SharePoint client. Checks basic syntactic requirements for the key configuration parameters expected to make connection with the REST API.
386             Parameters: [optional] a list of extra options that would require to be defined by the application
387             Returns: Error string if there was an error, empty string otherwise.
388              
389             =cut
390              
391             sub validate_config ($;@) {
392              
393 2     2 1 1771 my $self = shift;
394 2         6 my @extra_opts = @_;
395              
396 2         4 my $opts = $self->{config};
397 2         4 my $validated = '';
398              
399 2 50       6 return "Config was not found\n" unless $opts;
400 2         4 for my $id (qw(sharepoint_client_id sharepoint_tenant_id sharepoint_principal_id)) {
401 6 100       28 if (! $opts->{$id}) {
    50          
402 3         8 $validated .= "Missing $id in configuration\n";
403             }
404             elsif ($opts->{$id} !~ /^\w{8}-\w{4}-\w{4}-\w{4}-\w{12}$/) {
405 0         0 $validated .= "Badly formatted $id $opts->{$id} in configuration\n";
406             }
407             }
408             $validated .= "SharePoint secret must be 44-char string ending with =\n"
409             unless $opts->{sharepoint_client_secret}
410 2 100 66     14 && $opts->{sharepoint_client_secret} =~ /^(\S){43}\=/;
411             $validated .= "SharePoint access URL must start with https://\n"
412             unless $opts->{sharepoint_access_url}
413 2 100 66     11 && $opts->{sharepoint_access_url} =~ m|^https://|;
414             $validated .= "SharePoint host must be defined\n"
415 2 100       5 unless $opts->{sharepoint_host};
416             $validated .= "SharePoint Site must include 'sites' in the URL\n"
417             unless $opts->{sharepoint_site}
418 2 100 66     11 && $opts->{sharepoint_site} =~ m|^sites/.+|;
419 2         5 for my $extra_opt (@extra_opts) {
420             $validated .= "Option $extra_opt must be set according to the app"
421 0 0       0 unless $opts->{$extra_opt};
422             }
423 2         9 return $validated;
424             }
425              
426             =head2 log_it ($$;$)
427              
428             Log a message into the object. The messages are stored in the $object->{log} array reference. If the amount of messages exceeds $MAX_LOG_SIZE or $self->{config}{max_log_size} (if set), the older messages are shifted out of the log.
429             Parameters: the message
430             [optional] the severity (default - 'info')
431             Returns: the shifted discarded message if any
432              
433             =cut
434              
435             sub log_it ($$;$) {
436              
437 3     3 1 4865 my $self = shift;
438 3         6 my $message = shift;
439 3   50     9 my $severity = shift || 'info';
440              
441 3   100     16 $self->{log} ||= [];
442 3         4 push(@{$self->{log}}, [
  3         11  
443             time, $severity, $message
444             ]);
445 3 100       6 shift @{$self->{log}} if @{$self->{log}} > $self->{config}{max_log_size};
  1         4  
  3         12  
446             }
447              
448             =head2 create_payload ($)
449              
450             Creates an authorization request payload
451             Arguments: the options hashref containing the sharepoint data
452             Returns: the escaped payload
453              
454             =cut
455              
456             sub create_payload ($) {
457              
458 1     1 1 8 my $self = shift;
459              
460             my $payload = sprintf(
461             $PATTERNS{payload},
462             $self->{config}{sharepoint_client_id},
463             $self->{config}{sharepoint_client_secret},
464             $self->{config}{sharepoint_tenant_id},
465             $self->{config}{sharepoint_principal_id},
466             $self->{config}{sharepoint_host}
467 1         17 );
468 1         6 uri_escape($payload, "^A-Za-z0-9\-\._~\&\=");
469             }
470              
471             =head2 update_token ($$)
472              
473             Updates the SharePoint Token
474             Arguments: the options hashref containing sharepoint data
475             Returns: 1 upon success
476             undef upon failure
477              
478             =cut
479              
480             sub update_token ($) {
481              
482 0     0 1 0 my $self = shift;
483              
484 0   0     0 $self->{ua} ||= LWP::UserAgent->new();
485 0   0     0 $self->{token}{payload} ||= $self->create_payload();
486 0         0 verbose "Getting a fresh token";
487             my $token_response = $self->{ua}->post(
488             $self->{config}{sharepoint_access_url},
489             Content_Type => 'application/x-www-form-urlencoded',
490             Content => $self->{token}{payload}
491 0         0 );
492 0 0       0 unless ($token_response->is_success) {
493 0         0 $self->log_it(
494             "Updating token failed: " .
495             Dumper decode_json($token_response->content),
496             'error'
497             );
498 0         0 return undef;
499             }
500 0         0 my $json = decode_json($token_response->content);
501 0         0 $self->{token}{ts} = $json->{expires_on};
502 0         0 $self->{token}{token} = $json->{access_token};
503 0         0 $self->{token}{type} = $json->{token_type};
504 0         0 1;
505             }
506              
507              
508             =head2 init_token ($)
509              
510             Initializes a SharePoint token ( by calling ->update_token() ) and stores it in the $self->{config}{token_file}
511             Parameters: none
512             Returns: 1 if success
513             undef if failure
514              
515             =cut
516              
517             sub init_token ($) {
518              
519 0     0 1 0 my $self = shift;
520              
521 0         0 my $token_file = $self->{config}{token_file};
522 0 0       0 if (-f $token_file) {
523 0         0 $self->log_it("Trying to use token file $token_file", 'debug');
524 0         0 $self->{token} = retrieve $token_file;
525             return undef if (
526 0 0 0     0 time > $self->{token}{ts} - 1200
527             ) and ! $self->update_token();
528             }
529             else {
530 0 0       0 return undef unless $self->update_token();
531             }
532 0         0 store $self->{token}, $token_file;
533             $DEFAULT_SHAREPOINT_POST_PARAMS{Authorization} =
534 0         0 "$self->{token}{type} $self->{token}{token}";
535 0         0 1;
536             }
537              
538             =head2 create_sharepoint_url ($$;@)
539              
540             Creates the SharePoint URL to operate against, filling the relevant pattern with the actual data.
541             Parameters: the options hashref of the following keys
542             pattern - the ready pattern (usually used in chunk upload) - or
543             type - the type of the pattern
544             (upload, download, list, makedir, delete) and
545             subtype (for list only) - "files" or "folders"
546             folder - the sharepoint folder/path to operate upon
547             object - the sharepoint object to operate upon
548             See %PATTERNS in the source code for more details on the URL construction.
549             Returns: the filled URL string
550              
551             =cut
552              
553             sub create_sharepoint_url ($$;@) {
554              
555 39     39 1 20845 my $self = shift;
556 39         70 my $opts = shift;
557              
558 39 100 33     237 return undef unless $opts && ($opts->{pattern} || $opts->{type});
      66        
559 38   100     111 my $folder = $opts->{folder} || '';
560 38 50       84 $folder = '.' if $folder eq '/';
561 38   100     99 my $object = $opts->{object} || '';
562 38         69 my @extra_args = @_;
563 38         57 my $pattern = $opts->{pattern};
564 38 50       80 if (! $pattern) {
565 38 100       113 if (! $PATTERNS{$opts->{type}}) {
566 1         121 warn "Unknown type $opts->{type} of URL requested";
567 1         11 return undef;
568             }
569 37 100       99 if (ref $PATTERNS{$opts->{type}}) {
570 21 100 66     95 if (! $opts->{subtype} || ! $PATTERNS{$opts->{type}}->{$opts->{subtype}}) {
571 1         89 warn "Pattern type $opts->{type} requires a valid subtype";
572 1         11 return undef;
573             }
574 20         44 $pattern = $PATTERNS{$opts->{type}}->{$opts->{subtype}};
575             }
576             else {
577 16         29 $pattern = $PATTERNS{$opts->{type}};
578             }
579             }
580             $pattern =~
581 0         0 s|Shared Documents|"Shared Documents/$self->{config}{base_subfolder}"|ge
582 36 50       103 if $self->{config}{base_subfolder};
583             my $url = sprintf(
584             $pattern,
585             $self->{config}{sharepoint_host},
586             $self->{config}{sharepoint_site},
587 36   33     226 $object // (),
588             $folder, @extra_args,
589             );
590              
591 36         100 $url;
592             }
593              
594             =head2 try ($$$%)
595              
596             Tries to execute a SharePoint REST API call
597             Parameters: the options hashref with the following parameters:
598             action - mandatory, one of upload, download, list, makedir, delete,
599             chunk_upload_start, chunk_upload_continue, chunk_upload_finish
600             retries - optional, number of retries defaults to $DEFAULT_RETRIES
601             the url to try
602             extra http header options hash:
603             Accept => 'application/json;odata=verbose',
604             Content_Type => 'application/json;odata=verbose',
605             Authorization => 'Bearer TOKEN_STRING',
606             and for upload also:
607             Content_Length => length($data),
608             Content => $data,
609             Returns: the HTTP response if the API call was successful
610             undef otherwise
611              
612             =cut
613              
614             sub try ($$$%) {
615              
616 0     0 1 0 my $self = shift;
617 0         0 my $opts = shift;
618 0         0 my $url = shift;
619 0         0 my %http_opts = @_;
620              
621 0   0     0 $self->{ua} ||= LWP::UserAgent->new();
622 0   0     0 $opts->{retries} ||= $DEFAULT_RETRIES;
623              
624 0 0 0     0 my $method = $opts->{action} eq 'download' || $opts->{action} eq 'list' ?
625             'get' : 'post';
626 0         0 while ($opts->{retries}) {
627 0 0       0 unless ($self->init_token()) {
628 0         0 $self->log_it("Failed to initialize token", "error");
629 0         0 die "Failed to initialize token: $self->{log}[-2][2]";
630             }
631 0         0 debug "Trying url $url";
632 0   0     0 $http_opts{Authorization} ||= $DEFAULT_SHAREPOINT_POST_PARAMS{Authorization};
633 0         0 my $response = $self->{ua}->$method($url, %http_opts);
634 0 0       0 if ($response->is_success) {
635 0         0 $self->log_it("Item $opts->{action} successful");
636 0         0 return $response;
637             }
638 0         0 $opts->{retries}--;
639 0         0 $self->log_it(
640             "Couldn't $opts->{action} item ($opts->{retries} attempts remaining).\n" . $response->content, 'error'
641             );
642             }
643 0         0 return undef;
644             }
645              
646             =head2 get_chunk_pattern ($$)
647              
648             Selects correct pattern for uploading a chunk, depending on the stage of the upload.
649             Parameters: the chunk's number (0..N)
650             the number of total chunks (N)
651             Returns: the start upload pattern for the first chunk
652             the finish upload pattern for the last chunk
653             the continue upload pattern for the rest
654             Caveat: uses when() feature.
655              
656             =cut
657              
658             sub get_chunk_pattern ($$) {
659              
660 0     0 1 0 my $chunk_n = shift;
661 0         0 my $total_chunks = shift;
662              
663 0         0 my $pattern;
664 0         0 for ($chunk_n) {
665 0         0 when (0) { $pattern = 'start'; }
  0         0  
666 0         0 when ($total_chunks) { $pattern = 'finish'; }
  0         0  
667 0         0 default { $pattern = 'continue'; }
  0         0  
668             }
669              
670 0         0 $PATTERNS{chunk}->{$pattern};
671             }
672              
673             =head2 upload_in_chunks ($$$$$;$)
674              
675             Uploads a string in chunks, useful for uploading large volumes of data above the default SharePoint limit, usually 250000000 bytes.
676             Parameters: the options hash with the number of retries as the only used key.
677             the string scalar of data to upload
678             the SharePoint object basename to create
679             the SharePoint path to put the object in
680             (optional) the chunk size. Defaults to either configured chunk size or to $DEFAULT_CHUNK_SIZE.
681             Returns: the cumulative C response. If any of the tries fails aborts and returns 0.
682             Caveat: the object must already be exist in SharePoint, even with zero size. See C.
683              
684             =cut
685              
686             sub upload_in_chunks ($$$$$;$) {
687              
688 0     0 1 0 my $self = shift;
689 0         0 my $opts = shift;
690 0         0 my $item = shift;
691 0         0 my $object = shift;
692 0         0 my $folder = shift;
693 0   0     0 my $chunk = shift || $self->{config}{chunk_size} || $DEFAULT_CHUNK_SIZE;
694              
695 0 0       0 my $size = length(ref $item ? $$item : $item);
696 0         0 my $total_chunks = int($size/$chunk);
697              
698 0         0 my $ug = Data::UUID->new();
699 0         0 my $guid = $ug->to_string($ug->create());
700 0         0 my $r;
701 0         0 for my $chunk_n (0..$total_chunks) {
702 0 0       0 my $data = substr(
703             (ref $item ? $$item : $item),
704             $chunk_n*$chunk, $chunk
705             );
706 0         0 my $pattern = get_chunk_pattern($chunk_n, $total_chunks);
707 0 0       0 my $upload_url = $self->create_sharepoint_url({
708             pattern => $pattern,
709             object => $object,
710             folder => $folder,
711             }, $guid, $chunk_n ? $chunk_n * $chunk : ());
712 0         0 $self->log_it("Chunk upload ($pattern) to $upload_url", 'debug');
713             $r = $self->try(
714             {
715             action => "chunk_upload_$pattern",
716             retries => $opts->{retries} || $self->{config}{retries},
717             },
718 0   0     0 $upload_url, (
719             %DEFAULT_SHAREPOINT_POST_PARAMS,
720             Content_Length => length($data),
721             Content => $data,
722             )
723             );
724 0 0       0 return 0 unless $r;
725             }
726 0         0 $r;
727             }
728              
729             =head2 upload ($$$$)
730              
731             Uploads a file or a string to SharePoint. Initiates the upload in chunks if necessary, generating the zero sized file for it before calling C
732             Parameters: the options hash with
733             type - "file" means we're uploading a file
734             retries - the number of retries
735             the SharePoint target. If it's a path ending with '/', basename of the file is being appended.
736             the item - file or data string
737             Returns: the HTTP response object if successful.
738             0 when the upload fails or
739             when the file is unreadable or
740             when the upload is of a string and no target filename is specified.
741              
742             =cut
743              
744             sub upload ($$$$) {
745              
746 0     0 1 0 my $self = shift;
747 0         0 my $opts = shift;
748 0         0 my $target = shift;
749 0         0 my $item = shift;
750              
751 0         0 my ($object, $folder) = fileparse($target);
752 0   0     0 $opts->{type} ||= '';
753 0 0 0     0 if (! $object && $opts->{type} ne 'file') {
754 0         0 warn "Cannot upload without target filename";
755 0         0 return 0;
756             }
757 0   0     0 $object ||= basename($item);
758 0 0       0 if ($opts->{type} eq 'file') {
759 0 0       0 if (! -f $item) {
760 0         0 warn "File $item does not exist, ignoring";
761 0         0 return 0;
762             }
763 0         0 $item = read_file($item);
764             }
765 0         0 my $upload_url = $self->create_sharepoint_url({
766             type => 'upload',
767             object => $object,
768             folder => $folder,
769             });
770 0 0       0 if (length(ref $item ? $$item : $item) > $self->{config}{chunk_size}) {
    0          
771             my $r = $self->try(
772             {
773             action => 'upload',
774             retries => $opts->{retries} || $self->{config}{retries},
775             },
776 0   0     0 $upload_url, (
777             %DEFAULT_SHAREPOINT_POST_PARAMS,
778             Content_Length => 0,
779             Content => '',
780             )
781             );
782 0 0       0 return 0 unless $r;
783 0         0 $self->upload_in_chunks($opts, $item, $object, $folder);
784             }
785             else {
786 0         0 $self->log_it("Upload to $upload_url", 'debug');
787             return $self->try(
788             {
789             action => 'upload',
790             retries => $opts->{retries} || $self->{config}{retries},
791             },
792 0   0     0 $upload_url, (
793             %DEFAULT_SHAREPOINT_POST_PARAMS,
794             Content_Length => length($item),
795             Content => ref $item ? $$item : $item,
796             )
797             ) || 0;
798             }
799             }
800              
801             =head2 download ($$$;$)
802              
803             Downloads an object from SharePoint, optionally saving it into a file.
804             Parameters: the options hashref
805             save_file - the local path to save (or see target below)
806             retries - the number of retries
807             the SharePoint path to download
808             (optional) the target local path to save. If target (or save_file value) is a directory, use basename of the SharePoint path for filename. The directory tree is created via C.
809             Returns: 0 if download failed
810             path contents as a string scalar if string is requested
811             saved path if a file save is requested
812              
813             =cut
814              
815             sub download ($$$;$) {
816              
817 0     0 1 0 my $self = shift;
818 0         0 my $opts = shift;
819 0         0 my $item = shift;
820 0   0     0 my $target = shift || '';
821              
822 0 0       0 $opts->{save_file} = $target if $target;
823 0         0 my $download_url = $self->create_sharepoint_url({
824             type => 'download',
825             object => basename($item),
826             folder => dirname($item),
827             });
828 0         0 $self->log_it("Download from $download_url", 'debug');
829             my $response = $self->try(
830             {
831             action => 'download',
832             retries => $opts->{retries} || $self->{config}{retries},
833             },
834 0   0     0 $download_url, %DEFAULT_SHAREPOINT_POST_PARAMS,
835             );
836 0 0       0 return 0 if ! defined $response;
837 0 0       0 return $response->content unless $opts->{save_file};
838 0 0       0 $opts->{save_file} .= "/" . basename($item) if -d $opts->{save_file};
839 0         0 write_file($response->content, $opts->{save_file}, 1);
840 0         0 return $opts->{save_file};
841             }
842              
843             =head2 list ($$;$)
844              
845             Gets the contents of a given SharePoint folder. Note that you cannot list a file, you need to provide its path (event if it is root), and filter the results. Two API calls are issued, one to list files in the folders, one to list subfolders.
846             Parameters: the options hashref
847             path - the path to list
848             retries - the number of retries
849             path - (optional) - alternative way to specify path to list
850             Returns: a decoded JSON structure of the REST API response or
851             an empty list in case of failure.
852             For the interpretation of the results for an actual listing, see the print_list_reports subroutine in the example SharePoint client provided in the package.
853              
854             =cut
855              
856             sub list ($$;$) {
857              
858 0     0 1 0 my $self = shift;
859 0         0 my $opts = shift;
860 0   0     0 my $path = shift || $opts->{path};
861              
862 0         0 my @results = ();
863 0         0 for my $list_type (qw(files folders)) {
864             my $list_url = $self->create_sharepoint_url({
865 0         0 pattern => $PATTERNS{list}->{$list_type},
866             object => $path,
867             });
868 0         0 $self->log_it("Listing $list_url", 'debug');
869             my $list_response = $self->try(
870             {
871             action => 'list',
872             retries => $opts->{retries} || $self->{config}{retries},
873             },
874 0   0     0 $list_url, %DEFAULT_SHAREPOINT_POST_PARAMS,
875             );
876 0 0       0 next unless defined $list_response;
877 0         0 my $json = decode_json($list_response->content);
878 0         0 push(@results, @{$json->{d}{results}});
  0         0  
879             }
880 0         0 return \@results;
881             }
882              
883             =head2 makedir ($$$)
884              
885             Creates a new folder in SharePoint.
886             Parameters: the options hashref
887             retries - the number of retries
888             the folder to create
889             Returns: the REST API response as returned by C
890              
891             =cut
892              
893             sub makedir ($$$) {
894              
895 0     0 1 0 my $self = shift;
896 0         0 my $opts = shift;
897 0         0 my $folder = shift;
898              
899 0         0 my $mkdir_url = $self->create_sharepoint_url({
900             type => 'makedir',
901             folder => $folder,
902             });
903 0         0 $self->log_it("Creating folder $mkdir_url", 'debug');
904             $self->try(
905             {
906             action => 'makedir',
907             retries => $opts->{retries} || $self->{config}{retries},
908             },
909 0   0     0 $mkdir_url, %DEFAULT_SHAREPOINT_POST_PARAMS,
910             );
911             }
912              
913             =head2 delete ($$$)
914              
915             Deletes an item in SharePoint.
916             Parameters: the options hashref
917             retries - the number of retries
918             the item to delete
919             Returns: the REST API response as returned by C
920             Note: any item will be deleted (put to Recycle Bin), even a non-empty folder. If a non-existent item is requested for deletion, the deletion will still return success, but the resulting response will have field $json->{d}{Recycle} set to "00000000-0000-0000-0000-000000000000"
921              
922             =cut
923              
924             sub delete ($$$) {
925              
926 0     0 1 0 my $self = shift;
927 0         0 my $opts = shift;
928 0         0 my $item = shift;
929              
930 0         0 my $delete_url = $self->create_sharepoint_url({
931             type => 'delete',
932             object => $item,
933             });
934 0         0 $self->log_it("Deleting item $delete_url", 'debug');
935             $self->try(
936             {
937             action => 'delete',
938             retries => $opts->{retries} || $self->{config}{retries},
939             },
940 0   0     0 $delete_url, %DEFAULT_SHAREPOINT_POST_PARAMS,
941             );
942             }
943              
944             =head2 move ($$$$)
945              
946             Moves an item in SharePoint
947             Parameters: the options hashref
948             retries - the number of retries
949             the item to move
950             the destination to move to
951             Returns: the REST API response as returned by C
952              
953             =cut
954              
955             sub move ($$$$) {
956              
957 0     0 1 0 my $self = shift;
958 0         0 my $opts = shift;
959 0         0 my $item = shift;
960 0         0 my $target = shift;
961              
962 0         0 my $move_url = $self->create_sharepoint_url({
963             type => 'move',
964             object => $item,
965             folder => $target,
966             });
967 0         0 $self->log_it("Moving item $item to $target", 'debug');
968             $self->try(
969             {
970             action => 'move',
971             retries => $opts->{retries} || $self->{config}{retries},
972             },
973 0   0     0 $move_url, %DEFAULT_SHAREPOINT_POST_PARAMS,
974             );
975             }
976              
977             =head2 copy ($$$$)
978              
979             Copies an item in SharePoint
980             Parameters: the options hashref
981             retries - the number of retries
982             the item to copy
983             the destination to copy to
984             Returns: the REST API response as returned by C
985              
986             =cut
987              
988             sub copy ($$$$) {
989              
990 0     0 1 0 my $self = shift;
991 0         0 my $opts = shift;
992 0         0 my $item = shift;
993 0         0 my $target = shift;
994              
995 0         0 my $copy_url = $self->create_sharepoint_url({
996             type => 'copy',
997             object => $item,
998             folder => $target,
999             });
1000 0         0 $self->log_it("Copying item $item to $target", 'debug');
1001             $self->try(
1002             {
1003             action => 'copy',
1004             retries => $opts->{retries} || $self->{config}{retries},
1005             },
1006 0   0     0 $copy_url, %DEFAULT_SHAREPOINT_POST_PARAMS,
1007             );
1008             }
1009              
1010             =head1 AUTHOR
1011              
1012             Roman Parparov, C<< >>
1013              
1014             =head1 BUGS
1015              
1016             Please report any bugs or feature requests to C, or through the web interface at L. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
1017              
1018              
1019             =head1 SUPPORT
1020              
1021             You can find documentation for this module with the perldoc command.
1022              
1023             perldoc Net::SharePoint::Basic
1024              
1025              
1026             You can also look for information at:
1027              
1028             =over 4
1029              
1030             =item * RT: CPAN's request tracker (report bugs here)
1031              
1032             L
1033              
1034             =item * AnnoCPAN: Annotated CPAN documentation
1035              
1036             L
1037              
1038             =item * CPAN Ratings
1039              
1040             L
1041              
1042             =item * Search CPAN
1043              
1044             L
1045              
1046             =item * Repository
1047              
1048             L
1049              
1050             =item * MSDN SharePoint REST API
1051              
1052             L
1053              
1054             =back
1055              
1056             =head1 ACKNOWLEDGEMENTS
1057              
1058             Special thanks to Andre Abramenko L for helping me figure out the REST API when I initially implemented it at VMware.
1059              
1060             =head1 LICENSE AND COPYRIGHT
1061              
1062             Copyright 2018 VMware.com
1063              
1064             This program is free software; you can redistribute it and/or modify it
1065             under the terms of either: the GNU General Public License as published
1066             by the Free Software Foundation; or the Artistic License.
1067              
1068             See L for more information.
1069              
1070              
1071             =cut
1072              
1073             1; # End of Net::SharePoint::Basic