Beefy Boxes and Bandwidth Generously Provided by pair Networks
Syntactic Confectionery Delight
 
PerlMonks  

comment on

( #3333=superdoc: print w/replies, xml ) Need Help??
{ package Win32::ProjectBuilder::SSManager; require 5.004; use strict; use warnings; use Carp; use vars qw( @ISA $VERSION @EXPORT ); $VERSION = "0.01"; @ISA = qw( Exporter ); @EXPORT = (); use protect; use File::Basename qw( dirname ); use File::Path; use File::Spec::Functions qw( canonpath ); use Time::Local qw( timelocal ); use Win32::API; use Win32::OLE qw( in ); use Win32::OLE::Const; use Win32::OLE::Variant; use Win32::File; =head1 NAME Win32::ProjectBuilder::SSManager SSManager - Wrapper Class for SourceSafe OLE Server functions =head1 SYNOPSIS use Win32::ProjectBuilder::SSManager; my $refo_vssmanager; my ( $bool_labelonly, $bool_listonly ); my ( $refar_pattern, $refo_getitem, $refo_version ); my ( $s_ssinipath, $s_localbasepath, $s_passwd, $s_return , $s_const, $s_specpath, $s_username, $s_version ); my ( $s_itemflag, $s_flag ); my ( $ref_getitems ); my ( @ar_versions ); my ( %h_vssconst ); $s_ssinipath = "C:\\Program Files\\Microsoft Visual Studio\\". "Common\\VSS\\srcsafe.ini"; $s_username = "admin"; $s_passwd = ""; $s_return = -1; if ( defined( $refo_vssmanager = Win32::ProjectBuilder::SSManager-> new( $s_ssinipath, $s_username, $s_passwd ))) { $s_return = 0; $refo_vssmanager->autoundocheckout( 1 ); print "AutoUndoCheckout property is ". (( $refo_vssmanager->autoundocheckout ) ? ( "on.\n" ) : ( "off.\n" )); $s_specpath = "\$\/Someproject\/OrFile"; print "SpecPath is ".$refo_vssmanager->specpath.".\n"; $refo_vssmanager->specpath( $s_specpath ); print "SpecPath is ".$refo_vssmanager->specpath.".\n\n"; $s_localbasepath = "C:\\Temp\\Tempdownload\\$s_username"; print "VSSManager LocalBasePath is ". $refo_vssmanager->localbasepath.".\n"; $refo_vssmanager->localbasepath( $s_localbasepath ); print "VSSManager LocalBasePath is ". $refo_vssmanager->localbasepath.".\n\n"; %h_vssconst = $refo_vssmanager->const(); foreach $s_const ( keys %h_vssconst ) { print "Const $s_const = $h_vssconst{$s_const}.\n"; }; print "\n"; $bool_labelonly = 0; $s_flag = $refo_vssmanager->const( "VSSFLAG_RECURSYES" ); $s_version = "Fixed Login Crash"; $s_return = $refo_vssmanager->getversions( \@ar_versions , $s_flag, $s_version, $bool_labelonly ); if ( $s_return == 0 ) { print "Version entries=".( $#ar_versions + 1 ).".\n\n" +; foreach $refo_version ( @ar_versions ) { print "Version Action=". $refo_version->action."\n"; print "Version Comment=". $refo_version->comment."\n"; print "Version Date=". $refo_version->date."\n"; print "Version Label=". $refo_version->label."\n"; print "Version Item Name=". $refo_version->ssitem->name."\n"; print "Version Item Spec=". $refo_version->ssitem->spec."\n"; print "Version Item Type=". $refo_version->ssitem->type."\n"; print "Version UserName=". $refo_version->username."\n"; print "Version VersionNumber=". $refo_version->versionnumber."\n"; print "\n"; }; undef @ar_versions; } else { print "OLE or user-defined error $s_return returned ". "from method getversions.\n"; }; $bool_listonly = 0; $s_itemflag = $refo_vssmanager->const( "VSSITEM_FILE" ); $refar_pattern = [ '*.dsp', '*.dsw' ]; $ref_getitems = []; $s_flag = $refo_vssmanager->const( "VSSFLAG_RECURSYES" ); $s_version = "26/02/02"; $s_return = $refo_vssmanager->getitems( $s_itemflag, $s_flag , $s_version, $refar_pattern, $ref_getitems , $bool_listonly ); if( $s_return == 0 ) { if ( ref( $ref_getitems ) =~ /SCALAR/ ) { print "Get Item entries=".${ $ref_getitems }. ".\n\n"; } elsif ( ref( $ref_getitems ) =~ /ARRAY/ ) { print "Get Item entries=". ( $#$ref_getitems + 1 ).".\n\n"; foreach $refo_getitem ( @{ $ref_getitems }) { print "Get Name=". $refo_getitem->name."\n"; print "Get Spec=". $refo_getitem->spec."\n"; print "Get Type=". $refo_getitem->type."\n"; print "Get LocalSpec=". $refo_getitem->localspec.".\n" +; print "Get RealLocalSpec=". $refo_getitem->reallocalspec. ".\n"; print "Get Spec=". $refo_getitem->spec.".\n"; print "Get VersionNumber=". $refo_getitem->versionnumber. ".\n"; print "\n"; }; undef @{ $ref_getitems }; }; } else { print "OLE or user-defined error $s_return returned ". "from method getitems.\n"; }; }; exit $s_return; =head1 DESCRIPTION This module wraps a number of SourceSafe OLE Server functions in one-step function calls. Navigation in the SourceSafe database is handled in much the same way as navigating the file system at the command prompt, so that any action is applied to the current sourcesafe spec. Particularly it can handle files functions recursively which takes the burden of having to custom program the OLE SourceSafe Server in your script. Another enhancement is the ability to define wildcards that will filter the files and projects that the functions are meant to apply to. Along with the SSManager class there exist the SSFile , SSProject, SSCheckout, and SSVersion classes which are used to retur +n the properties of their OLE object counterparts in SSManager methods. They have no functions and can not be publicly created. =head1 BUGS None discovered...yet. Not all SourceServer OLE functions are wrapped. =head1 AUTHOR Dominick Moré <dominick.more@audatex.ch> =cut use constant LOCALE_IDATE => 0x00000021; use constant LANG_NEUTRAL => 0x0; use constant SORT_DEFAULT => 0x0; use constant SUBLANG_DEFAULT => 0x1; use constant LANG_USER_DEFAULT => LANG_NEUTRAL | ( SU +BLANG_DEFAULT * 0x400 ); use constant LOCALE_USER_DEFAULT => LANG_USER_DEFAULT | + ( SORT_DEFAULT * 0x10000 ); Win32::OLE->Option( Warn => 0 ); members qw ( SSManager ); my $_debug = 0; my $refsub_getcwd = new Win32::API("kernel32", "GetCurrentDire +ctory", ['N', 'P'], 'N'); my $refsub_getlocaleinfo = new Win32::API("kernel32", "GetLoca +leInfo", ['N', 'N', 'P', 'N'], 'N' ); our $refh_vssconst = Win32::OLE::Const->Load( 'Microsoft Sourc +eSafe .*? Type Library' ) || croak "Unable to load SourceSafe constants.\n"; =head1 METHODS =head2 METHOD new The class constructor. Returns the class instance or undef on error. Arguments are: [ $s_ssinipath, $s_username, $s_userpwd ] =over =item * ( optional ) A string. Sets the the Sourcesafe inifilepath C<ssinipath +> property. Defaults to "". =item * ( optional ) A string. Sets the Sourcesafe Login username C<username> property. Defaults to "". =item * ( optional ) A string. Sets the Sourcesafe Login password property. Defaults to "". =back =cut sub new( $;$$$ ) { is ('public'); my $s_proto = shift; my ( $s_ssinipath, $s_username, $s_userpwd ) = @_; my $s_class = ref( $s_proto ) || $s_proto; if ( $s_class ne __PACKAGE__ ) { carp "Illegal global call on a class ".__PACKA +GE__." constructor.\n"; return undef; }; my( $bool_return, $bool_pathdefined ); $bool_return = $bool_pathdefined = 0; if ( defined($s_ssinipath) && ref( \$s_ssinipath ) =~ +/SCALAR/i ) { if (($s_ssinipath !~ /^.+\.ini?$/i) || (!(-s $ +s_ssinipath) || !(-T $s_ssinipath))) { $s_ssinipath = ""; } else { $bool_pathdefined = 1; }; } else { $s_ssinipath = ""; }; if ((ref( \$s_username ) !~ /SCALAR/i ) || ( !$s_usern +ame )) { $s_username = ""; }; if ((ref( \$s_userpwd ) !~ /SCALAR/i ) || ( !$s_userpw +d )) { $s_userpwd = ""; }; my $refh_newself = { AUTOUNCHKOUT => 0, CALLBACKARGS => undef, CALLBACKFUNC => undef, _DEBUG => \$_debug, DIRRECURSPAT => [], DIRRECURSFLAGS => 0, DIRRECURSITEMS => 0, INDIRRECURS => 0, INIFILEPATH => undef, ITEMSTACK => [], LOCALBASEPATH => undef, OBJ_VSS => undef, PROJECTRECURS => 0, USERNAME => "", USERPWD => "", VSSCONST => $refh_vssconst, }; my $refh_self = sub { is ('private'); return $refh_newself; }; bless ($refh_self, $s_class); if ( $refh_self->_initialize() == 0 ) { if ( $bool_pathdefined ) { $refh_self->open($s_ssinipath, $s_user +name, $s_userpwd); }; $refh_self->localbasepath( $ENV{"TEMP"} ); if ( !$refh_self->localbasepath ) { carp "Unable to set initial localpath +in ". __PACKAGE__." constructor.\n"; undef $refh_self; }; } else { undef $refh_self; }; return $refh_self; }; sub DESTROY( $ ) { is ('public'); my $refh_self = shift; unless (ref( $refh_self ) && ($refh_self->isa(__PACKAG +E__))) { carp "Illegal global call on a class ".__PACKA +GE__." destructor.\n"; return undef; }; my $refh_data = &{$refh_self}; undef @{$refh_data->{'ITEMSTACK'}}; if ( $refh_self->specpath && $refh_data->{'AUTOUNCHKOU +T'} ) { $refh_self->specpath("\$\/"); $refh_self->undocheckouts(); }; undef $refh_data->{'OBJ_VSS'}; undef $refh_self; }; =head2 METHOD checkinitems C<checkinitems> This method checks in any items that match the parameter arguments in the current database specpath and are checked out in the context of the current SourceSafe username. The return value is "0" if the operation is successful. If the operation fails then the return value is either "-1" (in the case of a SSManager class internal error) or the SourceSafe OLE Server HRESULT. Arguments are: [ $s_vssitems, $s_vssflags, $s_comment, $refar_pattern, $refar_items ] =over =item * ( optional ) A number. Specifies whether the function acts on files and/or projects. Recognized values include the SourceSafe constants ( VSSITEM_FILE and VSSITEM_PROJECT ). Defaults to ( VSSITEM_FILE | VSSITEM_PROJECT ). =item * ( optional ) A number. Specifies the VSSFLAGS passed on to SourceSafe OLE function, Any SourceSafe VSSFLAG_* constants are valid values. Defaults to ( VSSFLAG_RECURSYES | VSSFLAG_GETYES | VSSFLAG_USERRONO | VSSFLAG_REPREPLACE | VSSFLAG_KEEPNO | VSSFLAG_UPDUNCH ). =item * ( optional ) A string. Specifies the comment that is passed to files checked in to SourceSafe. Defaults to "". =item * ( optional ) An array reference. Specifies a list of wildcards that ar +e used to filter files and projects that the function acts upon. Wildcards my be specified as using the DOS typical '*' and '?' modifiers ( e.g. '*.txt' or '*.t??' ). Defaults to [ '*' ]. =item * ( optional ) An array or scalar reference. If the argument is neither it will be ignored. If the argument is a scalar reference then it will be filled with the count of checked-in items. If it is an array reference then it will be filled with a list of SSFile objects representing the files checked-in. The checkouts property of the SSFil +e objects are not filled. =back =cut sub checkinitems( $;$$$\@\@ ) { is ('public'); my $refh_self = shift; unless (ref( $refh_self ) && ($refh_self->isa(__PACKAG +E__))) { carp "Illegal global call on a class ".(caller +(0))[3]." method.\n"; return -1; }; my ( $s_vssitems, $s_vssflags, $s_comment, $refar_patt +ern, $refar_items ) = @_; my $refh_data = &{$refh_self}; my $refh_const = $refh_data->{'VSSCONST'}; if ( ref( $refar_items ) =~ /ARRAY/ ) { undef @{$refar_items}; } elsif ( ref( $refar_items ) =~ /SCALAR/ ) { ${$refar_items} = 0; } else { $refar_items = undef; }; $s_comment = undef unless( ref( \$s_comment ) =~ /SCAL +AR/ ); my $refh_arg = { 'ar_tempitems' => $refar_item +s, 's_comment' => $s_comment }; my $refc_chkincallback = sub { my ( $refo_vssitem, $refh_argt, $s_flags ) = @ +_; my ( $reh_checkout, $refh_item, $refo_checkout + ); my ( $s_name, $s_path, $s_reallocalpath, $s_re +turn , $s_spec, $s_type, $s_username ); my @ar_hresult; my $bool_checkedin = 0; $s_return = 0; $s_type = $refo_vssitem->{'Type'}; if ( $s_type == $refh_const->{'VSSITEM_PROJECT +'} ) { return $s_return; }; $s_name = $refo_vssitem->{'Name'}; $s_spec = $refo_vssitem->{'Spec'}; $s_reallocalpath = ""; if ( $refh_const->{'VSSFILE_CHECKEDOUT_ME'} & $refo_vssitem->{'IsCheckedOut'} ) { foreach $refo_checkout ( in $refo_vssi +tem->{'Checkouts'} ) { $s_username = $refo_checkout-> +{'UserName'}; if ( $refh_data->{'USERNAME'} +=~ /^$s_username$/i ) { $s_reallocalpath = $re +fo_checkout->{'LocalSpec'}. "\\$s_name"; $refo_vssitem->Checkin +( Variant( VT_BSTR , $refh_argt-> +{'s_comment'} ) , Variant( VT_ +BSTR, $s_reallocalpath ) , Variant( VT_ +I4, $s_flags )); $s_return += Win32::OL +E->LastError(); if ( $s_return ) { @ar_hresult = split( + /\n/ , Win3 +2::OLE->LastError()); undef $refo_ch +eckout; carp "Error wa +s \"".$ar_hresult[2]. "\" in + method ". (calle +r(2))[3].".\n"; return $s_retu +rn; } else { $bool_checkedi +n = 1; }; }; }; }; if ( $bool_checkedin ) { if ( ${ $refh_data->{ '_DEBUG' }} ) { print "Checkin Item $s_realloc +alpath in ". (caller(2))[3]." succe +ssful.\n"; }; if ( ref( $refh_argt->{'ar_tempitems'} + ) =~ /ARRAY/ ) { if ( defined( $refh_item = SSF +ile->_new( $refo_vssitem->{'Delet +ed'}, $refo_vssitem->{'Local +Spec'}, $s_name, $s_spec, $s_type, $refo_vssitem->{'Versi +onNumber'}, $refo_vssitem->{'Binar +y'}, $refo_vssitem->{'IsChe +ckedOut'}, $refo_vssitem->{'IsDif +ferent'})) ) { push @{$refh_argt->{'a +r_tempitems'}} , $refh_item; } else { carp "Unable to create + SSItem ". $refo_vssitem- +>{'Spec'}. " in ".(caller +(2))[3]." method.\n"; return $s_return = -1; }; } elsif ( ref( $refh_argt->{'ar_tempit +ems'} ) =~ /SCALAR/ ) { ${$refh_argt->{'ar_tempitems'} +}++; }; }; return $s_return; }; my $s_return = $refh_self->_dirrecurse( $refc_chkincal +lback, $refh_arg , $s_vssitems, $s_vssflags, $refar_pattern ); if ( $s_return != 0 ) { if ( ref( $refar_items ) =~ /ARRAY/ ) { undef @{$refar_items}; } elsif ( ref( $refar_items ) =~ /SCALAR/ ) { ${$refar_items} = 0; }; }; $refh_arg = undef; $refc_chkincallback = undef; return $s_return; }; =head2 METHOD checkoutitems C<checkoutitems> This method checks out any items that match the parameter arguments in the current database specpath in the context of the current SourceSafe username. The return value is "0" if the operation is successful. If the operation fails then the return value is either "-1" (in the case of a SSManager class internal error) or the SourceSafe OLE Server HRESULT. Arguments are: [ $s_vssitems, $s_vssflags, $s_comment, $refar_pattern, $refar_items ] =over =item * ( optional ) A number. Specifies whether the function acts on files and/or projects. Recognized values are the SourceSafe constants ( VSSITEM_FILE and VSSITEM_PROJECT ). Defaults to ( VSSITEM_FILE | VSSITEM_PROJECT ). =item * ( optional ) A number. Specifies the VSSFLAGS passed on to SourceSafe OLE function Any SourceSafe VSSFLAG_* constants are valid values. Defaults to ( VSSFLAG_RECURSYES | VSSFLAG_GETYES | VSSFLAG_USERRONO | VSSFLAG_REPREPLACE | VSSFLAG_KEEPNO | VSSFLAG_UPDUNCH ). =item * ( optional ) A string. Specifies the comment that is passed to files checked in to SourceSafe. Defaults to "". =item * ( optional ) An array reference. Specifies a list of wildcards that ar +e used to filter files and projects that the function acts upon. wildcards my be specified as using the DOS typical '*' and '?' modifiers ( e.g. '*.txt' or '*.t??' ). Defaults to [ '*' ]. =item * ( optional ) An array or scalar reference. If the argument is neither it will be ignored. If the argument is a scalar reference then it will be filled with the count of checked-in items. If it is an array reference then it will be filled with a list of SSFile objects representing the files checked-in +. The checkouts property of the SSFile objects are filled with a single checkout object representing the file or project being checked out. =back =cut sub checkoutitems( $;$$$\@\@ ) { is ('public'); my $refh_self = shift; unless (ref( $refh_self ) && ($refh_self->isa(__PACKAG +E__))) { carp "Illegal global call on a class ".(caller +(0))[3]." method.\n"; return -1; }; my ( $s_vssitems, $s_vssflags, $s_comment, $refar_patt +ern, $refar_items ) = @_; my $refh_data = &{$refh_self}; my $refh_const = $refh_data->{'VSSCONST'}; if ( ref( $refar_items ) =~ /ARRAY/ ) { undef @{$refar_items}; } elsif ( ref( $refar_items ) =~ /SCALAR/ ) { ${$refar_items} = 0; } else { $refar_items = undef; }; $s_comment = undef unless( ref( \$s_comment ) =~ /SCAL +AR/ ); my $refh_arg = { 'ar_tempitems' => $refar_item +s, 's_comment' => $s_comment }; my $refc_chkoutcallback = sub { my ( $refo_vssitem, $refh_argt, $s_flags ) = @ +_; my ( $bool_ischeckedout ); my ( $refar_time, $refh_checkouts, $refh_item, + $refo_checkout ); my ( $s_chkoutlocalspec, $s_localspec, $s_name +, $s_reallocalpath , $s_return, $s_spec, $s_type, $s_user +name ); my ( @ar_hresult, @ar_splitpath ); $s_return = 0; $s_type = $refo_vssitem->{'Type'}; if ( $s_type == $refh_const->{'VSSITEM_PROJEC +T'} ) { return $s_return; }; $s_localspec = $refo_vssitem->{'LocalSpec'}; $s_name = $refo_vssitem->{'Name'}; $s_spec = $refo_vssitem->{'Spec'}; if ( !$refh_data->{'LOCALBASEPATH'} ) { if ( !$s_localspec ) { $s_reallocalpath = _getcwd()." +\\$s_name"; } else { $s_reallocalpath = "$s_localsp +ec\\$s_name"; }; } else { @ar_splitpath = split( /\//, $s_spec ) +; shift @ar_splitpath; $s_reallocalpath = $refh_data->{'LOCAL +BASEPATH'}."\\". join( "\\", @ar_splitpath ); }; $bool_ischeckedout = 0; if ( $refh_const->{'VSSFILE_CHECKEDOUT_ME'} & $refo_vssitem->{'IsCheckedOut'} ) { foreach $refo_checkout ( in $refo_vssi +tem->{'Checkouts'} ) { $s_chkoutlocalspec = $refo_che +ckout->{'LocalSpec'}. "\\$s_name"; $s_username = $refo_checkout-> +{'UserName'}; if (( $refh_data->{'USERNAME'} + =~ /^$s_username$/i ) && ( lc( $s_chkoutloca +lspec ) eq lc( $s_reallocalpath ) +)) { $bool_ischeckedout = 1 +; undef $refo_checkout; last; }; }; }; if ( !$bool_ischeckedout ) { $refo_vssitem->Checkout( Variant( VT_B +STR , $refh_argt->{'s_comment'} ) , Variant( VT_BSTR, $s_realloc +alpath ) , Variant( VT_I4, $s_flags )); $s_return += Win32::OLE->LastError(); if ( $s_return ) { @ar_hresult = split( /\n/, Win +32::OLE->LastError()); carp "Error was \"".$ar_hresul +t[2]."\" in method ". (caller(2))[3].".\n"; return $s_return; } else { $bool_ischeckedout = 1; }; }; if ( $bool_ischeckedout ) { if ( ${ $refh_data->{ '_DEBUG' }} ) { print "Checkout Item $s_reallo +calpath in ". (caller(2))[3]." succe +ssful.\n"; }; if ( ref( $refh_argt->{'ar_tempitems'} + ) =~ /ARRAY/ ) { if( defined( $refh_item = SSFi +le->_new( $refo_vssitem->{'Delet +ed'}, $s_localspec, $s_name, $s_spec, $s_type, $refo_vssitem->{'Versi +onNumber'}, $refo_vssitem->{'Binar +y'}, $refo_vssitem->{'IsChe +ckedOut'}, $refo_vssitem->{'IsDif +ferent'})) ) { $refh_item->reallocals +pec( $s_reallocalpath ); if ( defined( $refo_ch +eckout = $refo_vssitem- +>Checkouts( Variant( VT_BSTR , $refh_data-> +{'USERNAME'} )))) { push (@{$refar +_time}, split( " " , $ref +o_checkout->{'Date'}-> Time(" +s m H"))); push (@{$refar +_time}, split( " " , $ref +o_checkout->{'Date'}-> Date(" +d M yyyy"))); $refar_time->[ +4] -= 1; $refh_item->_i +nsertcheckout( $refo_ +checkout->{'Comment'} , time +local(@{$refar_time}) , $ref +o_checkout->{'LocalSpec'} , $ref +o_checkout->{'Machine'} , $ref +o_checkout->{'Project'} , $ref +o_checkout->{'UserName'} , $ref +o_checkout->{'VersionNumber'} ); }; push @{$refh_argt->{'a +r_tempitems'}}, $refh_item; } else { carp "Unable to create + SSItem ". $refo_vssitem- +>{'Spec'}. " in ".(caller +(2))[3]." method.\n"; return $s_return = -1; }; } elsif ( ref( $refh_argt->{'ar_tempit +ems'} ) =~ /SCALAR/ ) { ${$refh_argt->{'ar_tempitems'} +}++; }; }; return $s_return; }; my $s_return = $refh_self->_dirrecurse( $refc_chkoutca +llback, $refh_arg , $s_vssitems, $s_vssflags, $refar_pattern ); if ( $s_return != 0 ) { if ( ref( $refar_items ) =~ /ARRAY/ ) { undef @{$refar_items}; } elsif ( ref( $refar_items ) =~ /SCALAR/ ) { ${$refar_items} = 0; }; }; $refh_arg = undef; $refc_chkoutcallback = undef; return $s_return; }; =head2 METHOD const C<const> Returns the numeric value of the specified SourceSafe constant or returns a copy of the hash of SourceSafe constants when re +quested in an array/hash context. Returns undef if the constant name cannot be resolved. Arguments are: [ $s_constname ] =over =item * ( optional ) A string. The name of the wanted constant value. =back =cut sub const( $;$ ) { is ('public'); my $refh_self = shift; unless (ref( $refh_self ) && ($refh_self->isa(__PACKAG +E__))) { carp "Illegal global call on a class ".(caller +(0))[3]." property.\n"; return undef; }; my $s_constname = shift; if( $s_constname ) { my $refh_data = &{$refh_self}; if ( ref( \$s_constname ) =~ /SCALAR/i && exists( $refh_data->{'VSSCONST'}->{ + $s_constname } )) { return $refh_data->{'VSSCONST'}->{ $s_ +constname }; } else { carp "Constant name \"$s_constname\" n +ame does not exist ". "in property ".(caller(0))[3]. +".\n"; }; } elsif ( wantarray()) { my $refh_data = &{$refh_self}; return %{$refh_data->{'VSSCONST'}}; } else { carp "Constant name \"$s_constname\" name does + not exist ". "in property ".(caller(0))[3].".\n"; }; return undef; }; sub _dirrecurse( $;\$$$$ ) { is ('private'); my $refh_self = shift; my $s_return = 0; my $refh_data = &{$refh_self}; unless (ref( $refh_self ) && ($refh_self->isa(__PACKAG +E__))) { carp "Illegal global call on a class ".(caller +(0))[3]." method.\n"; $refh_data->{'CALLBACKFUNC'} = undef; $refh_data->{'CALLBACKARGS'} = undef; $refh_data->{'DIRRECURSFLAGS'} = undef; $refh_data->{'DIRRECURSITEMS'} = undef; $refh_data->{'INDIRRECURS'} = 0; $refh_data->{'PROJECTRECURS'} = 0; undef @{$refh_data->{'ITEMSTACK'}}; undef @{$refh_data->{'DIRRECURSPAT'}}; return $s_return = -1; }; my ( $refc_callback, $s_callbackargs, $s_vssitems, $s_ +vssflags, $refar_pattern , $s_version, $bool_reset ) = @_; my ( $s_callreturn, $s_currentproj, $s_eval, $s_index, + $s_name , $s_searchparam, $s_searchtype, $s_pattern, $ +s_type ); my ( $refar_tempdate, $refo_vssitem, $refo_vsssubitem +); my $bool_wasprojectrecurs = 0; my @ar_hresult; my $refh_const = $refh_data->{'VSSCONST'}; my $refh_searchtype = { NONE => 0, DATE => 1, LABEL => 2, VERSIONNUMBER => 3 }; if ($bool_reset ) { $refh_data->{'CALLBACKARGS'} = undef; $refh_data->{'CALLBACKFUNC'} = undef; $refh_data->{'DIRRECURSFLAGS'} = undef; $refh_data->{'DIRRECURSITEMS'} = undef; $refh_data->{'INDIRRECURS'} = 0; $refh_data->{'PROJECTRECURS'} = 0; undef @{$refh_data->{'ITEMSTACK'}}; undef @{$refh_data->{'DIRRECURSPAT'}}; return $s_return = 0; } elsif ( !$refh_data->{'INDIRRECURS'} && $refh_self-> +specpath ) { $refh_data->{'CALLBACKFUNC'} = undef; $refh_data->{'CALLBACKARGS'} = undef; $refh_data->{'DIRRECURSFLAGS'} = undef; $refh_data->{'DIRRECURSITEMS'} = undef; $refh_data->{'INDIRRECURS'} = 0; $refh_data->{'PROJECTRECURS'} = 0; undef @{$refh_data->{'ITEMSTACK'}}; undef @{$refh_data->{'DIRRECURSPAT'}}; if ( ref( $refc_callback ) !~ /CODE/i ) { $s_return = -1; carp "Callback function not specified +in method ".(caller(1))[3].".\n"; return $s_return; } else { $refh_data->{'CALLBACKFUNC'} = $refc_c +allback; $refh_data->{'CALLBACKARGS'} = $s_call +backargs; }; if (( ref( \$s_vssitems ) =~ /SCALAR/i ) && de +fined( $s_vssitems )) { $s_vssitems =~ s/^\s*?(.*?)\s*?$/$1/; if ( $s_vssitems !~ /^\d+$/ ) { if ( $s_vssitems ) { $refh_data->{'DIRRECUR +SITEMS'} = eval("$s_vssitems"); } else { $refh_data->{'DIRRECUR +SITEMS'} = $refh_const- +>{'VSSITEM_FILE'} | $refh_const- +>{'VSSITEM_PROJECT'}; }; } else { $refh_data->{'DIRRECURSITEMS'} + = $s_vssitems; }; } else { $refh_data->{'DIRRECURSITEMS'} = $refh +_const->{'VSSITEM_FILE'} | $refh_const->{'VSSITEM_PROJE +CT'}; }; if ( !defined( $refh_data->{'DIRRECURSITEMS'} +) || $refh_data->{'DIRRECURSITEMS'} !~ / +^\d+$/ ) { $refh_data->{'CALLBACKFUNC'} = undef; $refh_data->{'CALLBACKARGS'} = undef; $refh_data->{'DIRRECURSITEMS'} = undef +; carp "Argument s_vssitems '$s_vssitems +' is meaningless in method ". (caller(1))[3].".\n"; return $s_return = -1; }; if (( ref( \$s_vssflags ) =~ /SCALAR/i ) && d +efined( $s_vssflags )) { $s_vssflags =~ s/^\s*?(.*?)\s*?$/$1/; if ( $s_vssflags !~ /^\d+$/ ) { if ( $s_vssflags ) { $refh_data->{'DIRRECUR +SFLAGS'} = eval("$s_vssflags"); } else { $refh_data->{'DIRRECUR +SFLAGS'} = ( $refh_const- +>{'VSSFLAG_RECURSYES'} | $refh_const- +>{'VSSFLAG_GETYES'} | $refh_const- +>{'VSSFLAG_USERRONO'} | $refh_const- +>{'VSSFLAG_REPREPLACE'} | $refh_const- +>{'VSSFLAG_KEEPNO'} | $refh_const- +>{'VSSFLAG_UPDUNCH'} ); }; } else { $refh_data->{'DIRRECURSFLAGS'} + = $s_vssflags; }; } else { $refh_data->{'DIRRECURSFLAGS'} = ( $refh_const->{'VSSFLAG_RECUR +SYES'} | $refh_const->{'VSSFLAG_GETYE +S'} | $refh_const->{'VSSFLAG_USERR +ONO'} | $refh_const->{'VSSFLAG_REPRE +PLACE'} | $refh_const->{'VSSFLAG_KEEPN +O'} | $refh_const->{'VSSFLAG_UPDUN +CH'} ); }; if ( !defined( $refh_data->{'DIRRECURSFLAGS'} +) || $refh_data->{'DIRRECURSFLAGS'} !~ / +^\d+$/ ) { $refh_data->{'CALLBACKFUNC'} = undef; $refh_data->{'CALLBACKARGS'} = undef; $refh_data->{'DIRRECURSFLAGS'} = undef +; $refh_data->{'DIRRECURSITEMS'} = undef +; carp "Argument s_vssflags '$s_vssflags +' is meaningless in method ". (caller(1))[3].".\n"; return $s_return = -1; } else { $refh_data->{'DIRRECURSFLAGS'} |= $refh_const->{'VSSFLAG_FORCEDI +RNO'} if ( $refh_data->{'LOCALBASEPA +TH'} ); $refh_data->{'DIRRECURSFLAGS'} ^= $refh_const->{'VSSFLAG_USERROY +ES'} if(( $refh_data->{'DIRRECURSFL +AGS'} & $refh_const->{'VSSFLAG_USERR +ONO'} ) && ( $refh_data->{'DIRRECURSFL +AGS'} & $refh_const->{'VSSFLAG_USERR +OYES'} )); $refh_data->{'DIRRECURSFLAGS'} ^= $refh_const->{'VSSFLAG_REPASK' +} if( $refh_data->{'DIRRECURSFLA +GS'} & $refh_const->{'VSSFLAG_REPAS +K'} ); $refh_data->{'DIRRECURSFLAGS'} ^= $refh_const->{'VSSFLAG_RECURSY +ES'} if(( $refh_data->{'DIRRECURSFL +AGS'} & $refh_const->{'VSSFLAG_RECUR +SNO'} ) && ( $refh_data->{'DIRRECURSFL +AGS'} & $refh_const->{'VSSFLAG_RECUR +SYES'} )); $refh_data->{'DIRRECURSFLAGS'} ^= $refh_const->{'VSSFLAG_FORCEDI +RYES'} if(( $refh_data->{'DIRRECURSFL +AGS'} & $refh_const->{'VSSFLAG_FORCE +DIRNO'} ) && ( $refh_data->{'DIRRECURSFL +AGS'} & $refh_const->{'VSSFLAG_FORCE +DIRYES'} )); $refh_data->{'DIRRECURSFLAGS'} ^= $refh_const->{'VSSFLAG_KEEPYES +'} if(( $refh_data->{'DIRRECURSFL +AGS'} & $refh_const->{'VSSFLAG_KEEPN +O'} ) && ( $refh_data->{'DIRRECURSFL +AGS'} & $refh_const->{'VSSFLAG_KEEPY +ES'} )); $refh_data->{'DIRRECURSFLAGS'} ^= $refh_const->{'VSSFLAG_DELYES' +} if((( $refh_data->{'DIRRECURSF +LAGS'} & $refh_const->{'VSSFLAG_DELNO +'} ) || ( $refh_data->{'DIRRECURSFL +AGS'} & $refh_const->{'VSSFLAG_DELNO +REPLACE'} )) && ( $refh_data->{'DIRRECURSFL +AGS'} & $refh_const->{'VSSFLAG_DELYE +S'} )); $refh_data->{'DIRRECURSFLAGS'} ^= $refh_const->{'VSSFLAG_DELNORE +PLACE'} if(( $refh_data->{'DIRRECURSFL +AGS'} & $refh_const->{'VSSFLAG_DELNO +'} ) && ( $refh_data->{'DIRRECURSFL +AGS'} & $refh_const->{'VSSFLAG_DELNO +REPLACE'} )); $refh_data->{'DIRRECURSFLAGS'} ^= $refh_const->{'VSSFLAG_DELTAYE +S'} if(( $refh_data->{'DIRRECURSFL +AGS'} & $refh_const->{'VSSFLAG_DELTA +NO'} ) && ( $refh_data->{'DIRRECURSFL +AGS'} & $refh_const->{'VSSFLAG_DELTA +YES'} )); $refh_data->{'DIRRECURSFLAGS'} ^= $refh_const->{'VSSFLAG_UPDUPDA +TE'} if(( $refh_data->{'DIRRECURSFL +AGS'} & $refh_const->{'VSSFLAG_UPDUN +CH'} ) && ( $refh_data->{'DIRRECURSFL +AGS'} & $refh_const->{'VSSFLAG_UPDUP +DATE'} )); $refh_data->{'DIRRECURSFLAGS'} ^= $refh_const->{'VSSFLAG_UPDASK' +} if( $refh_data->{'DIRRECURSFLA +GS'} & $refh_const->{'VSSFLAG_UPDAS +K'} ); }; if ((ref( \$refar_pattern ) =~ /SCALAR/i ) && +defined( $refar_pattern )) { my $s_temp = $refar_pattern; $s_temp =~ s/^\s*?(.*?)\s*?$/$1/; if ( $s_temp ) { push @{$refh_data->{'DIRRECURS +PAT'}}, $s_temp; }; }; if ( ref( $refar_pattern ) =~ /ARRAY/i ) { my @ar_temp = @{$refar_pattern}; for ( $s_index = 0; $s_index <= $#ar_t +emp; $s_index++ ) { $ar_temp[$s_index] =~ s/(\/|\\ +|\||\:|\"|\<|\>)//g; $ar_temp[$s_index] =~ s/(\.|\^ +|\$|\+)/\\$1/ig; $ar_temp[$s_index] =~ s/(\*|\? +)/\.$1/ig; if ( $ar_temp[$s_index] ) { push @{$refh_data->{'D +IRRECURSPAT'}} , $ar_temp[$s_ +index]; }; }; }; $s_currentproj = $refh_data->{'OBJ_VSS'}->{'Cu +rrentProject'}; if ( $s_currentproj ) { $s_searchtype = $refh_searchtype->{'NO +NE'}; if( ref( \$s_version ) =~ /SCALAR/i && + $s_version ) { if ( $s_version =~ /^\s*?(\d+) +\s*?$/ ) { $s_searchparam = $1; $s_searchtype = $refh_ +searchtype->{'VERSIONNUMBER'}; } elsif ( $s_version =~ /^\s*?(\d{1,4})\s*?(\\ +|\/|\.|-)\s*?(\d{1,2})\s*?\2\s*?(\d{1,4})\s*?$/ ) { $refar_tempdate = _splitdate( jo +in( "/", ( $1, $3, $4 ))); if ( !( $refar_tempdat +e )) { $s_return = Wi +n32::OLE->LastError(); $refh_data->{' +CALLBACKFUNC'} = undef; $refh_data->{' +CALLBACKARGS'} = undef; $refh_data->{' +DIRRECURSFLAGS'} = undef; $refh_data->{' +DIRRECURSITEMS'} = undef; undef @{$refh_ +data->{'DIRRECURSPAT'}}; carp "Could no +t parse date \"$s_version\" ". "in me +thod ". (calle +r(1))[3].".\n"; return $s_retu +rn = -1; }; $s_searchparam = join( + "/", @{ $refar_tempdate }); $s_searchtype = $refh_ +searchtype->{'DATE'}; } else { $s_searchparam = $s_ve +rsion; $s_searchtype = $refh_ +searchtype->{'LABEL'}; }; }; } else { $s_return = Win32::OLE->LastError(); $refh_data->{'CALLBACKFUNC'} = undef; $refh_data->{'CALLBACKARGS'} = undef; $refh_data->{'DIRRECURSFLAGS'} = undef +; $refh_data->{'DIRRECURSITEMS'} = undef +; undef @{$refh_data->{'DIRRECURSPAT'}}; if ( $s_return ) { @ar_hresult = split( /\n/, Win +32::OLE->LastError()); carp "Error was \"".$ar_hresul +t[2]."\".\n"; } else { carp "Could not get sourcesafe + spec in method ". (caller(1))[3].".\n"; }; return $s_return || -1; }; if ( $s_searchtype ) { $refo_vssitem = $refh_data->{'OBJ_VSS' +}->VSSItem(Variant( VT_BSTR , $s_currentproj ))-> Version( Variant( VT_BSTR, $s_ +searchparam )); if (( $s_searchtype != $refh_searchtyp +e->{'VERSIONNUMBER'} ) && $refo_vssitem ) { $s_searchparam = $refo_vssitem +->{'VersionNumber'}; undef $refo_vssitem; $refo_vssitem = $refh_data->{' +OBJ_VSS'}-> VSSItem(Variant( VT_BS +TR, $s_currentproj ))-> Version( Variant( VT_B +STR, $s_searchparam )); }; } else { $refo_vssitem = $refh_data->{'OBJ_VSS' +}->VSSItem( Variant( VT_BSTR, $s_currentpr +oj )); }; if ( !$refo_vssitem ) { $s_return = Win32::OLE->LastError(); $refh_data->{'CALLBACKFUNC'} = undef; $refh_data->{'CALLBACKARGS'} = undef; $refh_data->{'DIRRECURSFLAGS'} = undef +; $refh_data->{'DIRRECURSITEMS'} = undef +; undef @{$refh_data->{'DIRRECURSPAT'}}; if ( $s_return ) { @ar_hresult = split( /\n/, Win +32::OLE->LastError()); carp "Error was \"".$ar_hresul +t[2]."\" in method ". (caller(1))[3].".\n"; } else { carp "Could not get sourcesafe + item \"$s_currentproj\" ". "in method ".(caller(1 +))[3].".\n"; }; return $s_return || -1; } else { $refh_data->{'INDIRRECURS'} = 1; }; } elsif ( $refh_data->{'INDIRRECURS'} ) { $refo_vssitem = $refh_data->{'ITEMSTACK'}-> [ $#{ $refh_data->{'ITEMSTACK'}} ]; } else { $refh_data->{'CALLBACKARGS'} = undef; $refh_data->{'CALLBACKFUNC'} = undef; $refh_data->{'DIRRECURSFLAGS'} = undef; $refh_data->{'DIRRECURSITEMS'} = undef; $refh_data->{'INDIRRECURS'} = 0; $refh_data->{'PROJECTRECURS'} = 0; undef @{$refh_data->{'ITEMSTACK'}}; undef @{$refh_data->{'DIRRECURSPAT'}}; carp "No specpath value defined in method ".(c +aller(1))[3].".\n"; return $s_return = -1; }; $bool_wasprojectrecurs = $refh_data->{'PROJECTRECURS'} +; $s_type = $refo_vssitem->{'Type'}; if ( $refh_const->{'VSSITEM_PROJECT'} == $s_type ) { $s_eval = undef; if ( $#{$refh_data->{'DIRRECURSPAT'}} + 1 ) { $s_name = $refo_vssitem->{'Name'}; foreach $s_pattern ( @{$refh_data->{'D +IRRECURSPAT'}} ) { last if ( $s_eval = ( $s_name +=~ /^$s_pattern$/i )); }; } else { $s_eval = 1; }; if ( $s_eval ) { $s_callreturn = &{$refh_data->{'CALLBA +CKFUNC'}}( $refo_vssitem , $refh_data->{'CALLBACKARGS'} , $refh_data->{'DIRRECURSFLAGS +'} , $refh_data->{'DIRRECURSITEMS +'} ); if ( $s_callreturn != 0 ) { $refh_data->{'CALLBACKFUNC'} = + undef; $refh_data->{'CALLBACKARGS'} = + undef; $refh_data->{'DIRRECURSFLAGS'} + = undef; $refh_data->{'DIRRECURSITEMS'} + = undef; $refh_data->{'INDIRRECURS'} = +0; $refh_data->{'PROJECTRECURS'} += 0; undef $refo_vssitem; undef @{$refh_data->{'ITEMSTAC +K'}}; undef @{$refh_data->{'DIRRECUR +SPAT'}}; return $s_return = $s_callretu +rn; } else { $s_return = $s_callreturn; $refh_data->{'PROJECTRECURS'} += 1; }; }; foreach $refo_vsssubitem ( in $refo_vssitem->{ +'Items'} ) { $s_eval = undef; $s_type = $refo_vsssubitem->{'Type'}; if ( $refh_const->{'VSSITEM_FILE'} == ( $refh_data->{'DIRRECURSITEMS +'} & $s_type )) { if ( !$refh_data->{'PROJECTREC +URS'} && ( $#{$refh_data->{' +DIRRECURSPAT'}} + 1 )) { $s_name = $refo_vsssub +item->{'Name'}; foreach $s_pattern ( @{$refh_data- +>{'DIRRECURSPAT'}} ) { last if ( $s_e +val = $s_nam +e =~ /^$s_pattern$/i ); }; } else { $s_eval = 1; }; if ( $s_eval ) { $s_callreturn = &{$ref +h_data->{'CALLBACKFUNC'}} ( $refo_vsssub +item , $refh_data-> +{'CALLBACKARGS'} , $refh_data-> +{'DIRRECURSFLAGS'} , $refh_data-> +{'DIRRECURSITEMS'} ); if ( $s_callreturn != +0 ) { $refh_data->{' +CALLBACKFUNC'} = undef; $refh_data->{' +CALLBACKARGS'} = undef; $refh_data->{' +DIRRECURSFLAGS'} = undef; $refh_data->{' +DIRRECURSITEMS'} = undef; $refh_data->{' +INDIRRECURS'} = 0; $refh_data->{' +PROJECTRECURS'} = 0; undef @{$refh_ +data->{'ITEMSTACK'}}; undef @{$refh_ +data->{'DIRRECURSPAT'}}; undef $refo_vs +ssubitem; undef $refo_vs +sitem; return $s_retu +rn = $s_callreturn; } else { $s_return = $s +_callreturn; }; }; }; if (( $refh_const->{'VSSITEM_PROJECT'} + == $s_type ) && ( $refh_data->{'DIRRECURSFLAGS +'} & $refh_const->{'VSSFLAG_RECUR +SYES'} )) { push (@{$refh_data->{'ITEMSTAC +K'}}, $refo_vsssubitem ); $s_callreturn = $refh_self->_d +irrecurse(); pop @{$refh_data->{'ITEMSTACK' +}}; if ( $s_callreturn != 0 ) { $refh_data->{'CALLBACK +FUNC'} = undef; $refh_data->{'CALLBACK +ARGS'} = undef; $refh_data->{'DIRRECUR +SFLAGS'} = undef; $refh_data->{'DIRRECUR +SITEMS'} = undef; $refh_data->{'INDIRREC +URS'} = 0; $refh_data->{'PROJECTR +ECURS'} = 0; undef @{$refh_data->{' +ITEMSTACK'}}; undef @{$refh_data->{' +DIRRECURSPAT'}}; undef $refo_vsssubitem +; undef $refo_vssitem; return $s_return = $s_ +callreturn; } else { $s_return = $s_callreturn +; }; }; }; undef $refo_vsssubitem; undef $refo_vssitem; if ( $#{ $refh_data->{'ITEMSTACK'}} < 0 ) { $refh_data->{'CALLBACKFUNC'} = undef; $refh_data->{'CALLBACKARGS'} = undef; $refh_data->{'DIRRECURSFLAGS'} = undef +; $refh_data->{'DIRRECURSITEMS'} = undef +; $refh_data->{'INDIRRECURS'} = 0; $refh_data->{'PROJECTRECURS'} = 0; undef @{$refh_data->{'ITEMSTACK'}}; undef @{$refh_data->{'DIRRECURSPAT'}}; }; } elsif ( $refh_const->{'VSSITEM_FILE'} == ( $refh_data->{'DIRRECURSITEMS'} & $s_type )) { $s_eval = undef; if ( $#$refh_data->{'DIRRECURSPAT'} + 1 ) { $s_name = $refo_vssitem->{'Name'}; foreach $s_pattern ( @{$refh_data->{'D +IRRECURSPAT'}} ) { last if ( $s_eval = $s_name =~ + /^$s_pattern$/i ); }; } else { $s_eval = 1; }; if ( $s_eval ) { $s_return = &{$refh_data->{'CALLBACKFU +NC'}}( $refo_vssitem , $refh_data->{'CALLBACKARGS'} , $refh_data->{'DIRRECURSFLAGS +'} , $refh_data->{'DIRRECURSITEMS +'} ); }; $refh_data->{'CALLBACKFUNC'} = undef; $refh_data->{'CALLBACKARGS'} = undef; $refh_data->{'DIRRECURSFLAGS'} = undef; $refh_data->{'DIRRECURSITEMS'} = undef; $refh_data->{'INDIRRECURS'} = 0; $refh_data->{'PROJECTRECURS'} = 0; undef $refo_vssitem; undef @{$refh_data->{'ITEMSTACK'}}; undef @{$refh_data->{'DIRRECURSPAT'}}; } else { $refh_data->{'CALLBACKARGS'} = undef; $refh_data->{'CALLBACKFUNC'} = undef; $refh_data->{'DIRRECURSFLAGS'} = undef; $refh_data->{'DIRRECURSITEMS'} = undef; $refh_data->{'INDIRRECURS'} = 0; $refh_data->{'PROJECTRECURS'} = 0; undef @{$refh_data->{'ITEMSTACK'}}; undef @{$refh_data->{'DIRRECURSPAT'}}; carp "VSSItem Type not identified in method ". +(caller(1))[3].". Error ". "was \"".$ar_hresult[2]."\".\n"; $s_return = -1; };

In reply to SSManager by Anonymous Monk

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Are you posting in the right place? Check out Where do I post X? to know for sure.
  • Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
    <code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
  • Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
  • Want more info? How to link or or How to display code and escape characters are good places to start.
Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others chilling in the Monastery: (5)
As of 2022-01-27 15:37 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    In 2022, my preferred method to securely store passwords is:












    Results (70 votes). Check out past polls.

    Notices?