4 |
use strict; |
use strict; |
5 |
use warnings; |
use warnings; |
6 |
|
|
7 |
our $VERSION = '0.04_1'; |
our $VERSION = '0.04_2'; |
8 |
|
|
9 |
=head1 NAME |
=head1 NAME |
10 |
|
|
1659 |
my $reqbody = 'url=' . uri_escape($url) . '&label=' . uri_escape($label); |
my $reqbody = 'url=' . uri_escape($url) . '&label=' . uri_escape($label); |
1660 |
$reqbody .= '&credit=' . $credit if ($credit > 0); |
$reqbody .= '&credit=' . $credit if ($credit > 0); |
1661 |
|
|
1662 |
$self->shuttle_url( $self->{url} . '/_set_link', |
if ($self->shuttle_url( $self->{url} . '/_set_link', |
1663 |
'application/x-www-form-urlencoded', |
'application/x-www-form-urlencoded', |
1664 |
$reqbody, |
$reqbody, |
1665 |
undef |
undef |
1666 |
) == 200; |
) == 200) { |
1667 |
|
# refresh node info after adding link |
1668 |
|
$self->_set_info; |
1669 |
|
return 1; |
1670 |
|
} |
1671 |
|
} |
1672 |
|
|
1673 |
|
=head2 admins |
1674 |
|
|
1675 |
|
my @admins = @{ $node->admins }; |
1676 |
|
|
1677 |
|
Return array of users with admin rights on node |
1678 |
|
|
1679 |
|
=cut |
1680 |
|
|
1681 |
|
sub admins { |
1682 |
|
my $self = shift; |
1683 |
|
$self->_set_info unless ($self->{name}); |
1684 |
|
return $self->{admins}; |
1685 |
|
} |
1686 |
|
|
1687 |
|
=head2 guests |
1688 |
|
|
1689 |
|
my @guests = @{ $node->guests }; |
1690 |
|
|
1691 |
|
Return array of users with guest rights on node |
1692 |
|
|
1693 |
|
=cut |
1694 |
|
|
1695 |
|
sub guests { |
1696 |
|
my $self = shift; |
1697 |
|
$self->_set_info unless ($self->{name}); |
1698 |
|
return $self->{guests}; |
1699 |
|
} |
1700 |
|
|
1701 |
|
=head2 links |
1702 |
|
|
1703 |
|
my $links = @{ $node->links }; |
1704 |
|
|
1705 |
|
Return array of links for this node |
1706 |
|
|
1707 |
|
=cut |
1708 |
|
|
1709 |
|
sub links { |
1710 |
|
my $self = shift; |
1711 |
|
$self->_set_info unless ($self->{name}); |
1712 |
|
return $self->{links}; |
1713 |
} |
} |
1714 |
|
|
1715 |
|
|
1740 |
|
|
1741 |
return if ($rv != 200 || !$resbody); |
return if ($rv != 200 || !$resbody); |
1742 |
|
|
1743 |
# it seems that response can have multiple line endings |
my @lines = split(/[\r\n]/,$resbody); |
1744 |
$resbody =~ s/[\r\n]+$//; |
|
|
|
|
1745 |
( $self->{name}, $self->{label}, $self->{dnum}, $self->{wnum}, $self->{size} ) = |
( $self->{name}, $self->{label}, $self->{dnum}, $self->{wnum}, $self->{size} ) = |
1746 |
split(/\t/, $resbody, 5); |
split(/\t/, shift @lines, 5); |
1747 |
|
|
1748 |
|
return $resbody unless (@lines); |
1749 |
|
|
1750 |
|
shift @lines; |
1751 |
|
|
1752 |
|
while(my $admin = shift @lines) { |
1753 |
|
push @{$self->{admins}}, $admin; |
1754 |
|
} |
1755 |
|
|
1756 |
|
while(my $guest = shift @lines) { |
1757 |
|
push @{$self->{guests}}, $guest; |
1758 |
|
} |
1759 |
|
|
1760 |
|
while(my $link = shift @lines) { |
1761 |
|
push @{$self->{links}}, $link; |
1762 |
|
} |
1763 |
|
|
1764 |
|
return $resbody; |
1765 |
|
|
1766 |
} |
} |
1767 |
|
|