@ -101,7 +101,7 @@ sub OPTIONS :Allow {
sub PATCH :Allow {
my ( $ self , $ c , $ id ) = @ _ ;
my $ guard = $ c - > model ( 'DB' ) - > txn_scope_guard ;
{
my $ preference = $ self - > require_preference ( $ c ) ;
last unless $ preference ;
@ -113,22 +113,35 @@ sub PATCH :Allow {
) ;
last unless $ json ;
my $ item = $ self - > item_by_id ( $ c , $ id ) ;
last unless $ self - > resource_exists ( $ c , subscriberregistration = > $ item ) ;
my $ form = $ self - > get_form ( $ c ) ;
my $ old_resource = $ self - > resource_from_item ( $ c , $ item , $ form ) ;
my $ resource = $ self - > apply_patch ( $ c , $ old_resource , $ json ) ;
last unless $ form ;
my ( $ item , $ old_resource , $ resource ) ;
my ( $ guard , $ txn_ok ) = ( $ c - > model ( 'DB' ) - > txn_scope_guard , 0 ) ;
{
$ item = $ self - > item_by_id ( $ c , $ id ) ;
last unless $ self - > resource_exists ( $ c , subscriberregistration = > $ item ) ;
$ old_resource = $ self - > resource_from_item ( $ c , $ item , $ form ) ;
$ resource = $ self - > apply_patch ( $ c , $ old_resource , $ json ) ;
last unless $ resource ;
$ item = $ self - > update_item ( $ c , $ item , $ old_resource , $ resource , $ form ) ;
last unless $ item ;
$ guard - > commit ;
$ txn_ok = 1 ;
}
last unless $ txn_ok ;
$ item = $ self - > fetch_item ( $ c , $ resource , $ form , $ item ) ;
last unless $ item ;
if ( 'minimal' eq $ preference ) {
$ c - > response - > status ( HTTP_NO_CONTENT ) ;
$ c - > response - > header ( Preference_Applied = > 'return=minimal' ) ;
$ c - > response - > header ( Location = > sprintf ( '/%s%d' , $ c - > request - > path , $ item - > id ) ) ;
$ c - > response - > header ( Location = > sprintf ( ' %s%d', $ self - > dispatch_ path, $ item - > id ) ) ;
$ c - > response - > body ( q( ) ) ;
} else {
my $ hal = $ self - > hal_from_item ( $ c , $ item , $ form ) ;
@ -137,40 +150,54 @@ sub PATCH :Allow {
) , $ hal - > as_json ) ;
$ c - > response - > headers ( $ response - > headers ) ;
$ c - > response - > header ( Preference_Applied = > 'return=representation' ) ;
$ c - > response - > header ( Location = > sprintf ( ' /%s%d', $ c - > request - > path, $ item - > id ) ) ;
$ c - > response - > header ( Location = > sprintf ( ' %s%d', $ self - > dispatch_ path, $ item - > id ) ) ;
$ c - > response - > body ( $ response - > content ) ;
}
}
return ;
}
sub PUT :Allow {
my ( $ self , $ c , $ id ) = @ _ ;
my $ guard = $ c - > model ( 'DB' ) - > txn_scope_guard ;
{
my $ preference = $ self - > require_preference ( $ c ) ;
last unless $ preference ;
my $ item = $ self - > item_by_id ( $ c , $ id ) ;
my $ form = $ self - > get_form ( $ c ) ;
last unless $ form ;
my ( $ item , $ old_resource , $ resource ) ;
my ( $ guard , $ txn_ok ) = ( $ c - > model ( 'DB' ) - > txn_scope_guard , 0 ) ;
{
$ item = $ self - > item_by_id ( $ c , $ id ) ;
last unless $ self - > resource_exists ( $ c , subscriberregistration = > $ item ) ;
my $ resource = $ self - > get_valid_put_data (
$ old_resource = $ self - > resource_from_item ( $ c , $ item , $ form ) ;
$ resource = $ self - > get_valid_put_data (
c = > $ c ,
id = > $ id ,
media_type = > 'application/json' ,
) ;
last unless $ resource ;
my $ form = $ self - > get_form ( $ c ) ;
my $ old_resource = $ self - > resource_from_item ( $ c , $ item , $ form ) ;
$ item = $ self - > update_item ( $ c , $ item , $ old_resource , $ resource , $ form ) ;
last unless $ item ;
$ guard - > commit ;
$ txn_ok = 1 ;
}
last unless $ txn_ok ;
$ item = $ self - > fetch_item ( $ c , $ resource , $ form , $ item ) ;
last unless $ item ;
if ( 'minimal' eq $ preference ) {
$ c - > response - > status ( HTTP_NO_CONTENT ) ;
$ c - > response - > header ( Preference_Applied = > 'return=minimal' ) ;
$ c - > response - > header ( Location = > sprintf ( '/%s%d' , $ c - > request - > path , $ item - > id ) ) ;
$ c - > response - > header ( Location = > sprintf ( ' %s%d', $ self - > dispatch_ path, $ item - > id ) ) ;
$ c - > response - > body ( q( ) ) ;
} else {
my $ hal = $ self - > hal_from_item ( $ c , $ item , $ form ) ;
@ -179,10 +206,11 @@ sub PUT :Allow {
) , $ hal - > as_json ) ;
$ c - > response - > headers ( $ response - > headers ) ;
$ c - > response - > header ( Preference_Applied = > 'return=representation' ) ;
$ c - > response - > header ( Location = > sprintf ( ' /%s%d', $ c - > request - > path, $ item - > id ) ) ;
$ c - > response - > header ( Location = > sprintf ( ' %s%d', $ self - > dispatch_ path, $ item - > id ) ) ;
$ c - > response - > body ( $ response - > content ) ;
}
}
return ;
}